'From Squeak3.3alpha of 18 January 2002 [latest update: #4955] on 15 August 2002 at 11:21:25 pm'! "Change Set: commentVersions-asm Date: 13 August 2002 Author: Alejandro Magistrello A class-comment-versions-browser tool. Published as 4959commentVersions-asm.cs to 3.3a. To use, choose 'versions' from the selector-list-menu (or hit the 'versions' button) of a browser or message-list when a class comment is showing."! VersionsBrowser subclass: #ClassCommentVersionsBrowser instanceVariableNames: '' classVariableNames: '' module: #(Squeak Development Changes)! !ClassCommentVersionsBrowser commentStamp: 'asm 8/13/2002 23:20' prior: 0! A class-comment-versions-browser tool! !StringHolder methodsFor: 'message list menu' stamp: 'asm 8/13/2002 23:15'! browseVersions "Create and schedule a Versions Browser, showing all versions of the currently selected message." | selector class | (selector _ self selectedMessageName) ifNil:[^ self inform: 'Sorry, only actual methods have retrievable versions.'] ifNotNil: [(MessageSet isPseudoSelector: selector) ifTrue: ["Eliminates Definition and Hierarchy" ^ self classCommentIndicated ifTrue: [ ClassCommentVersionsBrowser browseCommentOf: self selectedClass]]. class _ self selectedClassOrMetaClass. VersionsBrowser browseVersionsOf: (class compiledMethodAt: selector) class: self selectedClass meta: class isMeta category: (class organization categoryOfElement: selector) selector: selector]! ! !ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'asm 8/13/2002 21:33'! compareToCurrentVersion "If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text" | change s1 s2 | listIndex = 0 ifTrue: [^ self]. change _ changeList at: listIndex. s1 _ classOfMethod organization classComment. s2 _ change string. s1 = s2 ifTrue: [^ self inform: 'Exact Match']. (StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: s1 to: s2 inClass: classOfMethod prettyDiffs: self showingPrettyDiffs)) openLabel: 'Comparison to Current Version'! ! !ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'asm 8/13/2002 21:02'! offerVersionsHelp (StringHolder new contents: self versionsHelpString) openLabel: 'Class Comment Versions Browsers'! ! !ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'asm 8/13/2002 23:37'! openSingleMessageBrowser | mr | "Create and schedule a message list browser populated only by the currently selected message" mr _ MethodReference new setStandardClass: self selectedClass methodSymbol: #Comment. Smalltalk browseMessageList: (Array with: mr) name: mr asStringOrText autoSelect: nil! ! !ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'asm 8/13/2002 21:53'! versionsMenu: aMenu "Fill aMenu with menu items appropriate to the receiver" Smalltalk isMorphic ifTrue: [aMenu title: 'versions'. aMenu addStayUpItemSpecial]. ^ aMenu addList: #( ('compare to current' compareToCurrentVersion 'compare selected version to the current version') ('revert to selected version' fileInSelections 'resubmit the selected version, so that it becomes the current version') ('remove from changes' removeMethodFromChanges 'remove this method from the current change set, if present') ('edit current method (O)' openSingleMessageBrowser 'open a single-message browser on the current version of this method') - ('toggle diffing (D)' toggleDiffing 'toggle whether or not diffs should be shown here') ('update list' reformulateList 'reformulate the list of versions, in case it somehow got out of synch with reality') - ('help...' offerVersionsHelp 'provide an explanation of the use of this tool')) ! ! !ClassCommentVersionsBrowser methodsFor: 'basic function' stamp: 'asm 8/13/2002 20:52'! scanVersionsOf: class " | position prevPos prevFileIndex preamble tokens stamp oldCommentRemoteStr ptr |" | oldCommentRemoteStr sourceFilesCopy position prevPos stamp preamble tokens prevFileIndex | classOfMethod _ class. oldCommentRemoteStr _ class organization commentRemoteStr. currentCompiledMethod _ oldCommentRemoteStr. changeList _ OrderedCollection new. list _ OrderedCollection new. listIndex _ 0. oldCommentRemoteStr ifNil:[^ nil] ifNotNil: [oldCommentRemoteStr sourcePointer]. sourceFilesCopy _ SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. position _ oldCommentRemoteStr position. file _ sourceFilesCopy at: oldCommentRemoteStr sourceFileNumber. [position notNil & file notNil] whileTrue: [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]. prevPos _ nil. stamp _ ''. (preamble findString: 'commentStamp:' startingAt: 1) > 0 ifTrue: [tokens _ Scanner new scanTokens: preamble] ifFalse: [tokens _ Array new]. (tokens at: tokens size-3) = #commentStamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp _ tokens at: tokens size-2. prevPos _ tokens last. prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos]. " ifFalse: [Old format gives no stamp; prior pointer in two parts prevPos _ tokens at: tokens size-2. prevFileIndex _ tokens last]. (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]]." self addItem: (ChangeRecord new file: file position: position type: #classComment class: class name category: nil meta: class stamp: stamp) text: stamp , ' ' , class name , ' class comment'. position _ prevPos. prevPos notNil & prevFileIndex > 0 ifTrue:[file _ sourceFilesCopy at: prevFileIndex] ifFalse:[file _ nil]]. sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]. listSelections _ Array new: list size withAll: false! ! !ClassCommentVersionsBrowser methodsFor: 'basic function' stamp: 'asm 8/13/2002 22:26'! diffedVersionContents "Answer diffed version contents, maybe pretty maybe not" | change class earlier later | (listIndex = 0 or: [changeList size < listIndex]) ifTrue: [^ '']. change _ changeList at: listIndex. later _ change text. class _ self selectedClass. (listIndex == changeList size or: [class == nil]) ifTrue: [^ later]. earlier _ (changeList at: listIndex + 1) text. ^ TextDiffBuilder buildDisplayPatchFrom: earlier to: later inClass: class prettyDiffs: self showingPrettyDiffs! ! !ClassCommentVersionsBrowser methodsFor: 'basic function' stamp: 'asm 8/13/2002 21:28'! reformulateList classOfMethod organization classComment ifNil: [^ self]. self scanVersionsOf: classOfMethod. self changed: #list. "for benefit of mvc" listIndex _ 1. self changed: #listIndex. self contentsChanged! ! !ClassCommentVersionsBrowser methodsFor: 'basic function' stamp: 'asm 8/13/2002 21:33'! updateListsAndCodeIn: aWindow | aComment | aComment _ classOfMethod organization commentRemoteStr. aComment == currentCompiledMethod ifFalse: ["Do not attempt to formulate if there is no source pointer. It probably means it has been recompiled, but the source hasn't been written (as during a display of the 'save text simply?' confirmation)." aComment last ~= 0 ifTrue: [self reformulateList]]. ^ true ! ! !ClassCommentVersionsBrowser methodsFor: 'misc' stamp: 'asm 8/13/2002 22:14'! priorSourceOrNil "If the currently-selected method has a previous version, return its source, else return nil" | aClass aSelector changeRecords | (aClass _ self selectedClass) ifNil: [^ nil]. (aSelector _ self selectedMessageName) ifNil: [^ nil]. changeRecords _ self class commentRecordsOf: self selectedClass. (changeRecords == nil or: [changeRecords size <= 1]) ifTrue: [^ nil]. ^ (changeRecords at: 2) string ! ! !ClassCommentVersionsBrowser methodsFor: 'misc' stamp: 'asm 8/13/2002 20:59'! selectedClass "Answer the class currently selected in the browser. In the case of a VersionsBrowser, the class and selector are always the same, regardless of which version is selected and indeed whether or not any entry is selected in the list pane" ^ classOfMethod! ! !ClassCommentVersionsBrowser class methodsFor: 'instance creation' stamp: 'asm 8/12/2002 22:46'! browseCommentOf: class | changeList | Cursor read showWhile: [changeList _ self new scanVersionsOf: class. changeList ifNil: [^ self inform: 'No versions available']. self open: changeList name: 'Recent versions of ',class name,'''s comments' multiSelect: false ] ! ! !ClassCommentVersionsBrowser class methodsFor: 'utilities' stamp: 'asm 8/13/2002 22:09'! commentRecordsOf: aClass "Return a list of ChangeRecords for all versions of the method at selector. Source code can be retrieved by sending string to any one. Return nil if the method is absent." | aList | aList _ self new scanVersionsOf: aClass. ^ aList ifNotNil: [aList changeList]! ! !ClassCommentVersionsBrowser class methodsFor: 'utilities' stamp: 'asm 8/13/2002 20:54'! timeStampFor: aSelector class: aClass reverseOrdinal: anInteger "Answer the time stamp corresponding to some version of the given method, nil if none. The reverseOrdinal parameter is interpreted as: 1 = current version; 2 = last-but-one version, etc." | aChangeList | aChangeList _ self new scanVersionsOf: aClass. ^ aChangeList ifNil: [nil] ifNotNil: [aChangeList list size >= anInteger ifTrue: [(aChangeList changeList at: anInteger) stamp] ifFalse: [nil]]! ! !ClassCommentVersionsBrowser class methodsFor: 'window color' stamp: 'asm 8/13/2002 20:57'! windowColorSpecification "Answer a WindowColorSpec object that declares my preference" ^ WindowColorSpec classSymbol: self name wording: 'Class Comment Versions Browser' brightColor: #(0.769 0.653 1.0) pastelColor: #(0.819 0.753 1.0) helpMessage: 'A tool for viewing prior versions of a class comment.'! !