'From Squeak3.6beta of ''4 July 2003'' [latest update: #5331] on 7 July 2003 at 1:20:10 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 windowColor ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-UI'! BorderedMorph subclass: #BugFixArchiveKeeperMorph instanceVariableNames: 'archive ' classVariableNames: '' poolDictionaries: '' category: 'BugFixArchive-UI'! !BugFixArchiveKeeperMorph commentStamp: '' prior: 0! My sole purpose is to maintain a strong reference to a BugFixArchive and display its status. ! AbstractPackageViewer subclass: #BugFixArchiveViewer instanceVariableNames: 'adHocFilterBlock groupSizeLimit nameRegexp emailRegexp titleOrBodyRegexp displayInGroupsPref backgroundUpdater ' 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: 'nk 6/28/2003 11:32'! filter: anObject "update my selection" | oldPackage index | oldPackage _ self selectedPackage. filter _ anObject. self noteChanged. index _ self packageList indexOf: oldPackage. index ifNil: [ index _ 0 ]. self packagesListIndex: index. ! ! !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: 'accessing' stamp: 'bkv 6/24/2003 08:34'! windowColor ^ windowColor! ! !AbstractPackageViewer methodsFor: 'accessing' stamp: 'bkv 6/24/2003 08:34'! windowColor: aColor windowColor _ aColor! ! !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/25/2003 13:36'! 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." | nonUiFilters | nonUiFilters _ self filter difference: (self filterSpecs collect: [ :ea | ea second ]). self displayInGroupsPref ifFalse: [ nonUiFilters remove: #filterGroupForSizeLimit ifAbsent:[] ]. ^ nonUiFilters! ! !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/30/2003 14:19'! addUpdateOptionsToMenu: aMenu self subclassResponsibility ! ! !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: 'nk 7/6/2003 14:05'! buildPackagePane | ptm | ptm _ PluggableTextMorph on: self text: #contents accept: nil readSelection: nil "#packageSelection " menu: #packageMenu:shifted:. 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/25/2003 14:10'! createWindow self addMorph: (self buildMorphicPackagesList borderWidth: 0) fullFrame: 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). ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'nk 6/24/2003 07:57'! packageListFrame ^ LayoutFrame fractions: (0 @ 0 corner: 0.4 @ 1) ! ! !AbstractPackageViewer methodsFor: 'gui building' stamp: 'nk 7/6/2003 14:17'! packageMenu: aMenu shifted: shifted shifted ifTrue: [ | shiftMenu | shiftMenu _ ParagraphEditor shiftedYellowButtonMenu. ^ aMenu labels: shiftMenu labelString lines: shiftMenu lineArray selections: shiftMenu selections ]. aMenu addList: #( ('find...(f)' find) ('find again (g)' findAgain) ('set search string (h)' setSearchString) - ('do again (j)' again) ('undo (z)' undo) - ('copy (c)' copySelection) ('cut (x)' cut) ('paste (v)' paste) ('paste...' pasteRecent) - ('do it (d)' doIt) ('print it (p)' printIt) ('inspect it (i)' inspectIt) ('fileIn selection (G)' fileItIn) - ('accept (s)' accept) ('cancel (l)' cancel) - ('more...' shiftedYellowButtonActivity)). ^ aMenu! ! !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 6/24/2003 10:08'! paneColor ^ self windowColor ifNil: [ self class defaultPaneColor ]! ! !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: '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 6/24/2003 08:41'! defaultPaneColor ^ Color yellow lighter duller! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 6/24/2003 08:42'! defaultWindowLabel ^ ''! ! !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/24/2003 08:42'! openOn: aModel ^ self openOn: aModel withLabel: self defaultWindowLabel withColor: self defaultPaneColor! ! !AbstractPackageViewer class methodsFor: 'instance creation' stamp: 'bkv 6/25/2003 11:21'! openOn: aModel withLabel: aString withColor: aColor | viewer | Cursor wait showWhile: [ viewer _ self newOn: aModel. viewer windowColor: aColor. viewer createWindow. viewer setLabel: aString. ]. 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! ! !BugFixArchiveKeeperMorph methodsFor: 'testing' stamp: 'nk 6/28/2003 13:30'! stepTime ^1000! ! !BugFixArchiveKeeperMorph methodsFor: 'testing' stamp: 'nk 6/28/2003 13:27'! wantsSteps ^archive notNil! ! !BugFixArchiveKeeperMorph methodsFor: 'accessing' stamp: 'nk 6/28/2003 13:33'! archive ^archive! ! !BugFixArchiveKeeperMorph methodsFor: 'initialization' stamp: 'nk 6/28/2003 14:04'! initializeOn: aBugFixArchive archive _ aBugFixArchive. super initialize. self borderWidth: 2. self color: Color white; borderColor: BugFixArchiveViewer defaultPaneColor. self setBalloonText: 'Delete me and close all open BugFixArchiveViewers if you want to release the memory taken up by the Bug Fix Archive called ', archive name. self layoutPolicy: TableLayout new; listDirection: #topToBottom; hResizing: #shrinkWrap; vResizing: #shrinkWrap; layoutInset: 4. self addMorphBack: (StringMorph contents: 'Keeping ', archive name). self addMorphBack: (StringMorph contents: '0') ! ! !BugFixArchiveKeeperMorph methodsFor: 'stepping and presenter' stamp: 'nk 6/28/2003 13:29'! step submorphs last contents: (String streamContents: [:s | s print: archive archivePosts size; nextPutAll: ' posts' ])! ! !BugFixArchiveKeeperMorph methodsFor: 'submorphs-add/remove' stamp: 'nk 6/28/2003 13:27'! delete archive _ nil. super delete! ! !BugFixArchiveKeeperMorph class methodsFor: 'instance creation' stamp: 'nk 6/28/2003 13:48'! keeperFor: aBugFixArchive "Find one of me, wherever it may be (in some other World, in the trash...), or make a new one." ^self allSubInstances detect: [ :m | m archive == aBugFixArchive ] ifNone: [ super basicNew initializeOn: aBugFixArchive ]! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/30/2003 18:47'! adHocFilterBlock ^ adHocFilterBlock! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/30/2003 18:51'! adHocFilterBlock: aBlock "The ad-hoc filter block should only be set when opening a new temporary view on the Bug Fixes Archive." adHocFilterBlock _ aBlock. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/25/2003 15:04'! displayInGroupsPref displayInGroupsPref ifNil: [ self initializeDisplayInGroupsPref ]. ^ displayInGroupsPref! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/25/2003 15:04'! displayInGroupsPref: aBoolean displayInGroupsPref _ aBoolean. self noteChanged.! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! emailRegexp ^ emailRegexp ! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'nk 6/28/2003 10:04'! emailRegexp: aString aString isEmptyOrNil ifTrue: [ emailRegexp _ '*@*' ] ifFalse: [ emailRegexp _ aString asString. (emailRegexp includesAnyOf: '*#') ifFalse: [ emailRegexp _ '*', emailRegexp, '*' ]]. self noteChanged. ^true! ! !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: 'nk 6/24/2003 07:54'! 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. ^ true ] ifFalse: [ ^ false ].! ! !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/30/2003 20:28'! initializePackagesList "We are inclusive by default. Apply exclusive filters at the end." | list filteredGroups | list _ OrderedCollection new. (self adHocFilterBlock isNil not) ifTrue: [ filteredGroups _ self packages select: [ :package | self adHocFilterBlock value: package ]. ] ifFalse: [ filteredGroups _ super initializePackagesList. ]. filteredGroups isEmptyOrNil ifTrue: [ ^ list ]. "Filter by status" filteredGroups _ filteredGroups select: [ :fg | fg hasNoStatus or: [ self statusFilters anySatisfy: [ :selector | (self perform: selector) value: fg ]]]. self displayInGroupsPref ifTrue: [ filteredGroups do: [ :group | list addAll: group allPosts ]] ifFalse:[ "In this case not actually groups, but individual posts" list _ filteredGroups ]. packagesList _ list. ^ packagesList! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! nameRegexp ^ nameRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'nk 6/28/2003 10:04'! nameRegexp: aString aString isEmptyOrNil ifTrue: [nameRegexp _ '*' ] ifFalse: [ nameRegexp _ aString asString. (nameRegexp includesAnyOf: '*#') ifFalse: [nameRegexp _ '*' , nameRegexp , '*']]. self noteChanged. ^ true! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'bkv 6/4/2003 15:28'! titleOrBodyRegexp ^ titleOrBodyRegexp! ! !BugFixArchiveViewer methodsFor: 'accessing' stamp: 'nk 6/28/2003 10:05'! titleOrBodyRegexp: aString aString isEmptyOrNil ifTrue: [titleOrBodyRegexp _ '*' ] ifFalse: [titleOrBodyRegexp _ aString asString. (titleOrBodyRegexp includesAnyOf: '*#') ifFalse: [titleOrBodyRegexp _ '*' , titleOrBodyRegexp , '*']]. self noteChanged. ^ true! ! !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/25/2003 15:04'! initializeDisplayInGroupsPref self displayInGroupsPref: true.! ! !BugFixArchiveViewer methodsFor: 'filter utilities' stamp: 'bkv 6/30/2003 18:50'! initializeFilters super initializeFilters. adHocFilterBlock _ nil. self initializeDisplayInGroupsPref. 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/30/2003 17:45'! addUpdateOptionsToMenu: aMenu aMenu addLine. aMenu add: 'load updates' target: self action: #loadUpdates. aMenu add: 'load previous posts going back..' target: self action: #loadPreviousPosts. aMenu add: 'load the entire archive' target: self action: #loadTheWholeEnchilada. self asyncLoadUpdates ifTrue: [ backgroundUpdater ifNotNil: [ aMenu add: 'stop background load' target: self selector: #stopAsyncUpdate. ] ]. aMenu addLine. aMenu add: 'validate local archive' target: self action: #validateLocalArchive. aMenu addLine. self asyncLoadUpdates ifTrue: [ aMenu add: ' load updates in background' target: self selector: #asyncLoadUpdates: argument: false ] ifFalse: [ aMenu add: ' load updates in background' target: self selector: #asyncLoadUpdates: argument: true ]. aMenu add: 'keep archive in memory...' target: self selector: #openKeeper. ! ! !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: 'nk 6/24/2003 07:36'! buildListControlSubPaneUsing: aTuple | ptm am | am _ AlignmentMorph newColumn color: Color transparent; borderColor: self paneColor; cellPositioning: #topLeft; borderWidth: 1. 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 transparent. ptm hResizing: #spaceFill; vResizing: #spaceFill. am addMorphBack: (StringMorph contents: aTuple first). am addMorphBack: ptm. ^ am! ! !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: 'nk 6/28/2003 10:16'! buildWindowMenu | menu | menu _ super buildWindowMenu. menu addLine. self displayInGroupsPref ifTrue: [ menu add: ' display in groups' target: self selector: #displayInGroupsPref: argument: false ] ifFalse: [ menu add: ' display in groups' target: self selector: #displayInGroupsPref: argument: true ]. ^menu! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'bkv 6/30/2003 16:56'! createWindow | fieldPane | fieldPane _ Morph new hResizing: #spaceFill; vResizing: #spaceFill; layoutPolicy: ProportionalLayout new. self addListControlSubPaneTo: fieldPane using: { 'Author name:'. #nameRegexp. #nameRegexp:. 'Filter by all or part of an author''s name..'. } inFrame: self nameRegexpPaneFrame. self addListControlSubPaneTo: fieldPane using: { 'Author email:'. #emailRegexp. #emailRegexp:. 'Filter by all or part of an author''s email address..'. } inFrame: self emailRegexpPaneFrame. self addListControlSubPaneTo: fieldPane using: { 'Text in title or body:'. #titleOrBodyRegexp. #titleOrBodyRegexp:. 'Filter by text in title or body..'. } inFrame: self titleOrBodyRegexpPaneFrame. self displayInGroupsPref ifTrue: [ self addListControlSubPaneTo: fieldPane using: { 'Number of posts:'. #groupSizeLimitString. #groupSizeLimit:. 'Filter by a minimum number of posts..'. } inFrame: self groupSizeLimitPaneFrame. ]. self addMorph: fieldPane fullFrame: (LayoutFrame fractions: (0@0 extent: 1@0) offsets: (0@0 corner: 0@(self searchFrameHeight))). super createWindow.! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'nk 6/28/2003 13:57'! defaultWindowLabel ^String streamContents: [ :s | s nextPutAll: self class defaultWindowLabel; nextPutAll: ' ['; nextPutAll: model name; nextPut: $] ].! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'nk 6/28/2003 14:01'! openKeeper ^(BugFixArchiveKeeperMorph keeperFor: self model) openInHand! ! !BugFixArchiveViewer methodsFor: 'gui building' stamp: 'nk 6/24/2003 07:18'! packageListFrame ^ LayoutFrame fractions: (0 @ 0 corner: 1.0 @ 0.7) offsets: ((0@self searchFrameHeight) corner: (0@0))! ! !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: 'nk 6/24/2003 07:34'! searchFrameHeight ^ (TextStyle defaultFont height * 2) + 23! ! !BugFixArchiveViewer methodsFor: 'gui building-field pane' stamp: 'nk 6/28/2003 07:27'! addListControlSubPaneTo: aMorph using: aTuple inFrame: aLayoutFrame | field fieldTitle | field _ PluggableTextMorph on: self text: (aTuple at: 2) accept: (aTuple at: 3). field setBalloonText: (aTuple at: 4); acceptOnCR: true; hideScrollBarIndefinitely; color: Color transparent; hResizing: #spaceFill; vResizing: #spaceFill. fieldTitle _ (StringMorph contents: aTuple first) hResizing: #spaceFill; vResizing: #spaceFill; color: Color black. aMorph addMorph: fieldTitle fullFrame: (aLayoutFrame copy bottomFraction: 0.5; bottomOffset: -2). aMorph addMorph: field fullFrame: (aLayoutFrame copy topFraction: 0.5; topOffset: -2).! ! !BugFixArchiveViewer methodsFor: 'gui building-field pane' stamp: 'nk 6/28/2003 07:16'! emailRegexpPaneFrame ^ LayoutFrame fractions: (0.25@0 extent: 0.25@1) offsets: (5@5 corner: -5@- 5)! ! !BugFixArchiveViewer methodsFor: 'gui building-field pane' stamp: 'nk 6/28/2003 07:16'! groupSizeLimitPaneFrame ^ LayoutFrame fractions: (0.75@0 extent: 0.25@1) offsets: (5@5 corner: -5@-5)! ! !BugFixArchiveViewer methodsFor: 'gui building-field pane' stamp: 'nk 6/28/2003 07:16'! nameRegexpPaneFrame ^ LayoutFrame fractions: (0@0 extent: 0.25@1) offsets: (5@5 corner: -5@-5)! ! !BugFixArchiveViewer methodsFor: 'gui building-field pane' stamp: 'nk 6/28/2003 07:16'! titleOrBodyRegexpPaneFrame ^ LayoutFrame fractions: (0.5@0 extent: 0.25@1) offsets: (5@5 corner: -5@-5)! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 6/25/2003 13:37'! 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 displayInGroupsPref ifTrue: [self packageList collect: [:e | e groupDisplayLabel ]] ifFalse: [self packageList collect: [ :e | e title ]]! ! !BugFixArchiveViewer methodsFor: 'lists' stamp: 'bkv 6/30/2003 18:40'! 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.' ) #- #( 'view unreviewed' #viewUnreviewed 'View contributions that have not yet been reviewed by anyone.' ) #( 'view reviewed but not yet approved' #viewReviewedNotYetApproved 'view contributions that have been reviewed, but not yet approved' ) #( 'view approved but not yet updates' #viewApprovedNotYetInUpdateStream 'view contributions that have been approved, but not yet put into the update stream' ) #- #( 'reload this post' reloadPost 'Reload this post from the Bug Fixes Archive.' ) #( 'explore this post' explorePost 'Open an ObjectExplorer on this post.' ) )! ! !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: 'nk 6/28/2003 09:02'! on: aBugFixArchive super on: aBugFixArchive. aBugFixArchive loadFilterSelectors: #(isFix isEnhancement isBug isGoodie isAnnouncement). self displayInGroupsPref: true.! ! !BugFixArchiveViewer methodsFor: 'model' stamp: 'nk 6/28/2003 10:20'! packages "We request the model's posts grouped by topic and sorted by UID in descending order." ^ self displayInGroupsPref ifTrue: [ self model archivePostGroups ] ifFalse: [ self model archivePosts ]! ! !BugFixArchiveViewer methodsFor: 'model' stamp: 'bkv 6/30/2003 17:47'! update: aParameter "Receive a change notice from an object of whom the receiver is a dependent" (aParameter == #listChanged) ifTrue: [self listChanged. self validateLocalArchive]. super update: aParameter! ! !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: 'nk 6/28/2003 07:46'! asyncLoadUpdates ^Preferences valueOfFlag: #bugFixArchiveViewerAsyncLoadUpdates ifAbsent: [ false ]! ! !BugFixArchiveViewer methodsFor: 'preferences' stamp: 'nk 6/28/2003 08:37'! asyncLoadUpdates: aBoolean "Enable or disable background loading" Preferences enableOrDisable: #bugFixArchiveViewerAsyncLoadUpdates asPer: aBoolean! ! !BugFixArchiveViewer methodsFor: 'submorphs-add/remove' stamp: 'nk 6/28/2003 11:19'! delete super delete. backgroundUpdater ifNotNil: [ backgroundUpdater terminate ].! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/28/2003 12:58'! cleanUpRepository | results emptyFiles emptyDirs | Cursor wait showWhile: [ results _ self model cleanUp. ]. results isEmptyOrNil ifTrue: [ ^ results ]. (results size < 2) ifTrue: [ ^ results ]. ((emptyFiles_(results at: 1)) notEmpty) ifTrue: [ self inform: 'Deleted ', emptyFiles size asString, ' empty files.'. ]. ((emptyDirs_(results at: 2)) notEmpty) ifTrue: [ self inform: 'Deleted ', emptyDirs size asString, ' empty directories.'. ]. ^ results! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 11:48'! listChanged "called from foreground Process to update the package list." | oldPackage index | self model ifNil: [ ^self ]. oldPackage _ self selectedPackage. self noteChanged. index _ self packageList indexOf: oldPackage. index ifNil: [ index _ 0 ]. self packagesListIndex: index. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:34'! loadMissingPosts self updateUrls ifNil: [ ^ nil ]. self updateUrls do: [ :url | self loadMissingPostsFromUrl: url ]. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:25'! loadMissingPostsAsynchronouslyFromUrl: aUrlOrString | msg count | backgroundUpdater ifNotNil: [^ self inform: 'already updating']. count _ self model countMissingPostsFromUrl: aUrlOrString. (count < 1) ifTrue: [ ^ self ]. msg _ String streamContents: [:stream | stream nextPutAll: self defaultWindowLabel; nextPutAll: ' (Loading '. stream nextPutAll: count asString; space. stream nextPutAll: 'missing posts)']. self setLabel: msg. backgroundUpdater _ [ self newAsyncPosts: (self model loadMissingPostsFromUrl: aUrlOrString) ] forkAt: Processor userBackgroundPriority. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:33'! loadMissingPostsFromUrl: aUrlOrString ^ ( self asyncLoadUpdates ) ifTrue: [ self loadMissingPostsAsynchronouslyFromUrl: aUrlOrString ] ifFalse: [ self loadUpdatesSynchronouslyStopAfter: aUrlOrString ] ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:32'! loadMissingPostsSynchronouslyFromUrl: aUrlOrString | count msg | count _ self model countMissingPostsFromUrl: aUrlOrString. (count < 1) ifTrue: [ ^ self ]. msg _ String streamContents: [:stream | stream nextPutAll: self defaultWindowLabel; nextPutAll: ' (Loading '. stream nextPutAll: count asString; space. stream nextPutAll: 'missing posts)']. self setLabel: msg. Cursor wait showWhile: [ self newPosts: (self model loadMissingPostsFromUrl: aUrlOrString). ]. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 13:55'! loadPreviousAsynchronouslyStopAfter: maxPrevious | msg | backgroundUpdater ifNotNil: [^ self inform: 'already updating']. msg _ String streamContents: [:stream | stream nextPutAll: self defaultWindowLabel; nextPutAll: ' (Loading '. maxPrevious > 0 ifTrue: [stream nextPutAll: maxPrevious asString; space]. stream nextPutAll: 'previous)']. self setLabel: msg. backgroundUpdater _ [ self newAsyncPosts: (self model loadPreviousStopAfter: maxPrevious) ] forkAt: Processor userBackgroundPriority! ! !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: 'nk 6/28/2003 09:07'! loadPreviousStopAfter: maxPrevious ^ ( self asyncLoadUpdates ) ifTrue: [ self loadPreviousAsynchronouslyStopAfter: maxPrevious ] ifFalse: [ self loadPreviousSynchronouslyStopAfter: maxPrevious ]. ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 09:07'! loadPreviousSynchronouslyStopAfter: maxPrevious Cursor wait showWhile: [ | newPosts | newPosts _ self model loadPreviousStopAfter: maxPrevious. self newPosts: newPosts ].! ! !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: 'nk 6/28/2003 13:55'! loadUpdatesAsynchronouslyStopAfter: maxUpdates | msg | backgroundUpdater ifNotNil: [^ self inform: 'already updating']. msg _ String streamContents: [:stream | stream nextPutAll: self defaultWindowLabel; nextPutAll: ' (Loading '. maxUpdates > 0 ifTrue: [stream nextPutAll: maxUpdates asString; space]. stream nextPutAll: 'updates)']. self setLabel: msg. backgroundUpdater _ [ self newAsyncPosts: (self model loadUpdatesStopAfter: maxUpdates) ] 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: 'nk 6/28/2003 07:44'! loadUpdatesSynchronouslyStopAfter: maxUpdates Cursor wait showWhile: [ | newPosts | newPosts _ self model loadUpdatesStopAfter: maxUpdates. self newPosts: newPosts ].! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 14:05'! newAsyncPosts: newPosts "called from background Process" self model ifNil: [^ self]. "probably should protect the model here" [newPosts do: [:archivePost | self model addArchivePost: archivePost]] ensure: [WorldState addDeferredUIMessage: (MessageSend receiver: self model selector: #listChanged). WorldState addDeferredUIMessage: (MessageSend receiver: self selector: #setLabel: argument: self defaultWindowLabel). backgroundUpdater _ nil]! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 13:59'! newPosts: newPosts "called from foreground Process" self model ifNil: [ ^self ]. Cursor wait showWhile: [ newPosts do: [ :archivePost | self model addArchivePost: archivePost ]. ]. self model listChanged.! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'nk 6/28/2003 11:37'! stopAsyncUpdate backgroundUpdater ifNotNil: [ backgroundUpdater terminate. backgroundUpdater _ nil. ]! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:46'! updateUrls self model ifNil: [ ^ nil ]. ^ self model updateUrls ! ! !BugFixArchiveViewer methodsFor: 'update services' stamp: 'bkv 6/30/2003 17:54'! validateLocalArchive | count | count _ 0. self updateUrls ifNil: [ ^ count ]. self updateUrls do: [ :url | count _ count + (self model countMissingPostsFromUrl: url). "Ask the user whether to try loading again" (count > 0) ifTrue: [(self confirm: (count asString, ' posts failed to load successfully from ', url asString, '. Should I try to load them again?')) ifTrue: [ self loadMissingPostsFromUrl: url ]] ifFalse: [ self inform: 'There are no gaps in the list of posts in this local archive.' ]]. ! ! !BugFixArchiveViewer methodsFor: 'viewer services' stamp: 'bkv 6/30/2003 20:29'! viewApprovedNotYetInUpdateStream | viewer | viewer _ self class newOn: self model. viewer adHocFilterBlock: [ :postOrGroup | ((self filterGroupForUpdateStreamStatus value: postOrGroup) not) and: [ postOrGroup hasNoStatus not ]]. viewer filterAdd: #filterGroupForApprovedStatus. viewer filterRemove: #filterGroupForUpdateStreamStatus. viewer displayInGroupsPref: self displayInGroupsPref. viewer createWindow. viewer windowColor: self paneColor. viewer setLabel: self defaultWindowLabel, ' ', ' ( approved -- but not in the update stream )'. viewer openInWorld. ^ viewer! ! !BugFixArchiveViewer methodsFor: 'viewer services' stamp: 'bkv 6/30/2003 20:29'! viewReviewedNotYetApproved | viewer | viewer _ self class newOn: self model. viewer filterRemove: #filterGroupForApprovedStatus. viewer filterRemove: #filterGroupForUpdateStreamStatus. viewer groupSizeLimit: 2. viewer displayInGroupsPref: self displayInGroupsPref. viewer createWindow. viewer windowColor: self paneColor. viewer setLabel: self defaultWindowLabel, ' ', ' ( reviewed -- but not approved )'. viewer openInWorld. ^ viewer ! ! !BugFixArchiveViewer methodsFor: 'viewer services' stamp: 'bkv 6/30/2003 20:29'! viewUnreviewed | viewer | viewer _ self class newOn: self model. viewer adHocFilterBlock: [ :postOrGroup | postOrGroup size == 1 ]. viewer displayInGroupsPref: self displayInGroupsPref. viewer createWindow. viewer windowColor: self paneColor. viewer setLabel: self defaultWindowLabel, ' ', ' ( not yet reviewed )'. viewer openInWorld. ^ viewer ! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/25/2003 13:50'! defaultOpenCommand ^ #open! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'nk 6/28/2003 09:02'! initialize "BugFixArchiveViewer initialize." (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ { { self menuRegistrationKey. self defaultOpenCommand. }. { self kcpRegistrationKey. self kcpOpenCommand. }. } do: [ :tuple | TheWorldMenu registerOpenCommand: { tuple at: 1. {self. tuple at: 2. }} ]]. Preferences addPreference: #bugFixArchiveViewerAsyncLoadUpdates category: #BFAV default: true balloonHelp: 'if true, the Bug Fix Archive Viewer will load its updates in the background'. ! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/25/2003 13:50'! kcpOpenCommand ^ #viewKCPSwikiArchive! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/25/2003 13:49'! kcpRegistrationKey ^ 'Kernel Cleaning Project (KCP) Archive Viewer' ! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'bkv 6/25/2003 13:49'! menuRegistrationKey ^ 'Bug Fixes Archive Viewer'! ! !BugFixArchiveViewer class methodsFor: 'menu registration' stamp: 'nk 6/28/2003 07:58'! removeFromSystem (TheWorldMenu respondsTo: #registerOpenCommand:) ifTrue: [ { self menuRegistrationKey. self kcpRegistrationKey. } do: [ :keySelector | TheWorldMenu unregisterOpenCommand: (self perform: keySelector) ]]. Preferences expungePreferenceNamed: #bugFixArchiveViewerAsyncLoadUpdates.! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/4/2003 09:55'! defaultModel ^ BugFixArchive gsugSwikiFixesArchive! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/23/2003 20:14'! defaultPaneColor ^ Color green darker duller! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/25/2003 13:49'! defaultWindowLabel ^ self menuRegistrationKey! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/30/2003 16:59'! openOn: aModel withLabel: aString withColor: aColor ^ self openOn: aModel withLabel: aString withColor: aColor withDisplayGroupsPref: true! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/30/2003 16:54'! openOn: aModel withLabel: aString withColor: aColor withDisplayGroupsPref: aBoolean | viewer | Cursor wait showWhile: [ viewer _ self newOn: aModel. viewer windowColor: aColor. viewer displayInGroupsPref: aBoolean. viewer createWindow. viewer setLabel: aString. ]. viewer loadUpdates. viewer openInWorld. ^ viewer ! ! !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.! ! !BugFixArchiveViewer class methodsFor: 'instance creation' stamp: 'bkv 6/30/2003 16:55'! viewKCPSwikiArchive "BugFixArchiveViewer viewKCPSwikiArchive" | kcpArchive viewer | Cursor wait showWhile: [ kcpArchive _ BugFixArchive kcpSwikiArchive ]. viewer _ self openOn: kcpArchive withLabel: 'Kernel Cleaning Project (KCP) Archive Viewer' withColor: Color orange lighter lighter lighter duller withDisplayGroupsPref: false. viewer displayInGroupsPref: false. viewer noteChanged.! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 7/3/2003 12:39'! addAttachments: aListOfFileNames | fileNames | fileNames _ aListOfFileNames union: self archivePost attachments. self archivePost attachments: fileNames. self changed: #attachmentsAsText. ! ! !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 7/3/2003 13:41'! attachments: aStringOfCrDelimitedFileNames | fileNames | self archivePost ifNil: [ ^ nil ]. aStringOfCrDelimitedFileNames isNil ifTrue: [ ^ nil ]. aStringOfCrDelimitedFileNames asString withBlanksTrimmed isEmpty ifTrue: [ self archivePost attachments: OrderedCollection new. ] ifFalse: [ fileNames _ aStringOfCrDelimitedFileNames asString findTokens: { Character cr. }. "Just clobber the present list of attachments on the model" self archivePost attachments: fileNames. ]. self changed: #attachmentsAsText. ! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 7/3/2003 13:42'! attachmentsAsText | txt | self attachments isEmptyOrNil ifTrue: [ ^ '' ]. txt _ (String streamContents: [ :strm | self attachments do: [ :fn | strm nextPutAll: fn. strm nextPut: Character cr. ]. ]) asText. ^ txt ! ! !CommentNotePad methodsFor: 'accessing' stamp: 'bkv 6/23/2003 12:25'! mainComments ^ mainComments! ! !CommentNotePad methodsFor: 'accessing' stamp: 'nk 7/2/2003 13:45'! mainComments: aString mainComments _ aString. self changed: #mainComments.! ! !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: 'dvf 6/25/2003 23:26'! summaryComments: aString aString isNil ifTrue: [ ^ false ]. summaryComments _ aString asString copyWithoutAll: '()'. ^true! ! !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 7/3/2003 12:36'! buildAttachmentFileNamesPane ^ self buildTextPaneUsing: {'Attachment file names:'. #attachmentsAsText. #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 7/3/2003 12:48'! 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 changeDragAndDrop. 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 7/3/2003 12:32'! on: anArchivePost self parentPost: anArchivePost. self parentPost isNil ifTrue: [self archivePost: ArchivePost new initialize] ifFalse: [self 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: 'nk 7/2/2003 12:37'! defaultPostingAddress "Answer the default address for a post to the list, to be used for a new post" ^'squeak-dev@lists.squeakfoundation.org'! ! !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 7/3/2003 11:40'! mailCommentsTo: emailAddressOrNil "If emailAddressOrNil is nil, it will be filled in from either the parent post, or from the default list posting address." | aTitle windowLabel parensComments from to body mailMsg mailMan bodyStream | 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 ifNil: [ '' ]. body _ self mainComments. from _ MailSender userName. from isEmptyOrNil ifTrue: [ from _ '' ]. to _ emailAddressOrNil. body _ body ifNil: [ '' ]. "Prepare the message" bodyStream _ WriteStream on: (String new: 1500). bodyStream cr; cr; nextPutAll: body; nextPutAll: (String new: 14 withAll: Character cr); nextPutAll: self blurb. mailMsg _ MailMessage from: bodyStream contents. mailMsg setField: 'from' toString: from. mailMsg setField: 'subject' toString: (aTitle, ' ', parensComments). self setThreadingHeadersIn: mailMsg withToAddress: to. (mailMsg hasFieldNamed: 'to') ifFalse: [ mailMsg setField: 'to' toString: (to ifNil: [ self defaultPostingAddress ]) ]. "Make sure to add attachments if there are any" self addAttachmentsTo: mailMsg. 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: 'nk 7/2/2003 12:37'! mailCommentsToList | mailMan | mailMan _ self mailCommentsTo: nil. 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 7/3/2003 11:39'! setThreadingHeadersIn: aMailMessage withToAddress: anEmailAddress "Make sure we stay threaded, for MUAs that support threaded views" | parentMessage | self parentPost ifNil: [ ^ aMailMessage ]. parentMessage _ self parentPost asMailMessage. "We don't assume that the parentPost was created from a MailMessage object ( could have come from an RSS feed, etc. )." parentMessage ifNil: [ ^ aMailMessage ]. (parentMessage fieldNamed: 'message-id' ifAbsent: []) ifNotNilDo: [ :msgid | msgid _ msgid copy. aMailMessage setField: 'in-reply-to' to: msgid. aMailMessage setField: 'references' toString: ((parentMessage fieldsNamed: 'references' separatedBy: ' '), ' ', msgid mainValue). ]. (parentMessage fieldNamed: 'thread-topic' ifAbsent: []) ifNotNilDo: [ :topic | aMailMessage setField: 'thread-topic' to: topic copy. ]. (parentMessage fieldsNamed: 'cc' ifAbsent: []) ifNotNilDo: [ :ccs | aMailMessage setFields: 'cc' to: ccs copy. ]. anEmailAddress ifNil: [ | toFields | toFields _ parentMessage fieldsNamed: 'to' ifAbsent: []. toFields ifNotNil: [ aMailMessage setFields: 'to' to: toFields copy ]. ]. ^ aMailMessage ! ! !CommentNotePad methodsFor: 'services' stamp: 'bkv 6/2/2003 12:13'! title self archivePost ifNil: [ ^ nil ]. ^ self archivePost title ! ! !CommentNotePad methodsFor: 'drag''n''drop' stamp: 'bkv 7/3/2003 12:39'! acceptDroppingMorph: aTransferMorph event: evt inMorph: dest | fileName fullFileName | fileName _ aTransferMorph passenger. fullFileName _ FileDirectory default fullNameFor: fileName. self addAttachments: { fullFileName. }. ^ true! ! !CommentNotePad methodsFor: 'drag''n''drop' stamp: 'bkv 7/3/2003 12:07'! wantsDroppedMorph: aTransferMorph event: evt inMorph: dest ^ (aTransferMorph isKindOf: TransferMorph) and: [ aTransferMorph dragTransferType == #file ] ! ! !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.! ! !FileList methodsFor: 'volume list and pattern' stamp: 'nk 6/28/2003 11:59'! pattern: textOrStringOrNil (textOrStringOrNil isNil or: [ textOrStringOrNil isEmpty ]) ifTrue: [pattern _ '*'] ifFalse: [pattern _ textOrStringOrNil asString]. self changed: #pattern. self updateFileList. ^ true ! ! !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! ! CommentNotePad initialize! !CommentNotePad reorganize! ('accessing' addAttachments: archivePost archivePost: attachments attachments: attachmentsAsText 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 defaultPostingAddress editTitle mailCommentsTo: mailCommentsToAuthor mailCommentsToList mailServiceProvider openCommentsAsMailToAuthor openCommentsAsMailToList perform:orSendTo: setThreadingHeadersIn:withToAddress: title) ('drag''n''drop' acceptDroppingMorph:event:inMorph: wantsDroppedMorph:event:inMorph:) ! BugFixArchiveViewer initialize! !BugFixArchiveViewer reorganize! ('accessing' adHocFilterBlock adHocFilterBlock: displayInGroupsPref displayInGroupsPref: emailRegexp emailRegexp: groupSizeLimit groupSizeLimit: groupSizeLimitString initializePackagesList nameRegexp nameRegexp: titleOrBodyRegexp titleOrBodyRegexp:) ('filter utilities' defaultFilters initializeDisplayInGroupsPref 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 buildWindowMenu createWindow defaultWindowLabel openKeeper packageListFrame packagePaneFrame searchFrameHeight) ('gui building-field pane' addListControlSubPaneTo:using:inFrame: emailRegexpPaneFrame groupSizeLimitPaneFrame nameRegexpPaneFrame titleOrBodyRegexpPaneFrame) ('lists' collectPackageNames generalOptions packageSpecificOptions) ('model' on: packages update:) ('post-specific services' createComment explorePost importUidForSelectedBaseUrl mailAuthor mailList reloadPost removePost viewPostAttachments) ('preferences' asyncLoadUpdates asyncLoadUpdates:) ('submorphs-add/remove' delete) ('update services' cleanUpRepository listChanged loadMissingPosts loadMissingPostsAsynchronouslyFromUrl: loadMissingPostsFromUrl: loadMissingPostsSynchronouslyFromUrl: loadPreviousAsynchronouslyStopAfter: loadPreviousPosts loadPreviousStopAfter: loadPreviousSynchronouslyStopAfter: loadTheWholeEnchilada loadUpdates loadUpdatesAsynchronouslyStopAfter: loadUpdatesStopAfter: loadUpdatesSynchronouslyStopAfter: newAsyncPosts: newPosts: stopAsyncUpdate updateUrls validateLocalArchive) ('viewer services' viewApprovedNotYetInUpdateStream viewReviewedNotYetApproved viewUnreviewed) ! !AbstractPackageViewer reorganize! ('accessing' filter filter: noteChanged packagesListIndex packagesListIndex: windowColor windowColor:) ('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 packageMenu:shifted: packagePaneFrame paneColor perform:orSendTo:) ('lists' collectPackageNames initializePackagesList packageList packageNameList packageSpecificOptions packagesMenu:) ('model' contents isUpdatable on: packages selectedPackage update:) ('preferences' displayUsingFilters startupCacheMax startupLoadMax updatesMax) ('services' loadUpdates) !