'From Squeak3.3alpha of 18 January 2002 [latest update: #4955] on 17 August 2002 at 2:31:01 pm'! "Change Set: misc-sw Date: 16 August 2002 Author: Scott Wallace ¥ Fixes bugs that would raise errors when trying to view a class comment in a message-list-browser while showing bytecodes or tiles. ¥ Adds an item to selector-list menus to copy the selector to the clipboard; alt-c (cmd-c) serves as a kbd shortcut. ¥ Adds a method which will put up a message-list browser showing all uncommented methods with any particular initials, presented in chronological order. Use this to locate all the methods you last touched which lack comments at the head of the method. For example: Utilities browseUncommentedMethodsWithInitials: 'jm'. ¥ Adds a utility method that produces compact printouts of summaries for any range of updates, using Dan's #summaryString method."! !StringHolder methodsFor: 'message list menu' stamp: 'sw 8/5/2002 16:53'! copySelector "Copy the selected selector to the clipboard" | selector | (selector _ self selectedMessageName) ifNotNil: [Clipboard clipboardText: selector asString]! ! !StringHolder methodsFor: 'message list menu' stamp: 'sw 8/5/2002 16:54'! messageListKey: aChar from: view "Respond to a Command key. I am a model with a code pane, and I also have a listView that has a list of methods. The view knows how to get the list and selection." | sel class | aChar == $D ifTrue: [^ self toggleDiffing]. sel _ self selectedMessageName. aChar == $m ifTrue: "These next two put up a type in if no message selected" [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: Smalltalk]. aChar == $n ifTrue: [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: Smalltalk]. "The following require a class selection" (class _ self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view]. aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $i ifTrue: [^ self methodHierarchy]. aChar == $h ifTrue: [^ self classHierarchy]. aChar == $p ifTrue: [^ self browseFullProtocol]. "The following require a method selection" sel ifNotNil: [aChar == $o ifTrue: [^ self fileOutMessage]. aChar == $c ifTrue: [^ self copySelector]. aChar == $v ifTrue: [^ self browseVersions]. aChar == $O ifTrue: [^ self openSingleMessageBrowser]. aChar == $x ifTrue: [^ self removeMessage]]. ^ self arrowKey: aChar from: view! ! !CodeHolder methodsFor: 'tiles' stamp: 'sw 8/16/2002 23:39'! installTilesForSelection "Install universal tiles into the code pane." | source aSelector aClass tree syn tileScriptor aWindow codePane | (aWindow _ self containingWindow) ifNil: [self error: 'hamna dirisha']. tileScriptor _ ( (aSelector _ self selectedMessageName) isNil or: [(aClass _ self selectedClassOrMetaClass classThatUnderstands: aSelector) isNil]) ifTrue: [PluggableTileScriptorMorph new] ifFalse: [source _ aClass sourceCodeAt: aSelector. tree _ Compiler new parse: source in: aClass notifying: nil. (syn _ tree asMorphicSyntaxUsing: SyntaxMorph) parsedInClass: aClass. syn inAPluggableScrollPane]. codePane _ aWindow findDeepSubmorphThat: [:m | (m isKindOf: PluggableTextMorph) and: [m getTextSelector == #contents]] ifAbsent: [nil]. codePane ifNotNil: [codePane hideScrollBar]. codePane ifNil: [codePane _ aWindow findDeepSubmorphThat: [:m | m isKindOf: PluggableTileScriptorMorph] ifAbsent: [self error: 'no code pane']]. tileScriptor color: aWindow paneColorToUse; setProperty: #hideUnneededScrollbars toValue: true. aWindow replacePane: codePane with: tileScriptor. currentCompiledMethod _ aClass ifNotNil: [aClass compiledMethodAt: aSelector]. tileScriptor owner clipSubmorphs: true. tileScriptor extent: codePane extent.! ! !CodeHolder methodsFor: 'message list' stamp: 'sw 8/16/2002 23:23'! selectedBytecodes "Answer text to show in a code pane when in showing-byte-codes mode" ^ (self selectedClassOrMetaClass compiledMethodAt: self selectedMessageName ifAbsent: [^ '' asText]) symbolic asText! ! !CodeHolder methodsFor: 'message list menu' stamp: 'sw 8/5/2002 16:56'! messageListKey: aChar from: view "Respond to a Command key. I am a model with a code pane, and I also have a listView that has a list of methods. The view knows how to get the list and selection." | sel class | aChar == $D ifTrue: [^ self toggleDiffing]. sel _ self selectedMessageName. aChar == $m ifTrue: "These next two put up a type in if no message selected" [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: Smalltalk]. aChar == $n ifTrue: [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: Smalltalk]. "The following require a class selection" (class _ self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view]. aChar == $b ifTrue: [^ Browser fullOnClass: class selector: sel]. aChar == $N ifTrue: [^ self browseClassRefs]. aChar == $i ifTrue: [^ self methodHierarchy]. aChar == $h ifTrue: [^ self classHierarchy]. aChar == $p ifTrue: [^ self browseFullProtocol]. "The following require a method selection" sel ifNotNil: [aChar == $o ifTrue: [^ self fileOutMessage]. aChar == $c ifTrue: [^ self copySelector]. aChar == $v ifTrue: [^ self browseVersions]. aChar == $O ifTrue: [^ self openSingleMessageBrowser]. aChar == $x ifTrue: [^ self removeMessage]. (aChar == $C and: [self canShowMultipleMessageCategories]) ifTrue: [^ self showHomeCategory]]. ^ self arrowKey: aChar from: view! ! !Browser methodsFor: 'message functions' stamp: 'sw 8/5/2002 16:50'! messageListMenu: aMenu shifted: shifted "Answer the message-list menu" shifted ifTrue: [^ self shiftedMessageListMenu: aMenu]. aMenu addList:#( ('what to show...' offerWhatToShowMenu) - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' classHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut (o)' fileOutMessage) ('printOut' printOutMessage) ('copy selector (c)' copySelector) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) - ('inst var refs...' browseInstVarRefs) ('inst var defs...' browseInstVarDefs) ('class var refs...' browseClassVarRefs) ('class variables' browseClassVariables) ('class refs (N)' browseClassRefs) - ('remove method (x)' removeMessage) - ('more...' shiftedYellowButtonActivity)). ^ aMenu! ! !MessageNames methodsFor: 'message list menu' stamp: 'sw 8/15/2002 17:24'! copyName "Copy the current selector to the clipboard" | selector | (selector _ self selectorList at: selectorListIndex ifAbsent: [nil]) ifNotNil: [Clipboard clipboardText: selector asString asText]! ! !Utilities class methodsFor: 'fetching updates' stamp: 'sw 7/3/2002 23:07'! summariesForUpdates: startNumber through: stopNumber "Answer the concatenation of summary strings for updates numbered in the given range" ^ String streamContents: [:aStream | ((ChangeSorter changeSetsNamedSuchThat: [:aName | aName first isDigit and: [aName initialIntegerOrNil >= startNumber] and: [aName initialIntegerOrNil <= stopNumber]]) asSortedCollection: [:a :b | a name < b name]) do: [:aChangeSet | aStream cr; nextPutAll: aChangeSet summaryString]] "Utilities summariesForUpdates: 4899 through: 4903" ! ! !Utilities class methodsFor: 'identification' stamp: 'sw 8/13/2002 07:05'! browseUncommentedMethodsWithInitials: targetInitials "Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials. Present them in chronological order. CAUTION: It will take several minutes for this to complete." "Time millisecondsToRun: [Utilities browseUncommentedMethodsWithInitials: 'jm']" | initials timeStamp methodReferences cm aMessageSet | methodReferences _ OrderedCollection new. Smalltalk allBehaviorsDo: [:aClass | aClass selectors do: [:sel | cm _ aClass compiledMethodAt: sel. timeStamp _ Utilities timeStampForMethod: cm. timeStamp isEmpty ifFalse: [initials _ timeStamp substrings first. initials first isDigit ifFalse: [((initials = targetInitials) and: [(aClass firstPrecodeCommentFor: sel) isNil]) ifTrue: [methodReferences add: (MethodReference new setStandardClass: aClass methodSymbol: sel)]]]]]. aMessageSet _ MessageSet new initializeMessageList: methodReferences. aMessageSet sortByDate. MessageSet openMessageList: aMessageSet messageList name: 'Uncommented methods with initials ', targetInitials! !