home *** CD-ROM | disk | FTP | other *** search
/ BURKS 2 / BURKS_AUG97.ISO / BURKS / LANGUAGE / SMALTALK / TEXTBOOK / AP09.ST (.txt) < prev    next >
Text File  |  1997-04-22  |  12KB  |  438 lines
  1.  
  2. 'Smalltalk Textbook Appendix 09'!
  3.  
  4.  
  5.  
  6.  
  7.  
  8. Model subclass: #EngiSystem
  9.     instanceVariableNames: ''
  10.     classVariableNames: 'SaveFiles '
  11.     poolDictionaries: ''
  12.     category: 'Engi-Kernel'!
  13. EngiSystem comment:
  14. '
  15.  
  16. Engi 0.03 (29 January 1994)
  17. Copyright (C) 1994 by Atsushi Aoki
  18.  
  19. '!
  20.  
  21.  
  22. !EngiSystem methodsFor: 'updating'!
  23.  
  24. update: aSymbol 
  25.     (aSymbol = #finishedSnapshot or: [aSymbol = #returnFromSnapshot])
  26.         ifTrue: 
  27.             [aSymbol = #returnFromSnapshot ifTrue: [self class login].
  28.             aSymbol = #finishedSnapshot ifTrue: [self class prologue]].
  29.     (aSymbol = #aboutToQuit or: [aSymbol = #aboutToSnapshot])
  30.         ifTrue: 
  31.             [aSymbol = #aboutToSnapshot ifTrue: [self class epilogue].
  32.             aSymbol = #aboutToQuit ifTrue: [self class logout]].
  33.     aSymbol = #condenseChanges ifTrue: ['no operation' yourself]! !
  34. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  35.  
  36. EngiSystem class
  37.     instanceVariableNames: 'soleEngiSystem '!
  38.  
  39.  
  40. !EngiSystem class methodsFor: 'class initialization'!
  41.  
  42. initialize
  43.     "EngiSystem initialize."
  44.  
  45.     self release.
  46.     Smalltalk addDependent: self soleEngiSystem!
  47.  
  48. release
  49.     "EngiSystem release."
  50.  
  51.     (Smalltalk dependents includes: soleEngiSystem)
  52.         ifTrue: [Smalltalk removeDependent: soleEngiSystem].
  53.     Smalltalk dependents copy do: [:each | (each isKindOf: self)
  54.             ifTrue: [Smalltalk removeDependent: each]]! !
  55.  
  56. !EngiSystem class methodsFor: 'instance creation'!
  57.  
  58. new
  59.     ^self soleEngiSystem!
  60.  
  61. soleEngiSystem
  62.     soleEngiSystem isNil ifTrue: [soleEngiSystem := super new].
  63.     ^soleEngiSystem! !
  64.  
  65. !EngiSystem class methodsFor: 'login'!
  66.  
  67. login
  68.     "EngiSystem login."
  69.  
  70.     self userInterruptSignal handle: [:exception | exception proceed]
  71.         do: 
  72.             [self loginAction.
  73.             self soleEngiSystem changed: #login]!
  74.  
  75. loginAction
  76.     "EngiSystem loginAction."
  77.  
  78.     self about.
  79.     ^self!
  80.  
  81. prologue
  82.     "EngiSystem prologue."
  83.  
  84.     self userInterruptSignal handle: [:exception | exception proceed]
  85.         do: 
  86.             [self prologueAction.
  87.             self soleEngiSystem changed: #prologue]!
  88.  
  89. prologueAction
  90.     "EngiSystem prologueAction."
  91.  
  92.     self about.
  93.     ^self! !
  94.  
  95. !EngiSystem class methodsFor: 'logout'!
  96.  
  97. epilogue
  98.     "EngiSystem epilogue."
  99.  
  100.     self userInterruptSignal handle: [:exception | exception proceed]
  101.         do: 
  102.             [self epilogueAction.
  103.             self soleEngiSystem changed: #epilogue]!
  104.  
  105. epilogueAction
  106.     "EngiSystem epilogueAction."
  107.  
  108.     ^self!
  109.  
  110. logout
  111.     "EngiSystem logout."
  112.  
  113.     self userInterruptSignal handle: [:exception | exception proceed]
  114.         do: 
  115.             [self logoutAction.
  116.             self soleEngiSystem changed: #logout]!
  117.  
  118. logoutAction
  119.     "EngiSystem logoutAction."
  120.  
  121.     ^self! !
  122.  
  123. !EngiSystem class methodsFor: 'about'!
  124.  
  125. about
  126.     "EngiSystem about."
  127.  
  128.     | pixmapBlock aboutPixmap aboutPoint openRectangle aWindow windowContext |
  129.     pixmapBlock := 
  130.             [| composedText aRectangle aPixmap aPoint |
  131.             composedText := self copyrightString asComposedText centered.
  132.             aRectangle := composedText bounds expandedBy: 20.
  133.             aPixmap := Pixmap extent: aRectangle extent.
  134.             aPoint := aPixmap bounds center - composedText bounds center.
  135.             composedText displayOn: aPixmap graphicsContext at: aPoint.
  136.             aPixmap].
  137.     aboutPixmap := pixmapBlock value.
  138.     openRectangle := 0 @ 0 extent: aboutPixmap extent.
  139.     aboutPoint := Screen default bounds center.
  140.     openRectangle := openRectangle align: openRectangle center with: aboutPoint.
  141.     openRectangle := Screen default makeRectangleVisible: openRectangle.
  142.     aWindow := Window openNewIn: openRectangle withType: #dialog.
  143.     windowContext := aWindow graphicsContext.
  144.     aWindow sensor cursorPoint: aWindow bounds center.
  145.     [aWindow sensor hasDamage] whileFalse.
  146.     Cursor blank show.
  147.     aboutPixmap displayOn: windowContext.
  148.     [aWindow sensor noButtonPressed]
  149.         whileTrue: 
  150.             [(Cursor blank = Cursor currentCursor and: [aWindow sensor cursorPoint ~= aWindow bounds center])
  151.                 ifTrue: [Cursor normal show].
  152.             aboutPixmap displayOn: windowContext.
  153.             ScheduledControllers checkForEvents.
  154.             (Delay forMilliseconds: 50) wait].
  155.     Cursor normal show.
  156.     aWindow sensor waitNoButton.
  157.     aWindow close.
  158.     aboutPixmap close! !
  159.  
  160. !EngiSystem class methodsFor: 'copyright'!
  161.  
  162. copyright
  163.     ^'Copyright (C) 1994 by Atsushi Aoki'!
  164.  
  165. copyrightString
  166.     "EngiSystem copyrightString."
  167.  
  168.     | stream |
  169.     stream := WriteStream on: (String new: 256).
  170.     stream cr.
  171.     stream nextPutAll: self system.
  172.     stream space.
  173.     stream nextPutAll: self version.
  174.     stream space.
  175.     stream nextPutAll: '('.
  176.     stream nextPutAll: self date.
  177.     stream nextPutAll: ')'.
  178.     stream cr.
  179.     stream nextPutAll: self copyright.
  180.     stream cr.
  181.     ^stream contents!
  182.  
  183. copyrightToClasses
  184.     "EngiSystem copyrightToClasses."
  185.  
  186.     | copyrightString |
  187.     copyrightString := ('\' , self copyrightString , '\') withCRs.
  188.     self classes do: [:each | each comment = copyrightString ifFalse: [each comment: copyrightString]]! !
  189.  
  190. !EngiSystem class methodsFor: 'version'!
  191.  
  192. date
  193.     ^'29 January 1994' copy!
  194.  
  195. system
  196.     ^'Engi' copy!
  197.  
  198. version
  199.     ^'0.03' copy! !
  200.  
  201. !EngiSystem class methodsFor: 'classes'!
  202.  
  203. classes
  204.     "EngiSystem classes."
  205.  
  206.     | rootClasses allClasses blockClosure |
  207.     rootClasses := Smalltalk values select: [:each | (each isBehavior and: [each isMeta not])
  208.                     and: [each superclass isNil]].
  209.     allClasses := OrderedCollection new.
  210.     blockClosure := 
  211.             [:each | 
  212.             | engi string |
  213.             (each isBehavior and: [each isMeta not])
  214.                 ifTrue: 
  215.                     [engi := self system.
  216.                     string := each name asString.
  217.                     engi = (string copyFrom: 1 to: (engi size min: string size)) ifTrue: [allClasses add: each]]].
  218.     rootClasses
  219.         do: 
  220.             [:root | 
  221.             blockClosure value: root.
  222.             root allSubclasses do: [:each | (rootClasses includes: each) not ifTrue: [blockClosure value: each]]].
  223.     ^allClasses asArray!
  224.  
  225. classNames
  226.     "EngiSystem classNames."
  227.  
  228.     ^self classes collect: [:each | each name]!
  229.  
  230. numberOfClasses
  231.     "EngiSystem numberOfClasses."
  232.  
  233.     ^self classes size! !
  234.  
  235. !EngiSystem class methodsFor: 'messages'!
  236.  
  237. messages
  238.     "EngiSystem messages."
  239.  
  240.     | instanceMessages classMessages |
  241.     instanceMessages := Set new.
  242.     classMessages := Set new.
  243.     self classes
  244.         do: 
  245.             [:each | 
  246.             instanceMessages addAll: each selectors.
  247.             classMessages addAll: each class selectors].
  248.     instanceMessages := instanceMessages asSortedCollection.
  249.     classMessages := classMessages asSortedCollection.
  250.     ^Array with: instanceMessages with: classMessages!
  251.  
  252. numberOfMessages
  253.     "EngiSystem numberOfMessages."
  254.  
  255.     ^self messages collect: [:each | each size]! !
  256.  
  257. !EngiSystem class methodsFor: 'saving'!
  258.  
  259. save
  260.     "EngiSystem save."
  261.  
  262.     | allClasses saveDirectory separatorString extensionString baseString fileNames fileNo fileName writeStream |
  263.     allClasses := self classes.
  264.     saveDirectory := self saveDirectory.
  265.     separatorString := String with: Filename separator.
  266.     extensionString := '.st'.
  267.     baseString := '0000'.
  268.     fileNames := OrderedCollection new.
  269.     fileNo := 1.
  270.     self classes
  271.         do: 
  272.             [:each | 
  273.             | stream filename file |
  274.             stream := WriteStream on: (String new: 12).
  275.             stream nextPutAll: self system.
  276.             baseString size - fileNo printString size timesRepeat: [stream nextPutAll: '0'].
  277.             stream nextPutAll: fileNo printString.
  278.             stream nextPutAll: extensionString.
  279.             fileNames add: stream contents.
  280.             filename := Filename currentDirectoryString , saveDirectory asString.
  281.             filename := filename , separatorString , stream contents.
  282.             file := SourceCodeStream on: (Filename named: filename) writeStream.
  283.             [self privateSaveClass: each into: file]
  284.                 valueNowOrOnUnwindDo: [file close].
  285.             fileNo := fileNo + 1].
  286.     fileName := Filename defaultDirectoryName , saveDirectory asString.
  287.     fileName := fileName , separatorString , self system , baseString , extensionString.
  288.     Transcript cr; show: self system , ' -> ' , fileName asString.
  289.     writeStream := (Filename named: fileName) writeStream.
  290.     [self
  291.         privateSaveInstallation: allClasses
  292.         into: writeStream
  293.         files: fileNames]
  294.         valueNowOrOnUnwindDo: [writeStream close]!
  295.  
  296. saveDirectory
  297.     "EngiSystem saveDirectory."
  298.  
  299.     | fileName |
  300.     fileName := Filename named: self system , self version.
  301.     fileName exists ifFalse: [fileName makeDirectory].
  302.     ^fileName!
  303.  
  304. saveFileAt: className 
  305.     "EngiSystem saveFileAt: #EngiSystem."
  306.  
  307.     SaveFiles isNil ifTrue: [^nil].
  308.     className isBehavior ifTrue: [^SaveFiles at: className name ifAbsent: [nil]].
  309.     ^SaveFiles at: className asSymbol ifAbsent: [nil]!
  310.  
  311. saveFiles
  312.     "EngiSystem saveFiles."
  313.  
  314.     ^SaveFiles! !
  315.  
  316. !EngiSystem class methodsFor: 'private'