'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5278] on 23 June 2003 at 5:39:13 pm'! "Change Set: BugFixArchive-UI-bkv Date: 10 May 2003 Author: Brent Vukmer This viewer is meant to be a handy tool for individual Squeakers to comment on proposed fixes and enhancements for Squeak. The BugFixArchiveViewer automates a good bit of the process of browsing to the Bug Fixes Archive, downloading a fix/enhancement changeset, evaluating the changeset, and posting a comment to the Squeak development email list. See http://minnow.cc.gatech.edu/squeak/3214 for the BugFixArchiveViewer changelog and other details about the project.." ! SystemWindow subclass: #AbstractPackageViewer instanceVariableNames: 'packagesList packagesListIndex filter ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-UI'! AbstractPackageViewer subclass: #BugFixArchiveViewer instanceVariableNames: 'groupSizeLimit nameRegexp emailRegexp titleOrBodyRegexp ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-UI'! !BugFixArchiveViewer commentStamp: 'bkv 5/10/2003 15:52' prior: 0! This viewer is meant to be a handy tool for individual Squeakers to comment on proposed fixes and enhancements for Squeak. The BugFixArchiveViewer automates a good bit of the process of browsing to the Bug Fixes Archive, downloading a fix/enhancement changeset, evaluating the changeset, and posting a comment to the Squeak development email list. An instance of BugFixArchiveViewer allows you to view a copy of the Bug Fixes Archive ( currently reachable over the Web by going to http://swiki.gsug.org/sqfixes ). You can open a BugFixArchiveViewer by going to the world menu, clicking on 'open', and then clicking on 'Bug Fix Archive Viewer', or you can execute the following code as a do-it: BugFixArchiveViewer open. This opens a viewer on the *default* local copy of the archive. (A BugFixArchiveViewer uses an instance of the BugFixArchive class as its model). If you want to investigate the default local copy used by the viewer, do: BugFixArchive default inspect. If you want to open a viewer on a *custom* copy of the archive, use: BugFixArchiveViewer openOn: aBugFixArchiveInstance. See the comments on the BugFixArchive class for further notes on how the local copy is initialized. The viewer offers the following services: 1.) The left-hand panel shows a filtered list of archive post titles. 2.) The mouse menu on the left-hand panel has several options for viewing archive changesets. 3.) The mouse menu also has several options for filtering the list. * if nothing is selected, everything is shown * if date-filters are selected, it filters out posts that don't match the date-filters * see BugFixArchiveViewer>>archivePostsList for more details 4.) The right-hand panel shows the details for the currently-selected archive post. Please note: the first time that you open a viewer, it will initialize the default local copy of the archive. This may take a while!! System Recomendations: Get the most current VM for your platform. I saw some weird socket errors when I was running the 3.2.2 Windows VM. They seem to have gone away with the 3.4.4 Windows VM. Dependencies: SMLoader MailSender BugFixArchive Scamper ( dependency for the model class, BugFixArchive ) HTTPSocket ( dependency for the model class, BugFixArchive ) SwikiProjectPageOrganizer ( dependency for the model class, BugFixArchive ) Developer Notes: TBD List: 1) Date filtering stuff should use *real Date objects*, not String match: 2) The loadUpdates method should probably run in background process 3) Add filter by title (get input from popup, use regexp) 4) Add filter by years (get input from popups) 5) Get rid of hard-coded filter-by-year methods ! SystemWindow subclass: #CommentNotePad instanceVariableNames: 'archivePost parentPost summaryComments mainComments ' classVariableNames: 'Blurb ' poolDictionaries: '' category: 'BugFixArchive-UI'! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'nk 6/17/2003 08:24'! filter filter ifNil: [ self initializeFilters ]. ^filter! ! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'bkv 5/30/2003 11:41'! filter: anObject "update my selection" | oldPackage index | oldPackage _ self selectedPackage. filter _ anObject. index _ self packageList indexOf: oldPackage. index ifNil: [ index _ 0 ]. self packagesListIndex: index. self noteChanged.! ! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'bkv 6/11/2003 18:16'! noteChanged packagesList _ nil. self changed: #packageNameList. self changed: #packagesListIndex. "update my selection" self contentsChanged.! ! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'bkv 5/30/2003 11:42'! packagesListIndex ^ packagesListIndex ifNil: [ 0 ]! ! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'bkv 5/30/2003 11:43'! packagesListIndex: anObject packagesListIndex _ anObject. self changed: #packagesListIndex. "update my selection" self contentsChanged.! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/30/2003 11:34'! filterAdd: anObject self filter: (self filter copyWith: anObject) ! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/30/2003 11:35'! filterRemove: anObject self filter: (self filter copyWithout: anObject) ! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/29/2003 23:34'! filterSpecs ^ self subclassResponsibility! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/29/2003 23:33'! labelForFilter: aFilterSymbol ^ (self filterSpecs detect: [:fs | fs second = aFilterSymbol]) first! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/29/2003 23:33'! showFilterString: aFilterSymbol ^ (self stateForFilter: aFilterSymbol), (self labelForFilter: aFilterSymbol)! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/29/2003 23:33'! stateForFilter: aFilterSymbol ^ (self filter includes: aFilterSymbol) ifTrue: [''] ifFalse: [''] ! ! !AbstractPackageViewer methodsFor: 'filter utilities' stamp: 'bkv 5/29/2003 23:33'! toggleFilterState: aFilterSymbol ^ (self filter includes: (aFilterSymbol)) ifTrue: [self filterRemove: aFilterSymbol] ifFalse: [self filterAdd: aFilterSymbol]! ! !AbstractPackageViewer methodsFor: 'filters' stamp: 'bkv 5/29/2003 23:35'! defaultFilters ^ { }! ! !AbstractPackageViewer methodsFor: 'filters' stamp: 'bkv 6/18/2003 13:47'! initializeFilters "Initial configuration" filter _ OrderedCollection new. self defaultFilters do: [ :selector | filter add: selector ].! ! !AbstractPackageViewer methodsFor: 'filters' stamp: 'bkv 6/18/2003 15:10'! nonUiFilters "Returns the filter selectors that are not included in the filterSpecs. By convention, such selectors are assumed to be always applicable, since there is no GUI for turning them off." ^ self filter difference: (self filterSpecs collect: [ :ea | ea second ])! ! !AbstractPackageViewer methodsFor: 'filters' stamp: 'bkv 6/18/2003 15:10'! uiEnabledFilters "Returns the filter selectors that currently selected in the UI" ^ self filter intersection: (self filterSpecs collect: [ :ea | ea second ]) ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/9/2003 22:34'! addFilters: aListOfFilters toMenu: aMenu | filterSymbol help | aListOfFilters do: [:filterArray | filterSymbol _ filterArray second. help _ filterArray third. aMenu addUpdating: #showFilterString: target: self selector: #toggleFilterState: argumentList: (Array with: filterSymbol). aMenu balloonTextForLastItem: help ].! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/9/2003 22:34'! addFiltersToMenu: aMenu self addFilters: self filterSpecs toMenu: aMenu.! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 5/30/2003 11:47'! addPackagesTo: window at: fractions plus: verticalOffset "Add the list for packages, and answer the verticalOffset plus the height added" | divider listMorph | listMorph _ self buildMorphicPackagesList. listMorph borderWidth: 0. divider _ BorderedSubpaneDividerMorph forBottomEdge. Preferences alternativeWindowLook ifTrue:[ divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2. ]. window addMorph: listMorph! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/4/2003 10:52'! addUpdateOptionsToMenu: aMenu aMenu addLine. aMenu add: 'load updates' target: self action: #loadUpdates. ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 5/30/2003 11:47'! buildMorphicPackagesList | list | (list _ PluggableListMorph new) on: self list: #packageNameList selected: #packagesListIndex changeSelected: #packagesListIndex: menu: #packagesMenu: keystroke: #packagesListKey:from:. ^ list! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 5/30/2003 11:47'! buildPackagePane | ptm | ptm _ PluggableTextMorph on: self text: #contents accept: nil readSelection: nil "#packageSelection " menu: nil. ptm lock. ^ ptm! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 22:57'! buildWindowMenu "This adds options to the tiny menu in the top (label) pane of the viewer." | aMenu | aMenu _ super buildWindowMenu. ( self displayUsingFilters ) ifTrue: [ aMenu addLine. self addFiltersToMenu: aMenu. ]. ( self isUpdatable ) ifTrue: [ self addUpdateOptionsToMenu: aMenu. ]. ^ aMenu! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/18/2003 19:03'! createWindow self addMorph: (self buildMorphicPackagesList borderWidth: 0) frame: self packageListFrame. self addMorph: (self buildPackagePane borderWidth: 0) frame: self packagePaneFrame. self on: #mouseEnter send: #paneTransition: to: self. self on: #mouseLeave send: #paneTransition: to: self. self setUpdatablePanesFrom: #(#packageNameList #selectedPackagesList). self setLabel: self windowLabel! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/18/2003 18:58'! packageListFrame ^ (0 @ 0 corner: 0.4 @ 1) ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 6/18/2003 18:58'! packagePaneFrame ^ (0.4 @ 0 corner: 1.0 @ 1.0) ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 5/30/2003 11:49'! perform: selector orSendTo: otherTarget "Selector was just chosen from a menu by a user. If can respond, then perform it on myself. If not, send it to otherTarget, presumably the editPane from which the menu was invoked." (self respondsTo: selector) ifTrue: [^ self perform: selector] ifFalse: [^ super perform: selector orSendTo: otherTarget]! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'bkv 5/30/2003 11:48'! windowLabel ^ self subclassResponsibility! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 5/29/2003 23:22'! collectPackageNames self subclassResponsibility. ! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 6/18/2003 15:56'! initializePackagesList "We are inclusive by default" "Filter based on the selectors that are turned on/off by the UI. Filter inclusively." packagesList _ self packages select: [:e | self uiEnabledFilters anySatisfy: [:currFilter | (self perform: currFilter) value: e ]]. "Filter based on the selectors that are *not* turned on/off by the UI. By convention, all such selectors are assumed to be always applicable -- so filter exclusively." packagesList _ packagesList select: [:e | self nonUiFilters allSatisfy: [:currFilter | (self perform: currFilter) value: e ]]. ^ packagesList ! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 6/11/2003 18:14'! packageList "We are inclusive by default" ^ packagesList ifNil: [ self initializePackagesList ] ! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 5/30/2003 11:45'! packageNameList ^ self collectPackageNames! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 5/30/2003 00:08'! packageSpecificOptions ^ self subclassResponsibility! ! !AbstractPackageViewer methodsFor: 'lists' stamp: 'bkv 6/9/2003 22:42'! packagesMenu: aMenu "Answer the packages-list menu" | choices | choices _ OrderedCollection new. choices addAll: self packageSpecificOptions. choices addAll: self generalOptions. aMenu addList: choices. ^aMenu! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 5/30/2003 11:43'! contents | package | package _ self selectedPackage. ^ package ifNil: [''] ifNotNil: [package fullDescription]! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 6/1/2003 14:51'! isUpdatable ^ self model notNil and: [ self model isUpdatable ]! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 6/23/2003 16:04'! on: aPackageModel self model: aPackageModel. self initializeFilters. ! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 5/29/2003 23:42'! packages ^ self subclassResponsibility ! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 6/4/2003 16:10'! selectedPackage ^ ((self packagesListIndex = 0) | (self packageList size < self packagesListIndex)) ifTrue: [ nil ] ifFalse: [ self packageList at: self packagesListIndex ]! ! !AbstractPackageViewer methodsFor: 'model' stamp: 'bkv 6/4/2003 15:58'! update: aParameter "Receive a change notice from an object of whom the receiver is a dependent" ((aParameter == #contentsChanged) or: [ aParameter == #noteChanged ]) ifTrue: [self perform: aParameter ]. super update: aParameter! ! !AbstractPackageViewer methodsFor: 'preferences' stamp: 'bkv 5/30/2003 12:22'! displayUsingFilters "Returns the value for the Preference for using filters to display the packagesList." ^ self class displayUsingFilters! ! !AbstractPackageViewer methodsFor: 'preferences' stamp: 'bkv 5/30/2003 12:22'! startupCacheMax "Returns the maximum number of cached packages to load." ^ self class startupCacheMax! ! !AbstractPackageViewer methodsFor: 'preferences' stamp: 'bkv 6/3/2003 21:53'! startupLoadMax ^ self class startupLoadMax! ! !AbstractPackageViewer methodsFor: 'preferences' stamp: 'bkv 5/30/2003 12:22'! updatesMax "This should be set as a property, not hard-coded. A 'max' of zero indicates that there is *no* max; load as many updates as are available." ^ self class updatesMax! ! !AbstractPackageViewer methodsFor: 'services' stamp: 'bkv 5/30/2003 10:07'! loadUpdates ^ self subclassResponsibility! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 5/29/2003 23:54'! defaultModel ^ self subclassResponsibility! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 5/29/2003 23:54'! new "Create a browser on the default model." ^self newOn: self defaultModel! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 5/30/2003 00:19'! newOn: model "Create a browser on model." ^ super new on: model; yourself! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 5/30/2003 10:02'! open "self open" self openOn: self defaultModel! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 16:08'! openOn: aModel | viewer | Cursor wait showWhile: [ viewer _ self newOn: aModel. viewer createWindow ]. viewer loadUpdates. viewer openInWorld. ^ viewer ! ! !AbstractPackageViewer class methodsFor: 'preferences' stamp: 'bkv 5/30/2003 12:21'! displayUsingFilters "Returns the value for the Preference for using filters to display the packagesList." ^ true! ! !AbstractPackageViewer class methodsFor: 'preferences' stamp: 'bkv 5/30/2003 14:43'! startupCacheMax "Returns the maximum number of cached packages to load." ^ 50! ! !AbstractPackageViewer class methodsFor: 'preferences' stamp: 'bkv 6/4/2003 14:47'! startupLoadMax ^ 500! ! !AbstractPackageViewer class methodsFor: 'preferences' stamp: 'bkv 5/30/2003 14:43'! updatesMax "This should be set as a property, not hard-coded. A 'max' of zero indicates that there is *no* max; load as many updates as are available." ^ 50! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! emailRegexp ^ emailRegexp ! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/19/2003 19:06'! emailRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. emailRegexp _ aString asString. self noteChanged. ^ aString! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:39'! groupSizeLimit "Returns the minimum size of ArchivePostGroup that is acceptable" ^ groupSizeLimit! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/19/2003 19:06'! groupSizeLimit: aNumber | number | (aNumber isText or: [ aNumber isString ]) ifTrue: [ (aNumber isEmptyOrNil not) ifTrue: [ number _ aNumber asString asNumber ]] ifFalse: [ number _ aNumber ]. (number notNil and: [ number > 0 ]) ifTrue: [ groupSizeLimit _ number. self noteChanged. ^ number ] ifFalse: [ ^ nil ].! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/18/2003 20:30'! groupSizeLimitString "Returns the minimum size of ArchivePostGroup that is acceptable, as a String" ^ self groupSizeLimit asString! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! nameRegexp ^ nameRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/19/2003 19:06'! nameRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. nameRegexp _ aString asString. self noteChanged. ^ aString! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! titleOrBodyRegexp ^ titleOrBodyRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/19/2003 19:06'! titleOrBodyRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. titleOrBodyRegexp _ aString asString. self noteChanged. ^ aString! ! !BugFixArchiveViewer methodsFor: 'filter utilities' stamp: 'bkv 6/10/2003 08:39'! defaultFilters ^ #( filterShowFixes filterShowEnhancements filterGroupForAuthorEmailMatch filterGroupForAuthorNameMatch filterGroupForSizeLimit filterGroupForTitleOrBodyMatch )! ! !BugFixArchiveViewer methodsFor: 'filter utilities' stamp: 'bkv 6/19/2003 19:08'! initializeFilters super initializeFilters. titleOrBodyRegexp _ self defaultRegexp. nameRegexp _ self defaultRegexp. emailRegexp _ self defaultEmailRegexp. groupSizeLimit _ self defaultSizeFilter. "Reset the regexp PluggableTextMorphs" self submorphsDo: [ :morph | (morph respondsTo: #cancel) ifTrue: [ morph cancel ]]. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'filter utilities' stamp: 'bkv 6/18/2003 15:54'! statusFilters ^ self currentStatusFilterSelectors ! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/18/2003 13:56'! currentStatusFilterSelectors ^ self defaultStatusFilterSelectors intersection: self filter ! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/6/2003 21:32'! defaultSizeFilter "A group has to have at least one post to exist." ^ 1 ! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/18/2003 13:53'! defaultStatusFilterSelectors ^ self harvestingStatusSpecs collect: [ :ea | ea second ] ! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/10/2003 08:45'! filterGroupForApprovedStatus ^ [ :archivePostGroup | archivePostGroup isMarkedAsApproved or: [ (archivePostGroup posts select: [ :any | '*approve*' match: any title ]) notEmpty]]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/4/2003 15:42'! filterGroupForAuthorEmailMatch ^ [ :archivePostGroup | archivePostGroup authorEmailMatches: self emailRegexp ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/4/2003 15:41'! filterGroupForAuthorNameMatch ^ [ :archivePostGroup | archivePostGroup authorNameMatches: self nameRegexp ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/10/2003 08:45'! filterGroupForClosedStatus "We want to be relaxed about the input we accept ( but strict about what we emit from CommentNotePad, of course ). Parse at all costs -- don't be fussy here." ^ [ :archivePostGroup | archivePostGroup isMarkedAsClosed or: [ (archivePostGroup posts select: [ :any | '*closed*' match: any title ]) notEmpty ]]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/4/2003 15:41'! filterGroupForSizeLimit ^ [ :archivePostGroup | archivePostGroup sizeMatches: self groupSizeLimit ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/4/2003 15:41'! filterGroupForTitleOrBodyMatch ^ [ :archivePostGroup | archivePostGroup titleOrBodyMatches: self titleOrBodyRegexp ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/10/2003 07:41'! filterGroupForUpdateStreamStatus "We want to be relaxed about the input we accept ( but strict about what we emit from CommentNotePad, of course ). Parse at all costs -- don't be fussy here." ^ [ :archivePostGroup | archivePostGroup isMarkedAsUpdate or: [ (archivePostGroup allPosts select: [ :ea | '*update -*' match: ea title ]) notEmpty ]]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:24'! filterShowAnnouncements ^ [ :group | group isAnnouncement ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:25'! filterShowBugs ^ [ :group | group isBugOnly ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:25'! filterShowEnhancements ^ [ :group | group isEnhancement ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:25'! filterShowFixes ^ [ :group | group isFix ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:25'! filterShowGoodies ^ [ :group | group isGoodie ]! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/18/2003 13:55'! filterSpecs "Specs for filters that get turned on and off." ^ (self postTypeFilterSpecs asOrderedCollection addAll: self harvestingStatusSpecs; yourself) asArray ! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:43'! harvestingStatusSpecs "Specs for filters that get turned on and off." ^#( #('show approved groups' filterGroupForApprovedStatus 'Include/exclude groups marked with an [approved] tag.') #('show closed groups' filterGroupForClosedStatus 'Include/exclude groups marked with a [closed] tag.') #('show groups that have been assigned an update number' filterGroupForUpdateStreamStatus 'Include/exclude groups marked with an [update - *] tag.') )! ! !BugFixArchiveViewer methodsFor: 'group filters' stamp: 'bkv 6/9/2003 21:43'! postTypeFilterSpecs "Specs for filters that get turned on and off." ^#( #('show announcements' filterShowAnnouncements 'show [ANN] posts') #('show bugs' filterShowBugs 'show [BUG] posts') #('show enhancements' filterShowEnhancements 'show [ENH] posts') #('show fixes ' filterShowFixes 'show [FIX] posts') #('show goodies ' filterShowGoodies 'show [GOODIE] posts') )! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'bkv 6/6/2003 21:30'! defaultEmailRegexp ^ '*@*' ! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'bkv 6/6/2003 21:30'! defaultRegexp ^ '*' ! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'nk 6/17/2003 08:31'! setEmailRegexp | answer initialAnswer | initialAnswer _ self emailRegexp ifNil: [ self defaultEmailRegexp ]. answer _ FillInTheBlankMorph request: 'Author email to match:' initialAnswer: initialAnswer centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: self emailRegexp acceptOnCR: true. [ ((answer isEmptyOrNil not) and: [ answer ~= self emailRegexp ]) ifTrue: [ self emailRegexp: answer. ]] on: Error do: [ self inform: 'Can''t proceed..' ]. ! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'nk 6/17/2003 08:31'! setNameRegexp | answer initialAnswer | initialAnswer _ self nameRegexp ifNil: [ self defaultRegexp ]. answer _ FillInTheBlankMorph request: 'Author name to match:' initialAnswer: initialAnswer centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: self nameRegexp acceptOnCR: true. [ ((answer isEmptyOrNil not) and: [ answer ~= self nameRegexp ]) ifTrue: [ self nameRegexp: answer. ]] on: Error do: [ self inform: 'Can''t proceed..' ]. ! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'bkv 6/4/2003 16:26'! setSizeFilter | answer newSize | answer _ FillInTheBlankMorph request: 'Minimum number of posts in a group:' initialAnswer: self groupSizeLimit asString centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: self groupSizeLimit asString acceptOnCR: true. [ newSize _ answer asNumber. ((newSize ~= self groupSizeLimit) and: [ newSize >= 0]) ifTrue: [ self groupSizeLimit: newSize. ]] on: Error do: [ self inform: 'Can''t proceed; ', answer, ' is not a number.' ]. ! ! !BugFixArchiveViewer methodsFor: 'group-specific services' stamp: 'nk 6/17/2003 08:31'! setTitleOrBodyRegexp | answer initialAnswer | initialAnswer _ self titleOrBodyRegexp ifNil: [ self defaultRegexp. ]. answer _ FillInTheBlankMorph request: 'Title or body text to match:' initialAnswer: initialAnswer centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: self titleOrBodyRegexp acceptOnCR: true. [ ((answer isEmptyOrNil not) and: [ answer ~= self titleOrBodyRegexp ]) ifTrue: [ self titleOrBodyRegexp: answer. ]] on: Error do: [ self inform: 'Can''t proceed..' ]. ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/9/2003 22:36'! addFiltersToMenu: aMenu self addFilters: self harvestingStatusSpecs toMenu: aMenu. aMenu addLine. self addFilters: self postTypeFilterSpecs toMenu: aMenu.! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/4/2003 15:18'! addUpdateOptionsToMenu: aMenu super addUpdateOptionsToMenu: aMenu. aMenu add: 'load previous posts going back..' target: self action: #loadPreviousPosts. ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:33'! buildEmailRegexpPane ^ self buildListControlSubPaneUsing: { 'Author email:'. #emailRegexp. #emailRegexp:. 'Filter by all or part of an author''s email address..'. } ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:32'! buildGroupSizeLimitPane ^ self buildListControlSubPaneUsing: { 'Number of posts:'. #groupSizeLimitString. #groupSizeLimit:. 'Filter by a minimum number of posts..'. }! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 18:30'! buildListControlSubPaneUsing: aTuple | ptm | ptm _ PluggableTextMorph on: self text: (aTuple at: 2) accept: (aTuple at: 3). ptm setBalloonText: (aTuple at: 4). ptm acceptOnCR: true. ptm hideScrollBarIndefinitely. ptm color: Color white. ^ ptm! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:32'! buildNameRegexpPane ^ self buildListControlSubPaneUsing: { 'Author name:'. #nameRegexp. #nameRegexp:. 'Filter by all or part of an author''s name..'. } ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:32'! buildTitleOrBodyRegexpPane ^ self buildListControlSubPaneUsing: { 'Text in title or body:'. #titleOrBodyRegexp. #titleOrBodyRegexp:. 'Filter by text in title or body..'. }! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:21'! createWindow self addMorph: (self buildNameRegexpPane borderWidth: 1) frame: self nameRegexpPaneFrame. self addMorph: (self buildEmailRegexpPane borderWidth: 1) frame: self emailRegexpPaneFrame. self addMorph: (self buildTitleOrBodyRegexpPane borderWidth: 1) frame: self titleOrBodyRegexpPaneFrame. self addMorph: (self buildGroupSizeLimitPane borderWidth: 1) frame: self groupSizeLimitPaneFrame. super createWindow.! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:15'! emailRegexpPaneFrame ^ (0.25 @ 0.025 corner: 0.35 @ 0.075)! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:15'! groupSizeLimitPaneFrame ^ (0.65 @ 0.025 corner: 0.75 @ 0.075)! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:15'! nameRegexpPaneFrame ^ (0.05 @ 0.025 corner: 0.15 @ 0.075)! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 18:45'! packageListFrame ^ (0 @ 0.1 corner: 1.0 @ 0.7) ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/18/2003 19:57'! packagePaneFrame ^ (0 @ 0.7 corner: 1.0 @ 1.0) ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 5/9/2003 13:42'! paneColor ^ Color green darker duller! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 19:15'! titleOrBodyRegexpPaneFrame ^ (0.45 @ 0.025 corner: 0.55 @ 0.075)! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/19/2003 18:37'! windowLabel ^'Bug Fixes Archive Viewer'! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 6/1/2003 14:46'! collectPackageNames "Might want to toggle back and forth between flat list of archive posts ( listed by title ) and topic-groups ( listed by group topic ). Right now we assume topic groups." ^ self packageList collect: [:e | e groupDisplayLabel ]! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 6/22/2003 18:06'! generalOptions ^#( #( 'open comments note pad' createComment 'Compose a comment on this post, for the author or for the list.' ) #- #( 'load updates' #loadUpdates 'load the most recent updates to this archive.' ) #- #( 'reset all filters' #initializeFilters 'reset all filters to their default settings.' ) #- #( 'reload this post' reloadPost 'Reload this post from the Bug Fixes Archive.' ) #( 'import post with UID' importUidForSelectedBaseUrl 'Import a post with the given UID.' ) #( 'explore this post' explorePost 'Open an ObjectExplorer on this post.' ) )! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 6/18/2003 15:17'! initializePackagesList "We are inclusive by default. Apply exclusive filters at the end." | list filteredGroups | list _ OrderedCollection new. filteredGroups _ super initializePackagesList. filteredGroups isEmptyOrNil ifTrue: [ ^ list ]. filteredGroups _ filteredGroups select: [ :fg | fg hasNoStatus or: [ self statusFilters anySatisfy: [ :selector | (self perform: selector) value: fg ]]]. filteredGroups do: [ :group | list addAll: group allPosts ]. packagesList _ list. ^ packagesList! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 5/30/2003 00:15'! packageSpecificOptions | choices | self selectedPackage ifNil: [ ^ #() ]. choices _ OrderedCollection new. (self selectedPackage hasAttachments) ifTrue: [ choices add: #( 'view attachments' viewPostAttachments 'Open a file explorer to this post''s attachments.' ) ]. ^choices! ! !BugFixArchiveViewer methodsFor: 'model' stamp: 'bkv 6/9/2003 21:18'! packages "We request the model's posts grouped by topic and sorted by UID in descending order." ^ self model archivePostGroups! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/22/2003 17:33'! createComment ^ CommentNotePad openOn: self selectedPackage! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/3/2003 22:37'! explorePost self selectedPackage explore. ! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/4/2003 17:49'! importUidForSelectedBaseUrl | answer uid | self selectedPackage ifNil: [ self inform: 'No package selected.' ]. answer _ FillInTheBlankMorph request: 'Enter a UID for a post that you would like to import into this post''s group:' initialAnswer: 2627 asString centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: 0 asString acceptOnCR: true. [ uid _ answer asNumber. ] on: Error do: [ self inform: 'Can''t proceed; ', answer, ' is not a number.' ]. (uid > 0) ifTrue: [ | url archivePost | url _ self selectedPackage postUrl asString. url _ url copyFrom: 1 to: (url lastIndexOf: $/). url _ (url, uid asString, '.txt') asUrl. archivePost _ self model archivePostFromUrl: url. self model addArchivePost: archivePost. self noteChanged. ] ! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/20/2003 08:44'! mailAuthor | notePad | notePad _ CommentNotePad on: self selectedPackage. notePad mailCommentsToAuthor. ! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/20/2003 08:44'! mailList | notePad | notePad _ CommentNotePad on: self selectedPackage. notePad mailCommentsToList. ! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 5/29/2003 23:29'! reloadPost Cursor wait showWhile: [ self selectedPackage reload ]. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 5/29/2003 23:29'! removePost self model removeArchivePost: self selectedPackage. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/3/2003 22:25'! viewPostAttachments "Open a file explorer to this post's attachments." | dir aLabel | self selectedPackage ifNil: [ ^nil ]. dir _ self selectedPackage attachmentsDirectory. dir isNil ifTrue: [ ^ self inform: 'This post doesn''t have any attachments.' ]. aLabel _ self selectedPackage title, ' -- Attachments'. (FileList2 morphicViewOn: dir withLabel: aLabel) openInWorld.! ! !BugFixArchiveViewer methodsFor: 'preferences' stamp: 'bkv 5/30/2003 14:29'! asyncLoadUpdates "Should be made a Preference" ^ false "I haven't figured out how to do the asynchronous stuff very well yet." ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/4/2003 17:09'! loadPreviousPosts | answer numPosts | answer _ FillInTheBlankMorph request: 'Number of previous archive posts to load:' initialAnswer: self updatesMax asString centerAt: Sensor cursorPoint inWorld: self world onCancelReturn: '-1' acceptOnCR: true. [ numPosts _ answer asNumber. ] on: Error do: [ self inform: 'Can''t proceed; ', answer, ' is not a number.' ]. numPosts ifNotNil: [ (numPosts > 0) ifTrue: [ self loadPreviousStopAfter: numPosts ]].! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/4/2003 17:07'! loadPreviousStopAfter: maxUpdates Cursor write showWhile: [ self model loadPreviousStopAfter: maxUpdates ]. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 5/30/2003 11:24'! loadTheWholeEnchilada ^ self loadUpdatesStopAfter: 0 ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/3/2003 21:54'! loadUpdates | limit | ( self packages size == 0 ) ifTrue: [ limit _ self startupLoadMax ] ifFalse: [ limit _ self updatesMax ]. self loadUpdatesStopAfter: limit. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/1/2003 21:37'! loadUpdatesAsynchronouslyStopAfter: maxUpdates | msg | msg _ String streamContents: [ :stream | stream nextPutAll: 'Loading '. ( maxUpdates > 0 ) ifTrue: [ stream nextPutAll: maxUpdates asString. stream nextPut: Character space. ]. stream nextPutAll: 'updates as a background task...' ]. WorldState addDeferredUIMessage: [ self inform: msg ]. [ self model loadUpdatesStopAfter: maxUpdates. WorldState addDeferredUIMessage: (MessageSend receiver: self selector: #contentsChanged). ] forkAt: Processor userBackgroundPriority! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 5/30/2003 12:31'! loadUpdatesStopAfter: maxUpdates ^ ( self asyncLoadUpdates ) ifTrue: [ self loadUpdatesAsynchronouslyStopAfter: maxUpdates ] ifFalse: [ self loadUpdatesSynchronouslyStopAfter: maxUpdates ]. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/23/2003 16:03'! loadUpdatesSynchronouslyStopAfter: maxUpdates Cursor wait showWhile: [ self model loadUpdatesStopAfter: maxUpdates ]. self noteChanged.! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/4/2003 19:16'! initialize "BugFixArchiveViewer initialize." (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ TheWorldMenu registerOpenCommand: { self menuRegistrationKey. {self. #open}} ].! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/4/2003 19:15'! menuRegistrationKey ^'Bug Fixes Archive Viewer'! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/4/2003 19:16'! removeFromSystem (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ TheWorldMenu unregisterOpenCommand: self menuRegistrationKey ]. super removeFromSystem. ! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 09:55'! defaultModel ^ BugFixArchive gsugSwikiFixesArchive! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/1/2003 21:38'! openOn: aBugFixArchive withStartupDirectory: aDirectory "By convention aDirectory is assumed to contain text files that can be converted into MailMessage objects." | emailFileRepository | emailFileRepository _ EmailFileRepository onDirectory: aDirectory. aBugFixArchive repository: emailFileRepository. ^ super openOn: aBugFixArchive! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 09:54'! viewGsugSwikiArchive "BugFixArchiveViewer viewGsugSwikiArchive" self openOn: BugFixArchive gsugSwikiArchive.! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 09:54'! viewGsugSwikiFixesArchive "BugFixArchiveViewer viewGsugSwikiFixesArchive" self openOn: BugFixArchive gsugSwikiFixesArchive.! ! !CommentNotePad methodsFor: 'accessing'! archivePost ^ archivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/22/2003 17:27'! archivePost: anArchivePost archivePost _ anArchivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/22/2003 19:14'! attachments self archivePost ifNil: [ ^ nil ]. ^ self archivePost attachments! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/23/2003 13:56'! attachments: aStringOfCommaDelimitedFileNames | fileNames | self archivePost ifNil: [ ^ nil ]. aStringOfCommaDelimitedFileNames isEmptyOrNil ifTrue: [ ^ nil ]. fileNames _ aStringOfCommaDelimitedFileNames asString findTokens: { Character cr. }. self archivePost attachments: fileNames. ! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/23/2003 12:25'! mainComments ^ mainComments! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/22/2003 17:27'! mainComments: aString mainComments _ aString! ! !CommentNotePad methodsFor: 'accessing'! parentPost ^ parentPost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/22/2003 17:28'! parentPost: anArchivePost parentPost _ anArchivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/23/2003 12:27'! qaTags self archivePost ifNil: [^ nil]. ^ self archivePost qaTags! ! !CommentNotePad methodsFor: 'accessing'! summaryComments ^ summaryComments! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/23/2003 12:17'! summaryComments: aString aString isNil ifTrue: [ ^ nil ]. summaryComments _ aString asString copyWithoutAll: '()'! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 18:58'! attachmentFileNamesFrame ^ 0 @ 0.85 corner: 1.0 @ 1.0! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 19:15'! buildAttachmentFileNamesPane ^ self buildTextPaneUsing: {'Attachment file names:'. #attachments. #attachments:. 'Enter attachment file names, separated by commas..'}! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 13:26'! buildMainCommentsPane ^ self buildTextPaneUsing: {'Main comments:'. #mainComments. #mainComments:. 'Enter detailed comments ( like ''Needs tests'' )..'} ! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 18:27'! buildQaTagsPane | notePad | notePad _ MenuMorph new defaultTarget: self. ArchivePost harvestingTagSpecs do: [:spec | notePad addUpdating: #includeQaTagString: target: self selector: #addOrRemoveQaTag: argumentList: (Array with: spec second asSymbol). notePad balloonTextForLastItem: spec third]. notePad toggleCornerRounding. notePad toggleStickiness. notePad stayUp: true. ^ notePad! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 12:13'! buildSummaryCommentsPane ^ self buildTextPaneUsing: {'Summary comments:'. #summaryComments. #summaryComments:. 'Enter brief summary comments ( like ''Needs tests'' )..'}! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 13:27'! buildTextPaneUsing: anArray "Right now we don't accept changes to the text pane on CR, because it doesn't seem as usable." ^ self buildTextPaneUsing: anArray acceptOnCR: false! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 13:26'! buildTextPaneUsing: anArray acceptOnCR: aBoolean | ptm | ptm _ PluggableTextMorph on: self text: (anArray at: 2) accept: (anArray at: 3) readSelection: nil menu: #codePaneMenu:shifted:. ptm setBalloonText: (anArray at: 4). ptm acceptOnCR: aBoolean. ptm hideScrollBarIndefinitely. ptm color: Color white. ^ ptm! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 18:04'! codePaneMenu: aMenu shifted: shifted "Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items" ^ StringHolder basicNew codePaneMenu: (self notePadMenu: aMenu) shifted: shifted! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 18:59'! createWindow self addMorph: (self buildQaTagsPane borderWidth: 0) frame: self qaTagsFrame. self addMorph: (self buildSummaryCommentsPane borderWidth: 0) frame: self summaryCommentsFrame. self addMorph: (self buildMainCommentsPane borderWidth: 0) frame: self mainCommentsFrame. self addMorph: (self buildAttachmentFileNamesPane borderWidth: 0) frame: self attachmentFileNamesFrame. self on: #mouseEnter send: #paneTransition: to: self. self on: #mouseLeave send: #paneTransition: to: self. self setLabel: self windowLabel! ! !CommentNotePad methodsFor: 'gui building'! helpWindow ^ (StringHolder new contents: self helpText) openLabel: 'Help on using the CommentNotePad'! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 18:59'! mainCommentsFrame ^ 0 @ 0.25 corner: 1.0 @ 0.85! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 20:26'! notePadMenu: aMenu aMenu add: 'send to list' target: self action: #mailCommentsToList. self parentPost ifNotNil: [aMenu add: 'send to archive-post author' target: self action: #mailCommentsToAuthor]. aMenu addLine. aMenu add: 'help' target: self action: #helpWindow. aMenu addLine. aMenu add: 'open as email to list' target: self action: #openCommentsAsMailToList. self parentPost ifNotNil: [aMenu add: 'open as email to archive-post author' target: self action: #openCommentsAsMailToAuthor]. aMenu addLine. ^ aMenu! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 12:22'! paneColor ^ self class paneColor! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 17:53'! qaTagsFrame ^ 0 @ 0 corner: 0.25 @ 0.25! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/22/2003 17:53'! summaryCommentsFrame ^ 0.25 @ 0 corner: 1.0 @ 0.25! ! !CommentNotePad methodsFor: 'gui building' stamp: 'bkv 6/23/2003 12:24'! windowLabel self archivePost isNil ifTrue: [^ 'Comment for Bug Fixes Archive']. ^ self archivePost title! ! !CommentNotePad methodsFor: 'initialization' stamp: 'bkv 6/23/2003 12:13'! on: anArchivePost self parentPost: anArchivePost. self parentPost isNil ifTrue: [archivePost _ ArchivePost new initialize] ifFalse: [archivePost _ ArchivePost new title: (ArchivePostGroup topicContentFrom: parentPost title)]! ! !CommentNotePad methodsFor: 'printing' stamp: 'bkv 6/22/2003 17:29'! formatSummaryCommentsWithTags (self qaTags isEmptyOrNil and: [self summaryComments isEmptyOrNil]) ifTrue: [^ '']. ^ String streamContents: [:stream | stream nextPut: $(. stream nextPut: Character space. self qaTags do: [:tag | stream nextPutAll: tag ]. self summaryComments isEmptyOrNil ifFalse: [ stream nextPut: Character space. stream nextPutAll: self summaryComments]. stream nextPut: Character space. stream nextPut: $)]! ! !CommentNotePad methodsFor: 'printing'! helpText ^ self class helpText! ! !CommentNotePad methodsFor: 'qa tags' stamp: 'bkv 6/22/2003 17:25'! addOrRemoveQaTag: aSymbol | flag tag | flag _ aSymbol asSymbol. tag _ self archivePost tagForQaFlag: flag. (self qaTags includes: tag) ifTrue: [self archivePost removeQaTag: tag] ifFalse: [self archivePost addQaTag: tag]! ! !CommentNotePad methodsFor: 'qa tags' stamp: 'bkv 6/22/2003 17:26'! includeQaTagString: aString ^ (self stateForQaFlag: aString) , (self labelForQaFlag: aString)! ! !CommentNotePad methodsFor: 'qa tags' stamp: 'bkv 6/22/2003 17:26'! labelForQaFlag: aSymbol ^ (ArchivePost harvestingTagSpecs detect: [:spec | spec second == aSymbol asSymbol]) first! ! !CommentNotePad methodsFor: 'qa tags' stamp: 'bkv 6/22/2003 17:27'! stateForQaFlag: aSymbol | tag | self qaTags ifNil: [^ nil]. tag _ self archivePost tagForQaFlag: aSymbol. ^ (self qaTags includes: tag) ifTrue: [''] ifFalse: ['']! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/23/2003 14:15'! addAttachmentsTo: aMailMessage aMailMessage ifNil: [ ^ nil ]. self attachments isEmptyOrNil ifTrue: [ ^ aMailMessage ]. self attachments do: [ :fileName | | file fullFileName | fullFileName _ FileDirectory default fullNameFor: fileName withBlanksTrimmed. file _ FileStream readOnlyFileNamed: fullFileName. file ifNotNil: [file binary. aMailMessage regenerateText. aMailMessage addAttachmentFrom: file withName: file localName. aMailMessage regenerateText. file close]]. ^ aMailMessage! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/23/2003 12:33'! blurb ^ self class blurb! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/2/2003 13:52'! editSummaryComments commentsHolder openLabel: 'Edit Summary Comments'. ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/2/2003 13:27'! editTitle self window relabel. self archivePost title: self window label. ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/23/2003 14:37'! mailCommentsTo: anEmailAddressString | aTitle windowLabel parensComments from to body messageStrm mailMsg mailMan | parensComments _ self formatSummaryCommentsWithTags. "Make sure that the archivePost title is set correctly, if this is a new post with no parent". self parentPost ifNil: [self label ifNotNil: [ windowLabel _ self label. ]. windowLabel isEmptyOrNil ifTrue: [ aTitle _ parensComments. ] ifFalse: [ aTitle _ windowLabel. self archivePost title: aTitle. ]]. (aTitle _ self archivePost title) isNil ifTrue: [ aTitle _ '' ]. body _ self mainComments. from _ MailSender userName. from isEmptyOrNil ifTrue: [ from _ '' ]. to _ anEmailAddressString. to isNil ifTrue: [ to _ '' ]. body ifNil: [ body _ ''. ]. "Prepare the message" messageStrm _ WriteStream on: (String new: 1500). messageStrm nextPutAll: 'From: '; nextPutAll: from; cr; nextPutAll: 'To: ', to; cr; nextPutAll: 'Subject: '; nextPutAll: aTitle; nextPut: Character space; nextPutAll: parensComments; cr;cr; nextPutAll: body; cr;cr; cr;cr; cr;cr; cr;cr; cr;cr; cr;cr; cr;cr; nextPutAll: self blurb. "Make sure to add attachments if there are any" mailMsg _ self addAttachmentsTo: (MailMessage from: messageStrm contents). mailMan _ self mailServiceProvider sendMailMessage: mailMsg. ^ mailMan ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 20:23'! mailCommentsToAuthor | emailAddress mailMan | parentPost ifNil: [^ nil]. emailAddress _ parentPost authorEmail. emailAddress isEmptyOrNil ifTrue: [ emailAddress _ '< Email address unknown >' ]. mailMan _ self mailCommentsTo: emailAddress. mailMan submit. self delete.! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 20:24'! mailCommentsToList | mailMan | mailMan _ self mailCommentsTo: 'squeak-dev@lists.squeakfoundation.org'. mailMan submit. self delete.! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 17:31'! mailServiceProvider | provider | provider _ Smalltalk at: #MailSender. provider isNil ifTrue: [^ nil]. ^ provider default! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 20:22'! openCommentsAsMailToAuthor | emailAddress | parentPost ifNil: [^ nil]. emailAddress _ parentPost authorEmail. emailAddress isEmptyOrNil ifTrue: [ emailAddress _ '< Email address unknown >' ]. self mailCommentsTo: emailAddress! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 20:22'! openCommentsAsMailToList self mailCommentsTo: 'squeak-dev@lists.squeakfoundation.org'! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/22/2003 17:31'! perform: aSelector orSendTo: aReceiver (self respondsTo: aSelector) ifTrue: [^ self perform: aSelector]. ^ super perform: aSelector orSendTo: aReceiver! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/2/2003 12:13'! title self archivePost ifNil: [ ^ nil ]. ^ self archivePost title ! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 12:14'! on: anArchivePost "Setup the CommentNotePad to create a reply to anArchivePost." ^ self new on: anArchivePost; yourself ! ! !CommentNotePad class methodsFor: 'instance creation'! open self openOn: nil! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 12:15'! openOn: anArchivePost (self on: anArchivePost) createWindow; openInWorld! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 12:22'! paneColor ^ (Color r: 0.0 g: 0.452 b: 0.677)! ! !CommentNotePad class methodsFor: 'utilities' stamp: 'bkv 6/23/2003 12:23'! bugFixingMachineBlurb ^ String streamContents: [:strm | strm nextPutAll: '< I''m a bug-fixing machine!! >'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: 'This post brought to you by the BugFixArchiveViewer, a handy tool that makes it easy to comment on proposed fixes and enhancements for Squeak.'. strm nextPutAll: ' For more information, check out the Web page for the BugFixArchiveViewer project: http://minnow.cc.gatech.edu/squeak/3214 '. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: '< I''m a bug-fixing machine!! >']! ! !CommentNotePad class methodsFor: 'utilities' stamp: 'bkv 6/23/2003 17:32'! helpText ^ String streamContents: [:strm | strm nextPutAll: 'Step 1: Create a brief summary comment ( i.e., ''Needs SUnit tests'' or ''Design suggestions'')'; nextPut: Character cr; nextPutAll: 'Step 2: Set the harvesting tags for your post.'; nextPut: Character cr; nextPutAll: 'Step 4: Compose your summary comments (''Needs tests'', for example ); do ''accept'' to save your summary comments.'; nextPut: Character cr; nextPutAll: 'Step 4: Compose your detailed comments, including code snippets; do ''accept'' to save your detailed comments.'; nextPut: Character cr; nextPutAll: 'Step 5: Add attachment file names, separated by CRs; do ''accept'' to save the attachment file names.'; nextPut: Character cr; nextPutAll: 'Step 6a: *Optional* If you want, open your comments in the default email client to check that everything is setup correctly.'; nextPut: Character cr; nextPutAll: 'Step 6b: Send your comments to the Squeak list, or to the author of the fix/enhancement you are reviewing.'; yourself]! ! !CommentNotePad class methodsFor: 'utilities' stamp: 'bkv 6/23/2003 12:34'! longBugFixingMachineBlurb ^ String streamContents: [ :strm | strm nextPutAll: '< I''m a bug-fixing machine!! >'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: 'This post brought to you by the BugFixArchiveViewer, a handy tool that makes it easy to comment on proposed fixes and enhancements for Squeak. The BugFixArchiveViewer enables you to browse the Bug Fixes Archive, evaluate the changeset(s) for a given post, and correctly post a comment to the Bug Fixes Archive -- all from within the Squeak image.'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPut: Character tab. strm nextPutAll: 'Bug Fixes Archive on the Web -> http://swiki.gsug.org/sqfixes'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPut: Character tab. strm nextPutAll: 'Guidelines for reporting bugs and fixes -> http://minnow.cc.gatech.edu/squeak/398'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPut: Character tab. strm nextPutAll: 'Do-it for installing the BugFixArchiveViewer from SqueakMap:'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPut: Character tab. strm nextPut: Character tab. strm nextPutAll: '{ ''8f502bf8-63bf-43e4-9b85-ec7870ceebac''. ''0a52d654-0b9a-4e1d-abfa-ce8d0f320cfb''. }'. strm nextPut: Character cr. strm nextPut: Character tab. strm nextPut: Character tab. strm nextPut: Character tab. strm nextPutAll: 'do: [ :uuid | SMSqueakMap default installPackageWithId: uuid ].'. strm nextPut: Character cr. ]. ! ! !CommentNotePad class methodsFor: 'utilities' stamp: 'bkv 6/23/2003 12:34'! miniBlurb ^ String streamContents: [ :strm | strm nextPutAll: '< Brought to you by '. self parentPost ifNotNil: [ strm nextPutAll: 'the BugFixArchiveViewer and '. ]. strm nextPutAll: 'CommentNotePad >'. strm nextPut: Character cr. ] ! ! !CommentNotePad class methodsFor: 'utilities' stamp: 'bkv 6/23/2003 12:35'! miniBugFixingMachineBlurb ^ String streamContents: [ :strm | strm nextPutAll: '< I''m a bug-fixing machine!! >'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: 'This post brought to you by the BugFixArchiveViewer, a handy tool that makes it easy to comment on proposed fixes and enhancements for Squeak.'. strm nextPutAll: ' For more information, check out the Web page for the BugFixArchiveViewer project: http://minnow.cc.gatech.edu/squeak/3214 '. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: '< I''m a bug-fixing machine!! >'. ]. ! ! !CommentNotePad class methodsFor: 'class initialization' stamp: 'bkv 6/23/2003 12:37'! blurb Blurb ifNil: [ self initialize ]. ^ Blurb! ! !CommentNotePad class methodsFor: 'class initialization' stamp: 'bkv 6/23/2003 14:23'! initialize "CommentNotePad initialize." Blurb _ self bugFixingMachineBlurb. (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ TheWorldMenu registerOpenCommand: { self menuRegistrationKey. {self. #open}} ].! ! !CommentNotePad class methodsFor: 'class initialization' stamp: 'bkv 6/23/2003 14:24'! menuRegistrationKey ^ 'Reviewer Comments Note Pad'! ! !CommentNotePad class methodsFor: 'class initialization' stamp: 'bkv 6/23/2003 14:24'! removeFromSystem (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ TheWorldMenu unregisterOpenCommand: self menuRegistrationKey ]. super removeFromSystem.! ! !FileList2 class methodsFor: 'morphic ui' stamp: 'bkv 5/30/2003 18:10'! morphicViewOn: aDirectory withLabel: aString | aFileList window fileListBottom midLine fileListTopOffset buttonPane | aFileList _ self new directory: aDirectory. window _ (SystemWindow labelled: aString) model: aFileList. fileListTopOffset _ (TextStyle defaultFont pointSize * 2) + 14. fileListBottom _ 0.4. midLine _ 0.4. buttonPane _ aFileList optionalButtonRow addMorph: (aFileList morphicPatternPane vResizing: #spaceFill; yourself). self addFullPanesTo: window from: { {buttonPane. 0@0 corner: 1@0. 0@0 corner: 0@fileListTopOffset}. {aFileList morphicDirectoryTreePane. 0@0 corner: midLine@fileListBottom. 0@fileListTopOffset corner: 0@0}. {aFileList morphicFileListPane. midLine @ 0 corner: 1@fileListBottom. 0@fileListTopOffset corner: 0@0}. {aFileList morphicFileContentsPane. 0@fileListBottom corner: 1@1. nil}. }. aFileList postOpen. ^ window ! ! !MailComposition class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 13:04'! sendMailMessage: aMailMessage | newComposition | newComposition _ self new. newComposition messageText: aMailMessage text; open. ^ newComposition! ! !MailMessage methodsFor: 'printing/formatting' stamp: 'bkv 6/23/2003 14:17'! regenerateBodyFromParts "regenerate the message body from the multiple parts" | bodyText | bodyText := String streamContents: [ :str | str cr. parts do: [ :part | str cr; nextPutAll: '--'; nextPutAll: self attachmentSeparator; cr; nextPutAll: part text ]. str cr; nextPutAll: '--'; nextPutAll: self attachmentSeparator; nextPutAll: '--'; cr ]. body := MIMEDocument contentType: 'multipart/mixed' content: bodyText. text := nil. "text needs to be reformatted"! ! CommentNotePad class removeSelector: #bugFixMachineBlurb! CommentNotePad class removeSelector: #defaultWindowColor! CommentNotePad initialize! CommentNotePad class removeSelector: #miniBugFixMachineBlurb! CommentNotePad removeSelector: #addModelItemsToWindowMenu:! CommentNotePad removeSelector: #addOrRemoveHarvestingTag:! CommentNotePad removeSelector: #attachmentFileNames! CommentNotePad removeSelector: #attachmentFileNames:! CommentNotePad removeSelector: #bugFixMachineBlurb! CommentNotePad removeSelector: #embeddedInMorphicWindowLabeled:! CommentNotePad removeSelector: #harvestingTagSpecs! CommentNotePad removeSelector: #harvestingTags! CommentNotePad removeSelector: #includeHarvestingTagString:! CommentNotePad removeSelector: #initialize! CommentNotePad removeSelector: #labelForHarvestingFlag:! CommentNotePad removeSelector: #miniBlurb! CommentNotePad removeSelector: #miniBugFixMachineBlurb! CommentNotePad removeSelector: #openWithTitleLabel! CommentNotePad removeSelector: #stateForHarvestingFlag:! CommentNotePad removeSelector: #window! !CommentNotePad reorganize! ('accessing' archivePost archivePost: attachments attachments: mainComments mainComments: parentPost parentPost: qaTags summaryComments summaryComments:) ('gui building' attachmentFileNamesFrame buildAttachmentFileNamesPane buildMainCommentsPane buildQaTagsPane buildSummaryCommentsPane buildTextPaneUsing: buildTextPaneUsing:acceptOnCR: codePaneMenu:shifted: createWindow helpWindow mainCommentsFrame notePadMenu: paneColor qaTagsFrame summaryCommentsFrame windowLabel) ('initialization' on:) ('printing' formatSummaryCommentsWithTags helpText) ('qa tags' addOrRemoveQaTag: includeQaTagString: labelForQaFlag: stateForQaFlag:) ('services' addAttachmentsTo: blurb editSummaryComments editTitle mailCommentsTo: mailCommentsToAuthor mailCommentsToList mailServiceProvider openCommentsAsMailToAuthor openCommentsAsMailToList perform:orSendTo: title) ! BugFixArchiveViewer initialize! !BugFixArchiveViewer reorganize! ('accessing' emailRegexp emailRegexp: groupSizeLimit groupSizeLimit: groupSizeLimitString nameRegexp nameRegexp: titleOrBodyRegexp titleOrBodyRegexp:) ('filter utilities' defaultFilters initializeFilters statusFilters) ('group filters' currentStatusFilterSelectors defaultSizeFilter defaultStatusFilterSelectors filterGroupForApprovedStatus filterGroupForAuthorEmailMatch filterGroupForAuthorNameMatch filterGroupForClosedStatus filterGroupForSizeLimit filterGroupForTitleOrBodyMatch filterGroupForUpdateStreamStatus filterShowAnnouncements filterShowBugs filterShowEnhancements filterShowFixes filterShowGoodies filterSpecs harvestingStatusSpecs postTypeFilterSpecs) ('group-specific services' defaultEmailRegexp defaultRegexp setEmailRegexp setNameRegexp setSizeFilter setTitleOrBodyRegexp) ('gui building' addFiltersToMenu: addUpdateOptionsToMenu: buildEmailRegexpPane buildGroupSizeLimitPane buildListControlSubPaneUsing: buildNameRegexpPane buildTitleOrBodyRegexpPane createWindow emailRegexpPaneFrame groupSizeLimitPaneFrame nameRegexpPaneFrame packageListFrame packagePaneFrame paneColor titleOrBodyRegexpPaneFrame windowLabel) ('lists' collectPackageNames generalOptions initializePackagesList packageSpecificOptions) ('model' packages) ('post-specific services' createComment explorePost importUidForSelectedBaseUrl mailAuthor mailList reloadPost removePost viewPostAttachments) ('preferences' asyncLoadUpdates) ('update services' loadPreviousPosts loadPreviousStopAfter: loadTheWholeEnchilada loadUpdates loadUpdatesAsynchronouslyStopAfter: loadUpdatesStopAfter: loadUpdatesSynchronouslyStopAfter:) ! !AbstractPackageViewer reorganize! ('accessing' filter filter: noteChanged packagesListIndex packagesListIndex:) ('filter utilities' filterAdd: filterRemove: filterSpecs labelForFilter: showFilterString: stateForFilter: toggleFilterState:) ('filters' defaultFilters initializeFilters nonUiFilters uiEnabledFilters) ('gui building' addFilters:toMenu: addFiltersToMenu: addPackagesTo:at:plus: addUpdateOptionsToMenu: buildMorphicPackagesList buildPackagePane buildWindowMenu createWindow packageListFrame packagePaneFrame perform:orSendTo: windowLabel) ('lists' collectPackageNames initializePackagesList packageList packageNameList packageSpecificOptions packagesMenu:) ('model' contents isUpdatable on: packages selectedPackage update:) ('preferences' displayUsingFilters startupCacheMax startupLoadMax updatesMax) ('services' loadUpdates) !