home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BURKS 2
/
BURKS_AUG97.ISO
/
BURKS
/
LANGUAGE
/
SMALTALK
/
TEXTBOOK
/
AP09.ST
(
.txt
)
< prev
next >
Wrap
Text File
|
1997-04-22
|
12KB
|
438 lines
'Smalltalk Textbook Appendix 09'!
Model subclass: #EngiSystem
instanceVariableNames: ''
classVariableNames: 'SaveFiles '
poolDictionaries: ''
category: 'Engi-Kernel'!
EngiSystem comment:
'
Engi 0.03 (29 January 1994)
Copyright (C) 1994 by Atsushi Aoki
'!
!EngiSystem methodsFor: 'updating'!
update: aSymbol
(aSymbol = #finishedSnapshot or: [aSymbol = #returnFromSnapshot])
ifTrue:
[aSymbol = #returnFromSnapshot ifTrue: [self class login].
aSymbol = #finishedSnapshot ifTrue: [self class prologue]].
(aSymbol = #aboutToQuit or: [aSymbol = #aboutToSnapshot])
ifTrue:
[aSymbol = #aboutToSnapshot ifTrue: [self class epilogue].
aSymbol = #aboutToQuit ifTrue: [self class logout]].
aSymbol = #condenseChanges ifTrue: ['no operation' yourself]! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
EngiSystem class
instanceVariableNames: 'soleEngiSystem '!
!EngiSystem class methodsFor: 'class initialization'!
initialize
"EngiSystem initialize."
self release.
Smalltalk addDependent: self soleEngiSystem!
release
"EngiSystem release."
(Smalltalk dependents includes: soleEngiSystem)
ifTrue: [Smalltalk removeDependent: soleEngiSystem].
Smalltalk dependents copy do: [:each | (each isKindOf: self)
ifTrue: [Smalltalk removeDependent: each]]! !
!EngiSystem class methodsFor: 'instance creation'!
new
^self soleEngiSystem!
soleEngiSystem
soleEngiSystem isNil ifTrue: [soleEngiSystem := super new].
^soleEngiSystem! !
!EngiSystem class methodsFor: 'login'!
login
"EngiSystem login."
self userInterruptSignal handle: [:exception | exception proceed]
do:
[self loginAction.
self soleEngiSystem changed: #login]!
loginAction
"EngiSystem loginAction."
self about.
^self!
prologue
"EngiSystem prologue."
self userInterruptSignal handle: [:exception | exception proceed]
do:
[self prologueAction.
self soleEngiSystem changed: #prologue]!
prologueAction
"EngiSystem prologueAction."
self about.
^self! !
!EngiSystem class methodsFor: 'logout'!
epilogue
"EngiSystem epilogue."
self userInterruptSignal handle: [:exception | exception proceed]
do:
[self epilogueAction.
self soleEngiSystem changed: #epilogue]!
epilogueAction
"EngiSystem epilogueAction."
^self!
logout
"EngiSystem logout."
self userInterruptSignal handle: [:exception | exception proceed]
do:
[self logoutAction.
self soleEngiSystem changed: #logout]!
logoutAction
"EngiSystem logoutAction."
^self! !
!EngiSystem class methodsFor: 'about'!
about
"EngiSystem about."
| pixmapBlock aboutPixmap aboutPoint openRectangle aWindow windowContext |
pixmapBlock :=
[| composedText aRectangle aPixmap aPoint |
composedText := self copyrightString asComposedText centered.
aRectangle := composedText bounds expandedBy: 20.
aPixmap := Pixmap extent: aRectangle extent.
aPoint := aPixmap bounds center - composedText bounds center.
composedText displayOn: aPixmap graphicsContext at: aPoint.
aPixmap].
aboutPixmap := pixmapBlock value.
openRectangle := 0 @ 0 extent: aboutPixmap extent.
aboutPoint := Screen default bounds center.
openRectangle := openRectangle align: openRectangle center with: aboutPoint.
openRectangle := Screen default makeRectangleVisible: openRectangle.
aWindow := Window openNewIn: openRectangle withType: #dialog.
windowContext := aWindow graphicsContext.
aWindow sensor cursorPoint: aWindow bounds center.
[aWindow sensor hasDamage] whileFalse.
Cursor blank show.
aboutPixmap displayOn: windowContext.
[aWindow sensor noButtonPressed]
whileTrue:
[(Cursor blank = Cursor currentCursor and: [aWindow sensor cursorPoint ~= aWindow bounds center])
ifTrue: [Cursor normal show].
aboutPixmap displayOn: windowContext.
ScheduledControllers checkForEvents.
(Delay forMilliseconds: 50) wait].
Cursor normal show.
aWindow sensor waitNoButton.
aWindow close.
aboutPixmap close! !
!EngiSystem class methodsFor: 'copyright'!
copyright
^'Copyright (C) 1994 by Atsushi Aoki'!
copyrightString
"EngiSystem copyrightString."
| stream |
stream := WriteStream on: (String new: 256).
stream cr.
stream nextPutAll: self system.
stream space.
stream nextPutAll: self version.
stream space.
stream nextPutAll: '('.
stream nextPutAll: self date.
stream nextPutAll: ')'.
stream cr.
stream nextPutAll: self copyright.
stream cr.
^stream contents!
copyrightToClasses
"EngiSystem copyrightToClasses."
| copyrightString |
copyrightString := ('\' , self copyrightString , '\') withCRs.
self classes do: [:each | each comment = copyrightString ifFalse: [each comment: copyrightString]]! !
!EngiSystem class methodsFor: 'version'!
date
^'29 January 1994' copy!
system
^'Engi' copy!
version
^'0.03' copy! !
!EngiSystem class methodsFor: 'classes'!
classes
"EngiSystem classes."
| rootClasses allClasses blockClosure |
rootClasses := Smalltalk values select: [:each | (each isBehavior and: [each isMeta not])
and: [each superclass isNil]].
allClasses := OrderedCollection new.
blockClosure :=
[:each |
| engi string |
(each isBehavior and: [each isMeta not])
ifTrue:
[engi := self system.
string := each name asString.
engi = (string copyFrom: 1 to: (engi size min: string size)) ifTrue: [allClasses add: each]]].
rootClasses
do:
[:root |
blockClosure value: root.
root allSubclasses do: [:each | (rootClasses includes: each) not ifTrue: [blockClosure value: each]]].
^allClasses asArray!
classNames
"EngiSystem classNames."
^self classes collect: [:each | each name]!
numberOfClasses
"EngiSystem numberOfClasses."
^self classes size! !
!EngiSystem class methodsFor: 'messages'!
messages
"EngiSystem messages."
| instanceMessages classMessages |
instanceMessages := Set new.
classMessages := Set new.
self classes
do:
[:each |
instanceMessages addAll: each selectors.
classMessages addAll: each class selectors].
instanceMessages := instanceMessages asSortedCollection.
classMessages := classMessages asSortedCollection.
^Array with: instanceMessages with: classMessages!
numberOfMessages
"EngiSystem numberOfMessages."
^self messages collect: [:each | each size]! !
!EngiSystem class methodsFor: 'saving'!
save
"EngiSystem save."
| allClasses saveDirectory separatorString extensionString baseString fileNames fileNo fileName writeStream |
allClasses := self classes.
saveDirectory := self saveDirectory.
separatorString := String with: Filename separator.
extensionString := '.st'.
baseString := '0000'.
fileNames := OrderedCollection new.
fileNo := 1.
self classes
do:
[:each |
| stream filename file |
stream := WriteStream on: (String new: 12).
stream nextPutAll: self system.
baseString size - fileNo printString size timesRepeat: [stream nextPutAll: '0'].
stream nextPutAll: fileNo printString.
stream nextPutAll: extensionString.
fileNames add: stream contents.
filename := Filename currentDirectoryString , saveDirectory asString.
filename := filename , separatorString , stream contents.
file := SourceCodeStream on: (Filename named: filename) writeStream.
[self privateSaveClass: each into: file]
valueNowOrOnUnwindDo: [file close].
fileNo := fileNo + 1].
fileName := Filename defaultDirectoryName , saveDirectory asString.
fileName := fileName , separatorString , self system , baseString , extensionString.
Transcript cr; show: self system , ' -> ' , fileName asString.
writeStream := (Filename named: fileName) writeStream.
[self
privateSaveInstallation: allClasses
into: writeStream
files: fileNames]
valueNowOrOnUnwindDo: [writeStream close]!
saveDirectory
"EngiSystem saveDirectory."
| fileName |
fileName := Filename named: self system , self version.
fileName exists ifFalse: [fileName makeDirectory].
^fileName!
saveFileAt: className
"EngiSystem saveFileAt: #EngiSystem."
SaveFiles isNil ifTrue: [^nil].
className isBehavior ifTrue: [^SaveFiles at: className name ifAbsent: [nil]].
^SaveFiles at: className asSymbol ifAbsent: [nil]!
saveFiles
"EngiSystem saveFiles."
^SaveFiles! !
!EngiSystem class methodsFor: 'private'