'From Squeak3.6alpha of ''17 March 2003'' [latest update: #5269] on 18 June 2003 at 4:43:21 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. Change log: 1.12 Edited group-filters methods on BugFixArchiveViewer to correct filtering bugginess that made it appear that the load-posts-going-back-to option was breaking load-updates. Changed the auto-blurb that CommentNotePad appends to every email, to explain what the BugFixArchiverViewer tool does and to point to helpful links." ! 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 ! StringHolder subclass: #CommentNotePad instanceVariableNames: 'window commentsHolder archivePost parentPost ' classVariableNames: '' 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/4/2003 15:23'! 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 5/30/2003 11:48'! createWindow self addMorph: (self buildMorphicPackagesList borderWidth: 0) frame: (0 @ 0 corner: 0.4 @ 1). self addMorph: (self buildPackagePane borderWidth: 0) frame: (0.4 @ 0 corner: 1.0 @ 1.0). 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 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: 'nk 6/17/2003 08:20'! on: aPackageModel self model: aPackageModel. self loadUpdates. 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/3/2003 22:16'! openOn: aModel (self newOn: aModel) createWindow; openInWorld! ! !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/4/2003 15:56'! emailRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. emailRegexp _ aString. 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/4/2003 15:56'! groupSizeLimit: aNumber (aNumber notNil and: [ aNumber > 0 ]) ifTrue: [ groupSizeLimit _ aNumber. self noteChanged. ^ aNumber ] ifFalse: [ ^ nil ].! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! nameRegexp ^ nameRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:57'! nameRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. nameRegexp _ aString. self noteChanged. ^ aString! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! titleOrBodyRegexp ^ titleOrBodyRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:57'! titleOrBodyRegexp: aString aString isEmptyOrNil ifTrue: [ ^ nil ]. titleOrBodyRegexp _ aString. 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/18/2003 13:41'! initializeFilters super initializeFilters. titleOrBodyRegexp _ self defaultRegexp. nameRegexp _ self defaultRegexp. emailRegexp _ self defaultEmailRegexp. groupSizeLimit _ self defaultSizeFilter. 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/4/2003 16:30'! buildWindowMenu | aMenu | aMenu _ super buildWindowMenu. aMenu addLine. aMenu add: 'reset all filters' target: self action: #initializeFilters. aMenu balloonTextForLastItem: 'Reset all filters to default settings.'. aMenu add: 'filter by size..' target: self action: #setSizeFilter. aMenu balloonTextForLastItem: 'Display only groups with a minimum size of..'. aMenu add: 'filter by author name..' target: self action: #setNameRegexp. aMenu balloonTextForLastItem: 'Display only groups that match author name..'. aMenu add: 'filter by author email..' target: self action: #setEmailRegexp. aMenu balloonTextForLastItem: 'Display only groups that match author email..'. aMenu add: 'filter by text in title or body..' target: self action: #setTitleOrBodyRegexp. aMenu balloonTextForLastItem: 'Display only groups of posts with title or body text that matches..'. ^ aMenu ! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 5/9/2003 13:42'! paneColor ^ Color green darker duller! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 5/9/2003 13:40'! windowLabel ^'Bug Fix 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/10/2003 07:58'! generalOptions ^#( #( 'mail the author' mailAuthor 'Mail a comment on this post to the author.' ) #( 'mail the list' mailList 'Mail a comment on this post to the squeak-dev list.' ) #( '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 5/29/2003 23:28'! 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/4/2003 10:35'! mailAuthor | notePad | notePad _ CommentNotePad on: self selectedPackage. notePad mailCommentsToAuthor. ! ! !BugFixArchiveViewer methodsFor: 'post-specific services' stamp: 'bkv 6/4/2003 10:34'! 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/1/2003 16:38'! loadUpdatesSynchronouslyStopAfter: maxUpdates Cursor write 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: 'tiny menu' stamp: 'bkv 6/2/2003 14:04'! addModelItemsToWindowMenu: aMenu "This adds options to the tiny menu in the top (label) pane of the viewer." aMenu addLine. aMenu add: 'help' target: self action: #helpWindow. aMenu add: 'edit summary comments' target: self action: #editSummaryComments. aMenu add: 'mail to list' target: self action: #mailCommentsToList. self parentPost ifNotNil: [ aMenu add: 'mail to archive-post author' target: self selector: #mailCommentsTo: argumentList: (Array with: self parentPost authorEmail) ]. "TBD: if no parent post, add type-tag-setting bidness." aMenu addLine. self harvestingTagSpecs do: [ :array | aMenu addUpdating: #includeHarvestingTagString: target: self selector: #addOrRemoveHarvestingTag: argumentList: (Array with: array second asSymbol). aMenu balloonTextForLastItem: array third. ]. ^ aMenu ! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 13:01'! addOrRemoveHarvestingTag: aSymbolOrString | symbol tag | symbol _ aSymbolOrString asSymbol. tag _ self archivePost tagForQaFlag: symbol. ( self harvestingTags includes: tag ) ifTrue: [ self archivePost removeQaTag: tag ] ifFalse: [ self archivePost addQaTag: tag ].! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 11:37'! canonicalHarvestingTags ^ ArchivePost canonicalQaTags! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 12:55'! harvestingTagSpecs ^ ArchivePost harvestingTagSpecs ! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 11:34'! harvestingTags ^ self archivePost qaTags! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 13:06'! includeHarvestingTagString: aHarvestingTagSymbol ^ (self stateForHarvestingFlag: aHarvestingTagSymbol), (self labelForHarvestingFlag: aHarvestingTagSymbol) ! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 13:06'! labelForHarvestingFlag: aHarvestingFlag ^ ( self harvestingTagSpecs detect: [:fs | fs second == aHarvestingFlag asSymbol ] ) first! ! !CommentNotePad methodsFor: 'tiny menu' stamp: 'bkv 6/2/2003 13:06'! stateForHarvestingFlag: aHarvestingFlag | tag | tag _ self archivePost tagForQaFlag: aHarvestingFlag. ^ ( self harvestingTags includes: tag ) ifTrue: [''] ifFalse: ['']! ! !CommentNotePad methodsFor: 'initialization' stamp: 'bkv 6/2/2003 13:52'! initialize (self parentPost isNil) ifTrue: [ archivePost _ ArchivePost new initialize. ] ifFalse: [ archivePost _ ArchivePost new title: (ArchivePostGroup topicContentFrom: parentPost title). ]. commentsHolder _ StringHolder new contents: self archivePost comments. ! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:29'! archivePost ^ archivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 5/25/2003 18:28'! archivePost: anArchivePost archivePost _ anArchivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 5/26/2003 00:08'! helpText ^ String streamContents: [ :stream | stream nextPutAll: 'Step 1: Use the CommentNotePad''s tiny-menu to create a brief summary comment ( i.e., ''Needs SUnit tests'' or ''Design suggestions'')'; nextPut: Character cr; nextPutAll: 'Step 2: Compose your comments, including code snippets.'; nextPut: Character cr; nextPutAll: 'Step 3: Use the CommentNotePad''s tiny-menu to set the harvesting tags for your comment.'; nextPut: Character cr; nextPutAll: 'Step 4: Use the CommentNotePad''s tiny-menu to send your comment as an email.'; nextPut: Character cr; nextPutAll: 'Step 5: Use your mail client to add attachments.'; yourself. ] ! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:29'! parentPost ^ parentPost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/2/2003 11:22'! parentPost: anArchivePost parentPost _ anArchivePost! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/2/2003 13:53'! summaryComments ^ commentsHolder contents asString ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/7/2003 15:04'! bugFixMachineBlurb ^ String streamContents: [ :strm | strm nextPutAll: '< I''m a bug-fixing machine!! >'. strm nextPut: Character cr. strm nextPut: Character cr. strm nextPutAll: 'The BugFixArchiveViewer is 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 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/2/2003 13:13'! formatSummaryCommentsWithTags self harvestingTags isEmptyOrNil ifTrue: [ ^ '' ]. ^ String streamContents: [ :stream | stream nextPut: $(. stream nextPut: Character space. self harvestingTags 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: 'services' stamp: 'bkv 6/7/2003 14:58'! mailCommentsTo: anEmailAddressString | aTitle windowLabel parensComments from to body blurb messageStrm | (aTitle _ self archivePost title) isNil ifTrue: [ aTitle _ '' ]. "Make sure that the archivePost title is set correctly". self window ifNotNil: [ windowLabel _ self window label. ]. windowLabel isEmptyOrNil ifFalse: [ self archivePost title: windowLabel ]. parensComments _ self formatSummaryCommentsWithTags. body _ self contents. from _ MailSender userName. from isEmptyOrNil ifTrue: [ from _ '' ]. to _ anEmailAddressString. to isNil ifTrue: [ to _ '' ]. body ifNil: [ body _ ''. ]. blurb _ self bugFixMachineBlurb. "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: blurb. self mailServiceProvider sendMailMessage: (MailMessage from: messageStrm contents). ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/4/2003 10:42'! mailCommentsToAuthor | authorEmail | parentPost ifNil: [ ^ nil ]. authorEmail _ parentPost authorEmail. authorEmail isEmptyOrNil ifTrue: [ authorEmail _ '< Email address unknown >' ]. self mailCommentsTo: authorEmail. ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 5/25/2003 18:36'! mailCommentsToList self mailCommentsTo: 'squeak-dev@lists.squeakfoundation.org'! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 5/25/2003 23:59'! mailServiceProvider | provider | provider _ (Smalltalk at: #MailSender). provider isNil ifTrue: [ ^nil ]. ^ provider default ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/7/2003 14:57'! 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 methodsFor: 'services' stamp: 'bkv 6/2/2003 12:13'! title self archivePost ifNil: [ ^ nil ]. ^ self archivePost title ! ! !CommentNotePad methodsFor: 'window creation' stamp: 'bkv 6/2/2003 12:10'! embeddedInMorphicWindowLabeled: labelString | myWindow | myWindow _ super embeddedInMorphicWindowLabeled: labelString. myWindow setWindowColor: self class defaultWindowColor. "Store this SystemWindow internally for future reference." window _ myWindow. ^ myWindow! ! !CommentNotePad methodsFor: 'window creation' stamp: 'bkv 5/26/2003 00:06'! helpWindow ^ ( StringHolder new contents: self helpText ) openLabel: 'Help on using the CommentNotePad' ! ! !CommentNotePad methodsFor: 'window creation' stamp: 'bkv 5/25/2003 18:27'! openWithTitleLabel | label | archivePost ifNil: [ label _ 'Comment for Bug Fix Archive' ]. label ifNil: [ label _ archivePost title ]. ^ self openLabel: label! ! !CommentNotePad methodsFor: 'window creation' stamp: 'bkv 6/2/2003 12:47'! window ^ window! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 5/25/2003 23:51'! defaultWindowColor ^ (Color r: 0.0 g: 0.452 b: 0.677)! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 10:36'! on: anArchivePost "Setup the CommentNotePad to create a reply to anArchivePost." | notePad | notePad _ self new parentPost: anArchivePost; initialize; yourself. ^ notePad ! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/2/2003 11:52'! open "CommentNotePad open" self openOn: nil. ! ! !CommentNotePad class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 10:36'! openOn: anArchivePost "Opening on a particular ArchivePost will setup the CommentNotePad to create a reply to that post." | notePad | notePad _ self on: anArchivePost. notePad openWithTitleLabel. ! ! !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 ! ! BugFixArchiveViewer initialize! !BugFixArchiveViewer reorganize! ('accessing' emailRegexp emailRegexp: groupSizeLimit groupSizeLimit: 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: buildWindowMenu paneColor 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 perform:orSendTo: windowLabel) ('lists' collectPackageNames initializePackagesList packageList packageNameList packageSpecificOptions packagesMenu:) ('model' contents isUpdatable on: packages selectedPackage update:) ('preferences' displayUsingFilters startupCacheMax startupLoadMax updatesMax) ('services' loadUpdates) !