'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 28 October 2003 at 12:36:10 pm'! "Change Set: browseWithComments Date: 28 October 2003 Author: Lex Spoon This changeset causes class comments to appear in the system browser whenever a class definition is being viewed."! !Browser methodsFor: 'accessing' stamp: 'ls 10/28/2003 12:28'! 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: [^ self classDefinitionText ]. 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: 'class functions' stamp: 'ls 10/28/2003 12:34'! classDefinitionText "return the text to display for the definition of the currently selected class" | theClass | theClass _ self selectedClassOrMetaClass. theClass ifNil: [ ^'']. ^Text streamContents: [ :str | str nextPutAll: (theClass definitionST80: Preferences printAlternateSyntax not). str cr; cr. theClass hasComment ifTrue: [ str nextPutAll: '"Class comment:"'; cr. "ideally, this should avoid the asString, so that the text attributes are nice" str nextPutAll: theClass comment asString asSmalltalkComment ] ifFalse: [ str withAttribute: TextColor red do: [ str nextPutAll: '"THIS CLASS HAS NO COMMENT!!"' ] ] ]. ! ! !ClassDescription methodsFor: 'accessing' stamp: 'ls 10/28/2003 12:32'! hasComment "return whether this class truly has a comment other than the default" | org | org := self theNonMetaClass organization. ^org classComment notNil and: [ org classComment isEmpty not ]. ! ! !String methodsFor: 'converting' stamp: 'ls 10/28/2003 12:24'! asSmalltalkComment "return this string, munged so that it can be treated as a comment in Smalltalk code. Quote marks are added to the beginning and end of the string, and whenever a solitary quote mark appears within the string, it is doubled" ^String streamContents: [ :str | | quoteCount first | str nextPut: $". quoteCount := 0. first := true. self do: [ :char | char = $" ifTrue: [ first ifFalse: [ str nextPut: char. quoteCount := quoteCount + 1 ] ] ifFalse: [ quoteCount odd ifTrue: [ "add a quote to even the number of quotes in a row" str nextPut: $" ]. quoteCount := 0. str nextPut: char ]. first := false ]. quoteCount odd ifTrue: [ "check at the end" str nextPut: $". ]. str nextPut: $". ]. ! !