'From VisualWorks(R), Release 2.5.1 of October 9, 1996 on January 15, 1997 at 6:32:03 pm'! Object subclass: #AutoCommentorParameters instanceVariableNames: 'problemSection superclassSection contactsSection subclassesSection autoheaderSection headerDefault formattedVars varsSections refedBySection ' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! AutoCommentorParameters comment: 'Used to configure which sections of an auto comment should be generated. Instance Variables problemSection [description] superclassSection [description] contactsSection [description] subclassesSection [description] autoheaderSection [description] headerDefault [description] formattedVars [description] varsSections [description] refedBySection [description] Class Variables none Contacts barcalow@cat.ncsa.uiuc.edu '! !AutoCommentorParameters methodsFor: 'default setups'! allNew self headerDefault: true. self autoheaderSection: true. self superclassSection: true. self subclassesSection: true. self refedBySection: true. self formattedVars: true. self varsSections: true. self contactsSection: true. self problemSection: true.! allPreserve self headerDefault: false. self autoheaderSection: false. self superclassSection: false. self subclassesSection: false. self refedBySection: false. self formattedVars: false. self varsSections: false. self contactsSection: false. self problemSection: false.! htmlExists self allNew. self headerDefault: false. self varsSections: false. self contactsSection: true.! htmlNew self allNew. self headerDefault: false.! imageExists self allPreserve! imageNew self allNew. self superclassSection: false. self subclassesSection: false. self refedBySection: false.! ! !AutoCommentorParameters methodsFor: 'accessing'! autoheaderSection ^autoheaderSection! autoheaderSection: anObject autoheaderSection := anObject! contactsSection ^contactsSection! contactsSection: anObject contactsSection := anObject! formattedVars ^formattedVars! formattedVars: anObject formattedVars := anObject! headerDefault ^headerDefault! headerDefault: anObject headerDefault := anObject! problemSection ^problemSection! problemSection: anObject problemSection := anObject! refedBySection ^refedBySection! refedBySection: anObject refedBySection := anObject! subclassesSection ^subclassesSection! subclassesSection: anObject subclassesSection := anObject! superclassSection ^superclassSection! superclassSection: anObject superclassSection := anObject! varsSections ^varsSections! varsSections: anObject varsSections := anObject! ! Object subclass: #AutoCommentor instanceVariableNames: 'commentClass comment classVariable instVariable params isSearched commentStream parsedSubstrings ' classVariableNames: 'Contact Destination Matchers References ' poolDictionaries: '' category: 'Documentation-Tool'! AutoCommentor comment: ' Steps for adding a new regular expression 1) Create *RegExp method in AutoCommentor class>regular expressions which returns the regular expression string. 2) Create *Parser: method in AutoCommentor>parsers 3) Create string generation method in the ''string - parsed substr'' protocol of AutoCommentor, ImageCommentor, and HtmlCommentor 4) Add entry for Matchers initialization in AutoCommentor class>>matchersSpec 5) Add entry to AutoCommentor>>findInExistingComment. If new regular expression overlaps with another regular expression, make sure they are correctly ordered. For an example of the results loof at the top of the Cat comment hierarchy: http://cat.ncsa.uiuc.edu/~yoder/fmdocs/comments/ Instance Variables commentClass [description] comment [description] classVariable [description] instVariable [description] params [description] isSearched [description] commentStream [description] parsedSubstrings [description] Class Variables Contact [email address] Matchers [description] References [description] Destination [directory name] Original Design and Ideas by Jeff Barcalow (barcalow@uiuc.edu) and Joe Yoder (yoder@uiuc.edu) Developed by Jeff Barcalow (barcalow@uiuc.edu) with Minor Coding by Joe Yoder (yoder@uiuc.edu)'! !AutoCommentor methodsFor: 'accessing'! classVariable classVariable isNil ifTrue: [classVariable := false]. ^classVariable! comment ^comment! comment: aString comment := aString! commentClass ^commentClass! commentClass: aClass commentClass := aClass. comment := aClass comment! commentStream commentStream isNil ifTrue: [commentStream := WriteStream on: (String new: 100)]. ^commentStream! instVariable instVariable isNil ifTrue: [instVariable := false]. ^instVariable! isSearched isSearched isNil ifTrue: [isSearched := false]. ^isSearched! isSearched: anObject isSearched := anObject! params ^params! params: anObject params := anObject! parsedSubstrings parsedSubstrings isNil ifTrue: [parsedSubstrings := SortedCollection sortBlock: [:x :y| x interval first < y interval first]]. ^parsedSubstrings! ! !AutoCommentor methodsFor: 'actions'! checkComment "comment must be searched first before this is called" self searchComment. self checkHtmls. self checkEmails. self checkVars. self checkTypes! createComment ^self subclassResponsibility! searchComment self isSearched ifFalse: [comment isEmpty ifTrue: [self class log error: 'Template comment' for: commentClass asString] ifFalse: [self isAutoGenerated ifTrue: [self class log error: 'Template comment' for: commentClass asString. comment := ''] ifFalse: [self class log status: 'Existing comment' for: commentClass asString]]. self findInExistingComment]. self isSearched: true. self checkHtmls! ! !AutoCommentor methodsFor: 'parsers'! completeParser: matcher ^matcher subexpression: 1.! varType2Parser: matcher | var type1 typeConnector type2 type | var := matcher subexpression: 3. type1 := matcher subexpression: 4. typeConnector := matcher subexpression: 5. type2 := matcher subexpression: 7. type := type1 , typeConnector , type2. ^Array with: var with: type! varType3Parser: matcher | type1 var typeConnector type type2 | var := matcher subexpression: 3. type1 := matcher subexpression: 4. type2 := matcher subexpression: 5. typeConnector := ((Smalltalk includesKey: type1 asSymbol) and: [(Smalltalk at: type1 asSymbol) isKindOf: ValueModel]) ifTrue: [' on: '] ifFalse: [' of: ']. type := type1 , typeConnector , type2. ^Array with: var with: type! varType4Parser: matcher | type type1 var type3 type2 typeConnector1 typeConnector2 | var := matcher subexpression: 3. type1 := matcher subexpression: 4. type2 := matcher subexpression: 5. type3 := matcher subexpression: 6. typeConnector1 := ((Smalltalk includesKey: type1 asSymbol) and: [(Smalltalk at: type1 asSymbol) isKindOf: ValueModel]) ifTrue: [' on: '] ifFalse: [' of: ']. typeConnector2 := ((Smalltalk includesKey: type2 asSymbol) and: [(Smalltalk at: type2 asSymbol) isKindOf: ValueModel]) ifTrue: [' on '] ifFalse: [' of ']. type := type1 , typeConnector1 , type2 , typeConnector2 , type3. ^Array with: var with: type! varTypeParser: matcher | var type | var := matcher subexpression: 3. type := matcher subexpression: 4. ^Array with: var with: type! ! !AutoCommentor methodsFor: 'searching'! doMatcher: type | index | index := 1. [index > comment size] whileFalse: [index := self findUsing: type startingAt: index]! findInExistingComment self doMatcher: #varType2. self doMatcher: #varType. self doMatcher: #varType3. self doMatcher: #varType4. self doMatcher: #email. self doMatcher: #htmlLink. self doMatcher: #image. self doMatcher: #html. self findSections! findSections | index matcher | matcher := (Matchers at: #section) matcher. index := 1. [index < comment size] whileTrue: [| interval newParagraph oldIndex | oldIndex := index. (matcher search: (comment copyFrom: index to: comment size)) ifTrue: [interval := (matcher subBeginning: 1) + index - 1 to: (matcher subEnd: 1) + index - 1. newParagraph := comment copyFrom: index to: interval first. index := interval last + 1] ifFalse: ["not found" newParagraph := comment copyFrom: index to: comment size. index := comment size + 1]. (self isInstVarSection: newParagraph) ifTrue: [self processInstVarSectionFrom: oldIndex to: interval] ifFalse: [(self isClassVarSection: newParagraph) ifTrue: [self processClassVarSectionFrom: oldIndex to: interval] ifFalse: [self processDescriptionFrom: oldIndex to: interval]]]! findUsing: type startingAt: index | data matcher pss matcherSpec | matcherSpec := Matchers at: type. matcher := matcherSpec matcher. (matcher search: (comment copyFrom: index to: comment size)) ifFalse: [^comment size + 1]. data := self perform: matcherSpec parserSelector with: matcher. pss :=ParsedSubstringSpec new type: type; data: data; stringGenerationSelector: matcherSpec stringGenerationSelector; interval: (index + (matcher subBeginning: matcherSpec substringSelectorIndex) - 1 to: index + (matcher subEnd: matcherSpec substringSelectorIndex) - 1). (pss overlaps: self parsedSubstrings) ifFalse: [self parsedSubstrings add: pss]. ^index + (matcher subEnd: 1)! isClassVarSection: section | ret | ret := (section rangeOfPattern: 'Class Variable' startingAt: 1 ignoreCase: true) first ~= 0. ret ifTrue: [classVariable := true. self class log status: 'Class variable section found' for: commentClass asString]. ^ret! isInstVarSection: section | ret | ret := (section rangeOfPattern: 'Instance Variable' startingAt: 1 ignoreCase: true) first ~= 0. ret ifTrue: [instVariable := true. self class log status: 'Instance variable section found' for: commentClass asString]. ^ret! ! !AutoCommentor methodsFor: 'checking'! checkEmails self emails isEmpty ifFalse: [self class log status: 'Email contact found' for: commentClass asString]! checkHtmls self htmls isEmpty ifFalse: [self class log status: 'Html link found' for: commentClass asString]! checkTypes self varTypes do: [:each | | var type typeParts | var := each data first. type := each data last. type := type replaceAll: $| with: $ . typeParts := type tokensBasedOn: Character space. typeParts removeAllSuchThat: [:element | element isEmpty]. typeParts do: [:part | (((self class typeConnectors includes: part asSymbol) or: [Smalltalk includesKey: part asSymbol]) or: [Smalltalk includesKey: (self singularClassName: part) asSymbol]) ifFalse: [self class log error: 'Variable has invalid type' for: commentClass asString -> (Array with: var with: type)]]]! checkVars | classVarsFound instVarsFound allInstVars allClassVars varsFound | varsFound := self varTypes collect: [:each | each data first]. classVarsFound := varsFound select: [:each | each first isUppercase]. instVarsFound := varsFound select: [:each | each first isLowercase]. allInstVars := commentClass instVarNames asSet. allClassVars := commentClass classVarNames collect: [:each | each asString]. self instVariable ifTrue: [instVarsFound do: [:var | allInstVars remove: var ifAbsent: [self class log error: 'Instance variable commented but not in class definition' for: commentClass asString -> var]]. allInstVars do: [:var | self class log error: 'Instance variable not commented' for: commentClass asString -> var]]. self classVariable ifTrue: [classVarsFound do: [:var | allClassVars remove: var asString ifAbsent: [self class log error: 'Class variable comment but not in class definition' for: commentClass asString -> var]]. allClassVars do: [:var | self class log error: 'Class variable not commented' for: commentClass asString -> var]]. "commentClass instVarNames isEmpty not & self instVariable not ifTrue: [ self class log error: 'No instance variable section' for: commentClass asString]. commentClass classVarNames isEmpty not & self classVariable not ifTrue: [ self class log error: 'No class variable section' for: commentClass asString]"! emails ^self parsedSubstrings select: [:each | each isEmail]! htmls ^self parsedSubstrings select: [:each | each isHtml | each isImage | (each type = #htmlLink)].! variables ^self parsedSubstrings select: [:each | each type = #varType]! varTypes ^self parsedSubstrings select: [:each | each isVarType]! ! !AutoCommentor methodsFor: 'string'! classFilename ^self commentClass asString , '.html'! commaDelimitedList: classes ^classes isEmpty ifTrue: [self tab , 'none' , self cr] ifFalse: [| length tabLength stream | tabLength := self class tabLength. stream := String new writeStream. stream nextPutAll: self tab. length := tabLength. classes do: [:class | length := length + class printString size + 2. length > self class lineLength ifTrue: [stream nextPutAll: self crTab. length := tabLength + class printString size + 2]. stream nextPutAll: (self classString: class)] separatedBy: [stream nextPutAll: ', ']. stream nextPutAll: self cr. stream contents]! commentString ^(#(genHeadingSection genSuperclassSection genSubclassesSection genSubclassResponsibilitySection genReferencedBySection genExistingSection genInstVarSection genClassVarSection genContactsSection genProblemSection) do: [ :each | self commentStream nextPutAll: (self perform: each)]) asText! crTab ^self cr, self tab! emailList | string | self emails isEmpty ifTrue: [string := ' ' , (self email: self class contact) , '\' withCRs] ifFalse: ["under the current implementation, emailList is only called when self emails is Empty" string := self tab. self emails do: [:each | string := string , (each stringFor: self) , self cr] separatedBy: [string := string , self tab]]. ^string! singularClassName: part | newPart | (Smalltalk includesKey: part asSymbol) ifTrue: [^part] ifFalse: [part last = $s ifTrue: [newPart := part copyFrom: 1 to: part size - 1. (Smalltalk includesKey: newPart asSymbol) ifTrue: [^newPart] ifFalse: [newPart last = $e ifTrue: [newPart := newPart copyFrom: 1 to: newPart size - 1. (Smalltalk includesKey: newPart asSymbol) ifTrue: [^newPart] ifFalse: [newPart last = $i ifTrue: [newPart := (newPart copyFrom: 1 to: newPart size - 1) , 'y'. (Smalltalk includesKey: newPart asSymbol) ifTrue: [^newPart]]]]]]]. ^part! varList: varList ^varList isEmpty ifTrue: [' none\' withCRs] ifFalse: [| stream | stream := (String new: 20) writeStream. varList do: [:each | self parsedSubstrings add: (ParsedSubstringSpec new type: #varType; data: (Array with: each with: self class defaultType); stringGenerationSelector: #stringGenerationSelector; interval: (0 to: 0)). stream nextPutAll: (self var: each type: self class defaultType); cr]. stream contents]! ! !AutoCommentor methodsFor: 'string - parsed substr'! noChange: string ^string! varType: array ^self var: array first type: array last! ! !AutoCommentor methodsFor: 'string - subclass resp'! begin ^self subclassResponsibility! classString: aClass ^self subclassResponsibility! cr ^self subclassResponsibility! defaultContact ^self subclassResponsibility! email: string ^self subclassResponsibility! end ^self subclassResponsibility! fontBegin ^self subclassResponsibility! fontEnd ^self subclassResponsibility! gt ^self subclassResponsibility! heading ^self subclassResponsibility! image: string ^self subclassResponsibility! lt ^self subclassResponsibility! preformattedString: string ^self subclassResponsibility! section: dt withList: list ^self subclassResponsibility! tab ^self subclassResponsibility! typeString: aType ^self subclassResponsibility! url: string ^self subclassResponsibility! var: var type: type ^self subclassResponsibility! ! !AutoCommentor methodsFor: 'sections'! genClassVarSection ^self params varsSections ifTrue: [classVariable := true. self section: 'Class Variables' withList: (self varList: commentClass classVarNames)] ifFalse: ['']! genContactsSection ^(self params contactsSection and: [self emails isEmpty]) ifTrue: [ "only generate contact section of comments without email links" self section: 'Contacts' withList: self emailList] ifFalse: ['']! genExistingSection ^self params varsSections ifTrue: [''] ifFalse: [self params formattedVars ifTrue: [self genFormattedExistingSection] ifFalse: [self genUnformattedExistingSection]]! genFormattedExistingSection ^self subclassResponsibility! genHeadingSection ^self params autoheaderSection ifTrue: [(self params headerDefault ifTrue: [self class autoCommentString] ifFalse: ['']) , self heading] ifFalse: ['']! genInstVarSection ^self params varsSections ifTrue: [instVariable := true. self section: 'Instance Variables' withList: (self varList: commentClass instVarNames)] ifFalse: ['']! genProblemSection | probStr | ^self params problemSection ifTrue: [self checkComment. probStr := self class log errorStringForClass: commentClass. probStr isEmpty ifTrue: [''] ifFalse: [self section: 'Potential problems with this comment:' withList: (self preformattedString: probStr)]] ifFalse: ['']! genReferencedBySection ^self params refedBySection ifTrue: [self section: 'Referenced By' withList: (self commaDelimitedList: (self class referencesTo: commentClass))] ifFalse: ['']! genSubclassesSection ^self params subclassesSection ifTrue: [self section: 'Subclasses' withList: (self commaDelimitedList: (commentClass allSubclasses))] ifFalse: ['']! genSubclassResponsibilitySection | selectors | selectors := (commentClass whichSelectorsReferTo: (#subclass , #Responsibility) asSymbol) collect: [:each | each printString]. ^selectors isEmpty ifTrue: [''] ifFalse: [self section: 'Subclass Responsibilities' withList: (self commaDelimitedList: selectors)]! genSuperclassSection ^self params superclassSection ifTrue: [self section: 'Superclass' withList: ' ' , (self classString: commentClass superclass)] ifFalse: ['']! genUnformattedExistingSection ^self subclassResponsibility! ! !AutoCommentor methodsFor: 'testing'! isAutoGenerated ^(comment rangeOfPattern: self class autoCommentString startingAt: 1 ignoreCase: false) first ~= 0! ! !AutoCommentor methodsFor: 'unimplemeneted'! processClassVarSectionFrom: index to: interval! processDescriptionFrom: index to: interval! processInstVarSectionFrom: index to: interval! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AutoCommentor class instanceVariableNames: ''! !AutoCommentor class methodsFor: 'cat actions'! allCatCommentsCheck self destination: self catDestination. self contact: self catContact. ^self checkClassCommentsFor: self catClasses! allCatCommentsToWeb "Send all of the comments from catCategories to the web. Run the clearReferences below only if you have already run this once and wish to update the references. Also run clearComments if you want to delete old comments and categories on the web." "self clearReferences." self destination: self catDestination. self contact: self catContact. "self clearComments." self generateWebPagesFor: self catClasses! catCategories | categories | categories := (InstallChanges reuseCategories , InstallChanges auroraCategories, InstallChanges kemCategories , #(#'CAT-InstallSupport')) asOrderedCollection. ^categories reject: [:each| ('*DataModel' match: each) or: ['*DataTables' match: each]]! catClasses ^self classNamesForCategories: self catCategories! catContact ^'yoder@cs.uiuc.edu'! catDestination ^#('~barcalow/public_html/comments/' '~yoder/public_html/fmdocs/comments/') at: 2! ! !AutoCommentor class methodsFor: 'comment tool actions'! checkComment: aClass | wwwComment | self setup. wwwComment := self new commentClass: aClass. wwwComment checkComment. ^self log displayErrorsForClass: aClass! createComment: aClass | wwwComment | self setup. wwwComment := ImageCommentor new commentClass: aClass. ^wwwComment createComment! createTemplateComment: aClass | wwwComment | self setup. wwwComment := ImageCommentor new commentClass: aClass. ^wwwComment createTemplateComment! ! !AutoCommentor class methodsFor: 'classes and categories'! categoriesForClasses: classes | categories | categories := OrderedCollection new. classes do: [:class | (categories includes: class category) ifFalse: [categories add: class category]]. ^categories! classesForClassNames: classNames ^classNames collect: [:className | (Smalltalk at: className)]! classNamesForCategories: categories | classes | classes := OrderedCollection new. categories do: [:categ | classes addAll: (Smalltalk organization listAtCategoryNamed: categ)]. ^classes! ! !AutoCommentor class methodsFor: 'actions'! checkClassCommentsFor: classNames "self allCatCommentsCheck" | classes | classes := self classesForClassNames: classNames. self resetReferencesFor: classNames. self setup. classes do: [:each | (ImageCommentor new commentClass: each) checkComment]. ^self log displayErrorsByClass! generateWebCategoryIndexesFor: classes (self categoriesForClasses: classes) do: [:categ | | selectedClasses indexFilename | selectedClasses := (Smalltalk organization listAtCategoryNamed: categ) select: [:each | classes includes: (Smalltalk at: each)]. indexFilename := self categoryDirectory construct: categ copyWithoutSeparators , '.html'. self makeIndex: categ in: indexFilename for: selectedClasses in: '../classes' linkPost: '.html' credits: false]! generateWebClassCommentFor: classes self setup. classes do: [:each | | wwwComment | wwwComment := HtmlCommentor new commentClass: each. wwwComment dumpCommentIn: self classDirectory]! generateWebPagesFor: classNames | classes | classes := self classesForClassNames: classNames. self makeTopIndexFor: classes. self fileOutSelfToWWW. self generateWebCategoryIndexesFor: classes. self generateWebClassCommentFor: classes. ^self log errors! setup self log initialize. self initializeMatchers.! ! !AutoCommentor class methodsFor: 'classVars'! contact Contact isNil ifTrue: [Contact := '']. ^Contact! contact: string Contact := string! destination ^Destination! destination: aDirectoryName Destination := aDirectoryName! references References isNil ifTrue: [References := Dictionary new]. ^References! referencesTo: aClass ^self references at: aClass ifAbsent: [Set new]! resetReferencesFor: classesNames | assocs | References := Dictionary new. assocs := Set new. assocs := (classesNames collect: [:class | References at: (Smalltalk at: class) put: Set new. Smalltalk associationAt: class]) asSet. Smalltalk allBehaviorsDo: [:class | class selectors do: [:sel | | method | method := class compiledMethodAt: sel. method withAllBlockMethodsDo: [:m | m literalsDo: [:literal | (literal isVariableBinding and: [assocs includes: literal]) ifTrue: [(References at: literal value ifAbsentPut: [Set new]) add: (class isMeta ifTrue: [class soleInstance] ifFalse: [class])]]]]]! ! !AutoCommentor class methodsFor: 'constants'! autoCommentString ^'This comment was generated automatically by the AutoCommentor class. It still may\require further detail. Please remove these header sentences if you edit this comment.\\' withCRs! defaultType ^'aClass'! font ^'Times'! htmlBegin ^''! htmlCredits ^('

\Back to top page\

\

\These pages were automatically generated using \\' , self asString , '.' , '\
\If you have any questions or suggestions, please contact Jeff Barcalow\') withCRs! lineLength ^90! log ^AutoCommentorLog! typeConnectors "anObject should not be in this collection IMHO" ^#(of of: on on: and or or: with with: | nil anObject)! ! !AutoCommentor class methodsFor: 'string html'! htmlEnd ^''! htmlHeading: aClass ^'

' , aClass asString , '

\' withCRs! htmlTitle: aClass ^'' , aClass asString , ' \' withCRs! ! !AutoCommentor class methodsFor: 'index html'! htmlItemList: classes in: dirName linkPost: ending | stream | stream := (String new: 100) writeStream. stream nextPutAll: '
    '; cr. classes do: [:each | stream nextPutAll: '
  • '; nextPutAll: (self itemWithLink: each asString copyWithoutSeparators in: dirName linkPost: ending); cr]. stream nextPutAll: '
'. ^stream contents! itemWithLink: aClass in: dir linkPost: ending | dirString | dirString := dir isNil ifTrue: [''] ifFalse: [dir , '/']. ^'' , aClass asString , ''! makeIndex: title in: file for: items in: itemDirName linkPost: ending credits: creditsBoolean | stream | stream := file writeStream. stream nextPutAll: self htmlBegin. stream nextPutAll: (self htmlTitle: title asString). stream nextPutAll: (self htmlHeading: title asString). stream nextPutAll: (self htmlItemList: items in: itemDirName linkPost: ending). creditsBoolean ifTrue: [stream nextPutAll: self htmlCredits]. stream nextPutAll: self htmlEnd. stream flush. stream close! makeTopIndexFor: classes | file categories | categories := self categoriesForClasses: classes. file := (self destination asFilename construct: 'index.html'). self makeIndex: 'Comments' in: file for: categories in: 'categories' linkPost: '.html' credits: true! ! !AutoCommentor class methodsFor: 'file i/o'! categoryDirectory ^self destination asFilename construct: 'categories'! classDirectory ^self destination asFilename construct: 'classes'! clearComments self recursiveDeleteContentsOf: self classDirectory. self recursiveDeleteContentsOf: self categoryDirectory! fileOutSelfToWWW | fileManager | fileManager := SourceCodeStream write: (self destination asFilename constructString: self asString , '.st') encoding: #Source. [fileManager timeStamp. Smalltalk organization fileOutCategorySource: self category on: fileManager] valueNowOrOnUnwindDo: [fileManager close]! recursiveDeleteContentsOf: directory | files | files := directory directoryContents asList. files do: [:each | |file| file := directory construct: each. file isDirectory ifTrue: [self recursiveDeleteContentsOf: file]. file delete]! ! !AutoCommentor class methodsFor: 'matchers'! initializeMatchers Matchers := Dictionary new. self matchersSpec do: [:each | |matcher type matcherSpec| type := (each at: 1). matcher := self matcherClass new initializeFromString: (self perform: (each at: 2)). matcherSpec := MatcherSpec new. matcherSpec type: type; matcher: matcher; stringGenerationSelector: (each at: 4); parserSelector: (each at: 3); substringSelectorIndex: (each at: 5). Matchers at: type put: matcherSpec]! matcherClass ^(Smalltalk includesKey: #UnixRegExpression) ifTrue: [Smalltalk at: #UnixRegExpression] ifFalse: [Smalltalk at: #RxMatcher]! matchersSpec "Each array includes: 1) type/key 2) selector which returns string for regualr expression 3) selector which parses the matched string and creates the data for a ParsedSubstringSpec 4) selector which processes the data from the ParsedSubstringSpec into an output string 5) index of substring to generate interval from" ^#(#(#email #emailRegExp #completeParser: #email: 1) #(#varType #varTypeRegExp #varTypeParser: #varType: 2) #(#varType2 #varType2RegExp #varType2Parser: #varType: 2) #(#varType3 #varType3RegExp #varType3Parser: #varType: 2) #(#varType4 #varType4RegExp #varType4Parser: #varType: 2) #(#html #htmlURLRegExp #completeParser: #url: 1) #(#image #htmlImageRegExp #completeParser: #image: 1) #(#htmlLink #htmlLinkRegExp #completeParser: #noChange: 1) #(#section #sectionRegExp #noParser: #noChange: 1))! ! !AutoCommentor class methodsFor: 'regular expressions'! emailRegExp ^'[a-zA-Z]*@[a-zA-Z.]*'! htmlImageRegExp ^'http://[-0-9A-Za-z:/~.]*.(gif|jpg)'! htmlLinkRegExp ^'(<(a href|A HREF)="?(' , self htmlURLRegExp , ')"?>)([^<]*)'! htmlURLRegExp ^'http://[-0-9A-Za-z:/~.]*'! sectionRegExp ^'\[ ]*\' withCRs! varType2RegExp ^'\([ ]*([A-Za-z0-9]+)[ :-][ :-]*<([0-9_A-Za-z]+)>( (o[nf]|with):? )<([0-9_A-Za-z]+)>[ ]*)' withCRs! varType3RegExp ^'\([ ]*([A-Za-z0-9]+)[ :-][ :-]*<([0-9_A-Za-z]+) *<([0-9_A-Za-z| ]+)>>[ ]*)' withCRs! varType4RegExp ^'\([ ]*([A-Za-z0-9]+)[ :-][ :-]*<([0-9_A-Za-z]+) *<([0-9_A-Za-z]+) *<([0-9_A-Za-z| ]+)>>>[ ]*)' withCRs! varTypeRegExp ^'\([ ]*([A-Za-z0-9]+)[ :-][ :-]*<([0-9_A-Za-z:| ]+)>[ ]*)' withCRs! ! Object subclass: #ParsedSubstringSpec instanceVariableNames: 'interval type data stringGenerationSelector ' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! ParsedSubstringSpec comment: 'Stored information from the search stage of AutoCommentor for use in the comment generation stage. Instance Variables interval interval of matched string in the original comment type identifies which matcher was used to find string data Data found when string was matched Class Variables none Contacts barcalow@uiuc.edu '! !ParsedSubstringSpec methodsFor: 'accessing'! data ^data! data: anObject data := anObject! interval ^interval! interval: anObject interval := anObject! stringGenerationSelector ^stringGenerationSelector! stringGenerationSelector: anObject stringGenerationSelector := anObject! type ^type! type: anObject type := anObject! ! !ParsedSubstringSpec methodsFor: 'actions'! stringFor: ac ^ac perform: stringGenerationSelector with: data! uniqueAddTo: pssCollection (self overlaps: pssCollection) ifFalse: [pssCollection add: self].! ! !ParsedSubstringSpec methodsFor: 'printing'! printString ^data printString , ' ' , interval printString! ! !ParsedSubstringSpec methodsFor: 'testing'! isEmail ^self type = #email! isHtml ^self type = #html! isImage ^self type = #image! isVarType ^(self type indexOfSubCollection: #varType startingAt: 1) ~= 0! overlaps: pssCollection pssCollection detect: [:each | (interval includes: each interval first) or: [(interval includes: each interval last) or: [each interval includes: interval first]]] ifNone: [^false]. ^true! ! AutoCommentor subclass: #ImageCommentor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! !ImageCommentor methodsFor: 'actions'! createComment (comment isEmpty or: [self isAutoGenerated]) ifTrue: [self params: AutoCommentorParameters new imageNew] ifFalse: [self params: AutoCommentorParameters new imageExists]. self commentStream nextPutAll: self begin , self fontBegin. self commentString. self commentStream nextPutAll: self fontEnd , self end. ^commentStream contents! createTemplateComment self params: AutoCommentorParameters new imageNew. comment := ''. self commentStream nextPutAll: self begin , self fontBegin. self commentString. self commentStream nextPutAll: self fontEnd , self end. ^commentStream contents! ! !ImageCommentor methodsFor: 'string'! begin ^''! classString: aClass ^aClass asString! cr ^'\' withCRs! defaultContact ^(CEnvironment userEnvironment at: 'USER') , '@cat.ncsa.uiuc.edu'! end ^''! fontBegin ^''! fontEnd ^''! gt ^'>'! heading ^commentClass asString , '\ [general description]\\' withCRs! lt ^'<'! preformattedString: aString ^self noChange: aString! section: dt withList: dd ^dt , '\' withCRs , dd , '\' withCRs! tab ^' ' withCRs! typeString: type ^self lt , type , self gt , ' [description]'! var: variable type: type ^' ' , variable , ' ' , (self typeString: type)! ! !ImageCommentor methodsFor: 'string - parsed substr'! email: address ^self noChange: address! image: string ^self noChange: string! url: string ^self noChange: string! ! !ImageCommentor methodsFor: 'sections'! genFormattedExistingSection ^comment! genUnformattedExistingSection ^comment! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! ImageCommentor class instanceVariableNames: ''! !ImageCommentor class methodsFor: 'constants'! tabLength ^6! ! ApplicationModel subclass: #AutoCommentorDialog instanceVariableNames: 'environmentEditor ' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! AutoCommentorDialog comment: 'AutoCommentorDialog pops up an Interface for selecting the classes you would like to comment. It uses the Environments from the RefactoryBrowser developed by John Brant. Instance Variables environmentEditor [description] Class Variables none Contacts barcalow@uiuc.edu yoder@cs.uiuc.edu'! !AutoCommentorDialog methodsFor: 'actions'! cancel self closeRequest! check AutoCommentor checkClassCommentsFor: environmentEditor selectedEnvironment classNames! html | destination clearComments resetReferences classNames | destination := Dialog requestFileName: 'Please enter the top level web directory.' default: AutoCommentor destination version: #mustBeOld. destination isEmpty ifTrue: [^self]. clearComments := Dialog confirm: 'Clear existing comments?' initialAnswer: true. resetReferences := Dialog confirm: 'Reset ReferencedBy cache?' initialAnswer: true. classNames := environmentEditor selectedEnvironment classNames. AutoCommentor destination: destination. clearComments ifTrue: [AutoCommentor clearComments]. resetReferences ifTrue: [AutoCommentor resetReferencesFor: classNames]. AutoCommentor generateWebPagesFor: classNames. self closeRequest! ! !AutoCommentorDialog methodsFor: 'interface opening'! postBuildWith: aBuilder super postBuildWith: aBuilder. environmentEditor builder composite components do: [:each | (each widget isKindOf: RadioButtonView) ifTrue: [each beInvisible]]! ! !AutoCommentorDialog methodsFor: 'accessing'! environmentEditor "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^environmentEditor isNil ifTrue: [environmentEditor := EnvironmentEditor new environment: ClassEnvironment new] ifFalse: [environmentEditor]! ! !AutoCommentorDialog methodsFor: 'aspects'! clearComments "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^clearComments isNil ifTrue: [clearComments := false asValue] ifFalse: [clearComments]! clearReferences "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^clearReferences isNil ifTrue: [clearReferences := false asValue] ifFalse: [clearReferences]! destination "This method was generated by UIDefiner. Any edits made here may be lost whenever methods are automatically defined. The initialization provided below may have been preempted by an initialize method." ^destination isNil ifTrue: [destination := String new asValue] ifFalse: [destination]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AutoCommentorDialog class instanceVariableNames: ''! !AutoCommentorDialog class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Auto Comment Selector' #bounds: #(#Rectangle 362 308 886 738 ) #isEventDriven: true ) #component: #(#SpecCollection #collection: #( #(#SubCanvasSpec #layout: #(#LayoutFrame 0 0 0 0 0 1.00936 -66 1 ) #name: #environmentEditor #flags: 0 #majorKey: #EnvironmentEditor #minorKey: #classWindowSpec #clientKey: #environmentEditor ) #(#ActionButtonSpec #layout: #(#AlignmentOrigin 0 0.651685 -16 1 0.5 1 ) #name: #cancel #model: #cancel #label: 'Cancel' #defaultable: true ) #(#ActionButtonSpec #layout: #(#AlignmentOrigin 0 0.496255 -16 1 0.5 1 ) #name: #check #model: #check #label: 'Check' #defaultable: true ) #(#ActionButtonSpec #layout: #(#AlignmentOrigin 0 0.346442 -16 1 0.5 1 ) #name: #html #model: #html #label: 'HTML' #defaultable: true ) ) ) )! ! AutoCommentor subclass: #HtmlCommentor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! !HtmlCommentor methodsFor: 'actions'! createComment (comment isEmpty or: [self isAutoGenerated]) ifTrue: [self params: AutoCommentorParameters new htmlNew] ifFalse: [self params: AutoCommentorParameters new htmlExists]. self commentStream nextPutAll: self begin , self fontBegin. self commentString. self commentStream nextPutAll: self fontEnd , self end. ^commentStream contents! dumpCommentIn: baseDirectory | stream | stream := (baseDirectory construct: self classFilename) writeStream. [stream nextPutAll: self createComment. stream flush] valueNowOrOnUnwindDo: [stream close]! ! !HtmlCommentor methodsFor: 'searching'! findCommentFormatting self findLongSectionsBreaks. self findNewLt. self findNewGt! findLongSectionsBreaks | cr nexti overlap lineBegin i breaki sectionInterval intervals | intervals := self parsedSubstrings collect: [:each | each interval]. cr := '\' withCRs. i := 1. [i < comment size] whileTrue: [nexti := comment indexOfSubCollection: cr startingAt: i + 1. nexti = 0 ifTrue: [i := comment size] ifFalse: [sectionInterval := i to: nexti. overlap := intervals select: [:each | sectionInterval includes: each first]. overlap isEmpty ifTrue: [lineBegin := i + 1. [nexti - lineBegin > self class lineLength] whileTrue: [breaki := comment prevIndexOf: $ from: lineBegin + self class lineLength to: lineBegin. self parsedSubstrings add: (ParsedSubstringSpec new type: #cr; data: cr; stringGenerationSelector: #noChange:; interval: (breaki to: breaki)). lineBegin := breaki + 1]]. i := nexti + 1]]! findNewGt | i pss | i := 1. [i < comment size] whileTrue: [i := comment indexOfSubCollection: '>' startingAt: i. i = 0 ifTrue: [i := comment size] ifFalse: [pss := ParsedSubstringSpec new type: #gt; data: self gt; stringGenerationSelector: #noChange:; interval: (i to: i). pss uniqueAddTo: self parsedSubstrings. i := i + 1]]! findNewLt | i pss | i := 1. [i < comment size] whileTrue: [i := comment indexOfSubCollection: '<' startingAt: i. i = 0 ifTrue: [i := comment size] ifFalse: [pss := ParsedSubstringSpec new type: #lt; data: self lt; stringGenerationSelector: #noChange:; interval: (i to: i). pss uniqueAddTo: self parsedSubstrings. i := i + 1]]! replace: pattern with: replacement in: text startingAt: index | newText matcher | matcher := self class matcherClass new initializeFromString: pattern. (matcher search: (text copyFrom: index to: text size)) ifFalse: [^text -> (text size + 1)]. newText := text changeFrom: (matcher subBeginning: 1) + index - 1 to: (matcher subEnd: 1) + index - 1 with: replacement. ^newText -> ((matcher subBeginning: 1) + index - 1 + replacement size)! replaceAll: pattern in: text with: replacement | index newText | index := 1. newText := text. [index > newText size] whileFalse: [| r | r := self replace: pattern with: replacement in: newText startingAt: index. index := r value. newText := r key]. ^newText! ! !HtmlCommentor methodsFor: 'string'! begin ^'\' withCRs! classString: aClass ^(self class references keys includes: aClass) ifTrue: ['' , aClass asString , ''] ifFalse: [aClass asString]! cr ^'
\' withCRs! end ^''! fontBegin ^'\' withCRs! fontEnd ^'\' withCRs! gt ^'>'! heading ^(self class htmlTitle: commentClass) , (self class htmlHeading: commentClass)! lt ^'<'! preformattedString: aString ^'
' , aString , '
'! section: dt withList: dd ^'
' , dt , '\
' withCRs , dd , '
\

\' withCRs! tab ^'

' withCRs! typeString: type | string typeParts types | types := self replaceAll: '|' in: type with: ' | '. typeParts := types tokensBasedOn: Character space. string := self lt. typeParts do: [:part | | partString | partString := self singularClassName: part. partString := (Smalltalk includesKey: partString asSymbol) ifTrue: [self classString: (Smalltalk at: partString asSymbol)] ifFalse: [partString]. string := string , partString] separatedBy: [string := string , ' ']. ^string , self gt! var: variable type: type ^'
' , variable , ' ' , (self typeString: type) , ' '! ! !HtmlCommentor methodsFor: 'string - parsed substr'! email: address ^'' , address , '' withCRs! image: string ^''! url: string ^'' , string , ''! ! !HtmlCommentor methodsFor: 'sections'! genFormattedExistingSection | stream index | self searchComment. self findCommentFormatting. stream := (String new: 100) writeStream. stream nextPutAll: '
'.
	index := self parsedSubstrings inject: 1
				into: 
					[:i :each | 
					stream nextPutAll: (comment copyFrom: i to: each interval first - 1).
					stream nextPutAll: (each stringFor: self).
					each interval last + 1].
	stream nextPutAll: (comment copyFrom: index to: comment size).
	stream nextPutAll: '
\

\' withCRs. ^stream contents! genUnformattedExistingSection | text | text := self replaceAll: '>' in: comment with: self gt. ^self replaceAll: '<' in: text with: self lt! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! HtmlCommentor class instanceVariableNames: ''! !HtmlCommentor class methodsFor: 'constants'! tabLength ^10! ! Object subclass: #MatcherSpec instanceVariableNames: 'type matcher stringGenerationSelector parserSelector substringSelectorIndex ' classVariableNames: '' poolDictionaries: '' category: 'Documentation-Tool'! MatcherSpec comment: 'Instance Variables type [description] matcher [description] stringGenerationSelector [description] parserSelector [description] substringSelectorIndex [description] Class Variables none Contacts barcalow@uiuc.edu '! !MatcherSpec methodsFor: 'accessing'! matcher ^matcher! matcher: anObject matcher := anObject! parserSelector ^parserSelector! parserSelector: anObject parserSelector := anObject! stringGenerationSelector ^stringGenerationSelector! stringGenerationSelector: anObject stringGenerationSelector := anObject! substringSelectorIndex ^substringSelectorIndex! substringSelectorIndex: anObject substringSelectorIndex := anObject! type ^type! type: anObject type := anObject! ! ApplicationModel subclass: #AutoCommentorLog instanceVariableNames: 'errorString ' classVariableNames: 'Errors Status ' poolDictionaries: '' category: 'Documentation-Tool'! AutoCommentorLog comment: ' Logs status and error messages from the AutoCommentor. Also displays results from AutoCommentor>>checkComment: in a window. Instance Variables errorString Used by AutoCommentorLog''s display window Class Variables Status Errors Contacts barcalow@cat.ncsa.uiuc.edu '! !AutoCommentorLog methodsFor: 'accessing'! errorString ^errorString! errorString: anObject errorString := anObject! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! AutoCommentorLog class instanceVariableNames: ''! !AutoCommentorLog class methodsFor: 'initialize'! initialize super initialize. Status := Dictionary new. Errors := Dictionary new.! ! !AutoCommentorLog class methodsFor: 'actions'! clearLogForClass: aClass Errors keysAndValuesDo: [:error :classes | classes class = Dictionary ifTrue: [classes removeKey: aClass asString ifAbsent: []] ifFalse: [classes remove: aClass asString]]! displayErrors |aStream| aStream := '' writeStream. self printErrorLogOn: aStream. self openOn: (self new errorString: aStream contents)! displayErrorsByClass |aStream| aStream := '' writeStream. self allClassesWithErrors do: [:each | aStream nextPutAll: (self printErrorStringForClass: each)]. self openOn: (self new errorString: aStream contents)! displayErrorsForClass: aClass |aStream| aStream := '' writeStream. aStream nextPutAll: (self printErrorStringForClass: aClass). self openOn: (self new errorString: aStream contents)! error: logString for: aClass | collection | collection := Errors at: logString ifAbsentPut: [aClass class = Association ifTrue: [Dictionary new] ifFalse: [Set new]]. aClass class = Association ifTrue: [(collection at: aClass key ifAbsentPut: [Set new]) add: aClass value] ifFalse: [collection add: aClass]! errorStringForClass: aClass | classString errorString | classString := aClass asString. errorString := ''. Errors keysAndValuesDo: [:error :classes | (classes class = Dictionary) ifTrue: [(classes includesKey: classString) ifTrue: [errorString := errorString , ' ' , error , ' - \ ' withCRs , (self commaDelimitedList: (classes at: classString)) , '\' withCRs]] ifFalse: [(classes includes: classString) ifTrue: [errorString := errorString , ' ' , error , '\' withCRs]]]. ^errorString! printErrorLog | aStream | aStream := '' writeStream. self printErrorLogOn: aStream. Transcript show: aStream contents.! printErrorStringForClass: aClass ^aClass asString , '\' withCRs , (self errorStringForClass: aClass) , '\' withCRs! status: logString for: aClass | collection | collection := Status at: logString ifAbsentPut: [aClass class = Association ifTrue: [Dictionary new] ifFalse: [Set new]]. aClass class = Association ifTrue: [(collection at: aClass key ifAbsentPut: [Set new]) add: aClass value] ifFalse: [collection add: aClass]! ! !AutoCommentorLog class methodsFor: 'accessing'! errors ^Errors! status ^Status! ! !AutoCommentorLog class methodsFor: 'private'! allClassesWithErrors | classes | classes := Set new. Errors do: [:values | values class = Set ifTrue: [classes addAll: values] ifFalse: [classes addAll: values keys]]. ^classes! commaDelimitedList: names | aString tabLength lineLength | tabLength := 16. lineLength := 70. aString := ''. names isEmpty ifTrue: [aString := aString , 'none' withCRs] ifFalse: [| length | length := tabLength. names do: [:each | aString := aString , each asString. length := length + each asString size + 2] separatedBy: [aString := aString , ', '. length > lineLength ifTrue: [aString := aString , '\ ' withCRs. length := tabLength]]]. ^aString! printErrorLogOn: aStream Errors keysAndValuesDo: [:message :values | aStream nextPutAll: message; nextPut: Character cr; nextPut: Character cr. values class = Set ifTrue: [values do: [:class | aStream nextPut: Character tab; nextPutAll: class; nextPut: Character cr]] ifFalse: [values keysAndValuesDo: [:class :vars | aStream nextPut: Character tab; nextPutAll: class; nextPut: Character cr. vars do: [:var | aStream nextPut: Character tab; nextPut: Character tab; nextPutAll: var printString; nextPut: Character cr]. aStream nextPut: Character cr]]. aStream nextPut: Character cr]! ! !AutoCommentorLog class methodsFor: 'interface specs'! windowSpec "UIPainter new openOnClass: self andSelector: #windowSpec" ^#(#FullSpec #window: #(#WindowSpec #label: 'Comment Errors' #bounds: #(#Rectangle 281 324 730 556 ) ) #component: #(#SpecCollection #collection: #( #(#TextEditorSpec #layout: #(#LayoutFrame -1 0 -1 0 0 1 0 1 ) #model: #errorString #isReadOnly: true ) ) ) )! ! AutoCommentorLog initialize!