home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 116.lha / SmallTalk / Sources / unix.st < prev   
Encoding:
Text File  |  1986-11-20  |  6.0 KB  |  256 lines
  1. *
  2. * Little Smalltalk, version 2
  3. * Written by Tim Budd, Oregon State University, July 1987
  4. *
  5. *  methods for the unix front end - single process version
  6. *
  7. *    (override previous declaration, adding new instance variable)
  8. Declare Smalltalk Object errorRecoveryBlock
  9. Declare File Object name pointer
  10. *    (better override global variable as well )
  11. Instance Smalltalk smalltalk
  12. *    make global variables for standard files
  13. Instance File stdin
  14. Instance File stdout
  15. Instance File stderr
  16. *
  17. Class File
  18.     asString    | text line |
  19.         text <- ''.
  20.         [line <- self getString. line notNil]
  21.             whileTrue: [ text <- text , line ].
  22.         ^ text
  23. |
  24.     name: string
  25.         name <- string
  26. |
  27.     name
  28.         ^ name
  29. |
  30.     scratchFile
  31.         name <- 'junk.tmp'
  32. |
  33.     open: mode
  34.         pointer <- <120 name mode>.
  35.         pointer isNil
  36.             ifTrue: [ smalltalk error: 'open failed']
  37. |
  38.     close
  39.         (pointer notNil)
  40.             ifTrue: [<121 pointer>].
  41.         pointer <- nil.
  42. |
  43.     delete
  44.         ('delete ', name) unixCommand
  45. |
  46.     fileIn        | line |
  47.         [ line <- self getString. line notNil ]
  48.             whileTrue: [ line <- line words:
  49.                 [:x | x isAlphabetic ] .
  50.                      Switch new; key: (line at: 1);
  51.             ifMatch: 'Class' do: [self fileInClass: line ] ;
  52.             ifMatch: 'Method' do:
  53.                     [ self fileInMethod: line ] ;
  54.                 else: [ ^ smalltalk error:
  55.                     'invalid format for fileIn'] ]
  56. |
  57.     fileInClass: commandLine    | name |
  58.         name <- (commandLine at: 2
  59.             ifAbsent: [^ smalltalk error:
  60.                 'missing class name in Class directive'])
  61.                     asSymbol.
  62.         globalNames at: name put: ( Class new;
  63.             name: name;
  64.             superClass: (globalNames at: (
  65.                 commandLine at: 3
  66.                 ifAbsent: [ ^ smalltalk error:
  67.                     'missing superclass name'])
  68.                     asSymbol
  69.                 ifAbsent: [ ^ smalltalk error:
  70.                     'unknown class']);
  71.             variables: (commandLine copyFrom: 4 to:
  72.                     commandLine size ) )
  73. |
  74.     fileInMethod: commandLine
  75.         (commandLine size ~= 2)
  76.             ifTrue: [ ^ smalltalk error:
  77.                 'invalid Method command line '].
  78.             (globalNames at: (commandLine at: 2) asSymbol
  79.                 ifAbsent: [ ^ smalltalk error:
  80.                     'unknown class in Method header'])
  81.                 fileInMethod: self
  82. |
  83.     getString
  84.         ^ (pointer notNil)
  85.             ifTrue: [<125 pointer>]
  86. |
  87.     getPrompt: aString
  88.         stdout printNoReturn: aString.
  89.         ^ self getString
  90. |
  91.     inquire: aString    | response |
  92.         response <- self getPrompt: aString.
  93.         response isNil
  94.             ifTrue: [ ^ false ].
  95.         ^ 'yY' includes: (response at: 1 ifAbsent: [])
  96. |
  97.     print: aString
  98.         (pointer notNil)
  99.             ifTrue: [<129 pointer aString>]
  100.             ifFalse: [smalltalk error: 'file not open']
  101. |
  102.     printNoReturn: aString
  103.         (pointer notNil)
  104.             ifTrue: [<128 pointer aString>]
  105.             ifFalse: [smalltalk error: 'file not open']
  106. |
  107.     readUntil: conditionBlock doing: actionBlock    | line |
  108.         [ line <- self getString. line notNil]
  109.             whileTrue: [ (conditionBlock value: line)
  110.                     ifTrue: [ ^ line ].
  111.                     actionBlock value: line ].
  112.         ^ nil
  113. |
  114.     saveImage
  115.         (pointer notNil)
  116.             ifTrue: [<127 pointer>]
  117.             ifFalse: [smalltalk error: 'file not open']
  118. ]
  119. Class Method
  120.     executeWith: arguments
  121.         ^ ( Context new ; method: self ;
  122.             temporaries: ( Array new: temporarySize) ;
  123.             arguments: arguments )
  124.            executeFrom: 0 creator: nil
  125. ]
  126. Class Class
  127.     addMethod
  128.         self doEdit: ''
  129. |
  130.     addSubClass        | name |
  131.         name <- (stdin getPrompt: 'Class Name? ') asSymbol.
  132.         globalNames at: name put:
  133.             ( Class new; name: name ; superClass: self ;
  134.                 readInstanceVariables; readMethods )
  135. |
  136.     addMethodText: text        | theMethod |
  137.         theMethod <- Method new; text: text.
  138.         (theMethod compileWithClass: self)
  139.             ifTrue: [ methods at: theMethod name put: theMethod.
  140.                   smalltalk flushMessageCache.
  141.                   ^ true ].
  142.         ^ false
  143. |
  144.     doEdit: startingText        | text |
  145.         text <- startingText.
  146.         [ text <- text edit.
  147.           (self addMethodText: text)
  148.             ifTrue: [ false ]
  149.             ifFalse: [ stdin inquire: 'edit again (yn) ? ' ]
  150.                 ] whileTrue
  151. |
  152.     display
  153.         ('Class name: ', name asString)  print.
  154.         (superClass notNil)
  155.             ifTrue: [ ('Superclass: ', superClass ) print ].
  156.         'Instance Variables:' print.
  157.         variables isNil
  158.             ifTrue: [ 'no instance variables ' print ]
  159.             ifFalse: [ variables display ].
  160.         'Subclasses: ' print.
  161.         self subClasses display
  162. |
  163.     editMethod: name
  164.         self doEdit: ( methods at: name
  165.             ifAbsent: [ 'no such method ' print. ^ nil ] ) text
  166. |
  167.     fileInMethod: file    | text line |
  168.         text <- ''.
  169.         line <- file readUntil: [:x | '|[' includes:
  170.                     (x at: 1 ifAbsent: [] ) ]
  171.                 doing: [:x | text <- text , x].
  172.         self addMethodText: text.
  173.         ^ line
  174. |
  175.     fileOut: file
  176.         file printNoReturn: 'Class ', name asString.
  177.         file printNoReturn: ' ', superClass name asString.
  178.         variables do: [:x | file printNoReturn: ' ', x ].
  179.         file print: ''.
  180.         methods do: [:x | self fileOutMethod: x name to: file ]
  181. |
  182.     fileOutMethod: method to: file
  183.         file print: 'Method ', name asString.
  184.         file print: (methods at: method
  185.             ifAbsent: [^ smalltalk error:
  186.                 'no such method' ]) text.
  187.         file print: '|'
  188. |
  189.     readInstanceVariables
  190.         self variables:
  191.             ((stdin getPrompt: 'Instance Variables? ')
  192.             words: [:x | x isAlphabetic ])
  193. |
  194.     readMethods
  195.         [ stdin inquire: 'Add a method (yn) ? ' ]
  196.             whileTrue: [ self addMethod ]
  197. |
  198.     viewMethod: name
  199.         (methods at: name
  200.             ifAbsent: [ 'no such method ' print. ^ nil ]) text print
  201. ]
  202. Class Smalltalk
  203.     error: aString
  204.         stderr print: 'Error: ',aString.
  205.         errorRecoveryBlock value
  206. |
  207.     openFiles
  208.         stdin name: 'stdin'.
  209.         stdin open: 'r'.
  210.         stdout name: 'stdout'.
  211.         stdout open: 'w'.
  212.         stderr name: 'stderr'.
  213.         stderr open: 'w'.
  214. |
  215.     commandLoop    | string |
  216.         self openFiles.
  217.         [ string <- stdin getPrompt: '> '. string notNil ]
  218.             whileTrue: [ (string size strictlyPositive)
  219.                     ifTrue: [ self doIt: string ] ]
  220. |
  221.     doIt: aString        | method |
  222.         errorRecoveryBlock <- [ ^ nil ].
  223.         method <- Method new.
  224.         method text: ( 'proceed ', aString ).
  225.         (method compileWithClass: Object)
  226.             ifTrue: [ method executeWith: #( 1 ) ]
  227. |
  228.     saveImage        | name |
  229.         name <- stdin getPrompt: 'type image name: '.
  230.         File new;
  231.             name: name;
  232.             open: 'w';
  233.             saveImage;
  234.             close.
  235.         ('image ', name, ' created') print
  236. ]
  237. Class String
  238.     edit    | file text |
  239.         file <- File new;
  240.             scratchFile;
  241.             open: 'w';
  242.             print: self;
  243.             close.
  244.         (editor, ' ', file name) unixCommand.
  245.         file open: 'r'.
  246.         text <- file asString.
  247.         file close; delete.
  248.         ^ text
  249. |
  250.     print
  251.         ^ stdout print: self
  252. |
  253.     unixCommand
  254.         ^ <88 self>
  255. ]
  256.