'From Squeak3.3alpha of 18 January 2002 [latest update: #4938] on 1 August 2002 at 6:28:50 pm'! "Change Set: classCommentStamp-sw Date: 1 August 2002 Author: Scott Wallace ¥ Fixes the long-standing deficiency that had kept class-comment-time-stamps from getting properly imported and preserved upon file-in. ¥ Makes the annotation pane of a code tool show the class-comment's time-stamp when the tool (browser or message-list) is displaying a class comment. At last. ¥ Makes browsers and message-lists that are pointing at class comments keep up-to-date when the class comments have changed elsewhere, uniform with the way the 'smart-updating' mechanism has worked for actual methods for years. ¥ Note that most class comments in the system have the old place-holder '' stamp, caused by the earlier flaws in this mechanism; and this update cannot recapture the original authoring stamps for these, but at least from this point forward, class-comment authoring stamps *should* be preserved, maintained, shown in annotation panes, and properly carried forward from image to image via fileout. ¥ Still waiting for someone to undertake: a class-comment-versions-browser tool."! ClassCategoryReader subclass: #ClassCommentReader instanceVariableNames: '' classVariableNames: '' module: #(Squeak Language Core Classes)! !ClassCommentReader methodsFor: 'as yet unclassified' stamp: 'sw 7/31/2002 10:40'! scanFrom: aStream "File in the class comment from aStream. Not string-i-fied, just a text, exactly as it is in the browser. Move to changes file." class theNonMetaClass classComment: (aStream nextChunkText) stamp: changeStamp "Writes it on the disk and saves a RemoteString ref"! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'sw 8/1/2002 14:25'! classComment: aString "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." aString isEmptyOrNil ifFalse: [self error: 'class comment set without stamp']. ^ self classComment: '' stamp: 'ignored'! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'sw 8/1/2002 14:23'! classComment: aString stamp: aStamp "Store the comment, aString or Text or RemoteString, associated with the class we are organizing. Empty string gets stored only if had a non-empty one before." | ptr header file oldCommentRemoteStr | (aString isKindOf: RemoteString) ifTrue: [Smalltalk changes commentClass: self. ^ self organization classComment: aString stamp: aStamp]. oldCommentRemoteStr _ self organization commentRemoteStr. (aString size = 0) & (oldCommentRemoteStr == nil) ifTrue: [^ organization classComment: nil]. "never had a class comment, no need to write empty string out" ptr _ oldCommentRemoteStr ifNil: [0] ifNotNil: [oldCommentRemoteStr sourcePointer]. SourceFiles ifNotNil: [(file _ SourceFiles at: 2) ifNotNil: [file setToEnd; cr; nextPut: $!!. "directly" "Should be saying (file command: 'H3') for HTML, but ignoring it here" header _ String streamContents: [:strm | strm nextPutAll: self name; nextPutAll: ' commentStamp: '. aStamp storeOn: strm. strm nextPutAll: ' prior: '; nextPutAll: ptr printString]. file nextChunkPut: header]]. Smalltalk changes commentClass: self. organization classComment: (RemoteString newString: aString onFileNumber: 2) stamp: aStamp ! ! !ClassDescription methodsFor: 'fileIn/Out' stamp: 'sw 8/1/2002 14:39'! fileOutMethod: selector asHtml: useHtml "Write source code of a single method on a file in .st or .html format" | fileStream nameBody | (selector == #Comment) ifTrue: [^ self inform: 'Sorry, cannot file out class comment in isolation.']. (self includesSelector: selector) ifFalse: [^ self error: 'Selector ', selector asString, ' not found']. nameBody _ self name , '-' , (selector copyReplaceAll: ':' with: ''). fileStream _ useHtml ifTrue: [(FileStream newFileNamed: nameBody , '.html') asHtml] ifFalse: [FileStream newFileNamed: nameBody , '.st']. fileStream header; timeStamp. self printMethodChunk: selector withPreamble: true on: fileStream moveSource: false toFile: 0. fileStream close! ! !ClassOrganizer methodsFor: 'accessing' stamp: 'sw 7/31/2002 11:07'! classComment: aString stamp: aStamp "Store the comment, aString, associated with the object that refers to the receiver." self commentStamp: aStamp. (aString isKindOf: RemoteString) ifTrue: [globalComment _ aString] ifFalse: [(aString == nil or: [aString size = 0]) ifTrue: [globalComment _ nil] ifFalse: [self error: 'use aClass classComment:'. globalComment _ RemoteString newString: aString onFileNumber: 2]] "Later add priorSource and date and initials?"! ! !ClassOrganizer methodsFor: 'accessing' stamp: 'sw 7/31/2002 02:00'! commentStamp "Answer the comment stamp for the class" ^ commentStamp! ! !CodeHolder methodsFor: 'annotation' stamp: 'sw 7/31/2002 11:20'! annotationForClassCommentFor: aClass "Provide a line of content for an annotation pane, given that the receiver is pointing at the clas comment of the given class." | aStamp | aStamp _ aClass organization commentStamp. ^ aStamp ifNil: [aClass name, ' has no class comment'] ifNotNil: ['class comment for ', aClass name, (aStamp = '' ifFalse: [' - ', aStamp] ifTrue: [''])]! ! !CodeHolder methodsFor: 'annotation' stamp: 'sw 7/31/2002 10:55'! annotationForSelector: aSelector ofClass: aClass "Provide a line of content for an annotation pane, representing information about the given selector and class" | stamp sendersCount implementorsCount aCategory separator aString aList aComment aStream requestList | aSelector == #Comment ifTrue: [^ self annotationForClassCommentFor: aClass]. aStream _ ReadWriteStream on: ''. requestList _ self annotationRequests. separator _ requestList size > 1 ifTrue: [self annotationSeparator] ifFalse: ['']. requestList do: [:aRequest | aRequest == #firstComment ifTrue: [aComment _ aClass firstCommentAt: aSelector. aComment isEmptyOrNil ifFalse: [aStream nextPutAll: aComment, separator]]. aRequest == #masterComment ifTrue: [aComment _ aClass supermostPrecodeCommentFor: aSelector. aComment isEmptyOrNil ifFalse: [aStream nextPutAll: aComment, separator]]. aRequest == #documentation ifTrue: [aComment _ aClass precodeCommentOrInheritedCommentFor: aSelector. aComment isEmptyOrNil ifFalse: [aStream nextPutAll: aComment, separator]]. aRequest == #timeStamp ifTrue: [stamp _ self timeStamp. aStream nextPutAll: (stamp size > 0 ifTrue: [stamp, separator] ifFalse: ['no timeStamp', separator])]. aRequest == #messageCategory ifTrue: [aCategory _ aClass organization categoryOfElement: aSelector. aCategory ifNotNil: "woud be nil for a method no longer present, e.g. in a recent-submissions browser" [aStream nextPutAll: aCategory, separator]]. aRequest == #sendersCount ifTrue: [sendersCount _ (Smalltalk allCallsOn: aSelector) size. sendersCount _ sendersCount == 1 ifTrue: ['1 sender'] ifFalse: [sendersCount printString, ' senders']. aStream nextPutAll: sendersCount, separator]. aRequest == #implementorsCount ifTrue: [implementorsCount _ Smalltalk numberOfImplementorsOf: aSelector. implementorsCount _ implementorsCount == 1 ifTrue: ['1 implementor'] ifFalse: [implementorsCount printString, ' implementors']. aStream nextPutAll: implementorsCount, separator]. aRequest == #priorVersionsCount ifTrue: [self addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream]. aRequest == #priorTimeStamp ifTrue: [stamp _ VersionsBrowser timeStampFor: aSelector class: aClass reverseOrdinal: 2. stamp ifNotNil: [aStream nextPutAll: 'prior time stamp: ', stamp, separator]]. aRequest == #recentChangeSet ifTrue: [aString _ ChangeSorter mostRecentChangeSetWithChangeForClass: aClass selector: aSelector. aString size > 0 ifTrue: [aStream nextPutAll: aString, separator]]. aRequest == #allChangeSets ifTrue: [aList _ ChangeSorter allChangeSetsWithClass: aClass selector: aSelector. aList size > 0 ifTrue: [aList size = 1 ifTrue: [aStream nextPutAll: 'only in change set '] ifFalse: [aStream nextPutAll: 'in change sets: ']. aList do: [:aChangeSet | aStream nextPutAll: aChangeSet name, ' ']] ifFalse: [aStream nextPutAll: 'in no change set']. aStream nextPutAll: separator]]. ^ aStream contents! ! !CodeHolder methodsFor: 'controls' stamp: 'sw 7/31/2002 13:12'! decorateForInheritance "Check to see if the currently-viewed method has a super send or an override, and if so, change screen feedback, unless the #decorateBrowserButtons says not to." | aColor aButton | (aButton _ self inheritanceButton) ifNil: [^ self]. aColor _ (((currentCompiledMethod isKindOf: CompiledMethod) not) or: [Preferences decorateBrowserButtons not]) ifTrue: [Color transparent] ifFalse: [currentCompiledMethod sendsToSuper ifTrue: [self isThereAnOverride ifTrue: [Color blue muchLighter] ifFalse: [Color green muchLighter ]] ifFalse: [self isThereAnOverride ifTrue: [Color tan lighter] ifFalse: [Color transparent]]]. aButton offColor: aColor! ! !CodeHolder methodsFor: 'self-updating' stamp: 'sw 7/31/2002 13:11'! didCodeChangeElsewhere "Determine whether the code for the currently selected method and class has been changed somewhere else." | aClass aSelector aCompiledMethod | currentCompiledMethod ifNil: [^ false]. (aClass _ self selectedClassOrMetaClass) ifNil: [^ false]. (aSelector _ self selectedMessageName) ifNil: [^ false]. aSelector == #Comment ifTrue: [^ currentCompiledMethod ~~ aClass organization commentRemoteStr]. ^ ((aCompiledMethod _ aClass compiledMethodAt: aSelector ifAbsent: [^ false]) ~~ currentCompiledMethod) and: [aCompiledMethod last ~= 0 "either not yet installed" or: [currentCompiledMethod last = 0 "or these methods don't have source pointers"]] ! ! !Browser methodsFor: 'accessing' stamp: 'sw 8/1/2002 14:20'! contents "Depending on the current selection, different information is retrieved. Answer a string description of that information. This information is the method of the currently selected class and message." | comment theClass latestCompiledMethod | latestCompiledMethod _ currentCompiledMethod. currentCompiledMethod _ nil. editSelection == #none ifTrue: [^ '']. editSelection == #editSystemCategories ifTrue: [^ systemOrganizer printString]. editSelection == #newClass ifTrue: [^ (theClass _ self selectedClass) ifNil: [Class template: self selectedSystemCategoryName] ifNotNil: [Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]]. editSelection == #editClass ifTrue: [^ (theClass _ self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass definitionST80: Preferences printAlternateSyntax not]]. editSelection == #editComment ifTrue: [(theClass _ self selectedClass) ifNil: [^ '']. comment _ theClass comment. currentCompiledMethod _ theClass organization commentRemoteStr. ^ comment size = 0 ifTrue: ['This class has not yet been commented.'] ifFalse: [comment]]. editSelection == #hierarchy ifTrue: [^ self selectedClassOrMetaClass printHierarchy]. editSelection == #editMessageCategories ifTrue: [^ self classOrMetaClassOrganizer printString]. editSelection == #newMessage ifTrue: [^ (theClass _ self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass sourceCodeTemplate]]. editSelection == #editMessage ifTrue: [self showingByteCodes ifTrue: [^ self selectedBytecodes]. currentCompiledMethod _ latestCompiledMethod. ^ self selectedMessage]. self error: 'Browser internal error: unknown edit selection.'! ! !Browser methodsFor: 'message list' stamp: 'sw 7/31/2002 13:25'! selectedMessageName "Answer the message selector of the currently selected message, if any. Answer nil otherwise." | aList | editSelection == #editComment ifTrue: [^ #Comment]. messageListIndex = 0 ifTrue: [^ nil]. ^ (aList _ self messageList) size >= messageListIndex ifTrue: [aList at: messageListIndex] ifFalse: [nil]! ! !Browser methodsFor: 'annotation' stamp: 'sw 8/1/2002 14:11'! annotation "Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver." | aSelector aClass | (aClass _ self selectedClassOrMetaClass) == nil ifTrue: [^ '------']. self editSelection == #editComment ifTrue: [^ self annotationForSelector: #Comment ofClass: aClass]. (aSelector _ self selectedMessageName) ifNil: [^ '------']. ^ self annotationForSelector: aSelector ofClass: aClass! ! !MessageSet methodsFor: 'contents' stamp: 'sw 7/31/2002 13:09'! selectedMessage "Answer the source method for the currently selected message." | source | self setClassAndSelectorIn: [:class :selector | class ifNil: [^ 'Class vanished']. selector first isUppercase ifTrue: [selector == #Comment ifTrue: [currentCompiledMethod _ class organization commentRemoteStr. ^ class comment]. selector == #Definition ifTrue: [^ class definitionST80: Preferences printAlternateSyntax not]. selector == #Hierarchy ifTrue: [^ class printHierarchy]]. source _ class sourceMethodAt: selector ifAbsent: [currentCompiledMethod _ nil. ^ 'Missing']. self showingDecompile ifTrue: [^ self decompiledSourceIntoContents]. currentCompiledMethod _ class compiledMethodAt: selector ifAbsent: [nil]. self showingDocumentation ifTrue: [^ self commentContents]. source _ self sourceStringPrettifiedAndDiffed. ^ source asText makeSelectorBoldIn: class]! ! !MessageSet methodsFor: 'private' stamp: 'sw 7/31/2002 12:58'! contents: aString notifying: aController "Compile the code in aString. Notify aController of any syntax errors. Answer false if the compilation fails. Otherwise, if the compilation created a new method, deselect the current selection. Then answer true." | category selector class oldSelector | self okayToAccept ifFalse: [^ false]. self setClassAndSelectorIn: [:c :os | class _ c. oldSelector _ os]. class ifNil: [^ false]. (oldSelector ~~ nil and: [oldSelector first isUppercase]) ifTrue: [oldSelector = #Comment ifTrue: [class comment: aString stamp: Utilities changeStamp. self changed: #annotation. self clearUserEditFlag. ^ false]. oldSelector = #Definition ifTrue: ["self defineClass: aString notifying: aController." class subclassDefinerClass evaluate: aString notifying: aController logged: true. self clearUserEditFlag. ^ false]. oldSelector = #Hierarchy ifTrue: [self inform: 'To change the hierarchy, edit the class definitions'. ^ false]]. "Normal method accept" category _ class organization categoryOfElement: oldSelector. selector _ class compile: aString classified: category notifying: aController. selector == nil ifTrue: [^ false]. self noteAcceptanceOfCodeFor: selector. selector == oldSelector ifFalse: [self reformulateListNoting: selector]. contents _ aString copy. self changed: #annotation. ^ true! !