'From Squeak3.3alpha of 18 January 2002 [latest update: #4938] on 1 August 2002 at 6:28:56 pm'! "Change Set: dateSortAndRecent-sw Date: 1 August 2002 Author: Scott Wallace Two largely unrelated enhancements: ¥ Allows user to request that a message-list be sorted by date of submission, via a new command in the shifted selector-list menu. Especially useful in implementors browsers, senders browsers, change-set browsers, etc. The oldest methods will be found at the top of the message-list, the most-recently-submitted ones at the bottom. ¥ Allows user to specify the number of past methods to be retained in the recent-submissions history; this is available in the shifted selector-list menu of a Recent Submissions browser."! !RecentMessageSet commentStamp: 'sw 8/1/2002 17:40' prior: 0! RecentMessageSet is a message set that shows the most recently-submitted methods, in chronological order.! !ClassOrganizer methodsFor: 'accessing' stamp: 'sw 8/1/2002 18:16'! dateCommentLastSubmitted "Answer a Date object indicating when my class comment was last submitted. If there is no date stamp, or one of the old-time guys, return nil" "RecentMessageSet organization dateCommentLastSubmitted" | aStamp tokens | (aStamp _ self commentStamp) isEmptyOrNil ifTrue: [^ nil]. tokens _ aStamp findBetweenSubStrs: ' '. "space is expected delimiter, but cr is sometimes seen, though of mysterious provenance" ^ tokens size > 1 ifTrue: [[tokens second asDate] ifError: [nil]] ifFalse: [nil]! ! !CompiledMethod methodsFor: 'printing' stamp: 'sw 7/29/2002 02:24'! dateMethodLastSubmitted "Answer a Date object indicating when a method was last submitted. If there is no date stamp, return nil" "(CompiledMethod compiledMethodAt: #dateMethodLastSubmitted) dateMethodLastSubmitted" | aStamp tokens | aStamp _ self timeStamp. tokens _ aStamp findBetweenSubStrs: ' '. "space is expected delimiter, but cr is sometimes seen, though of mysterious provenance" ^ tokens size > 1 ifTrue: [[tokens second asDate] ifError: [nil]] ifFalse: [nil]! ! !CompiledMethod methodsFor: 'printing' stamp: 'sw 7/29/2002 02:21'! timeStamp "Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available." "(CompiledMethod compiledMethodAt: #timeStamp) timeStamp" | position file preamble stamp tokens tokenCount | self fileIndex == 0 ifTrue: [^ String new]. "no source pointer for this method" position _ self filePosition. file _ SourceFiles at: self fileIndex. file ifNil: [^ String new]. "sources file not available" "file does not exist happens in secure mode" file _ [file readOnlyCopy] on: FileDoesNotExistException do:[:ex| nil]. file ifNil: [^ String new]. file position: (0 max: position - 150). "Skip back to before the preamble" [file position < (position - 1)] "then pick it up from the front" whileTrue: [preamble _ file nextChunk]. stamp _ String new. tokens _ (preamble findString: 'methodsFor:' startingAt: 1) > 0 ifTrue: [Scanner new scanTokens: preamble] ifFalse: [Array new "ie cant be back ref"]. (((tokenCount _ tokens size) between: 7 and: 8) and: [(tokens at: tokenCount - 5) = #methodsFor:]) ifTrue: [(tokens at: tokenCount - 3) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokenCount - 2]]. ((tokenCount between: 5 and: 6) and: [(tokens at: tokenCount - 3) = #methodsFor:]) ifTrue: [(tokens at: tokenCount - 1) = #stamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokenCount]]. file close. ^ stamp ! ! !MessageSet methodsFor: 'message list' stamp: 'sw 7/28/2002 22:39'! addExtraShiftedItemsTo: aMenu "The shifted selector-list menu is being built. Add items specific to MessageSet" self growable ifTrue: [aMenu addList: #( - ('remove from this browser' removeMessageFromBrowser) ('filter message list...' filterMessageList) ('add to message list...' augmentMessageList))]. aMenu add: 'sort by date' action: #sortByDate! ! !MessageSet methodsFor: 'message list' stamp: 'sw 8/1/2002 18:18'! sortByDate "Sort the message-list by date of time-stamp" | assocs aCompiledMethod aDate inOrder | assocs _ messageList collect: [:aRef | aDate _ aRef methodSymbol == #Comment ifTrue: [aRef actualClass organization dateCommentLastSubmitted] ifFalse: [aCompiledMethod _ aRef actualClass compiledMethodAt: aRef methodSymbol ifAbsent: [nil]. aCompiledMethod ifNotNil: [aCompiledMethod dateMethodLastSubmitted]]. aRef -> (aDate ifNil: [Date fromString: '01/01/1996'])]. "The dawn of Squeak history" inOrder _ assocs asSortedCollection: [:a :b | a value < b value]. messageList _ inOrder asArray collect: [:assoc | assoc key]. self changed: #messageList! ! !RecentMessageSet methodsFor: 'message list' stamp: 'sw 7/28/2002 23:20'! addExtraShiftedItemsTo: aMenu "The shifted selector-list menu is being built. Overridden here to defeat the presence of the items that add or change order, since RecentMessageSet defines methods & order explicitly based on external criteria" aMenu add: 'set size of recent history...' action: #setRecentHistorySize! ! !RecentMessageSet methodsFor: 'message list' stamp: 'sw 7/28/2002 23:50'! setRecentHistorySize "Let the user specify the recent history size" | aReply aNumber | aReply _ FillInTheBlank request: 'How many recent methods should be maintained?' initialAnswer: Utilities numberOfRecentSubmissionsToStore asString. aReply isEmptyOrNil ifFalse: [aNumber _ aReply asNumber rounded. (aNumber > 1 and: [aNumber <= 1000]) ifTrue: [Utilities numberOfRecentSubmissionsToStore: aNumber. self inform: 'Okay, ', aNumber asString, ' is the new size of the recent method history'] ifFalse: [self inform: 'Sorry, must be a number between 2 & 1000']] ! ! !Utilities class methodsFor: 'miscellaneous' stamp: 'sw 7/29/2002 02:23'! timeStampForMethod: method "Answer the authoring time-stamp for the given method, retrieved from the sources or changes file. Answer the empty string if no time stamp is available." "Utilities timeStampForMethod: (Utilities class compiledMethodAt: #timeStampForMethod:)" ^ method timeStamp! ! !Utilities class methodsFor: 'recent method submissions' stamp: 'sw 7/28/2002 23:20'! numberOfRecentSubmissionsToStore "Answer how many methods back the 'recent method submissions' history should store" ^ Preferences parameterAt: #numberOfRecentSubmissionsToStore ifAbsentPut: [30]! ! !Utilities class methodsFor: 'recent method submissions' stamp: 'sw 7/28/2002 23:52'! numberOfRecentSubmissionsToStore: aNumber "Set the number of Recent Submissions to store" Preferences setParameter: #numberOfRecentSubmissionsToStore to: aNumber! !