home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / smalltalk / !GNUst / st / Object < prev    next >
Encoding:
Text File  |  1991-09-13  |  7.1 KB  |  323 lines
  1. "======================================================================
  2. |
  3. |   Object Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1990, 1991 Free Software Foundation, Inc.
  11. | Written by Steve Byrne.
  12. |
  13. | This file is part of GNU Smalltalk.
  14. |
  15. | GNU Smalltalk is free software; you can redistribute it and/or modify it
  16. | under the terms of the GNU General Public License as published by the Free
  17. | Software Foundation; either version 1, or (at your option) any later version.
  18. | 
  19. | GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  20. | ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  21. | FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
  22. | details.
  23. | 
  24. | You should have received a copy of the GNU General Public License along with
  25. | GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  26. | Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  27. |
  28.  ======================================================================"
  29.  
  30.  
  31. "
  32. |     Change Log
  33. | ============================================================================
  34. | Author       Date       Change 
  35. | sbb         12 Sep 91      Fixed #addDependent: syntax problem.
  36. |
  37. | sbyrne     26 Apr 90      Fixed shallowCopy to send new messages to the
  38. |                         object's class instead of the object itself.
  39. |
  40. | sbyrne     19 Sep 89      Converted to use real method categories.
  41. |
  42. | sbyrne      4 Jul 89      Added support for dependence relationships.
  43. |                         (-: how appropriate: July 4 is when the US declared
  44. |                             its INdependence from England :-)
  45. |
  46. | sbyrne     25 Apr 89      created.
  47. |
  48. "
  49.  
  50. Object comment: 
  51. 'I am the root of the Smalltalk class system. 
  52. All classes in the system are subclasses of me.' !
  53.  
  54.  
  55. !Object methodsFor: 'Relational operators'!
  56.  
  57. ~= anObject
  58.     ^(self = anObject) == false
  59. !
  60.  
  61. ~~ anObject
  62.     ^(self == anObject) == false 
  63. !
  64.  
  65. isNil
  66.     ^false
  67. !
  68.  
  69. notNil
  70.     ^true
  71. !!
  72.  
  73.  
  74.  
  75. !Object methodsFor: 'testing functionality'!
  76.  
  77. isKindOf: aClass
  78.     ^(self isMemberOf: aClass) or:
  79.         [ self class inheritsFrom: aClass ]
  80. !
  81.  
  82. isMemberOf: aClass
  83.     "Returns true if the receiver is an instance of the class 'aClass'"
  84.     ^self class == aClass
  85. !!
  86.  
  87.  
  88.  
  89. !Object methodsFor: 'copying'!
  90.  
  91. copy
  92.     ^self shallowCopy
  93. !
  94.  
  95. shallowCopy
  96.     | class aCopy |
  97.     class _ self class.
  98.     class isVariable
  99.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  100.     ifFalse: [ aCopy _ class basicNew ].
  101.  
  102.     " copy the instance variables (if any) "
  103.     1 to: class instSize do:
  104.         [ :i | aCopy instVarAt: i
  105.                  put: (self instVarAt: i) ].
  106.  
  107.     " copy the indexed variables (if any) "
  108.     class isVariable
  109.         ifTrue: [ 1 to: self basicSize do:
  110.                 [ :i | aCopy basicAt: i
  111.                          put: (self basicAt: i) ] ].
  112.     ^aCopy
  113. !
  114.  
  115. deepCopy
  116.     | class aCopy |
  117.     class _ self class.
  118.     class isVariable
  119.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  120.     ifFalse: [ aCopy _ class basicNew ].
  121.  
  122.     " copy the instance variables (if any) "
  123.     1 to: class instSize do:
  124.         [ :i | aCopy instVarAt: i
  125.                  put: (self instVarAt: i) deepCopy ].
  126.  
  127.     " copy the indexed variables (if any) "
  128.     class isVariable
  129.         ifTrue: [ 1 to: self basicSize do:
  130.                 [ :i | aCopy basicAt: i
  131.                          put: (self basicAt: i) deepCopy ] ].
  132.     ^aCopy
  133. !!
  134.  
  135.  
  136.  
  137. !Object methodsFor: 'class type methods'!
  138.  
  139. species
  140.     ^self class
  141. !
  142.  
  143. yourself
  144.     ^self
  145. !!
  146.  
  147.  
  148.  
  149. !Object methodsFor: 'dependents access'!
  150.  
  151. addDependent: anObject
  152.     | dependencies |
  153.     dependencies _ Smalltalk dependenciesAt: self.
  154.     dependencies isNil ifTrue:
  155.         [ dependencies _ Set new.
  156.       (Smalltalk at: #Dependencies) at: self put: dependencies ].
  157.     dependencies add: anObject
  158. !
  159.  
  160. removeDependent: anObject
  161.     | dependencies |
  162.     dependencies _ Smalltalk dependenciesAt: self.
  163.     dependencies notNil ifTrue:
  164.         [ dependencies remove: anObject ifAbsent: [] ]
  165. !
  166.  
  167. dependents
  168.     | dependencies |
  169.     dependencies _ Smalltalk dependenciesAt: self.
  170.     dependencies isNil ifTrue: [ dependencies _ Set new ].
  171.     ^dependencies asOrderedCollection
  172. !
  173.  
  174. release
  175.     " +++ I'm not sure that this is the right thing to do here; the book is
  176.       so vague... "
  177.     (Smalltalk at: #Dependencies) removeKey: self
  178. !!
  179.  
  180.  
  181.  
  182. !Object methodsFor: 'change and update'!
  183.  
  184. changed
  185.     self changed: self
  186. !
  187.  
  188. changed: aParameter
  189.     | dependencies |
  190.     dependencies _ Smalltalk dependenciesAt: self.
  191.     dependencies notNil ifTrue:
  192.         [ dependencies do:
  193.         [ :dependent | dependent update: aParameter ] ]
  194. !
  195.  
  196. update: aParameter
  197.     "Default behavior is to do nothing"
  198. !
  199.  
  200. broadcast: aSymbol
  201.     | dependencies |
  202.     dependencies _ Smalltalk dependenciesAt: self.
  203.     dependencies notNil ifTrue:
  204.         [ dependencies do:
  205.         [ :dependent | dependent perform: aSymbol ] ]
  206. !
  207.  
  208. broadcast: aSymbol with: anObject
  209.     | dependencies |
  210.     dependencies _ Smalltalk dependenciesAt: self.
  211.     dependencies notNil ifTrue:
  212.         [ dependencies do:
  213.         [ :dependent | dependent perform: aSymbol with: anObject ] ]
  214. !!
  215.  
  216.  
  217.  
  218. !Object methodsFor: 'printing'!
  219.  
  220. printString
  221.     | stream |
  222.     stream _ WriteStream on: (String new: 0).
  223.     self printOn: stream.
  224.     ^stream contents
  225. !
  226.  
  227. printOn: aStream
  228.     | article nameString |
  229.     nameString _ self classNameString.
  230.     article _ nameString first isVowel ifTrue: [ 'an ' ] ifFalse: [ 'a ' ].
  231.     article printOn: aStream.
  232.     nameString printOn: aStream
  233. !
  234.  
  235. print
  236.     self printOn: stdout
  237. !
  238.  
  239. printNl
  240.     self print.
  241.     Character nl print
  242. !!
  243.  
  244.  
  245.  
  246. !Object methodsFor: 'storing'!
  247.  
  248. storeString
  249.     | stream |
  250.     stream _ WriteStream on: (String new: 0).
  251.     self storeOn: stream.
  252.     ^stream contents
  253. !
  254.  
  255. storeOn: aStream
  256.     | class hasSemi |
  257.     class _ self class.
  258.     aStream nextPut: $(.
  259.     aStream nextPutAll: self classNameString.
  260.     hasSemi _ false.
  261.     class isVariable
  262.         ifTrue: [ aStream nextPutAll: ' basicNew: '.
  263.               self basicSize printOn: aStream ]
  264.         ifFalse: [ aStream nextPutAll: ' basicNew' ].
  265.     1 to: class instSize do:
  266.         [ :i | aStream nextPutAll: ' instVarAt: '.
  267.            i printOn: aStream.
  268.            aStream nextPutAll: ' put: '.
  269.            (self instVarAt: i) storeOn: aStream.
  270.            aStream nextPut: $;.
  271.            hasSemi _ true ].
  272.     class isVariable ifTrue: 
  273.         [ 1 to: self basicSize do:
  274.         [ :i | aStream nextPutAll: ' basicAt: '.
  275.                i printOn: aStream.
  276.            aStream nextPutAll: ' put: '.
  277.            (self basicAt: i) storeOn: aStream.
  278.            aStream nextPut: $;.
  279.            hasSemi _ true ] ].
  280.     hasSemi ifTrue: [ aStream nextPutAll: ' yourself' ].
  281.     aStream nextPut: $)
  282. !
  283.  
  284. store
  285.     self storeOn: stdout
  286. !
  287.  
  288. storeNl
  289.     self store.
  290.     Character nl print
  291. !!
  292.  
  293.  
  294.  
  295. !Object methodsFor: 'debugging'!
  296.  
  297. inspect
  298.     | class instVars instVal |
  299.     class _ self class.
  300.     instVars _ class instVarNames.
  301.     'An instance of ' print.
  302.     class printNl.
  303.     1 to: instVars size do:
  304.         [ :i | '  ' print.
  305.            (instVars at: i) print.
  306.            ': ' print.
  307.            (self instVarAt: i)  printNl ]
  308. !!
  309.  
  310.  
  311.  
  312. !Object methodsFor: 'private'!
  313.  
  314. classNameString
  315.     | name |
  316.     name _ self class name.
  317.     name isNil
  318.         ifTrue: [ name _ self name , ' class' ].
  319.     ^name
  320.  
  321. !!
  322.  
  323.