'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 1 April 2003 at
8:51:54 am'! Object subclass: #ClassReview instanceVariableNames: 'reviewClass
allBehaviors allImplementedMessages allUndeclaredAssociations methodReviews '
classVariableNames: 'ProgressFlag ' poolDictionaries: '' category:
'Goodies-Review'! !ClassReview commentStamp: '<historical>' prior: 0! |
methodReview | methodReview := MethodReview class: String selector:
#displayOn:at:. methodReview report. ^methodReviewn.! ClassReview subclass:
#CodeReview instanceVariableNames: 'classCollection ' classVariableNames: ''
poolDictionaries: '' category: 'Goodies-Review'! !CodeReview commentStamp:
'<historical>' prior: 0! # # This file is encoded in (so called) SHIFT-JIS, #
line delimitor is CR. # Code Review Goodies for Squeak 1.31, 2.0 Broken English
description This goodies is a modification for Squeak from Mr. AOKI's Code
Review Goodies for VisualWorks 2.5 and VisualWave 1.0 Copyright (C) 1997-1998
AOKI Atsushi 1998/01/05
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/CodeRevw.st
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/CodeRevw.txt
Summary: This goodies produces useful information to review program code.
Variables: check not declared, not used, not assigned variables, and used
variables list made from special, argument, temporary instance, class, pool and
global variables. You can check using suitable variable name. messages: check
not implemented, empty categories, and output list of receiver type (variables,
literals or so). This list is classified "sending messages to me" and "sending
messages to them", so you can get information of delegation message . other:
check used literals, number of assignments, number of blocks, number of
cascades, number of returns, number of statements. The output report made from
items below. You can output this report as html file which is used to varioud
report. MethodReview: not declared variables: not used variables:
not assigned variables: used variables: special variables:
argument variables: temporary variables: (including block temporary
made from Compiler) instance variables: class variables:
pool variables: global variables: sending messages: to
self: to super: to thisContext: to literals:
to blocks: to variables: to argument variables:
to temporary variables: to instance variables: to
class variables: to pool variables: to global
variables: to expressions: used literals: number of
assignments: number of blocks: number of cascades: number of
returns: number of statements: main family percentage: branch
family percentage: ClassReview: not declared variables: not used
instance variables: not used class variables: not used variables:
not assigned variables: not implemented sendings: empty categories:
used special variables: used argument variables: used temporary
variables: (including block temporary made from Compiler) used instance
variables: used class variables: used pool variables: used global
variables: implemented messages: sending messages to me: sending
messages to them: used literals: number of sending messages:
number of assignments: number of blocks: number of cascades:
number of returns: number of statements: main family percentage:
branch family percentage: How to install: FileIn this goodies and makes
classes below in a category "Goodies-Review". ClassReview CodeReview
MethodReview and a category "Goodies-Support" MethodNodeEnumerator This
source adds no change to existing classes or methods. It completes within self.
When you want to restore your image, please remove these categories
"Goodies-Review" and "Goodies-Support" from your system. how to use: |
methodReview | methodReview := MethodReview class: String selector:
#displayOn:at:. methodReview report. ^methodReview | classReview | classReview
:= ClassReview class: ClassReview. classReview report. ^classReview |
codeReview | codeReview := CodeReview classCollection: (Array
with: MethodReview with: ClassReview
with: CodeReview). codeReview report. ^codeReview
########################################################## –؂³‚ñ‚Ì
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/CodeRevw.st ‚ð
Squeak —p‚É‚¢‚¶‚Á‚½‚à‚Ì‚Å‚·B ƒhƒLƒ…ƒƒ“ƒg‚Í
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/CodeRevw.txt
‚ðŽQÆ‚µ‚Ä‚‚¾‚³‚¢B ----------------------------------------------------------
¼Œ´‘Žm (NISHIHARA Satoshi) e-mail:
nishis@...,
tcc00164@... URL:
http://www.urban.ne.jp/home/nishis/
---------------------------------------------------------- ! Model subclass:
#DumpModel instanceVariableNames: 'byteArray startAddress textModel '
classVariableNames: 'YellowButtonMenu ' poolDictionaries: '' category:
'Goodies-Dump'! !DumpModel commentStamp: '<historical>' prior: 0! # # This file
is encoded in (so called) SHIFT-JIS, # line delimitor is CR. # Dump Goodies for
Squeak 1.31, Squeak 2.0 Broken English description This goodies is a
modification for Squeak from Mr. AOKI's Dump Goodies for VisualWorks 2.5 and
VisualWave 1.0 Copyright (c) 1995-1998 AOKI Atsushi 1998/01/05
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Dump.st
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Dump.txt
Summary: This goodies dumps from a ByteArray, contents of a file to hex number
and strings. How to install: FileIn this goodies and makes classes below in a
category "Goodies-Dump". DumpModel This source adds no change to existing
classes or methods. It completes within self. When you want to restore your
image, please remove a class "DumpModel" from your system, simply. how to
use: To dump a ByteArray: (DumpModel bytes: 'AOKI Atsushi' asByteArray) open
To dump the contents of a file: (DumpModel filename: 'filename') open on Mac:
':directory:filename', etc. on Win: 'directory\filename', etc. on Unix:
'directory/filename', etc. To dump the contents of a part of afile, use start
address and stop address: (DumpModel filename: 'filename' start: 100
stop: 200) open ##########################################################
–؂³‚ñ‚Ì
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Dump.st
‚ð Squeak —p‚É‚¢‚¶‚Á‚½‚à‚Ì‚Å‚·B ƒhƒLƒ…ƒƒ“ƒg‚Í
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Dump.txt
‚ðŽQÆ‚µ‚Ä‚‚¾‚³‚¢B ----------------------------------------------------------
¼Œ´‘Žm (NISHIHARA Satoshi) e-mail:
nishis@...,
tcc00164@... URL:
http://www.urban.ne.jp/home/nishis/
---------------------------------------------------------- ! Object subclass:
#Encyclopedia instanceVariableNames: 'classCollection sourceInclusion '
classVariableNames: '' poolDictionaries: '' category: 'Goodies-Encyclopedia'!
!Encyclopedia commentStamp: '<historical>' prior: 0! # # This file is encoded in
(so called) SHIFT-JIS, # line delimitor is CR. # Encyclopedia Goodies for Squeak
2.0 (Encyclopedia methodsFor: 'html methods' methodHtmlForClass: aClass
selector: aSymbol on: aStream fixed by the Most Revd AOKI Atsushi, Fri, 10 Apr
1998 17:12:35 +0900) Broken English description This goodies is a modification
for Squeak from Mr. AOKI's Encyclopedia Goodies for VisualWorks 2.5 and
VisualWave 1.0 Copyright (C) 1995-1998 AOKI Atsushi 1998/01/05
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Encyclo.st
Summary: This goodies makes html files of the classes you want to get from
virtual image. So you can browse it with WebBrowser (NetscapeNavigator,
InternetExplorer etc). Each html file contains suitable links, anchors. It is
an Encyclopedia (handbook) including table of contents, index file.
Installing: FileIn this goodies and makes a class "Encyclopedia" in a category
"Goodies-Encyclopedia". When you want to restore your image, please remove
this class "Encyclopedia" from your system. Image will be restored. how to
use: Making an Encyclopedia which target is all classes exist on your image:
do it the program below | collection encyclopedia | collection := IdentitySet
new. Smalltalk allBehaviorsDo: [:aClass | aClass isMeta
ifFalse: [collection add: aClass]]. encyclopedia := Encyclopedia classes:
collection. encyclopedia generate. ^encyclopedia It takes a long time to
finish. When all is over, the files are placed in current directory like that
Encyclopedia/ images/ dot1.gif : dot9.gif
index.gif xrefs.gif index.htm htmls/ classname.htm files
many as number of classes exist on your image xrefs.htm
xrefA.htm : xrefZ.htm Open "index.htm" in Encyclopedia directory
with WebBrowser (NetscapeNavigator, InternetExplorer etc). Also, you can
include source program within the Encyclopedia. For example, you can get an
Encyclopedia which is classes under Number within each source program, do it
below. | encyclopedia | encyclopedia := Encyclopedia classes: Number
withAllSubclasses. encyclopedia sourceInclusion: true. encyclopedia generate.
^encyclopedia You can browse the source program with WebBrowser insted of
using SystemBrowser on Smalltalk. *** caution!! *** When you do it which
target is all classes exist on your image like example4 or example8, you will
be warned that "Space is low". In that case, please 6MB or more plus for your VM
memory. At default, VM memory size is 7205KB. So it should be assigned at
13312KB or more is better. Some examples take very long time to finish. For
example, example4: about 21 min example8: about 32 min to complete. There are
521 classes, 12072 methods on PowerMacintosh 8500/120 with 750/233 Processor
Card. ########################################################## –؂³‚ñ‚Ì
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Encyclo.st ‚ð
Squeak —p‚É‚¢‚¶‚Á‚½‚à‚Ì‚Å‚·B ƒhƒLƒ…ƒƒ“ƒg‚Í
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/Encyclo.txt
‚ðŽQÆ‚µ‚Ä‚‚¾‚³‚¢B *** ’ˆÓŽ–€ *** —á‘è 4, 8
“™‘SƒNƒ‰ƒX‚ð‘ÎÛ‚É‚µ‚½‚à‚Ì‚ÍA“r’†‚Å "Space is low" Œx‚ª
oŒ»‚µ‚ÄAæ‚Öi‚ß‚È‚¢‚±‚Æ‚ª‚ ‚è‚Ü‚·B‚»‚ÌꇂÍA‚Æ‚è‚ ‚¦‚¸AŠ„“–ƒ ƒ‚ƒŠ‚ðÅ’á
6MB ˆÈã‘‚â‚·‚Æ“®‚©‚¹‚é‚悤‚É‚È‚è‚Ü‚·B ‚Ü‚½A—á‘è 4, 8
“™‘SƒNƒ‰ƒX‚ð‘ÎÛ‚É‚µ‚½‚à‚Ì‚ÍAŠ®—¹‚Ü‚Å‚É‚¯‚Á‚±‚¤‚È ŽžŠÔ‚ªŠ|‚©‚è‚Ü‚·B521
‚̃Nƒ‰ƒXA12072 ‚̃ƒ\ƒbƒh‚ðŽ‚ÂŒ»ƒCƒ[ƒW‚Å ‘–‚点‚Ä‚Ý‚½‚Æ‚±‚ëA example4: –ñ
21 •ª example8: –ñ 32 •ª ‚ð—v‚µ‚Ü‚µ‚½B PowerMacintosh 8500/120 with 750/233
Processor Card. ----------------------------------------------------------
¼Œ´‘Žm (NISHIHARA Satoshi) e-mail:
nishis@...,
tcc00164@... URL:
http://www.urban.ne.jp/home/nishis/
---------------------------------------------------------- ! StringMorph
subclass: #InfoMorph instanceVariableNames: '' classVariableNames: ''
poolDictionaries: '' category: 'SqueakRos'! Object subclass:
#MethodNodeEnumerator instanceVariableNames: '' classVariableNames: ''
poolDictionaries: '' category: 'Goodies-Support'! !MethodNodeEnumerator
commentStamp: '<historical>' prior: 0! # # This file is encoded in (so called)
SHIFT-JIS, # line delimitor is CR. # This is a simulation of
ProgramNodeEnumerator. To begin enumerating, must do first: yourInstance
nodeDo: anMethodNode Subclasses must implement below:
doAssignment:variable:value: doBlock:arguments:statements: doBrace:elements:
doCascade:receiver:messages: doLiteral:value:
doMessage:receiver:selector:arguments: doMethod:arguments:block:temporaries:
doReturn:value: doTempVariable:name: doVariable:name: see Atsushi AOKI,
"Smalltalk Idioms", SRC, 1997, Tokyo, ISBN4-915778-81-9 C3055 P4500E.
---------------------------------------------------------- ¼Œ´‘Žm (NISHIHARA
Satoshi) e-mail:
nishis@...,
tcc00164@... URL:
http://www.urban.ne.jp/home/nishis/
---------------------------------------------------------- !
MethodNodeEnumerator subclass: #MethodReview instanceVariableNames:
'reviewMethod variableNameStack sendingMessagesToSpecialVariables
sendingMessagesToArgumentsAndTemporaries sendingMessagesToOtherVariables
sendingMessagesToLiterals sendingMessagesToBlocks sendingMessagesToExpressions
notUsedVariables notAssignedVariables argumentVariables temporaryVariables
usedVariables specialVariables instanceVariables classVariables poolVariables
globalVariables notDeclaredVariables usedLiterals numberOfAssignments
numberOfBlocks numberOfCascades numberOfReturns numberOfStatements methodClass '
classVariableNames: '' poolDictionaries: '' category: 'Goodies-Review'!
!MethodReview commentStamp: '<historical>' prior: 0! Code Review Goodies for
VisualWorks 2.5 and VisualWave 1.0 Copyright (C) 1997-1998 AOKI Atsushi
1998/01/05 ŠT—vF ‚±‚̃OƒbƒfƒB[ƒY‚ÍCƒvƒƒOƒ‰ƒ€ƒR[ƒh‚̃Œƒrƒ…[‚ðs‚¤‚½‚ß‚Ìî
•ñ‚𶬂µ‚Ü‚·B •Ï”‚ÍC–¢’è‹`E–¢Žg—pE–¢‘ã“ü‚ðŽw“E‚·‚é‚Æ“¯Žž‚ÉCŽg—p‚µ‚½•Ï
”‚ð“ÁŽê•Ï”Eˆø”Eƒeƒ“ƒ|ƒ‰ƒŠ•Ï”EƒCƒ“ƒXƒ^ƒ“ƒX•Ï”EƒNƒ‰ƒX
•Ï”Eƒv[ƒ‹•Ï”EƒOƒ[ƒoƒ‹•Ï”‚É•ª•Ê‚µ‚ăŠƒXƒg‚µ‚Ü‚·B“KØ
‚È•Ï”–¼‚ªŽg‚í‚ê‚Ä‚¢‚é‚©‚Ç‚¤‚©‚ª–¾‚ç‚©‚É‚È‚è‚Ü‚·B
‚Ü‚½CƒƒbƒZ[ƒW‚ÍC–¢ŽÀ‘•‚̃ƒbƒZ[ƒW‚â‹ó‚̃ƒbƒZ[ƒWƒJƒeƒS
ƒŠ‚ðŽw“E‚·‚é‚Æ“¯Žž‚ÉCƒŒƒV[ƒo‚ÌŽí•Ê(•Ï”‚⃊ƒeƒ‰ƒ‹–ˆ)‚É•ª•Ê
‚µ‚ăŠƒXƒg‚µ‚Ü‚·BŽ©•ª‚É‘—M‚µ‚Ä‚¢‚郃bƒZ[ƒW‚Æ‘¼l‚É‘—M‚µ
‚Ä‚¢‚郃bƒZ[ƒW‚ð‹æ•Ê‚Å‚«‚Ü‚·‚©‚çCƒfƒŠƒQ[ƒg(ˆÏ÷)‚µ‚Ä‚¢‚é
ƒƒbƒZ[ƒW‚ð’m‚邱‚Æ‚ª‚Å‚«‚Ü‚·B
‚»‚Ì‘¼‚É‚àCŽg—p‚µ‚½ƒŠƒeƒ‰ƒ‹E‘ã“ü”EƒuƒƒbƒN”EƒJƒXƒP[ƒh
ƒƒbƒZ[ƒW”EƒŠƒ^[ƒ“”EƒXƒe[ƒgƒƒ“ƒg”‚È‚Ç‚Ìî•ñ‚à“¾‚邱 ‚Æ‚ª‚Å‚«‚Ü‚·B
‰º‹L‚ɃŠƒ|[ƒg‚Æ‚µ‚ăŠƒXƒg‚³‚ê‚é€–Ú‚ðŽ¦‚µ‚Ü‚·BƒŠƒ|[ƒg‚ÍC
HTMLƒtƒ@ƒCƒ‹‚Æ‚µ‚Ä‚ào—Í‚Å‚«‚Ü‚·‚Ì‚ÅC—lX‚È•ñ‘‚È‚Ç‚É‚²—˜ —p‚‚¾‚³‚¢B
MethodReview: ƒƒ\ƒbƒh‚̃Œƒrƒ…[ not declared variables: –¢’è‹`‚Ì•Ï”
not used variables: –¢Žg—p‚Ì•Ï” not assigned variables: –¢‘ã“ü‚Ì•Ï”
used variables: Žg—p‚µ‚½•Ï” special variables: Žg—p‚µ‚½“ÁŽê•Ï”
argument variables: Žg—p‚µ‚½ˆø”(ŠÜƒuƒƒbƒN•Ï”) temporary variables:
Žg—p‚µ‚½ƒeƒ“ƒ|ƒ‰ƒŠ•Ï” instance variables: Žg—p‚µ‚½ƒCƒ“ƒXƒ^ƒ“ƒX•Ï”
class variables: Žg—p‚µ‚½ƒNƒ‰ƒX•Ï” pool variables: Žg—p‚µ‚½ƒv[ƒ‹•Ï”
global variables: Žg—p‚µ‚½ƒOƒ[ƒoƒ‹•Ï” sending messages:
‘—M‚µ‚½ƒƒbƒZ[ƒW to self: ƒZƒ‹ƒt‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to super:
ƒX[ƒp‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to thisContext:
‚±‚̃Rƒ“ƒeƒLƒXƒg‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to literals:
ƒŠƒeƒ‰ƒ‹‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to blocks: ƒuƒƒbƒN‚É‘—M‚µ‚½ƒƒbƒZ[ƒW
to variables: •Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to argument variables:
ˆø”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to temporary variables:
ƒeƒ“ƒ|ƒ‰ƒŠ•Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to instance variables:
ƒCƒ“ƒXƒ^ƒ“ƒX•Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to class variables:
ƒNƒ‰ƒX•Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to pool variables:
ƒv[ƒ‹•Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to global variables:
ƒOƒ[ƒoƒ‹•Ï”‚É‘—M‚µ‚½ƒƒbƒZ[ƒW to expressions:
ƒƒbƒZ[ƒWŽ®‚É‘—M‚µ‚½ƒƒbƒZ[ƒW used literals: Žg—p‚µ‚½ƒŠƒeƒ‰ƒ‹ number
of assignments: ‘ã“ü” number of blocks: ƒuƒƒbƒN” number of cascades:
ƒJƒXƒP[ƒhƒƒbƒZ[ƒW” number of returns: ƒŠƒ^[ƒ“” number of
statements: ƒXƒe[ƒgƒƒ“ƒg” main family percentage: Ž©—Í–{Šèƒp[ƒZƒ“ƒe[ƒW
branch family percentage: ‘¼—Í–{Šèƒp[ƒZƒ“ƒe[ƒW ClassReview: ƒNƒ‰ƒX‚̃Œƒrƒ…[
not declared variables: –¢’è‹`‚Ì•Ï” not used instance variables:
–¢Žg—p‚̃Cƒ“ƒXƒ^ƒ“ƒX•Ï” not used class variables: –¢Žg—p‚̃Nƒ‰ƒX•Ï”
not used variables: –¢Žg—p‚Ì•Ï” not assigned variables: –¢‘ã“ü‚Ì•Ï”
not implemented sendings: –¢ŽÀ‘•ƒƒbƒZ[ƒW‚Ì‘—M empty categories:
‹ó‚̃ƒbƒZ[ƒWƒJƒeƒSƒŠ used special variables: Žg—p‚µ‚½“ÁŽê•Ï” used
argument variables: Žg—p‚µ‚½ˆø”(ŠÜƒuƒƒbƒN•Ï”) used temporary variables:
Žg—p‚µ‚½ƒeƒ“ƒ|ƒ‰ƒŠ•Ï” used instance variables: Žg—p‚µ‚½ƒCƒ“ƒXƒ^ƒ“ƒX•Ï”
used class variables: Žg—p‚µ‚½ƒNƒ‰ƒX•Ï” used pool variables:
Žg—p‚µ‚½ƒv[ƒ‹•Ï” used global variables: Žg—p‚µ‚½ƒOƒ[ƒoƒ‹•Ï”
implemented messages: ŽÀ‘•‚µ‚½ƒƒbƒZ[ƒW sending messages to me:
Ž©•ª‚É‘—M‚µ‚½ƒƒbƒZ[ƒW sending messages to them: ‘¼l‚É‘—M‚µ‚½ƒƒbƒZ[ƒW
used literals: Žg—p‚µ‚½ƒŠƒeƒ‰ƒ‹ number of sending messages: ƒƒbƒZ[ƒW‘—M”
number of assignments: ‘ã“ü” number of blocks: ƒuƒƒbƒN” number of
cascades: ƒJƒXƒP[ƒhƒƒbƒZ[ƒW” number of returns: ƒŠƒ^[ƒ“” number of
statements: ƒXƒe[ƒgƒƒ“ƒg” main family percentage: Ž©—Í–{Šèƒp[ƒZƒ“ƒe[ƒW
branch family percentage: ‘¼—Í–{Šèƒp[ƒZƒ“ƒe[ƒW ƒCƒ“ƒXƒg[ƒ‹•û–@F
CodeRevw.st‚ðƒtƒ@ƒCƒ‹ƒCƒ“‚µ‚Ä‚‚¾‚³‚¢BGoodies-Review‚Æ‚¢‚¤ƒJ
ƒeƒSƒŠ‚ÉMethodReview‚ÆClassReview‚»‚µ‚ÄCodeReview‚Æ‚¢‚¤3‚‚Ì
ƒNƒ‰ƒX‚ª‚Å‚«‚ ‚ª‚è‚Ü‚·BŠù‘¶‚̃Nƒ‰ƒX‚⃃\ƒbƒh‚ɂ͉½‚Ì•ÏX‚à
‰Á‚¦‚Ä‚¢‚Ü‚¹‚ñB‚à‚µC‚±‚̃OƒbƒfƒB[ƒY‚ðÁ‚µ‚½‚¢Žž‚É‚ÍC
Goodies-Review‚Æ‚¢‚¤ƒJƒeƒSƒŠ‚ð휂µ‚Ä‚‚¾‚³‚¢B Žg‚¢•ûF | methodReview |
methodReview := MethodReview class: Text selector: #displayOn:at:. methodReview
report. ^methodReview | classReview | classReview := ClassReview class:
ClassReview. classReview report. ^classReview | codeReview | codeReview :=
CodeReview classCollection: (Array with:
MethodReview with: ClassReview
with: CodeReview). codeReview report. ^codeReview
------------------------------------------------------------ –Ø~(AOKI
Atsushi)
http://www.sra.co.jp/people/aoki Software Research Associates,
Inc. mailto:
aoki@... Marusho-Bldg.5F, 3-12 Yotsuya,
Tel:03-3357-9361 Shinjuku-ku, Tokyo 160-0004, JAPAN Fax:03-3351-0880
------------------------------------------------------------ ! MethodReview
class instanceVariableNames: 'proxyNil '! Object subclass: #NewPolygon
instanceVariableNames: '' classVariableNames: '' poolDictionaries: ''
category: 'SqueakRos'! !NewPolygon commentStamp: '<historical>' prior: 0! "Solo
sirve cuando en el Mundo actual hay dos poligonos que se intersectan Los
pol’gonos originales deben estar compuestos por rectas "!
PluggableCodeGenerator subclass: #PluginCodeGenerator instanceVariableNames:
'headerString ' classVariableNames: '' poolDictionaries: '' category:
'Werdna-Re'! !PluginCodeGenerator commentStamp: '<historical>' prior: 0! I
assist PluginPlugin in generating code and exist only to add functionality to
the PluggableCodeGenerator. In particular, I permit the C Code Generator to add
additional text to the header files that are automatically generated on
compilation.! Object subclass: #SourceCodeSaver instanceVariableNames: 'name
categories filter footer directory ' classVariableNames: '' poolDictionaries:
'' category: 'Goodies-Tools'! !SourceCodeSaver commentStamp: '<historical>'
prior: 0! # # This file is encoded in (so called) SHIFT-JIS, # line delimitor is
CR. # Source Code Saver Goodies for Squeak 1.31, Squeak 2.0 Broken English
description This goodies is a modification for Squeak from Mr. AOKI's Source
Code Saver Goodies for VisualWorks 2.5 and VisualWave 1.0 Copyright (c)
1995-1998 AOKI Atsushi 1998/01/05
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/SrcSaver.st
Summary: The more making many classes, the harder are the problems of saving
them or etc. And what is the order to read in your system. Also there is a
case of the limitation of the length of filename (8+3, 31 chars etc), that
doesn't allow a class name to filename. This SourceCodeSaver goodies solves
these problems at simple way. Installing: FileIn this goodies and makes a
class "SourceCodeSaver" in a category "Goodies-Tools". This source adds no
change to existing classes or methods. It completes within self. When you want
to restore your image, please remove this class "SourceCodeSaver" from your
system, simply. how to use: The instance of the class SourceCodeSaver decides
the classes to be saved by gathering on a given pattern (category) and passing
through a given filter. If you send a message "save", you can get these
classes to be saved and a file to be used installing and a catalog file which
decides the order to fileIn. For example, | aSourceCodeSaver |
aSourceCodeSaver := SourceCodeSaver name: 'Name001'
categories: #('Goodies*') filter: [:aClass | aClass name =
SourceCodeSaver name]. aSourceCodeSaver save. Above, it point the category
pattern matching "Goodies*". Each of these classes is evaluated by
aBlockContext filter, picking up each value is true. In this example, the one
only class "SourceCodeSaver" will be selected. After above, he instance of the
class SourceCodeSaver receives a message "save", saves the files to be saved
below in the directory "Name001". Name001: Install.st Src00000.st
Src00001.st The first "Install.st" is for installing. For fileIn, you fileIn
this file only. The second "Src00000.st" is a catalog file for fileIn. The
third "Src00001.st" is a source code of SourceCodeSaver. If there are more
classes, produced Src?????.st incrementally. Src00000.st gives the information
of class-to-Src?????.st, one-to-one. For fileIn, you fileIn this file only,
again. FileIn this file only from fileList etc, all of the rest will be
installed. FileIn follows the superclass order.
########################################################## –؂³‚ñ‚Ì
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/SrcSaver.st ‚ð
Squeak —p‚É‚¢‚¶‚Á‚½‚à‚Ì‚Å‚·B ƒhƒLƒ…ƒƒ“ƒg‚Í
http://www.sra.co.jp/people/aoki/SmalltalkGoodies/VisualWorks/SrcSaver.txt
‚ðŽQÆ‚µ‚Ä‚‚¾‚³‚¢B ----------------------------------------------------------
¼Œ´‘Žm (NISHIHARA Satoshi) e-mail:
nishis@...,
tcc00164@... URL:
http://www.urban.ne.jp/home/nishis/
---------------------------------------------------------- ! !ClassReview
methodsFor: 'accessing'! reviewClass ^reviewClass! ! !ClassReview methodsFor:
'retrieving'! allBehaviors "ClassReview new allBehaviors." allBehaviors isNil
ifTrue: [allBehaviors := IdentitySet new. Smalltalk allBehaviorsDo:
[:aBehavior | allBehaviors add: aBehavior]]. ^allBehaviors! ! !ClassReview
methodsFor: 'retrieving'! allClasses "ClassReview new allClasses." ^self
allBehaviors select: [:each | each isMeta not]! ! !ClassReview methodsFor:
'retrieving' stamp: 'nishis 6/22/1998 14:56'! allImplementedMessages
"ClassReview new allImplementedMessages." allImplementedMessages isNil
ifTrue: [allImplementedMessages := IdentitySet new: Symbol allInstances
size. Smalltalk allBehaviorsDo: [:class | class selectors do: [:selector |
allImplementedMessages add: selector]]]. ^allImplementedMessages! !
!ClassReview methodsFor: 'retrieving' stamp: 'nishis 6/23/1998 12:54'!
allUndeclaredAssociations "ClassReview new allUndeclaredAssociations."
allUndeclaredAssociations isNil ifTrue: [allUndeclaredAssociations :=
IdentitySet new: Undeclared size. Undeclared associationsDo: [:assoc |
allUndeclaredAssociations add: assoc]]. ^allUndeclaredAssociations! !
!ClassReview methodsFor: 'method reviewing'! methodReviews | dictionary
methodReview | methodReviews isNil ifFalse: [^methodReviews]. self progress:
String new tabs: 0. self progress: self reviewClass name asString tabs: 0.
self progress: 'revewing methods...' asString tabs: 1. dictionary :=
OrderedCollection new: self reviewClass selectors size. self reviewClass
selectors asSortedCollection do: [:reviewSelector | self progress:
reviewSelector asString tabs: 2. methodReview := MethodReview class: self
reviewClass selector: reviewSelector. dictionary add: methodReview].
methodReviews := dictionary. ^methodReviews! ! !ClassReview methodsFor:
'variable reviewing'! argumentVariables | collection | self progress:
'argument variables...' tabs: 1. collection := Set new. self methodReviews do:
[:review | review argumentVariables do: [:each | collection add: each]].
^collection! ! !ClassReview methodsFor: 'variable reviewing'! classVariables |
collection | self progress: 'class variables...' tabs: 1. collection := Set
new. self methodReviews do: [:review | review classVariables do: [:each |
collection add: each]]. ^collection! ! !ClassReview methodsFor: 'variable
reviewing'! globalVariables | collection | self progress: 'global
variables...' tabs: 1. collection := Set new. self methodReviews do: [:review
| review globalVariables do: [:each | collection add: each]]. ^collection! !
!ClassReview methodsFor: 'variable reviewing'! instanceVariables | collection |
self progress: 'instance variables...' tabs: 1. collection := Set new. self
methodReviews do: [:review | review instanceVariables do: [:each | collection
add: each]]. ^collection! ! !ClassReview methodsFor: 'variable reviewing'
stamp: 'nishis 6/22/1998 13:39'! notAssignedVariables | collection selector set
| self progress: 'not assigned variables...' tabs: 1. collection := Dictionary
new. self methodReviews do: [:review | selector := review
methodSelector. review notAssignedVariables do: [:each | set
:= collection at: selector ifAbsent: [Set new]. (set includes: each)
ifFalse: [set add: each]. collection add: selector -> set]]. ^(self
associations: collection) asSet! ! !ClassReview methodsFor: 'variable
reviewing' stamp: 'nishis 6/26/1998 13:09'! notDeclaredVariables | collection
method selector set | self progress: 'not declared variables...' tabs: 1.
collection := Dictionary new. self reviewClass selectors do:
[:theSelector | method := self reviewClass compiledMethodAt: theSelector.
set := Set new. method literals do: [:literal | ((literal isKindOf:
Association) and: [self allUndeclaredAssociations includes: literal])
ifTrue: [set add: literal key asString]]. set isEmpty ifFalse: [collection
add: theSelector -> set]]. self methodReviews do: [:review | selector
:= review methodSelector. review notDeclaredVariables do: [:each |
set := collection at: selector ifAbsent: [Set new]. (set includes: each)
ifFalse: [set add: each]. collection add: selector -> set]]. ^(self
associations: collection) asSet! ! !ClassReview methodsFor: 'variable
reviewing' stamp: 'nishis 6/22/1998 18:33'! notUsedClassVariables | collection
class classes size | self progress: 'not used class variables...' tabs: 1.
collection := Set new. self reviewClass isMeta ifTrue: [class := self
reviewClass soleInstance] ifFalse: [class := self reviewClass]. classes :=
class withAllSuperclasses reversed , class allSubclasses asOrderedCollection.
(self associations: class classPool) asSortedCollection do: [:variableBinding |
classes detect: [:each | size := (each whichSelectorsReferTo:
variableBinding) size. size := size + (each class whichSelectorsReferTo:
variableBinding) size. size > 0] ifNone: [collection add: variableBinding
key asString]]. ^collection! ! !ClassReview methodsFor: 'variable reviewing'
stamp: 'nishis 6/22/1998 18:32'! notUsedInstanceVariables | collection classes
size | self progress: 'not used instance variables...' tabs: 1. collection :=
Set new. classes := (Array with: self reviewClass) , self reviewClass
allSubclasses asOrderedCollection. self reviewClass instVarNames do:
[:instVarName | classes detect: [:each | size := (each
whichSelectorsAccess: instVarName) size. size > 0] ifNone: [collection
add: instVarName asString]]. ^collection! ! !ClassReview methodsFor: 'variable
reviewing' stamp: 'nishis 6/22/1998 13:38'! notUsedVariables | collection
selector set | self progress: 'not used variables...' tabs: 1. collection :=
Dictionary new. self methodReviews do: [:review | selector := review
methodSelector. review notUsedVariables do: [:each | set :=
collection at: selector ifAbsent: [Set new]. (set includes: each)
ifFalse: [set add: each]. collection add: selector -> set]]. ^(self
associations: collection) asSet! ! !ClassReview methodsFor: 'variable
reviewing'! poolVariables | collection | self progress: 'pool variables...'
tabs: 1. collection := Set new. self methodReviews do: [:review | review
poolVariables do: [:each | collection add: each]]. ^collection! ! !ClassReview
methodsFor: 'variable reviewing'! specialVariables | collection | self
progress: 'special variables...' tabs: 1. collection := Set new. self
methodReviews do: [:review | review specialVariables do: [:each | collection
add: each]]. ^collection! ! !ClassReview methodsFor: 'variable reviewing'!
temporaryVariables | collection | self progress: 'temporary variables...'
tabs: 1. collection := Set new. self methodReviews do: [:review | review
temporaryVariables do: [:each | collection add: each]]. ^collection! !
!ClassReview methodsFor: 'variable reviewing'! usedVariables | collection |
self progress: 'used variables...' tabs: 1. collection := Set new. self
methodReviews do: [:review | review usedVariables do: [:each | collection add:
each]]. ^collection! ! !ClassReview methodsFor: 'message reviewing'!
implementedMessagePatterns | collection | self progress: 'implemented message
patterns...' tabs: 1. collection := SortedCollection new: self
implementedMessages size. self methodReviews do: [:review | collection add:
review methodSelector -> review messagePattern]. collection := collection
collect: [:assoc | assoc value]. ^collection! ! !ClassReview methodsFor:
'message reviewing'! implementedMessages self progress: 'implemented
messages...' tabs: 1. ^self reviewClass selectors! ! !ClassReview methodsFor:
'message reviewing' stamp: 'nishis 6/23/1998 11:23'! notImplementedSendings |
collection selectors bag scanner message | self progress: 'not implemented
sendings...' tabs: 1. collection := Dictionary new. self reviewClass selectors
do: [:aMessage | bag := Bag new. self withAllBlockMethodsDo:
[:method | scanner := InstructionStream on: method. scanner method
messages do: [:selector | (selector notNil and: [(self
allImplementedMessages includes: selector) not]) ifTrue: [bag add:
selector]]] with: (self reviewClass compiledMethodAt: aMessage). bag
isEmpty ifFalse: [collection add: aMessage -> bag]]. selectors := self
reviewClass allSelectors. self methodReviews do: [:review | message
:= review methodSelector. bag := collection at: message ifAbsent: [Bag new].
review sendingMessagesToMe do: [:aSelector | (selectors includes: aSelector)
ifFalse: [bag add: aSelector]]. bag isEmpty ifFalse: [collection add: message
-> bag]]. ^(self associations: collection) asSet! ! !ClassReview methodsFor:
'message reviewing'! sendingMessages | collection | self progress: 'sending
messages...' tabs: 1. collection := Bag new. self methodReviews do: [:review |
review sendingMessages do: [:each | collection add: each]]. ^collection! !
!ClassReview methodsFor: 'message reviewing'! sendingMessagesToMe | collection
| self progress: 'sending messages to me...' tabs: 1. collection := Bag new.
self methodReviews do: [:review | review sendingMessagesToMe do: [:each |
collection add: each]]. ^collection! ! !ClassReview methodsFor: 'message
reviewing'! sendingMessagesToThem | collection | self progress: 'sending
messages to them...' tabs: 1. collection := Bag new. self methodReviews do:
[:review | review sendingMessagesToThem do: [:each | collection add: each]].
^collection! ! !ClassReview methodsFor: 'literal reviewing'! usedLiterals |
collection | self progress: 'used literals...' tabs: 1. collection := Bag new.
self methodReviews do: [:review | review usedLiterals do: [:each | collection
add: each]]. ^collection! ! !ClassReview methodsFor: 'number reviewing'!
branchFamilyPercentage | denominator | self progress: 'branch family
percentage...' tabs: 1. denominator := self numberOfSendingMessages.
denominator = 0 ifTrue: [^0]. ^(self sendingMessagesToThem size / denominator *
100) rounded! ! !ClassReview methodsFor: 'number reviewing'!
mainFamilyPercentage | denominator | self progress: 'main family
percentage...' tabs: 1. denominator := self numberOfSendingMessages.
denominator = 0 ifTrue: [^0]. ^(self sendingMessagesToMe size / denominator *
100) rounded! ! !ClassReview methodsFor: 'number reviewing'!
numberOfAssignments | count | self progress: 'number of assignments...' tabs:
1. count := 0. self methodReviews do: [:review | count := count + review
numberOfAssignments]. ^count! ! !ClassReview methodsFor: 'number reviewing'!
numberOfBlocks | count | self progress: 'number of blocks...' tabs: 1. count
:= 0. self methodReviews do: [:review | count := count + review
numberOfBlocks]. ^count! ! !ClassReview methodsFor: 'number reviewing'!
numberOfCascades | count | self progress: 'number of cascades...' tabs: 1.
count := 0. self methodReviews do: [:review | count := count + review
numberOfCascades]. ^count! ! !ClassReview methodsFor: 'number reviewing'!
numberOfReturns | count | self progress: 'number of returns...' tabs: 1.
count := 0. self methodReviews do: [:review | count := count + review
numberOfReturns]. ^count! ! !ClassReview methodsFor: 'number reviewing'!
numberOfSendingMessages | count | self progress: 'number of sending
messages...' tabs: 1. count := 0. self methodReviews do: [:review | count :=
count + review numberOfSendingMessages]. ^count! ! !ClassReview methodsFor:
'number reviewing'! numberOfStatements | count | self progress: 'number of
statements...' tabs: 1. count := 0. self methodReviews do: [:review | count :=
count + review numberOfStatements]. ^count! ! !ClassReview methodsFor:
'category reviewing' stamp: 'nishis 7/19/1998 02:09'! emptyCategories | set
organization | self progress: 'empty categories...' tabs: 1. set := Set new.
organization := self reviewClass organization. organization categories do:
[:category | ((organization listAtCategoryNamed: category) isEmpty and:
[(category = 'no messages' asSymbol) not]) ifTrue: [set add: category
asString]]. ^set! ! !ClassReview methodsFor: 'reporting' stamp: 'nishis
6/30/1998 14:12'! report | aStream aModel | aStream := WriteStream on: (String
new: 1024). Cursor wait showWhile: [self reportOn: aStream]. aModel :=
StringHolder new. aModel contents: aStream contents. StringHolderView open:
aModel label: 'Class Review'! ! !ClassReview methodsFor: 'reporting' stamp:
'nishis 6/28/1998 22:28'! reportHtml | aStream aModel | aStream := WriteStream
on: (String new: 1024). self reportHtmlOn: aStream. aModel := StringHolder
new. aModel contents: aStream contents. StringHolderView open: aModel label:
'Class Review (HTML)'! ! !ClassReview methodsFor: 'reporting' stamp: 'nishis
6/26/1998 13:12'! reportHtmlOn: aStream aStream nextPutAll: '<HTML>'. aStream
cr. aStream nextPutAll: '<BODY BGCOLOR="#FFFFFF">'. aStream cr. aStream
nextPutAll: '<FONT SIZE=+1>'. aStream cr. aStream nextPutAll: '<B>'. aStream
nextPutAll: self reviewClass printString. aStream nextPutAll: '</B>'. aStream
nextPutAll: '<BR>'. aStream cr. aStream nextPutAll: '</FONT>'. aStream cr.
aStream nextPutAll: '<DL>'. aStream cr. self outputForVariables2: aStream
value: 'not declared variables:' value: self notDeclaredVariables value: 1.
self outputForVariables: aStream value: 'not used instance variables:'
value: self notUsedInstanceVariables value: 1. self reviewClass isMeta
ifFalse: [self outputForVariables: aStream value: 'not used class variables:'
value: self notUsedClassVariables value: 1]. self outputForVariables2:
aStream value: 'not used variables:' value: self notUsedVariables value:
1. self outputForVariables2: aStream value: 'not assigned variables:'
value: self notAssignedVariables value: 1. self outputForMessages: aStream
value: 'not implemented sendings:' value: self notImplementedSendings value:
1. self outputForVariables: aStream value: 'empty categories:' value: self
emptyCategories value: 1. self outputForVariables: aStream value: 'used
special variables:' value: self specialVariables value: 1. self
outputForVariables: aStream value: 'used argument variables:' value: self
argumentVariables value: 1. self outputForVariables: aStream value: 'used
temporary variables:' value: self temporaryVariables value: 1. self
outputForVariables: aStream value: 'used instance variables:' value: self
instanceVariables value: 1. self outputForVariables: aStream value: 'used
class variables:' value: self classVariables value: 1. self
outputForVariables: aStream value: 'used pool variables:' value: self
poolVariables value: 1. self outputForVariables: aStream value: 'used
global variables:' value: self globalVariables value: 1. self
outputForMessages2: aStream value: 'implemented messages:' value: self
implementedMessagePatterns value: 1. self outputForMessages3: aStream
value: 'sending messages to me:' value: self sendingMessagesToMe value: 1.
self outputForMessages3: aStream value: 'sending messages to them:' value:
self sendingMessagesToThem value: 1. self outputForLiterals: aStream value:
'used literals:' value: self usedLiterals value: 1. self outputForNumber:
aStream value: 'number of sending messages:' value: self
numberOfSendingMessages value: 1. self outputForNumber: aStream value:
'number of assignments:' value: self numberOfAssignments value: 1. self
outputForNumber: aStream value: 'number of blocks:' value: self
numberOfBlocks value: 1. self outputForNumber: aStream value: 'number of
cascades:' value: self numberOfCascades value: 1. self outputForNumber:
aStream value: 'number of returns:' value: self numberOfReturns value: 1.
self outputForNumber: aStream value: 'number of statements:' value: self
numberOfStatements value: 1. self outputForPercentage: aStream value: 'main
family percentage:' value: self mainFamilyPercentage value: 1. self
outputForPercentage: aStream value: 'branch family percentage:' value: self
branchFamilyPercentage value: 1. aStream nextPutAll: '</DL>'. aStream cr.
aStream nextPutAll: '<!!-- This Document was generated by ' , self class name ,
'. -->'. aStream cr. aStream nextPutAll: '<!!-- ' , self class name , ' was
developed by AOKI Atsushi. -->'. aStream cr. aStream nextPutAll: '</BODY>'.
aStream cr. aStream nextPutAll: '</HTML>'. aStream cr! ! !ClassReview
methodsFor: 'reporting' stamp: 'nishis 6/25/1998 03:45'! reportHtmlToFile:
filename | aStream | aStream := FileStream newFileNamed: filename. self
reportHtmlOn: aStream. aStream close! ! !ClassReview methodsFor: 'reporting'
stamp: 'nishis 6/30/1998 14:13'! reportOn: aStream aStream nextPutAll: self
reviewClass printString. aStream cr. aStream cr. self outputForVariables2:
aStream value: 'not declared variables:' value: self notDeclaredVariables
value: 1. self outputForVariables: aStream value: 'not used instance
variables:' value: self notUsedInstanceVariables value: 1. self reviewClass
isMeta ifFalse: [self outputForVariables: aStream value: 'not used class
variables:' value: self notUsedClassVariables value: 1]. self
outputForVariables2: aStream value: 'not used variables:' value: self
notUsedVariables value: 1. self outputForVariables2: aStream value: 'not
assigned variables:' value: self notAssignedVariables value: 1. self
outputForMessages: aStream value: 'not implemented sendings:' value: self
notImplementedSendings value: 1. self outputForVariables: aStream value:
'empty categories:' value: self emptyCategories value: 1. self
outputForVariables: aStream value: 'used special variables:' value: self
specialVariables value: 1. self outputForVariables: aStream value: 'used
argument variables:' value: self argumentVariables value: 1. self
outputForVariables: aStream value: 'used temporary variables:' value: self
temporaryVariables value: 1. self outputForVariables: aStream value: 'used
instance variables:' value: self instanceVariables value: 1. self
outputForVariables: aStream value: 'used class variables:' value: self
classVariables value: 1. self outputForVariables: aStream value: 'used pool
variables:' value: self poolVariables value: 1. self outputForVariables:
aStream value: 'used global variables:' value: self globalVariables value:
1. self outputForMessages2: aStream value: 'implemented messages:' value:
self implementedMessagePatterns value: 1. self outputForMessages3: aStream
value: 'sending messages to me:' value: self sendingMessagesToMe value: 1.
self outputForMessages3: aStream value: 'sending messages to them:' value:
self sendingMessagesToThem value: 1. self outputForLiterals: aStream value:
'used literals:' value: self usedLiterals value: 1. self outputForNumber:
aStream value: 'number of sending messages:' value: self
numberOfSendingMessages value: 1. self outputForNumber: aStream value:
'number of assignments:' value: self numberOfAssignments value: 1. self
outputForNumber: aStream value: 'number of blocks:' value: self
numberOfBlocks value: 1. self outputForNumber: aStream value: 'number of
cascades:' value: self numberOfCascades value: 1. self outputForNumber:
aStream value: 'number of returns:' value: self numberOfReturns value: 1.
self outputForNumber: aStream value: 'number of statements:' value: self
numberOfStatements value: 1. self outputForPercentage: aStream value: 'main
family percentage:' value: self mainFamilyPercentage value: 1. self
outputForPercentage: aStream value: 'branch family percentage:' value: self
branchFamilyPercentage value: 1! ! !ClassReview methodsFor: 'reporting'
stamp: 'nishis 6/25/1998 03:45'! reportToFile: filename | aStream | aStream :=
FileStream newFileNamed: filename. Cursor wait showWhile: [self reportOn:
aStream]. aStream close! ! !ClassReview methodsFor: 'reporting' stamp: 'nishis
6/30/1998 14:13'! shortReport | aStream aModel | aStream := WriteStream on:
(String new: 1024). Cursor wait showWhile: [self shortReportOn: aStream].
aModel := StringHolder new. aModel contents: aStream contents.
StringHolderView open: aModel label: 'Class Short Review'! ! !ClassReview
methodsFor: 'reporting' stamp: 'nishis 6/30/1998 14:14'! shortReportOn: aStream
| outputForVariables outputForVariables2 outputForMessages count aSelector aSet
aBag | outputForVariables := [:title :set :level | level timesRepeat:
[aStream tab]. aStream nextPutAll: title. aStream space; space; space.
aStream nextPutAll: set size printString. aStream cr. set
asSortedCollection do: [:each | level timesRepeat: [aStream
tab]. aStream tab. aStream nextPutAll: each. aStream cr]].
outputForVariables2 := [:title :collection :level | count := 0.
collection do: [:assoc | count := count + assoc value size]. level
timesRepeat: [aStream tab]. aStream nextPutAll: title. aStream space;
space; space. aStream nextPutAll: count printString. aStream cr.
collection asSortedCollection do: [:assoc | aSelector := assoc
key. aSet := assoc value. level timesRepeat: [aStream tab].
aStream tab. aStream nextPutAll: aSelector. aStream cr. aSet
do: [:each | level timesRepeat: [aStream tab]. aStream
tab; tab. aStream nextPutAll: each asString. aStream cr]]].
outputForMessages := [:title :collection :level | count := 0.
collection do: [:assoc | count := count + assoc value size]. level
timesRepeat: [aStream tab]. aStream nextPutAll: title. aStream space;
space; space. aStream nextPutAll: count printString. aStream cr.
collection asSortedCollection do: [:assoc | aSelector := assoc
key. aBag := assoc value. level timesRepeat: [aStream tab].
aStream tab. aStream nextPutAll: aSelector. aStream cr. aBag
asSet asSortedCollection do: [:it | count := aBag
occurrencesOf: it. level timesRepeat: [aStream tab]. aStream tab;
tab. aStream nextPutAll: it. aStream space; space; space.
aStream nextPutAll: '(' , count printString , ')'. aStream cr]]].
aStream nextPutAll: self reviewClass printString. aStream cr. aStream cr.
outputForVariables2 value: 'not declared variables:' value: self
notDeclaredVariables value: 1. outputForVariables value: 'not used instance
variables:' value: self notUsedInstanceVariables value: 1. self reviewClass
isMeta ifFalse: [outputForVariables value: 'not used class variables:'
value: self notUsedClassVariables value: 1]. outputForVariables2 value:
'not used variables:' value: self notUsedVariables value: 1.
outputForVariables2 value: 'not assigned variables:' value: self
notAssignedVariables value: 1. outputForMessages value: 'not implemented
sendings:' value: self notImplementedSendings value: 1. outputForVariables
value: 'empty categories:' value: self emptyCategories value: 1! !
!ClassReview methodsFor: 'reporting' stamp: 'nishis 6/25/1998 03:45'!
shortReportToFile: filename | aStream | aStream := FileStream newFileNamed:
filename. Cursor wait showWhile: [self shortReportOn: aStream]. aStream close!
! !ClassReview methodsFor: 'private' stamp: 'nishis 6/22/1998 13:37'!
associations: aCollection | anOrderedCollection | anOrderedCollection :=
OrderedCollection new: aCollection size. aCollection associationsDo:
[:association | anOrderedCollection add: association]. ^ anOrderedCollection! !
!ClassReview methodsFor: 'private'! progress: aString tabs: anInteger self
class progressFlag = true ifTrue: [Transcript cr. anInteger
timesRepeat: [Transcript tab]. Transcript show: aString]! ! !ClassReview
methodsFor: 'private'! setClass: aClass reviewClass := aClass. methodReviews
:= nil. self methodReviews. ^self! ! !ClassReview methodsFor: 'private'
stamp: 'nishis 6/23/1998 09:07'! withAllBlockMethodsDo: aBlock with:
aCompileMethod | literalClass | aBlock value: aCompileMethod. aCompileMethod
literals do: [:literal | literalClass := literal class. literalClass ==
CompiledMethod ifTrue: [self withAllBlockMethodsDo: aBlock with: literal]
ifFalse: [literalClass == BlockContext ifTrue: [self
withAllBlockMethodsDo: aBlock with: literal method]]]! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/22/1998 16:11'! outputForHtml:
aStream string: string string do: [:char | char = $< ifTrue: [aStream
nextPutAll: '<'] ifFalse: [char = $> ifTrue: [aStream nextPutAll:
'>'] ifFalse: [aStream nextPut: char]]] ! ! !ClassReview methodsFor:
'private reporting' stamp: 'nishis 6/30/1998 14:14'! outputForLiterals: aStream
value: title value: bag value: level | count | level timesRepeat: [aStream
tab]. aStream nextPutAll: title. aStream space; space; space. aStream
nextPutAll: bag size printString. aStream cr. (bag asSet asSortedCollection:
[:x :y | (x = self class proxyNil ifTrue: ['nil'] ifFalse: [x
printString]) < (y = self class proxyNil ifTrue: ['nil'] ifFalse:
[y printString])]) do: [:each | count := bag occurrencesOf: each.
level timesRepeat: [aStream tab]. aStream tab. each = self class proxyNil
ifTrue: [aStream nextPutAll: 'nil'] ifFalse: [aStream nextPutAll: each
printString]. aStream space; space; space. aStream nextPutAll: '(' , count
printString , ')'. aStream cr]! ! !ClassReview methodsFor: 'private
reporting' stamp: 'nishis 6/22/1998 16:55'! outputForLiteralsHtml: aStream
value: title value: bag value: level | count | level timesRepeat: [aStream
nextPutAll: '<DL>']. aStream cr. level timesRepeat: [aStream tab]. aStream
nextPutAll: '<B><I>'. aStream nextPutAll: title. aStream nextPutAll:
'</I></B>'. aStream space; space; space. aStream nextPutAll: bag size
printString. aStream cr. (bag asSet asSortedCollection: [:x :y | (x = self
class proxyNil ifTrue: ['nil'] ifFalse: [x printString]) < (y = self
class proxyNil ifTrue: ['nil'] ifFalse: [y printString])]) do:
[:each | aStream nextPutAll: '<DL>'. aStream cr. count := bag
occurrencesOf: each. level timesRepeat: [aStream tab]. aStream tab.
each = self class proxyNil ifTrue: [aStream nextPutAll: 'nil'] ifFalse:
[self outputForHtml: aStream string: each printString]. aStream space; space;
space. aStream nextPutAll: '(' , count printString , ')'. aStream cr.
aStream nextPutAll: '</DL>'. aStream cr]. level timesRepeat: [aStream
nextPutAll: '</DL>']. aStream cr! ! !ClassReview methodsFor: 'private
reporting' stamp: 'nishis 6/30/1998 14:14'! outputForMessages2: aStream value:
title value: collection value: level level timesRepeat: [aStream tab]. aStream
nextPutAll: title. aStream space; space; space. aStream nextPutAll: collection
size printString. aStream cr. collection do: [:pattern | level
timesRepeat: [aStream tab]. aStream tab. 1 to: pattern size by: 2
do: [:index | aStream nextPutAll: (pattern at: index). index +
1 > pattern size ifFalse: [aStream space]. index < pattern size ifTrue:
[aStream nextPutAll: (pattern at: index + 1)]. index + 1 >= pattern size
ifFalse: [aStream space]]. aStream cr]! ! !ClassReview methodsFor: 'private
reporting' stamp: 'nishis 6/22/1998 16:55'! outputForMessages2Html: aStream
value: title value: collection value: level level timesRepeat: [aStream
nextPutAll: '<DL>']. aStream cr. level timesRepeat: [aStream tab]. aStream
nextPutAll: '<B><I>'. aStream nextPutAll: title. aStream nextPutAll:
'</I></B>'. aStream space; space; space. aStream nextPutAll: collection size
printString. aStream cr. collection do: [:pattern | aStream
nextPutAll: '<DL>'. aStream cr. level timesRepeat: [aStream tab].
aStream tab. 1 to: pattern size by: 2 do: [:index |
aStream nextPutAll: '<B>'. self outputForHtml: aStream string: (pattern at:
index). aStream nextPutAll: '</B>'. index + 1 > pattern size ifFalse:
[aStream space]. index < pattern size ifTrue: [self outputForHtml: aStream
string: (pattern at: index + 1)]. index + 1 >= pattern size ifFalse:
[aStream space]]. aStream cr. aStream nextPutAll: '</DL>'. aStream cr].
level timesRepeat: [aStream nextPutAll: '</DL>']. aStream cr! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/30/1998 14:15'!
outputForMessages3: aStream value: title value: bag value: level | count |
level timesRepeat: [aStream tab]. aStream nextPutAll: title. aStream space;
space; space. aStream nextPutAll: bag size printString. aStream cr. bag asSet
asSortedCollection do: [:each | count := bag occurrencesOf: each.
level timesRepeat: [aStream tab]. aStream tab. aStream nextPutAll: each.
aStream space; space; space. aStream nextPutAll: '(' , count printString ,
')'. aStream cr]! ! !ClassReview methodsFor: 'private reporting' stamp:
'nishis 6/22/1998 16:55'! outputForMessages3Html: aStream value: title value:
bag value: level | count | level timesRepeat: [aStream nextPutAll: '<DL>'].
aStream cr. level timesRepeat: [aStream tab]. aStream nextPutAll: '<B><I>'.
aStream nextPutAll: title. aStream nextPutAll: '</I></B>'. aStream space;
space; space. aStream nextPutAll: bag size printString. aStream cr. bag asSet
asSortedCollection do: [:each | aStream nextPutAll: '<DL>'. aStream
cr. count := bag occurrencesOf: each. level timesRepeat: [aStream tab].
aStream tab. self outputForHtml: aStream string: each. aStream space;
space; space. aStream nextPutAll: '(' , count printString , ')'. aStream
cr. aStream nextPutAll: '</DL>'. aStream cr]. level timesRepeat: [aStream
nextPutAll: '</DL>']. aStream cr! ! !ClassReview methodsFor: 'private
reporting' stamp: 'nishis 6/30/1998 14:15'! outputForMessages: aStream value:
title value: collection value: level | count selector bag | count := 0.
collection do: [:assoc | count := count + assoc value size]. level timesRepeat:
[aStream tab]. aStream nextPutAll: title. aStream space; space; space.
aStream nextPutAll: count printString. aStream cr. collection
asSortedCollection do: [:assoc | selector := assoc key. bag :=
assoc value. level timesRepeat: [aStream tab]. aStream tab. aStream
nextPutAll: selector. aStream cr. bag asSet asSortedCollection do:
[:it | count := bag occurrencesOf: it. level timesRepeat: [aStream
tab]. aStream tab; tab. aStream nextPutAll: it. aStream space;
space; space. aStream nextPutAll: '(' , count printString , ')'.
aStream cr]]! ! !ClassReview methodsFor: 'private reporting' stamp: 'nishis
6/22/1998 16:56'! outputForMessagesHtml: aStream value: title value: collection
value: level | count selector bag | count := 0. collection do: [:assoc |
count := count + assoc value size]. level timesRepeat: [aStream nextPutAll:
'<DL>']. aStream cr. level timesRepeat: [aStream tab]. aStream nextPutAll:
'<B><I>'. aStream nextPutAll: title. aStream nextPutAll: '</I></B>'. aStream
space; space; space. aStream nextPutAll: count printString. aStream cr.
collection asSortedCollection do: [:assoc | aStream nextPutAll:
'<DL>'. aStream cr. selector := assoc key. bag := assoc value. level
timesRepeat: [aStream tab]. aStream tab. self outputForHtml: aStream
string: selector. aStream cr. bag asSet asSortedCollection do:
[:it | count := bag occurrencesOf: it. level timesRepeat: [aStream
tab]. aStream tab; tab. self outputForHtml: aStream string: it.
aStream space; space; space. aStream nextPutAll: '(' , count printString ,
')'. aStream cr]. aStream nextPutAll: '</DL>'. aStream cr]. level
timesRepeat: [aStream nextPutAll: '</DL>']. aStream cr! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/30/1998 14:15'!
outputForNumber: aStream value: title value: number value: level level
timesRepeat: [aStream tab]. aStream nextPutAll: title. aStream space; space;
space. aStream nextPutAll: number printString. aStream cr! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/22/1998 16:57'!
outputForNumberHtml: aStream value: title value: number value: level level
timesRepeat: [aStream nextPutAll: '<DL>']. aStream cr. level timesRepeat:
[aStream tab]. aStream nextPutAll: '<B><I>'. aStream nextPutAll: title.
aStream nextPutAll: '</I></B>'. aStream space; space; space. aStream
nextPutAll: number printString. aStream cr. level timesRepeat: [aStream
nextPutAll: '</DL>']. aStream cr! ! !ClassReview methodsFor: 'private
reporting' stamp: 'nishis 6/30/1998 14:15'! outputForPercentage: aStream value:
title value: number value: level level timesRepeat: [aStream tab]. aStream
nextPutAll: title. aStream space; space; space. aStream nextPutAll: number
printString , '%'. aStream cr! ! !ClassReview methodsFor: 'private reporting'
stamp: 'nishis 6/22/1998 16:57'! outputForPercentageHtml: aStream value: title
value: number value: level level timesRepeat: [aStream nextPutAll: '<DL>'].
aStream cr. level timesRepeat: [aStream tab]. aStream nextPutAll: '<B><I>'.
aStream nextPutAll: title. aStream nextPutAll: '</I></B>'. aStream space;
space; space. aStream nextPutAll: number printString , '%'. aStream cr. level
timesRepeat: [aStream nextPutAll: '</DL>']. aStream cr! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/30/1998 14:15'!
outputForVariables2: aStream value: title value: collection value: level |
count selector set | count := 0. collection do: [:assoc | count := count +
assoc value size]. level timesRepeat: [aStream tab]. aStream nextPutAll:
title. aStream space; space; space. aStream nextPutAll: count printString.
aStream cr. collection asSortedCollection do: [:assoc | selector :=
assoc key. set := assoc value. level timesRepeat: [aStream tab].
aStream tab. aStream nextPutAll: selector. aStream cr. set do:
[:each | level timesRepeat: [aStream tab]. aStream tab; tab.
aStream nextPutAll: each asString. aStream cr]]! ! !ClassReview
methodsFor: 'private reporting' stamp: 'nishis 6/22/1998 16:58'!
outputForVariables2Html: aStream value: title value: collection value: level |
count selector set | count := 0. collection do: [:assoc | count := count +
assoc value size]. level timesRepeat: [aStream nextPutAll: '<DL>']. aStream
cr. level timesRepeat: [aStream tab]. aStream nextPutAll: '<B><I>'. aStream
nextPutAll: title. aStream nextPutAll: '</I></B>'. aStream space; space;
space. aStream nextPutAll: count printString. aStream cr. collection
asSortedCollection do: [:assoc | aStream nextPutAll: '<DL>'.
aStream cr. selector := assoc key. set := assoc value. level
timesRepeat: [aStream tab]. aStream tab. self outputForHtml: aStream
string: selector. aStream cr. set do: [:each | aStream
nextPutAll: '<DL>'. aStream cr. level timesRepeat: [aStream tab].
aStream tab; tab. self outputForHtml: aStream string: each asString.
aStream cr. aStream nextPutAll: '</DL>'. aStream cr]. aStream
nextPutAll: '</DL>'. aStream cr]. level timesRepeat: [aStream nextPutAll:
'</DL>']. aStream cr! ! !ClassReview methodsFor: 'private reporting' stamp:
'nishis 6/30/1998 14:15'! outputForVariables: aStream value: title value: set
value: level level timesRepeat: [aStream tab]. aStream nextPutAll: title.
aStream space; space; space. aStream nextPutAll: set size printString. aStream
cr. set asSortedCollection do: [:each | level timesRepeat: [aStream
tab]. aStream tab. aStream nextPutAll: each. aStream cr]! !
!ClassReview methodsFor: 'private reporting' stamp: 'nishis 6/22/1998 16:58'!
outputForVariablesHtml: aStream value: title value: set value: level level
timesRepeat: [aStream nextPutAll: '<DL>']. aStream cr. level timesRepeat:
[aStream tab]. aStream nextPutAll: '<B><I>'. aStream nextPutAll: title.
aStream nextPutAll: '</I></B>'. aStream space; space; space. aStream
nextPutAll: set size printString. aStream cr. set asSortedCollection do:
[:each | aStream nextPutAll: '<DL>'. aStream cr. level timesRepeat:
[aStream tab]. aStream tab. self outputForHtml: aStream string: each.
aStream cr. aStream nextPutAll: '</DL>'. aStream cr]. level timesRepeat:
[aStream nextPutAll: '</DL>']. aStream cr! ! !ClassReview class methodsFor:
'copyright'! copyright ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights
Reserved.'! ! !ClassReview class methodsFor: 'copyright'! system ^'Goodies'! !
!ClassReview class methodsFor: 'copyright'! version ^'003'! ! !ClassReview
class methodsFor: 'instance creation'! class: aClass ^(self new) setClass:
aClass; yourself! ! !ClassReview class methodsFor: 'proxy nil'! proxyNil
^MethodReview proxyNil! ! !ClassReview class methodsFor: 'progress flag'!
progressFlag ProgressFlag isNil ifTrue: [ProgressFlag := false].
^ProgressFlag! ! !ClassReview class methodsFor: 'progress flag'! progressFlag:
aBoolean "ClassReview progressFlag: true." "ClassReview progressFlag: false."
ProgressFlag := aBoolean = true! ! !ClassReview class methodsFor: 'examples'!
example1 "ClassReview example1." | classReview | classReview := ClassReview
class: ClassReview. classReview report. ^classReview! ! !ClassReview class
methodsFor: 'examples'! example2 "ClassReview example2." | classReview |
classReview := ClassReview class: ClassReview. classReview reportHtml.
^classReview! ! !ClassReview class methodsFor: 'examples' stamp: 'nishis
6/22/1998 19:27'! example3 "ClassReview example3." | classReview |
classReview := ClassReview class: ClassReview. classReview shortReport.
^classReview! ! !ClassReview class methodsFor: 'examples' stamp: 'nishis
6/26/1998 13:07'! example4 "ClassReview example4." | classReview |
classReview := ClassReview class: Number. classReview reportToFile:
'Number.txt'. ^classReview! ! !CodeReview methodsFor: 'accessing'!
classCollection ^classCollection! ! !CodeReview methodsFor: 'reporting' stamp:
'nishis 6/30/1998 14:10'! report | aStream aModel | aStream := WriteStream on:
(String new: 1024). Cursor wait showWhile: [self reportOn: aStream]. aModel :=
StringHolder new. aModel contents: aStream contents. StringHolderView open:
aModel label: 'Code Review'! ! !CodeReview methodsFor: 'reporting' stamp:
'nishis 6/30/1998 14:10'! reportHtml | aStream aModel | aStream := WriteStream
on: (String new: 1024). self reportHtmlOn: aStream. aModel := StringHolder
new. aModel contents: aStream contents. StringHolderView open: aModel label:
'Code Review'! ! !CodeReview methodsFor: 'reporting'! reportHtmlOn: aStream
self classCollection do: [:aClass | super setClass: aClass. super
reportHtmlOn: aStream. self classCollection last = aClass ifFalse: [aStream
cr]]! ! !CodeReview methodsFor: 'reporting' stamp: 'nishis 6/25/1998 03:44'!
reportHtmlToFile: filename | aStream | aStream := FileStream newFileNamed:
filename. self reportHtmlOn: aStream. aStream close! ! !CodeReview
methodsFor: 'reporting'! reportOn: aStream self classCollection do:
[:aClass | super setClass: aClass. super reportOn: aStream. self
classCollection last = aClass ifFalse: [aStream cr]]! ! !CodeReview methodsFor:
'reporting' stamp: 'nishis 6/25/1998 03:43'! reportToFile: filename | aStream |
aStream := FileStream newFileNamed: filename. Cursor wait showWhile: [self
reportOn: aStream]. aStream close! ! !CodeReview methodsFor: 'reporting'
stamp: 'nishis 6/30/1998 14:12'! shortReport | aStream aModel | aStream :=
WriteStream on: (String new: 1024). Cursor wait showWhile: [self shortReportOn:
aStream]. aModel := StringHolder new. aModel contents: aStream contents.
StringHolderView open: aModel label: 'Code Short Review'! ! !CodeReview
methodsFor: 'reporting'! shortReportOn: aStream self classCollection do:
[:aClass | super setClass: aClass. super shortReportOn: aStream. self
classCollection last = aClass ifFalse: [aStream cr]]! ! !CodeReview methodsFor:
'reporting' stamp: 'nishis 6/25/1998 03:44'! shortReportToFile: filename |
aStream | aStream := FileStream newFileNamed: filename. Cursor wait showWhile:
[self shortReportOn: aStream]. aStream close! ! !CodeReview methodsFor:
'private'! setClassCollection: aCollection | collection | collection :=
SortedCollection new: aCollection size * 2. collection sortBlock: [:c1 :c2 | c1
name < c2 name]. aCollection do: [:aClass | aClass isMeta ifTrue:
[collection add: aClass soleInstance; add: aClass] ifFalse: [collection add:
aClass; add: aClass class]]. classCollection := collection asArray. ^self! !
!CodeReview class methodsFor: 'copyright'! copyright ^'Copyright (C) 1995-1998
AOKI Atsushi, All Rights Reserved.'! ! !CodeReview class methodsFor:
'copyright'! system ^'Goodies'! ! !CodeReview class methodsFor: 'copyright'!
version ^'003'! ! !CodeReview class methodsFor: 'instance creation'! class:
aClass ^self classCollection: (Array with: aClass)! ! !CodeReview class
methodsFor: 'instance creation'! classCollection: classCollection ^(super new)
setClassCollection: classCollection; yourself! ! !CodeReview class methodsFor:
'utilities'! checkSubclassResponsibility: classCollection "CodeReview
checkSubclassResponsibility: (SourceCodeSaver name: 'dummy' categories:
#('*') filter: [:aClass | true]) classes." | aBlock aCollection aCollection2
associations aMethod theClass startClass endClass theSelector aBoolean | aBlock
:= [:aClass | associations := OrderedCollection new. aClass selectors
do: [:aSelector | aMethod := aClass compiledMethodAt: aSelector.
(aMethod messages includes: #subclassResponsibility) ifTrue: [associations
add: aClass -> aSelector]]. associations yourself]. aCollection :=
OrderedCollection new. (classCollection select: [:aClass | aClass isMeta not])
do: [:aClass | aCollection addAll: (aBlock value: aClass).
aCollection addAll: (aBlock value: aClass class)]. aCollection2 :=
OrderedCollection new. aCollection do: [:assoc | (assoc key allSubclasses
select: [:each | each subclasses isEmpty]) do: [:aLeaf | aCollection2 add:
aLeaf -> assoc]]. aCollection := SortedCollection new. aCollection2 do:
[:assoc | theClass := startClass := assoc key. endClass := assoc value
key. theSelector := assoc value value. aBoolean := false. [theClass
notNil and: [(theClass = endClass) not]] whileTrue: [(theClass
selectors includes: theSelector) ifTrue: [aBoolean := true]. theClass
:= theClass superclass]. aBoolean ifFalse: [aCollection add: theSelector ->
(Array with: endClass with: startClass)]]. Transcript clear. Transcript show:
'subclass responsibility:'. Transcript cr. aCollection do: [:assoc |
Transcript tab; show: assoc key printString. Transcript space; show: '('.
Transcript space; show: assoc value first printString. Transcript space;
show: '-'. Transcript space; show: assoc value last printString.
Transcript space; show: ')'. Transcript cr]. ^aCollection! ! !CodeReview
class methodsFor: 'saving' stamp: 'nishis 6/30/1998 14:29'! save "CodeReview
save." | fileName classCollection aStream timeStamp | fileName :=
'CodeRevw.st'. classCollection := self saveClasses. aStream := FileStream
newFileNamed: fileName. aStream reset. Cursor write showWhile:
[timeStamp := Date today printString, ' ' , Time now printString. aStream cr.
aStream nextChunkPut: timeStamp printString. aStream cr; cr. (self comment
isNil or: [self comment isEmpty]) ifFalse: [aStream nextChunkPut:
(String cr, self comment asString, String cr) printString. aStream
cr; cr]. classCollection do: [:aClass | aStream nextChunkPut:
aClass definition. aStream cr; cr]. classCollection do:
[:aClass | aStream nextPut: Character newPage. aStream cr.
aClass fileOutOn: aStream moveSource: false toFile: 0. aStream cr.
aStream cr]]. aStream close. ^classCollection! ! !CodeReview class
methodsFor: 'saving' stamp: 'nishis 7/3/1998 00:34'! saveClasses "CodeReview
saveClasses." | patternCollection classCollection string something |
patternCollection := #('*Review*'). classCollection := (SystemOrganization
superclassOrder: self category). classCollection := classCollection select:
[:aClass | string := aClass name asString. something :=
patternCollection detect: [:it | it match: string] ifNone: [nil].
something notNil]. classCollection addFirst: MethodNodeEnumerator.
classCollection := ChangeSet superclassOrder: classCollection.
^classCollection! ! !CodeReview class methodsFor: 'examples'! example1
"CodeReview example1." | codeReview | codeReview := CodeReview class:
MethodReview. codeReview report. ^codeReview! ! !CodeReview class methodsFor:
'examples' stamp: 'nishis 6/30/1998 14:00'! example2 "CodeReview example2." |
codeReview | codeReview := CodeReview classCollection: (Array with:
MethodReview with: ClassReview with: CodeReview). codeReview report.
^codeReview! ! !CodeReview class methodsFor: 'examples' stamp: 'nishis
6/30/1998 13:59'! example3 "CodeReview example3." | codeReview | codeReview
:= CodeReview class: MethodReview. codeReview shortReport. ^codeReview! !
!CodeReview class methodsFor: 'examples' stamp: 'nishis 10/20/1998 23:00'!
example4 "CodeReview example4." | codeReview | codeReview := CodeReview
classCollection: (Array with: MethodReview with: ClassReview
with: CodeReview). codeReview reportToFile: 'CodeReview.txt'. ^codeReview! !
!DumpModel methodsFor: 'accessing'! bytes byteArray isNil ifTrue: [byteArray :=
ByteArray new]. ^byteArray! ! !DumpModel methodsFor: 'accessing' stamp:
'nishis 5/21/98 21:31'! bytes: bytes start: start byteArray := ByteArray
newFrom: bytes. startAddress := start. self textModel contents: self dump! !
!DumpModel methodsFor: 'accessing'! start startAddress isNil ifTrue:
[startAddress := 0]. ^startAddress! ! !DumpModel methodsFor: 'accessing'! stop
^self bytes size! ! !DumpModel methodsFor: 'comparing'! = dumpModel ^self
bytes = dumpModel bytes and: [self start = dumpModel start]! ! !DumpModel
methodsFor: 'model accessing' stamp: 'nishis 5/21/98 21:31'! textModel
textModel isNil ifTrue: [textModel := StringHolder new contents: Text new].
^textModel! ! !DumpModel methodsFor: 'interface opening' stamp: 'nishis 5/24/98
07:40'! open | topView view | view := StringHolderView new. view model: self
textModel. view borderWidth: 1. topView := StandardSystemView new. topView
model: view model; label: 'Dump'; borderWidth: 1; minimumSize: 450 @
250; backgroundColor: Color white. topView addSubView: view. topView
controller open! ! !DumpModel methodsFor: 'printing' stamp: 'nishis 5/21/98
13:07'! printOn: aStream aStream nextPutAll: self textModel contents! !
!DumpModel methodsFor: 'private' stamp: 'nishis 5/21/98 21:40'! addressString:
address | stream string | stream := WriteStream on: (String new: 9). string
:= self printStringOf: address radix: 16. string size > 8 ifTrue: [string :=
string copyFrom: string size - 8 + 1 to: string size] ifFalse: [8 - string
size timesRepeat: [stream nextPutAll: '0']]. stream nextPutAll: string. stream
nextPutAll: ':'. ^stream contents! ! !DumpModel methodsFor: 'private'! assert:
assertBlock do: doBlock ensure: ensureBlock ^self class assert: assertBlock
do: doBlock ensure: ensureBlock! ! !DumpModel methodsFor: 'private' stamp:
'nishis 5/21/98 21:41'! dump | stream dump count chars string | self assert:
[stream := ReadWriteStream on: (String new: 1024)] do: [count := self
start. chars := WriteStream on: (String new: 16). count \\ 16 = 0
ifFalse: [stream nextPutAll: (self addressString: count - (count \\ 16)).
0 to: count \\ 16 - 1 do: [:n | n \\ 2 = 0 ifTrue: [stream
space]. n \\ 8 = 0 ifTrue: [stream space]. stream space; space.
chars space]]. self bytes do: [:byte | self assert:
[count \\ 16 = 0 ifTrue: [stream nextPutAll: (self addressString: count)].
count \\ 2 = 0 ifTrue: [stream space]. count \\ 8 = 0 ifTrue: [stream
space]] do: [string := self printStringOf: byte radix: 16. 2 -
string size timesRepeat: [stream nextPutAll: '0']. stream nextPutAll:
string. chars nextPut: (self printable: byte)] ensure: [count
:= count + 1. count \\ 16 = 0 ifTrue: [stream space;
space. stream nextPutAll: chars contents. stream cr.
chars := WriteStream on: (String new: 16)]]]. [count \\ 16 = 0]
whileFalse: [self assert: [count \\ 2 = 0 ifTrue: [stream space].
count \\ 8 = 0 ifTrue: [stream space]] do: [stream space; space]
ensure: [count := count + 1. count \\ 16 = 0 ifTrue:
[stream space; space. stream nextPutAll: chars contents.
stream cr. chars := WriteStream on: (String new: 16)]]]. dump :=
stream contents] ensure: [stream close]. ^dump! ! !DumpModel methodsFor:
'private' stamp: 'nishis 5/21/98 22:05'! printOn: aStream number: number base: b
"by nishis, 1998/05/21 22:05" "see SmallInteger>>printOn:base:." |
digitsInReverse x i | number < 0 ifTrue: [ aStream nextPut: $-. ^ number
negated printOn: aStream base: b. ]. "by nishis, 1998/05/21 22:05" "not print
base" "b = 10 ifFalse: [aStream print: b; nextPut: $r]." digitsInReverse _
Array new: 32. x _ number. i _ 0. [x >= b] whileTrue: [ digitsInReverse at:
(i _ i + 1) put: x \\ b. x _ x // b. ]. digitsInReverse at: (i _ i + 1) put:
x. [i > 0] whileTrue: [ aStream nextPut: (Character digitValue:
(digitsInReverse at: i)). i _ i - 1. ].! ! !DumpModel methodsFor: 'private'
stamp: 'nishis 5/21/98 21:44'! printStringOf: number radix: radix | aStream |
aStream := WriteStream on: (String new: 16). self printOn: aStream number:
number base: radix. ^aStream contents! ! !DumpModel methodsFor: 'private'!
printable: byte (33 <= byte and: [byte <= 126]) ifTrue: [^Character value:
byte]. ^Character space! ! !DumpModel class methodsFor: 'copyright'!
copyright ^'Copyright (C) 1995-1998 AOKI Atsushi, All Rights Reserved.'! !
!DumpModel class methodsFor: 'copyright'! system ^'Goodies'! ! !DumpModel
class methodsFor: 'copyright'! version ^'003'! ! !DumpModel class methodsFor:
'class initialization'! flushMenus "DumpModel flushMenus." YellowButtonMenu
:= nil! ! !DumpModel class methodsFor: 'class initialization'! initialize
"DumpModel initialize." self initializeFont. self flushMenus! ! !DumpModel
class methodsFor: 'class initialization'! initializeFont "DumpModel
initializeFont." " | defaultFontName defaultFontSize fontDescription
characterAttributes textAttributes deviceFont | defaultFontName := #('Courier*'
'courier*' '*–¾’©*'). defaultFontSize := 12. fontDescription :=
FontDescription new. fontDescription family: defaultFontName. fontDescription
pixelSize: defaultFontSize. fontDescription boldness: 0.5. fontDescription
italic: false. fontDescription outline: false. fontDescription shadow: false.
fontDescription underline: false. fontDescription fixedWidth: true.
fontDescription serif: false. fontDescription strikeout: false.
fontDescription encodings: Locale current preferredEncodings.
characterAttributes := CharacterAttributes newWithDefaultAttributes.
characterAttributes setDefaultQuery: fontDescription. textAttributes :=
TextAttributes new. textAttributes setCharacterAttributes: characterAttributes.
deviceFont := Screen default defaultFontPolicy findFont: fontDescription.
textAttributes lineGrid: deviceFont height. textAttributes baseline: deviceFont
ascent. TextAttributes styleNamed: #DumpDefault put: textAttributes"! !
!DumpModel class methodsFor: 'instance creation'! bytes: aByteArray ^(self
new) bytes: aByteArray start: 0; yourself! ! !DumpModel class methodsFor:
'instance creation'! filename: aFilename ^self filename: aFilename start:
nil stop: nil! ! !DumpModel class methodsFor: 'instance creation'! filename:
aFilename start: startAddress ^self filename: aFilename start:
startAddress stop: nil! ! !DumpModel class methodsFor: 'instance creation'
stamp: 'nishis 5/21/98 17:05'! filename: aFilename start: startAddress stop:
stopAddress | readStream writeStream fileName fileSize startLocation
stopLocation byteArray byte dir | self assert: [dir := FileDirectory
dirPathFor: aFilename. fileName := (dir isNil or: [dir size = 0])
ifTrue: [aFilename asFileName] ifFalse: [aFilename]. readStream :=
FileStream oldFileNamed: fileName. fileSize := readStream size.
(readStream respondsTo: #binary) ifTrue: [readStream binary]. stopAddress
isNil ifTrue: [stopLocation := fileSize] ifFalse: [stopLocation :=
stopAddress min: fileSize]. startAddress isNil ifTrue: [startLocation :=
0] ifFalse: [startLocation := startAddress min: stopLocation].
writeStream := ReadWriteStream on: (ByteArray new: 1024)] do: [readStream
position: startLocation. [readStream position < stopLocation] whileTrue:
[byte := readStream next. writeStream nextPut: byte]. byteArray :=
writeStream contents] ensure: [readStream close. writeStream close].
^(self new) bytes: byteArray start: startLocation; yourself! ! !DumpModel class
methodsFor: 'saving'! save "DumpModel save." | fileName classCollection
aStream timeStamp | fileName := 'Dump.st'. classCollection := self
saveClasses. aStream := FileStream newFileNamed: fileName asFileName. aStream
reset. Cursor write showWhile: [timeStamp := Date today mmddyyyy, ' ' ,
Time now asString. aStream cr. aStream nextChunkPut: timeStamp
printString. aStream cr; cr. (self comment isNil or: [self comment
isEmpty]) ifFalse: [aStream nextChunkPut: (self comment asString)
printString. aStream cr; cr]. classCollection do: [:aClass |
aStream nextChunkPut: aClass definition. aStream cr; cr].
classCollection do: [:aClass | aStream nextPut: Character
newPage. aStream cr. aClass fileOutOn: aStream. aStream cr]].
aStream close. ^classCollection! ! !DumpModel class methodsFor: 'saving'!
saveClasses "DumpModel saveClasses." | patternCollection classCollection
string something | patternCollection := #('*Dump*'). classCollection :=
SystemOrganization superclassOrder: self category. classCollection :=
classCollection select: [:aClass | string := aClass name
asString. something := patternCollection detect: [:it | it match: string]
ifNone: [nil]. something notNil]. ^classCollection! ! !DumpModel class
methodsFor: 'private' stamp: 'nishis 6/28/1998 04:49'! assert: assertBlock do:
doBlock ensure: ensureBlock | result | assertBlock value. [result := doBlock
value] ifError: [:err :rcvr | ensureBlock value. ^result].
ensureBlock value. ^result! ! !DumpModel class methodsFor: 'examples' stamp:
'nishis 5/21/98 12:54'! example1 "DumpModel example1." | dumpModel |
dumpModel := DumpModel bytes: (Compiler evaluate: '^#( 71 73 70 56 55 97 16 0 16
0 247 0 0 255 255 255 255 255 204 255 255 153 255 255 102 255 255 51 255 255 0
255 204 255 255 204 204 255 204 153 255 204 102 255 204 51 255 204 0 255 153
255 255 153 204 255 153 153 255 153 102 255 153 51 255 153 0 255 102 255 255
102 204 255 102 153 255 102 102 255 102 51 255 102 0 255 51 255 255 51 204 255
51 153 255 51 102 255 51 51 255 51 0 255 0 255 255 0 204 255 0 153 255 0 102
255 0 51 255 0 0 204 255 255 204 255 204 204 255 153 204 255 102 204 255 51 204
255 0 204 204 255 204 204 204 204 204 153 204 204 102 204 204 51 204 204 0 204
153 255 204 153 204 204 153 153 204 153 102 204 153 51 204 153 0 204 102 255
204 102 204 204 102 153 204 102 102 204 102 51 204 102 0 204 51 255 204 51 204
204 51 153 204 51 102 204 51 51 204 51 0 204 0 255 204 0 204 204 0 153 204 0
102 204 0 51 204 0 0 153 255 255 153 255 204 153 255 153 153 255 102 153 255
51 153 255 0 153 204 255 153 204 204 153 204 153 153 204 102 153 204 51 153 204
0 153 153 255 153 153 204 153 153 153 153 153 102 153 153 51 153 153 0 153 102
255 153 102 204 153 102 153 153 102 102 153 102 51 153 102 0 153 51 255 153 51
204 153 51 153 153 51 102 153 51 51 153 51 0 153 0 255 153 0 204 153 0 153 153
0 102 153 0 51 153 0 0 102 255 255 102 255 204 102 255 153 102 255 102 102 255
51 102 255 0 102 204 255 102 204 204 102 204 153 102 204 102 102 204 51 102
204 0 102 153 255 102 153 204 102 153 153 102 153 102 102 153 51 102 153 0 102
102 255 102 102 204 102 102 153 102 102 102 102 102 51 102 102 0 102 51 255 102
51 204 102 51 153 102 51 102 102 51 51 102 51 0 102 0 255 102 0 204 102 0 153
102 0 102 102 0 51 102 0 0 51 255 255 51 255 204 51 255 153 51 255 102 51 255
51 51 255 0 51 204 255 51 204 204 51 204 153 51 204 102 51 204 51 51 204 0 51
153 255 51 153 204 51 153 153 51 153 102 51 153 51 51 153 0 51 102 255 51 102
204 51 102 153 51 102 102 51 102 51 51 102 0 51 51 255 51 51 204 51 51 153 51
51 102 51 51 51 51 51 0 51 0 255 51 0 204 51 0 153 51 0 102 51 0 51 51 0 0 0
255 255 0 255 204 0 255 153 0 255 102 0 255 51 0 255 0 0 204 255 0 204 204 0
204 153 0 204 102 0 204 51 0 204 0 0 153 255 0 153 204 0 153 153 0 153 102 0
153 51 0 153 0 0 102 255 0 102 204 0 102 153 0 102 102 0 102 51 0 102 0 0 51
255 0 51 204 0 51 153 0 51 102 0 51 51 0 51 0 0 0 255 0 0 204 0 0 153 0 0 102 0
0 51 238 0 0 221 0 0 187 0 0 170 0 0 136 0 0 119 0 0 85 0 0 68 0 0 34 0 0 17 0
0 0 238 0 0 221 0 0 187 0 0 170 0 0 136 0 0 119 0 0 85 0 0 68 0 0 34 0 0 17 0
0 0 238 0 0 221 0 0 187 0 0 170 0 0 136 0 0 119 0 0 85 0 0 68 0 0 34 0 0 17
238 238 238 221 221 221 187 187 187 170 170 170 136 136 136 119 119 119 85 85
85 68 68 68 34 34 34 17 17 17 0 0 0 44 0 0 0 0 16 0 16 0 0 8 76 0 1 8 28 72 176
160 65 130 227 198 29 52 152 112 33 67 135 2 19 42 4 32 241 160 196 139 21 9
22 216 200 145 227 193 142 32 15 94 24 73 146 164 200 146 40 13 98 91 201 178
37 54 131 32 98 202 156 9 115 166 205 131 236 114 234 204 233 144 39 0 159 16
29 6 4 0 59)'). dumpModel open. ^dumpModel! ! !DumpModel class methodsFor:
'examples'! example2 "DumpModel example2." | dumpModel | dumpModel :=
DumpModel filename: 'FILE NAME'. dumpModel open. ^dumpModel! ! !DumpModel
class methodsFor: 'examples' stamp: 'nishis 5/21/98 22:08'! example3 "DumpModel
example3." "on Mac: ':test:setlist.gif', etc" "on Win: 'test\setlist.gif',
etc" | dumpModel | dumpModel := DumpModel filename: 'FILE NAME' start: 100
stop: 200. dumpModel open. ^dumpModel! ! !Encyclopedia methodsFor:
'accessing'! classCollection classCollection isNil ifTrue: [classCollection :=
IdentitySet new]. ^classCollection! ! !Encyclopedia methodsFor: 'accessing'!
sourceInclusion ^sourceInclusion = true! ! !Encyclopedia methodsFor:
'accessing'! sourceInclusion: aBoolean sourceInclusion := aBoolean = true! !
!Encyclopedia methodsFor: 'generation' stamp: 'nishis 4/2/98 21:50'! generate |
aCollection | Cursor wait showWhile: [aCollection := self classCollection
asSortedCollection: [:c1 :c2 | c1 name < c2 name]]. aCollection do:
[:each | Transcript cr; show: each name asString. self
generateHtmlForClass: each]. self generateGifs. self generateIndex. self
generateXrefs. ^self! ! !Encyclopedia methodsFor: 'generation' stamp: 'nishis
6/11/1998 22:39'! generateGifs "Encyclopedia new generateGifs." | aCollection
readStream writeStream fileName gifData writeBlock | aCollection := Dictionary
new. aCollection add: self fileNameIndexGif -> self indexGifData. aCollection
add: self fileNameXrefsGif -> self xrefsGifData. aCollection add: self
fileNameDot1Gif -> self dot1GifData. aCollection add: self fileNameDot2Gif ->
self dot2GifData. aCollection add: self fileNameDot3Gif -> self dot3GifData.
aCollection add: self fileNameDot4Gif -> self dot4GifData. aCollection add:
self fileNameDot5Gif -> self dot5GifData. aCollection add: self fileNameDot6Gif
-> self dot6GifData. aCollection add: self fileNameDot7Gif -> self dot7GifData.
aCollection add: self fileNameDot8Gif -> self dot8GifData. aCollection add:
self fileNameDot9Gif -> self dot9GifData. writeBlock := [: aReadStream :
aWriteStream | [aReadStream atEnd] whileFalse: [aWriteStream
nextPut: aReadStream next]]. aCollection keysDo: [:each | fileName :=
each. gifData := aCollection at: fileName. readStream := ReadStream on:
gifData. writeStream := (FileStream fileNamed: self directoryNameForImages ,
fileName) binary. Cursor write showWhile: [writeBlock value:
readStream value: writeStream]. writeStream close.]. ^self! ! !Encyclopedia
methodsFor: 'generation' stamp: 'nishis 6/11/1998 22:39'! generateHtmlForClass:
aClass | fileName aStream | fileName := self directoryNameForHtmls , (self
htmlFileNameFor: aClass name). aStream := FileStream fileNamed: fileName.
Cursor write showWhile: [self headerHtmlForClass: aClass on: aStream.
self definitionHtmlForClass: aClass on: aStream. self variablesHtmlForClass:
aClass on: aStream. self methodsHtmlForClass: aClass on: aStream. self
footerHtmlForClass: aClass on: aStream]. aStream close. ^self! !
!Encyclopedia methodsFor: 'generation' stamp: 'nishis 6/11/1998 22:51'!
generateIndex "Encyclopedia new generateIndex." | aDictionary directoryName
aStream sortedCollection aCollection flag line tokens kind char value it |
aDictionary := Dictionary new. directoryName := self directoryNameForHtmls.
self htmlFileNames do: [:each | aStream := FileStream oldFileNamed:
(directoryName , each). Cursor read showWhile: [flag := false.
[aStream atEnd not and: [flag = false]] whileTrue: [line := self
getLine: aStream. tokens := self separate: line dividers: self
separators. (tokens size >= 4 and: ['A' = (tokens at: 1) and: ['NAME' =
(tokens at: 2)]]) ifTrue: [kind := tokens at: 3. kind
= 'Class' ifTrue: [it := tokens at: 4. char :=
it first asUppercase. value := aDictionary at: char ifAbsent:
[SortedCollection new]. value add: it -> each. aDictionary
at: char put: value. Transcript cr; show: it , '(' , each , ')'.
flag := true]]]]. aStream close]. sortedCollection := (self associations:
aDictionary) asSortedCollection. aCollection := OrderedCollection new:
sortedCollection size. sortedCollection do: [:assoc | assoc key isLetter
ifTrue: [aCollection add: assoc]]. sortedCollection do: [:assoc | assoc key
isLetter ifFalse: [aCollection add: assoc]]. aStream := FileStream fileNamed:
(self directoryNameForEncyclopedia , 'index' , self htmlFileExtension). Cursor
write showWhile: [self htmlForIndex: aCollection on: aStream]. aStream close! !
!Encyclopedia methodsFor: 'generation' stamp: 'nishis 6/11/1998 22:40'!
generateXrefs "Encyclopedia new generateXrefs." "This is a first part of
'generateXrefs (2 parts)." "Why I must divide this, see the last of source."
| aDictionary directoryName aStream kind key char dictionary value line tokens |
aDictionary := Dictionary new. directoryName := self directoryNameForHtmls.
self htmlFileNames do: [:each | Transcript cr; show: each. aStream
:= FileStream oldFileNamed: (directoryName , each). Cursor read showWhile:
[[aStream atEnd not] whileTrue: [line := self getLine: aStream.
tokens := self separate: line dividers: self separators. (tokens size >= 4
and: ['A' = (tokens at: 1) and: ['NAME' = (tokens at: 2)]]) ifTrue:
[kind := tokens at: 3. (((((((kind = 'Class' or: [kind = 'Category'])
or: [kind = 'InstanceVariable']) or: [kind = 'ClassInstanceVariable'])
or: [kind = 'ClassVariable']) or: [kind = 'PoolVariable']) or:
[kind = 'InstanceMethod']) or: [kind = 'ClassMethod']) ifTrue:
[kind := kind asSymbol. key := tokens at: 4. char := key
first asUppercase. dictionary := aDictionary at: char ifAbsent:
[Dictionary new]. value := dictionary at: key ifAbsent:
[SortedCollection sortBlock: [:a1 :a2 | a1 key < a2 key]]. value add:
kind -> each. dictionary at: key put: value. aDictionary at:
char put: dictionary]]]]. aStream close]. " The Walkback says: <<Cannot
compile - stack including temps is too deep>> CompileMethod(Object)>>error:
CompileMethod>>needsFrameSize: MethodNode>>generate: Encyclopedia
class(ClassDescription)>>compile:notifying:trailer:ifFail:elseSetSalectorAndNode\
: Encyclopedia class(ClassDescription)>>compile:classified:withStamp:notifying:
So I divide this method into 2. Original source code is stored at
<<generateXrefsInOne>> " self generateXrefsIntoFileForm: (self associations:
aDictionary) asSortedCollection. ^self! ! !Encyclopedia methodsFor:
'generation' stamp: 'nishis 6/28/1998 05:28'! generateXrefsInOne "this method
should be never called." "Encyclopedia new generateXrefs." | aDictionary
directoryName aStream sortedCollection fileName aCollection file associations
kind key char dictionary value line tokens | true ifTrue: [^ self error:
'generateXrefsInOne: should be never called.']. aDictionary := Dictionary new.
directoryName := self directoryNameForHtmls. self htmlFileNames do:
[:each | Transcript cr; show: each. aStream := FileStream oldFileNamed:
(directoryName , each). Cursor read showWhile: [[aStream atEnd not]
whileTrue: [line := self getLine: aStream. tokens := self separate:
line dividers: self separators. (tokens size >= 4 and: ['A' = (tokens at:
1) and: ['NAME' = (tokens at: 2)]]) ifTrue: [kind := tokens at:
3. (((((((kind = 'Class' or: [kind = 'Category']) or: [kind =
'InstanceVariable']) or: [kind = 'ClassInstanceVariable']) or:
[kind = 'ClassVariable']) or: [kind = 'PoolVariable']) or:
[kind = 'InstanceMethod']) or: [kind = 'ClassMethod']) ifTrue:
[kind := kind asSymbol. key := tokens at: 4. char := key
first asUppercase. dictionary := aDictionary at: char ifAbsent:
[Dictionary new]. value := dictionary at: key ifAbsent:
[SortedCollection sortBlock: [:a1 :a2 | a1 key < a2 key]]. value add:
kind -> each. dictionary at: key put: value. aDictionary at:
char put: dictionary]]]] aStream close]. sortedCollection := (self
associations: aDictionary) asSortedCollection. aDictionary := Dictionary new.
sortedCollection do: [:assoc | assoc key isLetter ifTrue: [file :=
'xrefs' , (String with: assoc key) , self htmlFileExtension. associations :=
aDictionary at: file ifAbsent: [OrderedCollection new]. associations add:
assoc. aDictionary at: file put: associations]]. sortedCollection do:
[:assoc | assoc key isLetter ifFalse: [file := 'xrefs' , self
htmlFileExtension. associations := aDictionary at: file ifAbsent:
[OrderedCollection new]. associations add: assoc. aDictionary at: file
put: associations]]. sortedCollection := (self associations: aDictionary)
asSortedCollection. sortedCollection do: [:assoc | fileName := assoc
key. aCollection := assoc value. Transcript cr; show: fileName. aStream
:= FileStream fileNamed: (self directoryNameForEncyclopedia , fileName) .
Cursor write showWhile: [self htmlForXrefs: aCollection all:
sortedCollection on: aStream]. aStream close]. ^self! ! !Encyclopedia
methodsFor: 'generation' stamp: 'nishis 6/11/1998 22:40'!
generateXrefsIntoFileForm: aSortedCollection "Encyclopedia new generateXrefs."
"This is a second part of 'generateXrefs' (and last)." | aDictionary aStream
sortedCollection fileName aCollection file associations | sortedCollection :=
aSortedCollection. aDictionary := Dictionary new. sortedCollection do: [:assoc
| assoc key isLetter ifTrue: [file := 'xrefs' , (String with: assoc key)
, self htmlFileExtension. associations := aDictionary at: file ifAbsent:
[OrderedCollection new]. associations add: assoc. aDictionary at: file
put: associations]]. sortedCollection do: [:assoc | assoc key isLetter
ifFalse: [file := 'xrefs' , self htmlFileExtension. associations :=
aDictionary at: file ifAbsent: [OrderedCollection new]. associations add:
assoc. aDictionary at: file put: associations]]. sortedCollection := (self
associations: aDictionary) asSortedCollection. sortedCollection do:
[:assoc | fileName := assoc key. aCollection := assoc value.
Transcript cr; show: fileName. aStream := FileStream fileNamed: (self
directoryNameForEncyclopedia , fileName) . Cursor write showWhile: [self
htmlForXrefs: aCollection all: sortedCollection on: aStream].
aStream close]. ^self! ! !Encyclopedia methodsFor: 'upgrading'!
classNameFromChunk: aChunk | className aStream line tokens | className :=
nil. (aChunk isNil or: [aChunk isEmpty]) ifTrue: [^className]. aStream :=
ReadStream on: aChunk asString. [aStream atEnd] whileFalse: [line := self
getLine: aStream. tokens := self separate: line dividers: self separators.
((tokens size >= 4 and: ['A' = (tokens at: 1) and: ['NAME' = (tokens at: 2)]])
and: ['Class' = (tokens at: 3)]) ifTrue: [className := tokens at: 4]].
^className! ! !Encyclopedia methodsFor: 'upgrading'! dictionaryFromChunk:
aChunk tag: tagString | aDictionary chunkStream aStream line tokens tag |
aDictionary := Dictionary new. (aChunk isNil or: [aChunk isEmpty]) ifTrue:
[^aDictionary]. chunkStream := nil. aStream := ReadStream on: aChunk asString.
[aStream atEnd] whileFalse: [line := self getLine: aStream. tokens :=
self separate: line dividers: self separatorsForChunks. (((tokens size = 4
and: ['<!!--' = (tokens at: 1) and: ['-->' = (tokens at: 4)]]) and: ['{' =
(tokens at: 3)]) and: [tagString ~= (tokens at: 2)]) ifTrue: [tag
:= tokens at: 2. chunkStream := WriteStream on: String new]. (((tokens
size = 4 and: ['<!!--' = (tokens at: 1) and: ['-->' = (tokens at: 4)]]) and:
['}' = (tokens at: 2)]) and: [tag = (tokens at: 3)]) ifTrue:
[chunkStream nextPutAll: line. aDictionary at: tag put: chunkStream
contents. chunkStream := nil]. chunkStream notNil ifTrue: [chunkStream
nextPutAll: line]]. ^aDictionary! ! !Encyclopedia methodsFor: 'upgrading'!
upgrade | aCollection | Cursor wait showWhile: [aCollection := self
classCollection asSortedCollection: [:c1 :c2 | c1 name < c2 name]]. aCollection
do: [:each | Transcript cr; show: each name asString. self
upgradeHtmlForClass: each]. self generateGifs. self generateIndex. self
generateXrefs. ^self! ! !Encyclopedia methodsFor: 'upgrading'!
upgradeCategoryHtmlForClass: aClass chunk: chunkTable on: aStream self
categoryHtmlForClass: aClass on: aStream. ^self! ! !Encyclopedia methodsFor:
'upgrading'! upgradeClassCommentHtmlForClass: aClass chunk: chunkTable on:
aStream | aChunk | aChunk := chunkTable at: '(comment)'. aStream nextPutAll:
aChunk. ^self! ! !Encyclopedia methodsFor: 'upgrading'!
upgradeClassNameHtmlForClass: aClass chunk: chunkTable on: aStream self
classNameHtmlForClass: aClass on: aStream. ^self! ! !Encyclopedia methodsFor:
'upgrading'! upgradeClassVariablesHtmlForClass: aClass chunk: chunkTable on:
aStream | aDictionary | aDictionary := self dictionaryFromChunk: (chunkTable
at: '(class_variables)') tag: '(class_variables)'. self
classVariablesHtmlForClass: aClass headerOn: aStream. aClass classVarNames
asSortedCollection do: [:aSymbol | (aDictionary includesKey: aSymbol asString)
ifTrue: [aStream nextPutAll: (aDictionary at: aSymbol asString)] ifFalse:
[self classVariablesHtmlForClass: aClass variable: aSymbol on:
aStream]]. self classVariablesHtmlForClass: aClass footerOn: aStream. ^self! !
!Encyclopedia methodsFor: 'upgrading'! upgradeFooterHtmlForClass: aClass chunk:
chunkTable on: aStream self footerHtmlForClass: aClass on: aStream. ^self! !
!Encyclopedia methodsFor: 'upgrading'! upgradeHeaderHtmlForClass: aClass chunk:
chunkTable on: aStream self headerHtmlForClass: aClass on: aStream. ^self! !
!Encyclopedia methodsFor: 'upgrading' stamp: 'nishis 6/11/1998 22:50'!
upgradeHtmlForClass: aClass | fileName chunkTable aStream chunkStream
className line tokens tag | fileName := self directoryNameForHtmls , (self
htmlFileNameFor: aClass name). (FileDirectory default fileExists: fileName)
ifFalse: [^self generateHtmlForClass: aClass]. chunkTable := Dictionary
new. chunkTable add: '(class_name)' -> nil. chunkTable add: '(comment)' ->
nil. chunkTable add: '(category)' -> nil. chunkTable add: '(inheritance)' ->
nil. chunkTable add: '(instance_variables)' -> nil. chunkTable add:
'(class_instance_variables)' -> nil. chunkTable add: '(class_variables)' ->
nil. chunkTable add: '(pool_variables)' -> nil. chunkTable add:
'(instance_methods)' -> nil. chunkTable add: '(class_methods)' -> nil. aStream
:= FileStream oldFileNamed: fileName. chunkStream := nil. Cursor read
showWhile: [[aStream atEnd not] whileTrue: [line := self getLine:
aStream. tokens := self separate: line dividers: self separatorsForChunks.
(((tokens size = 4 and: ['<!!--' = (tokens at: 1) and: ['-->' = (tokens at:
4)]]) and: ['{' = (tokens at: 3)]) and: [chunkTable includesKey:
(tokens at: 2)]) ifTrue: [tag := tokens at: 2. chunkStream :=
WriteStream on: String new]. (((tokens size = 4 and: ['<!!--' = (tokens at:
1) and: ['-->' = (tokens at: 4)]]) and: ['}' = (tokens at: 2)]) and:
[tag = (tokens at: 3)]) ifTrue: [chunkStream nextPutAll: line.
chunkTable at: tag put: chunkStream contents. chunkStream := nil].
chunkStream notNil ifTrue: [chunkStream nextPutAll: line]]]. aStream close.
className := self classNameFromChunk: (chunkTable at: '(class_name)').
className notNil ifTrue: [chunkTable at: '(class_name)' put: className.
Cursor write showWhile: [FileDirectory default copyFileNamed: fileName
toFileNamed: (fileName , '.bak')]. aStream := FileStream fileNamed: fileName"
asFilename writeStream". Cursor write showWhile: [self
upgradeHtmlForClass: aClass chunks: chunkTable on: aStream].
aStream close]. ^self! ! !Encyclopedia methodsFor: 'upgrading'!
upgradeHtmlForClass: aClass chunks: chunkTable on: aStream self
upgradeHeaderHtmlForClass: aClass chunk: chunkTable on: aStream. self
upgradeClassNameHtmlForClass: aClass chunk: chunkTable on: aStream. self
upgradeClassCommentHtmlForClass: aClass chunk: chunkTable on: aStream. self
upgradeCategoryHtmlForClass: aClass chunk: chunkTable on: aStream. self
upgradeInheritanceHtmlForClass: aClass chunk: chunkTable on: aStream. self
upgradeInstanceVariablesHtmlForClass: aClass chunk: chunkTable on: aStream.
self upgradeInstanceVariablesHtmlForClass: aClass class chunk: chunkTable
on: aStream. self upgradeClassVariablesHtmlForClass: aClass chunk:
chunkTable on: aStream. self upgradePoolVariablesHtmlForClass: aClass
chunk: chunkTable on: aStream. self upgradeInstanceMethodsHtmlForClass:
aClass chunk: chunkTable on: aStream. self
upgradeInstanceMethodsHtmlForClass: aClass class chunk: chunkTable on:
aStream. self upgradeFooterHtmlForClass: aClass chunk: chunkTable on:
aStream. ^self! ! !Encyclopedia methodsFor: 'upgrading'!
upgradeInheritanceHtmlForClass: aClass chunk: chunkTable on: aStream self
inheritanceHtmlForClass: aClass on: aStream. ^self! ! !Encyclopedia
methodsFor: 'upgrading'! upgradeInstanceMethodsHtmlForClass: aClass chunk:
chunkTable on: aStream | aDictionary | aClass isMeta ifTrue: [aDictionary
:= self dictionaryFromChunk: (chunkTable at: '(class_methods)') tag:
'(class_methods)'] ifFalse: [aDictionary := self dictionaryFromChunk:
(chunkTable at: '(instance_methods)') tag: '(instance_methods)']. self
instanceMethodsHtmlForClass: aClass headerOn: aStream. aClass selectors
asSortedCollection do: [:aSymbol | (aDictionary includesKey: aSymbol asString)
ifTrue: [aStream nextPutAll: (aDictionary at: aSymbol asString)] ifFalse:
[self methodHtmlForClass: aClass selector: aSymbol on: aStream]].
self instanceMethodsHtmlForClass: aClass footerOn: aStream. ^self! !
!Encyclopedia methodsFor: 'upgrading'! upgradeInstanceVariablesHtmlForClass:
aClass chunk: chunkTable on: aStream | aDictionary | aClass isMeta ifTrue:
[aDictionary := self dictionaryFromChunk: (chunkTable at:
'(class_instance_variables)') tag: '(class_instance_variables)']
ifFalse: [aDictionary := self dictionaryFromChunk: (chunkTable at:
'(instance_variables)') tag: '(instance_variables)']. self
instanceVariablesHtmlForClass: aClass headerOn: aStream. aClass instVarNames
asSortedCollection do: [:aString | (aDictionary includesKey: aString asString)
ifTrue: [aStream nextPutAll: (aDictionary at: aString asString)] ifFalse:
[self instanceVariablesHtmlForClass: aClass variable: aString on:
aStream]]. self instanceVariablesHtmlForClass: aClass footerOn: aStream.
^self! ! !Encyclopedia methodsFor: 'upgrading' stamp: 'nishis 4/4/98 18:25'!
upgradePoolVariablesHtmlForClass: aClass chunk: chunkTable on: aStream |
aDictionary key value | aDictionary := self dictionaryFromChunk: (chunkTable
at: '(pool_variables)') tag: '(pool_variables)'. self
poolVariablesHtmlForClass: aClass headerOn: aStream. aClass sharedPools do:
[:each | (self associations: each) asSortedCollection do: [:assoc |
key := assoc key. value := assoc value. (aDictionary includesKey: key
asString) ifTrue: [aStream nextPutAll: (aDictionary at: key asString)]
ifFalse: [self poolVariablesHtmlForClass: aClass key: key
value: value on: aStream]]]. self poolVariablesHtmlForClass: aClass
footerOn: aStream. ^self! ! !Encyclopedia methodsFor: 'html header and
footer'! footerHtmlForClass: aClass on: aStream aStream nextPutAll: '<P>'.
aStream cr. self htmlForLineOn: aStream. self htmlForIndexButton: aClass on:
aStream. self htmlForXrefsButton: aClass on: aStream. self htmlForEndingOn:
aStream. ^self! ! !Encyclopedia methodsFor: 'html header and footer'!
headerHtmlForClass: aClass on: aStream self htmlForTitle: aClass name on:
aStream. self htmlForIndexButton: aClass on: aStream. self htmlForXrefsButton:
aClass on: aStream. self htmlForDateOn: aStream. self htmlForLineOn: aStream.
^self! ! !Encyclopedia methodsFor: 'html definition'! categoryHtmlForClass:
aClass on: aStream aStream nextPutAll: '<!!-- (category) { -->'. aStream cr.
aStream nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<A
NAME="Category('. aStream nextPutAll: aClass category asString. aStream
nextPutAll: ')">'. aStream cr. aStream nextPutAll: '</A>'. aStream cr.
aStream nextPutAll: '<I>category:</I>'. aStream cr. aStream nextPutAll:
'<DL>'. aStream cr. aStream nextPutAll: '<DD><B>'. aStream cr. self
htmlForString: aClass category on: aStream. aStream cr. aStream nextPutAll:
'</B></DD>'. aStream cr. self htmlForXrefsAnchor: aClass category on: aStream.
aStream nextPutAll: '</DL>'. aStream cr. aStream nextPutAll: '<!!-- }
(category) -->'. aStream cr. ^self! ! !Encyclopedia methodsFor: 'html
definition'! classCommentHtmlForClass: aClass on: aStream | comment | aStream
nextPutAll: '<!!-- (comment) { -->'. aStream cr. aStream nextPutAll: '<P>'.
aStream cr. aStream nextPutAll: '<A NAME="Comment('. aStream nextPutAll:
aClass name asString. aStream nextPutAll: ')">'. aStream cr. aStream
nextPutAll: '</A>'. aStream cr. comment := aClass comment. (comment isNil or:
[comment isEmpty]) ifFalse: [self htmlForString: comment on: aStream.
aStream cr]. aStream nextPutAll: '<!!-- } (comment) -->'. aStream cr. ^self!
! !Encyclopedia methodsFor: 'html definition'! classNameHtmlForClass: aClass
on: aStream aStream nextPutAll: '<!!-- (class_name) { -->'. aStream cr.
aStream nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<A NAME="Class('.
aStream nextPutAll: aClass name asString. aStream nextPutAll: ')">'. aStream
cr. aStream nextPutAll: '</A>'. aStream cr. aStream nextPutAll: '<H2>'. self
htmlForString: aClass name on: aStream. aStream nextPutAll: '</H2>'. aStream
cr. aStream nextPutAll: '<!!-- } (class_name) -->'. aStream cr. ^self! !
!Encyclopedia methodsFor: 'html definition'! definitionHtmlForClass: aClass on:
aStream self classNameHtmlForClass: aClass on: aStream. self
classCommentHtmlForClass: aClass on: aStream. self categoryHtmlForClass: aClass
on: aStream. self inheritanceHtmlForClass: aClass on: aStream. ^self! !
!Encyclopedia methodsFor: 'html definition' stamp: 'nishis 4/2/98 11:44'!
hierarchyHtmlForClass: aClass on: aStream | superclasses | superclasses :=
aClass allSuperclasses reversed. superclasses do: [:each | aStream
nextPutAll: '<DL>'. aStream cr. self htmlForClassAnchor: each
base: aClass on: aStream. aStream cr]. self subclassesHtmlForClass:
aClass base: aClass on: aStream. superclasses size timesRepeat:
[aStream nextPutAll: '</DL>'. aStream cr]. ^self! ! !Encyclopedia
methodsFor: 'html definition'! inheritanceHtmlForClass: aClass on: aStream
aStream nextPutAll: '<!!-- (inheritance) { -->'. aStream cr. aStream
nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<A NAME="Inheritance('.
aStream nextPutAll: aClass name asString. aStream nextPutAll: ')">'. aStream
cr. aStream nextPutAll: '</A>'. aStream cr. aStream nextPutAll:
'<I>inheritance:</I>'. aStream cr. aStream nextPutAll: '<DL>'. aStream cr.
self hierarchyHtmlForClass: aClass on: aStream. aStream nextPutAll: '</DL>'.
aStream cr. aStream nextPutAll: '<!!-- } (inheritance) -->'. aStream cr.
^self! ! !Encyclopedia methodsFor: 'html definition' stamp: 'nishis 4/5/98
03:21'! subclassesHtmlForClass: aClass base: baseClass on: aStream |
subclasses | aStream nextPutAll: '<DL>'. aStream cr. self
htmlForClassAnchor: aClass base: baseClass on: aStream. aStream cr.
subclasses := aClass subclasses. aClass == Class ifTrue: [aStream cr;
nextPutAll: '... all the Metaclasses ...'. subclasses := subclasses reject:
[:sub | sub isMeta]]. "Non so pi cosa son, cosa faccio - Cherubino"
"(subclasses asSortedStrings: do: [:p :x :y | (p collate: x name to: y name)
<= 0])" (subclasses asSortedCollection: [:x :y | x name <= y name]) do: [:sub
| self subclassesHtmlForClass: sub base: baseClass on: aStream].
aStream nextPutAll: '</DL>'. aStream cr. ^self! ! !Encyclopedia methodsFor:
'html variables'! classVariablesHtmlForClass: aClass footerOn: aStream aStream
nextPutAll: '</UL>'. aStream cr. aStream nextPutAll: '<!!-- }
(class_variables) -->'. aStream cr. ^self! ! !Encyclopedia methodsFor: 'html
variables'! classVariablesHtmlForClass: aClass headerOn: aStream aStream
nextPutAll: '<!!-- (class_variables) { -->'. aStream cr. aStream nextPutAll:
'<P>'. aStream cr. aStream nextPutAll: '<A NAME="ClassVariables('. aStream
nextPutAll: aClass name asString. aStream nextPutAll: ')">'. aStream cr.
aStream nextPutAll: '</A>'. aStream cr. aStream nextPutAll: '<I>class
variables:</I>'. aStream cr. aStream nextPutAll: '<UL>'. aStream cr. ^self!
! !Encyclopedia methodsFor: 'html variables'! classVariablesHtmlForClass:
aClass on: aStream self classVariablesHtmlForClass: aClass headerOn: aStream.
aClass classVarNames asSortedCollection do: [:aSymbol | self
classVariablesHtmlForClass: aClass variable: aSymbol on: aStream]. self
classVariablesHtmlForClass: aClass footerOn: aStream. ^self! ! !Encyclopedia
methodsFor: 'html variables'! classVariablesHtmlForClass: aClass variable:
aSymbol on: aStream | value | aStream nextPutAll: '<!!-- '. aStream
nextPutAll: aSymbol asString. aStream nextPutAll: ' { -->'. aStream cr.
aStream nextPutAll: '<A NAME="'. aStream nextPutAll: 'ClassVariable('. aStream
nextPutAll: aSymbol asString. aStream nextPutAll: ')">'. aStream cr. aStream
nextPutAll: '</A>'. aStream cr. aStream nextPutAll: '<LI><B>'. self
htmlForString: aSymbol on: aStream. aStream nextPutAll: '</B>'. value :=
aClass classPool at: aSymbol asSymbol. aStream space. aStream nextPutAll:
'<I>'. value isLiteral ifTrue: [self htmlForString: value printString on:
aStream] ifFalse: [self htmlForString: value class name asString on: aStream].
aStream nextPutAll: '</I>'. aStream cr. self htmlForXrefsAnchor: aSymbol on:
aStream. aStream nextPutAll: '<!!-- } '. aStream nextPutAll: aSymbol asString.
aStream nextPutAll: ' -->'. aStream cr. ^self! ! !Encyclopedia methodsFor:
'html variables'! instanceVariablesHtmlForClass: aClass footerOn: aStream
aStream nextPutAll: '</UL>'. aStream cr. aClass isMeta ifTrue: [aStream
nextPutAll: '<!!-- } (class_instance_variables) -->'] ifFalse: [aStream
nextPutAll: '<!!-- } (instance_variables) -->']. aStream cr. ^self! !
!Encyclopedia methodsFor: 'html variables'! instanceVariablesHtmlForClass:
aClass headerOn: aStream aClass isMeta ifTrue: [aStream nextPutAll: '<!!--
(class_instance_variables) { -->'] ifFalse: [aStream nextPutAll: '<!!--
(instance_variables) { -->']. aStream cr. aStream nextPutAll: '<P>'. aStream
cr. aClass isMeta ifTrue: [aStream nextPutAll: '<A
NAME="ClassInstanceVariables('. aStream nextPutAll: aClass soleInstance name
asString] ifFalse: [aStream nextPutAll: '<A NAME="InstanceVariables('.
aStream nextPutAll: aClass name asString]. aStream nextPutAll: ')">'. aStream
cr. aStream nextPutAll: '</A>'. aStream cr. aClass isMeta ifTrue: [aStream
nextPutAll: '<I>class instance variables:</I>'] ifFalse: [aStream nextPutAll:
'<I>instance variables:</I>']. aStream cr. aStream nextPutAll: '<UL>'.
aStream cr. ^self! ! !Encyclopedia methodsFor: 'html variables'!
instanceVariablesHtmlForClass: aClass on: aStream self
instanceVariablesHtmlForClass: aClass headerOn: aStream. aClass instVarNames
asSortedCollection do: [:aString | self instanceVariablesHtmlForClass: aClass
variable: aString on: aStream]. self instanceVariablesHtmlForClass: aClass
footerOn: aStream. ^self! ! !Encyclopedia methodsFor: 'html variables'!
instanceVariablesHtmlForClass: aClass variable: aString on: aStream |
collection index | aStream nextPutAll: '<!!-- '. aStream nextPutAll: aString
asString. aStream nextPutAll: ' { -->'. aStream cr. aStream nextPutAll: '<A
NAME="'. aClass isMeta ifTrue: [aStream nextPutAll: 'ClassInstanceVariable(']
ifFalse: [aStream nextPutAll: 'InstanceVariable(']. aStream nextPutAll:
aString. aStream nextPutAll: ')">'. aStream cr. aStream nextPutAll: '</A>'.
aStream cr. aStream nextPutAll: '<LI><B>'. self htmlForString: aString on:
aStream. aStream nextPutAll: '</B>'. collection := Set new. index := aClass
allInstVarNames findFirst: [:each | each = aString]. index > 0 ifTrue: [aClass
allInstancesDo: [:each | collection add: (each instVarAt: index) class name]].
collection isEmpty ifFalse: [aStream space. aStream nextPutAll: '<I>'].
collection := collection asSortedCollection. collection do: [:each |
self htmlForString: each on: aStream. each = collection last ifFalse:
[aStream nextPutAll: ' | ']]. collection isEmpty ifFalse: [aStream nextPutAll:
'</I>']. aStream cr. self htmlForXrefsAnchor: aString on: aStream. aStream
nextPutAll: '<!!-- } '. aStream nextPutAll: aString asString. aStream
nextPutAll: ' -->'. aStream cr. ^self! ! !Encyclopedia methodsFor: 'html
variables'! poolVariablesHtmlForClass: aClass footerOn: aStream aStream
nextPutAll: '</UL>'. aStream cr. aStream nextPutAll: '<!!-- } (pool_variables)
-->'. aStream cr. ^self! ! !Encyclopedia methodsFor: 'html variables'!
poolVariablesHtmlForClass: aClass headerOn: aStream aStream nextPutAll: '<!!--
(pool_variables) { -->'. aStream cr. aStream nextPutAll: '<P>'. aStream cr.
aStream nextPutAll: '<A NAME="PoolVariables('. aStream nextPutAll: aClass name
asString. aStream nextPutAll: ')">'. aStream cr. aStream nextPutAll: '</A>'.
aStream cr. aStream nextPutAll: '<I>pool variables:</I>'. aStream cr. aStream
nextPutAll: '<UL>'. aStream cr. ^self! ! !Encyclopedia methodsFor: 'html
variables'! poolVariablesHtmlForClass: aClass key: key value: value on: aStream
aStream nextPutAll: '<!!-- '. aStream nextPutAll: key asString. aStream
nextPutAll: ' { -->'. aStream cr. aStream nextPutAll: '<A NAME="'. aStream
nextPutAll: 'PoolVariable('. aStream nextPutAll: key asString. aStream
nextPutAll: ')">'. aStream cr. aStream nextPutAll: '</A>'. aStream cr.
aStream nextPutAll: '<LI><B>'. self htmlForString: key on: aStream. aStream
nextPutAll: '</B>'. aStream space. aStream nextPutAll: '<I>'. value isLiteral
ifTrue: [self htmlForString: value printString on: aStream] ifFalse: [self
htmlForString: value class name on: aStream]. aStream nextPutAll: '</I>'.
aStream cr. self htmlForXrefsAnchor: key on: aStream. aStream nextPutAll:
'<!!-- } '. aStream nextPutAll: key asString. aStream nextPutAll: ' -->'.
aStream cr. ^self! ! !Encyclopedia methodsFor: 'html variables' stamp: 'nishis
4/3/98 03:53'! poolVariablesHtmlForClass: aClass on: aStream | key value |
self poolVariablesHtmlForClass: aClass headerOn: aStream. aClass sharedPools
do: [:each | (self associations: each) asSortedCollection do: [:assoc |
key := assoc key. value := assoc value. self
poolVariablesHtmlForClass: aClass key: key value: value on:
aStream]]. self poolVariablesHtmlForClass: aClass footerOn: aStream. ^self! !
!Encyclopedia methodsFor: 'html variables'! variablesHtmlForClass: aClass on:
aStream self instanceVariablesHtmlForClass: aClass on: aStream. self
instanceVariablesHtmlForClass: aClass class on: aStream. self
classVariablesHtmlForClass: aClass on: aStream. self poolVariablesHtmlForClass:
aClass on: aStream. ^self! ! !Encyclopedia methodsFor: 'html methods'!
instanceMethodsHtmlForClass: aClass footerOn: aStream aStream nextPutAll:
'</OL>'. aStream cr. aClass isMeta ifTrue: [aStream nextPutAll: '<!!-- }
(class_methods) -->'] ifFalse: [aStream nextPutAll: '<!!-- }
(instance_methods) -->']. aStream cr. ^self! ! !Encyclopedia methodsFor:
'html methods'! instanceMethodsHtmlForClass: aClass headerOn: aStream aClass
isMeta ifTrue: [aStream nextPutAll: '<!!-- (class_methods) { -->'] ifFalse:
[aStream nextPutAll: '<!!-- (instance_methods) { -->']. aStream cr. aStream
nextPutAll: '<P>'. aStream cr. aClass isMeta ifTrue: [aStream
nextPutAll: '<A NAME="ClassMethods('. aStream nextPutAll: aClass soleInstance
name asString] ifFalse: [aStream nextPutAll: '<A NAME="InstanceMethods('.
aStream nextPutAll: aClass name asString]. aStream nextPutAll: ')">'. aStream
cr. aStream nextPutAll: '</A>'. aStream cr. aClass isMeta ifTrue: [aStream
nextPutAll: '<I>class methods:</I>'] ifFalse: [aStream nextPutAll:
'<I>instance methods:</I>']. aStream cr. aStream nextPutAll: '<OL>'. aStream
cr. ^self! ! !Encyclopedia methodsFor: 'html methods'!
instanceMethodsHtmlForClass: aClass on: aStream self
instanceMethodsHtmlForClass: aClass headerOn: aStream. aClass selectors
asSortedCollection do: [:aSymbol | self methodHtmlForClass: aClass
selector: aSymbol on: aStream]. self instanceMethodsHtmlForClass: aClass
footerOn: aStream. ^self! ! !Encyclopedia methodsFor: 'html methods' stamp:
'nishis 4/11/98 01:14'! methodHtmlForClass: aClass selector: aSymbol on: aStream
"fixed by the Most Revd AOKI Atsushi, Fri, 10 Apr 1998 17:12:35 +0900" |
source parser pattern collection string comments start | source := aClass
sourceCodeAt: aSymbol. parser := aClass parserClass new. parser parseSelector:
source. pattern := source copyFrom: 1 to: parser endOfLastToken. [pattern last
isSeparator] whileTrue: [pattern := pattern copyFrom: 1 to: pattern size - 1].
aStream nextPutAll: '<!!!!-- '. aStream nextPutAll: aSymbol asString. aStream
nextPutAll: ' { -->'. aStream cr. aStream nextPutAll: '<A NAME="'. aClass
isMeta ifTrue: [aStream nextPutAll: 'ClassMethod('] ifFalse: [aStream
nextPutAll: 'InstanceMethod(']. aStream nextPutAll: aSymbol asString. aStream
nextPutAll: ')">'. aStream cr. aStream nextPutAll: '<LI>'. aSymbol numArgs =
0 ifTrue: [aStream nextPutAll: '<B>'. self htmlForString: pattern on:
aStream. aStream nextPutAll: '</B>'] ifFalse: [collection := Scanner new
scanTokens: pattern. 1 to: collection size by: 2 do: [:index
| "Why are you picked up, 'Doit'?" index > 1 ifTrue: [aStream space].
aStream nextPutAll: '<B>'. self htmlForString: (collection at: index)
on: aStream. aStream nextPutAll: '</B>'. aStream space. aStream
nextPutAll: (collection at: index + 1 ifAbsent: [String with: Character
space])]]. string := (aClass organization categoryOfElement: aSymbol) asString.
aStream nextPutAll: ' <I>[' , string , ']</I>'. aStream space. self
htmlForXrefsAnchor: aSymbol on: aStream. aStream nextPutAll: '<BR>'. aStream
cr. self sourceInclusion ifTrue: [start := parser endOfLastToken + 1.
[start <= source size and: [(source at: start) ~= Character cr]] whileTrue:
[start := start + 1]. source := source copyFrom: start to: source size.
aStream nextPutAll: '<PRE>'. self htmlForSource: source on: aStream.
aStream nextPutAll: '</PRE>'. aStream cr] ifFalse: [comments := Parser
new parseMethodComment: source setPattern: [:x | ]. comments isEmpty
ifFalse: [self htmlForString: comments first asString on: aStream.
aStream cr]]. aStream nextPutAll: '<!!!!-- } '. aStream nextPutAll: aSymbol
asString. aStream nextPutAll: ' -->'. aStream cr. ^self! ! !Encyclopedia
methodsFor: 'html methods'! methodsHtmlForClass: aClass on: aStream self
instanceMethodsHtmlForClass: aClass on: aStream. self
instanceMethodsHtmlForClass: aClass class on: aStream. ^self! ! !Encyclopedia
methodsFor: 'html index' stamp: 'nishis 4/2/98 11:42'! htmlForIndex:
charCollection character: aChar on: aStream | sortedCollection aCollection |
sortedCollection := charCollection asSortedCollection. aCollection :=
OrderedCollection new: charCollection size. sortedCollection do: [:each | each
isLetter ifTrue: [aCollection add: each]]. sortedCollection do: [:each | each
isLetter ifFalse: [aCollection add: each]]. aStream nextPutAll: '<FONT
SIZE=-1>'. aStream cr. aCollection do: [:each | each = aChar
ifTrue: [aStream nextPutAll: '<FONT SIZE=+1><B>'. aStream nextPut:
each. aStream nextPutAll: '</B></FONT>'] ifFalse: [aStream
nextPutAll: '<A HREF="#'. aStream nextPut: each. aStream nextPutAll:
'">'. aStream nextPut: each. aStream nextPutAll: '</A>'].
aCollection last = each ifFalse: [aStream nextPutAll: ' | ']. aStream cr].
aStream nextPutAll: '</FONT>'. aStream cr. ^self! ! !Encyclopedia methodsFor:
'html index'! htmlForIndex: aCollection on: aStream | charCollection aChar
assocCollection className fileName | charCollection := OrderedCollection new.
aCollection collect: [:pair | aChar := pair key. charCollection
add: aChar]. self htmlForTitle: 'Class Library Index' on: aStream. self
htmlForXrefsButton: nil on: aStream. self htmlForDateOn: aStream. self
htmlForLineOn: aStream. aStream nextPutAll: '<P>'. aStream cr. aStream
nextPutAll: '<H2>Class Library Index</H2>'. aStream cr. aCollection do:
[:pair | aChar := pair key. assocCollection := pair value. aStream
nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<A NAME="'. aStream
nextPut: aChar. aStream nextPutAll: '">'. aStream cr. self
htmlForIndex: charCollection character: aChar on: aStream. aStream
nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<OL>'. aStream cr.
assocCollection do: [:each | className := each key.
fileName := each value. aStream nextPutAll: '<A NAME="'. aStream
nextPutAll: className asString. aStream nextPutAll: '">'. aStream cr.
aStream nextPutAll: '<LI>'. aStream nextPutAll: '<A HREF="'. aStream
nextPutAll: self baseNameForHtmls. aStream nextPutAll: '/'. aStream
nextPutAll: fileName. aStream nextPutAll: '">'. self htmlForString:
className on: aStream. aStream nextPutAll: '</A>'. aStream cr].
aStream nextPutAll: '</OL>'. aStream cr]. aStream nextPutAll: '<P>'.
aStream cr. self htmlForLineOn: aStream. self htmlForXrefsButton: nil on:
aStream. self htmlForEndingOn: aStream. ^self! ! !Encyclopedia methodsFor:
'html index'! htmlForIndexButton: aClass on: aStream aClass isNil ifTrue:
[aStream nextPutAll: '<A HREF="index'. aStream nextPutAll: self
htmlFileExtension. aStream nextPutAll: '"><IMG SRC="'. aStream nextPutAll:
self baseNameForImages. aStream nextPutAll: '/'. aStream nextPutAll: self
fileNameIndexGif. aStream nextPutAll: '" ALT="index" ALIGN="top"></A>'.
aStream cr] ifFalse: [aStream nextPutAll: '<A HREF="../index'. aStream
nextPutAll: self htmlFileExtension. aStream nextPutAll: '#'. aStream
nextPutAll: aClass name asString. aStream nextPutAll: '"><IMG SRC="../'.
aStream nextPutAll: self baseNameForImages. aStream nextPutAll: '/'.
aStream nextPutAll: self fileNameIndexGif. aStream nextPutAll: '" ALT="index"
ALIGN="top"></A>'. aStream cr]. ^self! ! !Encyclopedia methodsFor: 'html
xrefs' stamp: 'nishis 4/3/98 03:54'! htmlForXrefs: aCollection all:
sortedCollection on: aStream | charCollection assocCollection aChar
aDictionary keyword kind file string | charCollection := OrderedCollection new.
sortedCollection do: [:pair | assocCollection := pair value.
assocCollection do: [:assoc | aChar := assoc key.
charCollection add: aChar]]. self htmlForTitle: 'Cross References' on: aStream.
self htmlForIndexButton: nil on: aStream. self htmlForDateOn: aStream. self
htmlForLineOn: aStream. aStream nextPutAll: '<P>'. aStream cr. aStream
nextPutAll: '<H2>Cross References</H2>'. aStream cr. aCollection do:
[:pair | aChar := pair key. aDictionary := pair value. aStream
nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<A NAME="'. aStream
nextPut: aChar. aStream nextPutAll: '">'. aStream cr. self
htmlForXrefs: charCollection character: aChar on: aStream. aStream
nextPutAll: '<P>'. aStream cr. aStream nextPutAll: '<OL>'. aStream cr.
(self associations: aDictionary) asSortedCollection do: [:assoc |
keyword := assoc key. aStream nextPutAll: '<A NAME="'. aStream
nextPutAll: keyword. aStream nextPutAll: '">'. aStream cr.
aStream nextPutAll: '<LI>'. aStream nextPutAll: keyword. aStream cr.
assoc value do: [:each | kind := each key. file :=
each value. aStream nextPutAll: '<A HREF="'. aStream nextPutAll:
self baseNameForHtmls. aStream nextPutAll: '/'. aStream
nextPutAll: file. aStream nextPutAll: '#'. string := kind asString
, '(' , keyword , ')'. aStream nextPutAll: string. aStream
nextPutAll: '">'. aStream nextPutAll: (self htmlForDot: kind).
aStream nextPutAll: '</A>'. aStream cr]]. aStream nextPutAll: '</OL>'.
aStream cr]. aStream nextPutAll: '<P>'. aStream cr. aStream nextPutAll:
'<HR>'. aStream cr. aStream nextPutAll: '<DL>'. aStream cr. aStream
nextPutAll: 'Notes:'. aStream cr. aStream nextPutAll: '<DL><TT>'. aStream cr.
aStream nextPutAll: '<DT>' , (self htmlForDot: #Class) , ' class'. aStream cr.
aStream nextPutAll: '<DT>' , (self htmlForDot: #Category) , ' category'.
aStream cr. aStream nextPutAll: '<DT>' , (self htmlForDot: #InstanceVariable) ,
' instance variable'. aStream cr. aStream nextPutAll: '<DT>' , (self
htmlForDot: #ClassInstanceVariable) , ' class instance variable'. aStream cr.
aStream nextPutAll: '<DT>' , (self htmlForDot: #ClassVariable) , ' class
variable'. aStream cr. aStream nextPutAll: '<DT>' , (self htmlForDot:
#PoolVariable) , ' pool variable'. aStream cr. aStream nextPutAll: '<DT>' ,
(self htmlForDot: #InstanceMethod) , ' instance method'. aStream cr. aStream
nextPutAll: '<DT>' , (self htmlForDot: #ClassMethod) , ' class method'. aStream
cr. aStream nextPutAll: '<DT>' , (self htmlForDot: nil) , ' unknown'. aStream
cr. aStream nextPutAll: '</TT></DL>'. aStream cr. aStream nextPutAll:
'</DL>'. aStream cr. aStream nextPutAll: '<P>'. aStream cr. self
htmlForLineOn: aStream. self htmlForIndexButton: nil on: aStream. self
htmlForEndingOn: aStream. ^self! ! !Encyclopedia methodsFor: 'html xrefs'
stamp: 'nishis 4/2/98 11:42'! htmlForXrefs: charCollection character: aChar on:
aStream | sortedCollection aCollection | sortedCollection := charCollection
asSortedCollection. aCollection := OrderedCollection new: charCollection size.
sortedCollection do: [:each | each isLetter ifTrue: [aCollection add: each]].
sortedCollection do: [:each | each isLetter ifFalse: [aCollection add: each]].
aStream nextPutAll: '<FONT SIZE=-1>'. aStream cr. aCollection do: [:each
| each = aChar ifTrue: [aStream nextPutAll: '<FONT SIZE=+1><B>'.
aStream nextPut: each. aStream nextPutAll: '</B></FONT>'] ifFalse:
[aStream nextPutAll: '<A HREF="xrefs'. each isLetter ifTrue: [aStream
nextPut: each]. aStream nextPutAll: self htmlFileExtension. aStream
nextPutAll: '">'. aStream nextPut: each. aStream nextPutAll: '</A>'].
aCollection last = each ifFalse: [aStream nextPutAll: ' | ']. aStream cr].
aStream nextPutAll: '</FONT>'. aStream cr! ! !Encyclopedia methodsFor: 'html
xrefs' stamp: 'nishis 4/2/98 11:42'! htmlForXrefsAnchor: aString on: aStream
aStream nextPutAll: '<A HREF="../xrefs'. aString asString first isLetter
ifTrue: [aStream nextPut: aString asString first asUppercase]. aStream
nextPutAll: self htmlFileExtension. aStream nextPutAll: '#'. aStream
nextPutAll: aString asString. aStream nextPutAll: '"><IMG SRC="../'. aStream
nextPutAll: self baseNameForImages. aStream nextPutAll: '/'. aStream
nextPutAll: self fileNameXrefsGif. aStream nextPutAll: '" ALT="xrefs"
ALIGN="top"></A>'. aStream cr! ! !Encyclopedia methodsFor: 'html xrefs' stamp:
'nishis 4/2/98 11:41'! htmlForXrefsButton: aClass on: aStream aClass isNil
ifTrue: [aStream nextPutAll: '<A HREF="xrefs'. aStream nextPutAll: self
htmlFileExtension. aStream nextPutAll: '"><IMG SRC="'. aStream nextPutAll:
self baseNameForImages. aStream nextPutAll: '/'. aStream nextPutAll: self
fileNameXrefsGif. aStream nextPutAll: '" ALT="xrefs" ALIGN="top"></A>'.
aStream cr] ifFalse: [aStream nextPutAll: '<A HREF="../xrefs'. aClass
name first isLetter ifTrue: [aStream nextPut: aClass name first asUppercase].
aStream nextPutAll: self htmlFileExtension. aStream nextPutAll: '#'.
aStream nextPutAll: aClass name asString. aStream nextPutAll: '"><IMG
SRC="../'. aStream nextPutAll: self baseNameForImages. aStream nextPutAll:
'/'. aStream nextPutAll: self fileNameXrefsGif. aStream nextPutAll: '"
ALT="xrefs" ALIGN="top"></A>'. aStream cr]. ^self! ! !Encyclopedia
methodsFor: 'html support'! htmlForClassAnchor: aClass base: baseClass on:
aStream | string | aClass = baseClass ifTrue: [aStream nextPutAll:
'<B>'. self htmlForString: aClass name on: aStream. aStream nextPutAll:
'</B>'] ifFalse: [(self classCollection includes: aClass) ifTrue:
[string := self htmlFileNameFor: aClass name. aStream nextPutAll: '<A
HREF="'. aStream nextPutAll: string. aStream nextPutAll: '">'.
self htmlForString: aClass name on: aStream. aStream nextPutAll: '</A>']
ifFalse: [self htmlForString: aClass name on: aStream]]. ^self! !
!Encyclopedia methodsFor: 'html support'! htmlForDateOn: aStream aStream
nextPutAll: self dateAndTimeString. aStream cr. ^self! ! !Encyclopedia
methodsFor: 'html support'! htmlForDot: kind | string1 string2 string3 |
string1 := '<IMG SRC="' , self baseNameForImages , '/'. string2 := '" ALT="'.
string3 := '" ALIGN="bottom">'. kind = #Class ifTrue: [^string1 , self
fileNameDot1Gif , string2 , '@' , string3]. kind = #Category ifTrue: [^string1
, self fileNameDot2Gif , string2 , '#' , string3]. kind = #InstanceVariable
ifTrue: [^string1 , self fileNameDot3Gif , string2 , '+' , string3]. kind =
#ClassInstanceVariable ifTrue: [^string1 , self fileNameDot4Gif , string2 , '-'
, string3]. kind = #ClassVariable ifTrue: [^string1 , self fileNameDot5Gif ,
string2 , '=' , string3]. kind = #PoolVariable ifTrue: [^string1 , self
fileNameDot6Gif , string2 , '%' , string3]. kind = #InstanceMethod ifTrue:
[^string1 , self fileNameDot7Gif , string2 , '*' , string3]. kind =
#ClassMethod ifTrue: [^string1 , self fileNameDot8Gif , string2 , '$' ,
string3]. ^string1 , self fileNameDot9Gif , string2 , '$' , string3! !
!Encyclopedia methodsFor: 'html support'! htmlForEndingOn: aStream aStream
nextPutAll: '<!!-- This Document was generated by ' , self class name , '. -->'.
aStream cr. aStream nextPutAll: '<!!-- ' , self class name , ' was developed by
AOKI Atsushi. -->'. aStream cr. aStream nextPutAll: '</BODY>'. aStream cr.
aStream nextPutAll: '</HTML>'. aStream cr. ^self! ! !Encyclopedia methodsFor:
'html support'! htmlForLineOn: aStream aStream nextPutAll: '<HR>'. aStream
cr. ^self! ! !Encyclopedia methodsFor: 'html support' stamp: 'nishis 4/2/98
23:34'! htmlForSource: aString on: aStream | readStream aCharacter |
readStream := ReadStream on: aString asString. [readStream atEnd] whileFalse:
[aCharacter := readStream next. aCharacter = Character linefeed ifTrue:
[aCharacter := Character cr] ifFalse: [aCharacter = Character cr ifTrue:
[readStream peek = Character linefeed ifTrue: [readStream next]]]. aCharacter
notNil ifTrue: [aCharacter = Character cr ifTrue: [aStream nextPut:
aCharacter] ifFalse: [aCharacter = $< ifTrue: [aStream nextPutAll:
'<'] ifFalse: [aCharacter = $> ifTrue: [aStream nextPutAll:
'>'] ifFalse: ["Object errorSignal handle: [:exception | aStream
nextPut: Character space] do: [aStream nextPut: aCharacter]" aStream
nextPut: aCharacter]]]]]. ^self! ! !Encyclopedia methodsFor: 'html support'
stamp: 'nishis 4/2/98 23:29'! htmlForString: aString on: aStream | readStream
aCharacter | readStream := ReadStream on: aString asString. [readStream atEnd]
whileFalse: [aCharacter := readStream next. aCharacter = Character
linefeed ifTrue: [aCharacter := Character cr] ifFalse: [aCharacter =
Character cr ifTrue: [readStream peek =
(El mensaje tiene más de 64K y ha sido truncado.)
Sin conexión 
Enviar correo