Object subclass: #CommentInserter instanceVariableNames: 'nullParagraphEditor classComment methodComment ' classVariableNames: 'CopyrightString ' poolDictionaries: '' category: 'Ume-CodingGoodies'! CommentInserter comment: 'Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved CommentInserter is a utility class which insert class and method comments. コメントを自動的に挿入するためのユーティリティクラスです Instance Variables: nullParagraphEditor dummy for method formatting classComment class comment methodComment method comment Class Variables: CopyrightString copyright '! !CommentInserter methodsFor: 'initailize-release'! initialize "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" nullParagraphEditor := NullParagraphEditor new. classComment := ''. methodComment := ''! ! !CommentInserter methodsFor: 'accessing'! classComment "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^classComment! classComment: aValue "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" classComment := aValue! methodComment "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^methodComment! methodComment: aValue "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" methodComment := aValue! nullParagraphEditor "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^nullParagraphEditor! ! !CommentInserter methodsFor: 'actions'! insertAllIn: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" self classesAllIn: aCategory do: [:cls | self insertClassComment: self classComment class: cls. self insertMethodComment: self methodComment class: cls. self insertMethodComment: self methodComment class: cls class]! insertClassComment: aString category: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" self classesAllIn: aCategory do: [:cls | self insertComment: aString class: cls]! insertClassComment: aString class: aClass "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | oldComment newComment | oldComment := aClass comment readStream. newComment := WriteStream with: aString copy. newComment cr. [oldComment atEnd] whileFalse: [newComment nextPut: oldComment next]. aClass comment: newComment contents! insertMethodComment: aString class: aClass "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | tmpString | tmpString := aString copy. self methodsAllIn: aClass do: [:eachMethod :eachMethodCat | | compiler formattedSource sourceStream selectorName oldSource newSource | compiler := aClass compilerClass new. "self nullParagraphEditor" formattedSource := compiler format: (aClass sourceCodeAt: eachMethod) in: aClass notifying: nil. sourceStream := ReadStream on: formattedSource. selectorName := sourceStream through: Character cr. oldSource := sourceStream upToEnd. newSource := WriteStream on: (String new: 16). newSource nextPutAll: selectorName. newSource tab; nextPut: $"; nextPutAll: tmpString; nextPut: $". newSource cr. newSource nextPutAll: oldSource. aClass compile: newSource contents classified: eachMethodCat asString]! removeAllIn: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" self classesAllIn: aCategory do: [:cls | self removeClassComment: self classComment class: cls. self removeMethodComment: self methodComment class: cls. self removeMethodComment: self methodComment class: cls class]! removeClassComment: aString category: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" self classesAllIn: aCategory do: [:cls | self removeComment: aString class: cls]! removeClassComment: aString class: aClass "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | oldComment newComment mark | oldComment := aClass comment readStream. mark := oldComment skipToAll: self classComment. mark notNil ifTrue: [oldComment skip: self classComment size. newComment := ReadWriteStream on: (String new: self classComment size). [oldComment atEnd] whileFalse: [newComment nextPut: oldComment next]. newComment reset. [| n | n := newComment next. n notNil and: [n isSeparator]] whileTrue. newComment skip: -1. aClass comment: newComment upToEnd]! removeMethodComment: aString class: aClass "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" self methodsAllIn: aClass do: [:eachMethod :eachMethodCat | | sourse sourceStream newSource comments former | sourse := aClass sourceCodeAt: eachMethod. comments := Parser new parseMethodComment: sourse setPattern: [:pa | pa]. (comments includes: self methodComment) ifTrue: [| compiler formattedSource | sourceStream := ReadStream on: sourse. former := sourceStream upToAll: self methodComment. sourceStream skip: self methodComment size + 1. newSource := WriteStream with: former. newSource skip: -1. [sourceStream atEnd] whileFalse: [newSource nextPut: sourceStream next]. compiler := aClass compilerClass new. formattedSource := compiler format: newSource contents in: aClass notifying: self nullParagraphEditor. aClass compile: formattedSource classified: eachMethodCat asString]]! ! !CommentInserter methodsFor: 'private'! classesAllIn: aCategory do: aBlock "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | classSymbols | classSymbols := Smalltalk organization listAtCategoryNamed: aCategory asSymbol. classSymbols do: [:each | | cls | cls := Smalltalk at: each. aBlock value: cls]! methodsAllIn: aClass do: aBlock "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | methodCategories | methodCategories := aClass organization categories. methodCategories do: [:eachMethodCat | | methods | methods := aClass organization listAtCategoryNamed: eachMethodCat. methods do: [:method | aBlock value: method value: eachMethodCat]]! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! CommentInserter class instanceVariableNames: ''! !CommentInserter class methodsFor: 'initialize'! initialize "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" "self initialize" CopyrightString := 'Copyright(C) 1996 Masashi Umezawa All Rights Reserved'! ! !CommentInserter class methodsFor: 'examples'! example1 "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" "self example1" self copyrightString: 'Copyright(C) 1996 Masashi Umezawa All Rights Reserved'. self insertCopyrightAllMatches: 'Ume-C*'! example2 "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" "self example2" self copyrightString: 'Copyright(C) 1996 Masashi Umezawa All Rights Reserved'. self removeCopyrightAllMatches: 'Ume-C*'! ! !CommentInserter class methodsFor: 'utilities'! insertCopyright: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | inst | inst := self new initialize. inst classComment: self copyrightString. inst methodComment: self copyrightString. inst insertAllIn: aCategory! insertCopyrightAllMatches: aString "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | targets | targets := OrderedCollection new. Smalltalk organization categories do: [:each | (aString match: each) ifTrue: [targets add: each]]. targets do: [:each | self insertCopyright: each]! removeCopyright: aCategory "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | inst | inst := self new initialize. inst classComment: self copyrightString. inst methodComment: self copyrightString. inst removeAllIn: aCategory! removeCopyrightAllMatches: aString "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" | targets | targets := OrderedCollection new. Smalltalk organization categories do: [:each | (aString match: each) ifTrue: [targets add: each]]. targets do: [:each | self removeCopyright: each]! ! !CommentInserter class methodsFor: 'accessing'! copyrightString "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^CopyrightString copy! copyrightString: aString "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" CopyrightString := aString! ! ParagraphEditor subclass: #NullParagraphEditor instanceVariableNames: 'selectionStartIndex selectionStopIndex ' classVariableNames: '' poolDictionaries: '' category: 'Ume-CodingGoodies'! NullParagraphEditor comment: 'Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved NullParagraphEditor is a dummy class for method formatting. This class is based on Instance Variables: selectionStartIndex selectionStopIndex '! !NullParagraphEditor methodsFor: 'initialize-release'! initialize "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" selectionStartIndex := 0. selectionStopIndex := 0! ! !NullParagraphEditor methodsFor: 'accessing'! selectionStartIndex "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^selectionStartIndex! selectionStartIndex: aValue "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" selectionStartIndex := aValue! selectionStopIndex "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^selectionStopIndex! selectionStopIndex: aValue "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" selectionStopIndex := aValue! ! !NullParagraphEditor methodsFor: 'selecting'! selectFrom: start to: stop "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" "do nothing"! ! "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! NullParagraphEditor class instanceVariableNames: ''! !NullParagraphEditor class methodsFor: 'instance creation'! from: startIndex to: stopIndex "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^(self new) selectionStartIndex: startIndex; selectionStopIndex: stopIndex! new "Copyright(C) 1996-1998 Masashi Umezawa All Rights Reserved" ^super new initialize! ! CommentInserter initialize!