home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnusmalltalk / object.st < prev    next >
Text File  |  1992-02-15  |  8KB  |  337 lines
  1. "======================================================================
  2. |
  3. |   Object Method Definitions
  4. |
  5.  ======================================================================"
  6.  
  7.  
  8. "======================================================================
  9. |
  10. | Copyright (C) 1990, 1991, 1992 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         25 Mar 91      Added -> operator.
  36. |
  37. | sbb          5 Nov 90      Fixed bug with addDependent: -- syntax error.
  38. |
  39. | sbyrne     26 Apr 90      Fixed shallowCopy to send new messages to the
  40. |                         object's class instead of the object itself.
  41. |
  42. | sbyrne     19 Sep 89      Converted to use real method categories.
  43. |
  44. | sbyrne      4 Jul 89      Added support for dependence relationships.
  45. |                         (-: how appropriate: July 4 is when the US declared
  46. |                             its INdependence from England :-)
  47. |
  48. | sbyrne     25 Apr 89      created.
  49. |
  50. "
  51.  
  52. Object comment: 
  53. 'I am the root of the Smalltalk class system. 
  54. All classes in the system are subclasses of me.' !
  55.  
  56.  
  57. !Object methodsFor: 'Relational operators'!
  58.  
  59. ~= anObject
  60.     ^(self = anObject) == false
  61. !
  62.  
  63. ~~ anObject
  64.     ^(self == anObject) == false 
  65. !
  66.  
  67. isNil
  68.     ^false
  69. !
  70.  
  71. notNil
  72.     ^true
  73. !!
  74.  
  75.  
  76.  
  77. !Object methodsFor: 'testing functionality'!
  78.  
  79. isKindOf: aClass
  80.     ^(self isMemberOf: aClass) or:
  81.         [ self class inheritsFrom: aClass ]
  82. !
  83.  
  84. isMemberOf: aClass
  85.     "Returns true if the receiver is an instance of the class 'aClass'"
  86.     ^self class == aClass
  87. !!
  88.  
  89.  
  90.  
  91. !Object methodsFor: 'copying'!
  92.  
  93. copy
  94.     ^self shallowCopy
  95. !
  96.  
  97. shallowCopy
  98.     | class aCopy |
  99.     class _ self class.
  100.     class isVariable
  101.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  102.     ifFalse: [ aCopy _ class basicNew ].
  103.  
  104.     " copy the instance variables (if any) "
  105.     1 to: class instSize do:
  106.         [ :i | aCopy instVarAt: i
  107.                  put: (self instVarAt: i) ].
  108.  
  109.     " copy the indexed variables (if any) "
  110.     class isVariable
  111.         ifTrue: [ 1 to: self basicSize do:
  112.                 [ :i | aCopy basicAt: i
  113.                          put: (self basicAt: i) ] ].
  114.     ^aCopy
  115. !
  116.  
  117. deepCopy
  118.     | class aCopy |
  119.     class _ self class.
  120.     class isVariable
  121.         ifTrue: [ aCopy _ class basicNew: self basicSize ]
  122.     ifFalse: [ aCopy _ class basicNew ].
  123.  
  124.     " copy the instance variables (if any) "
  125.     1 to: class instSize do:
  126.         [ :i | aCopy instVarAt: i
  127.                  put: (self instVarAt: i) deepCopy ].
  128.  
  129.     " copy the indexed variables (if any) "
  130.     class isVariable
  131.         ifTrue: [ 1 to: self basicSize do:
  132.                 [ :i | aCopy basicAt: i
  133.                          put: (self basicAt: i) deepCopy ] ].
  134.     ^aCopy
  135. !!
  136.  
  137.  
  138.  
  139. !Object methodsFor: 'class type methods'!
  140.  
  141. species
  142.     ^self class
  143. !
  144.  
  145. yourself
  146.     ^self
  147. !!
  148.  
  149.  
  150.  
  151. !Object methodsFor: 'dependents access'!
  152.  
  153. addDependent: anObject
  154.     | dependencies |
  155.     dependencies _ Smalltalk dependenciesAt: self.
  156.     dependencies isNil ifTrue:
  157.         [ dependencies _ Set new.
  158.       (Smalltalk at: #Dependencies) at: self put: dependencies ].
  159.     dependencies add: anObject
  160. !
  161.  
  162. removeDependent: anObject
  163.     | dependencies |
  164.     dependencies _ Smalltalk dependenciesAt: self.
  165.     dependencies notNil ifTrue:
  166.         [ dependencies remove: anObject ifAbsent: [] ]
  167. !
  168.  
  169. dependents
  170.     | dependencies |
  171.     dependencies _ Smalltalk dependenciesAt: self.
  172.     dependencies isNil ifTrue: [ dependencies _ Set new ].
  173.     ^dependencies asOrderedCollection
  174. !
  175.  
  176. release
  177.     " +++ I'm not sure that this is the right thing to do here; the book is
  178.       so vague... "
  179.     (Smalltalk at: #Dependencies) removeKey: self
  180. !!
  181.  
  182.  
  183.  
  184. !Object methodsFor: 'change and update'!
  185.  
  186. changed
  187.     self changed: self
  188. !
  189.  
  190. changed: aParameter
  191.     | dependencies |
  192.     dependencies _ Smalltalk dependenciesAt: self.
  193.     dependencies notNil ifTrue:
  194.         [ dependencies do:
  195.         [ :dependent | dependent update: aParameter ] ]
  196. !
  197.  
  198. update: aParameter
  199.     "Default behavior is to do nothing"
  200. !
  201.  
  202. broadcast: aSymbol
  203.     | dependencies |
  204.     dependencies _ Smalltalk dependenciesAt: self.
  205.     dependencies notNil ifTrue:
  206.         [ dependencies do:
  207.         [ :dependent | dependent perform: aSymbol ] ]
  208. !
  209.  
  210. broadcast: aSymbol with: anObject
  211.     | dependencies |
  212.     dependencies _ Smalltalk dependenciesAt: self.
  213.     dependencies notNil ifTrue:
  214.         [ dependencies do:
  215.         [ :dependent | dependent perform: aSymbol with: anObject ] ]
  216. ! !
  217.  
  218.  
  219.  
  220.  
  221. !Object methodsFor: 'syntax shortcuts'!
  222.  
  223. -> anObject
  224.     "Creates a new instance of Association with the receiver being the key
  225.      and the argument becoming the value"
  226.     ^Association key: self value: anObject
  227. ! !
  228.  
  229.  
  230.  
  231.  
  232. !Object methodsFor: 'printing'!
  233.  
  234. printString
  235.     | stream |
  236.     stream _ WriteStream on: (String new: 0).
  237.     self printOn: stream.
  238.     ^stream contents
  239. !
  240.  
  241. printOn: aStream
  242.     | article nameString |
  243.     nameString _ self classNameString.
  244.     article _ nameString first isVowel ifTrue: [ 'an ' ] ifFalse: [ 'a ' ].
  245.     aStream nextPutAll: article;
  246.         nextPutAll: nameString
  247. !
  248.  
  249. print
  250.     self printOn: stdout
  251. !
  252.  
  253. printNl
  254.     self print.
  255.     stdout nl
  256. !!
  257.  
  258.  
  259.  
  260. !Object methodsFor: 'storing'!
  261.  
  262. storeString
  263.     | stream |
  264.     stream _ WriteStream on: (String new: 0).
  265.     self storeOn: stream.
  266.     ^stream contents
  267. !
  268.  
  269. storeOn: aStream
  270.     | class hasSemi |
  271.     class _ self class.
  272.     aStream nextPut: $(.
  273.     aStream nextPutAll: self classNameString.
  274.     hasSemi _ false.
  275.     class isVariable
  276.         ifTrue: [ aStream nextPutAll: ' basicNew: '.
  277.               self basicSize printOn: aStream ]
  278.         ifFalse: [ aStream nextPutAll: ' basicNew' ].
  279.     1 to: class instSize do:
  280.         [ :i | aStream nextPutAll: ' instVarAt: '.
  281.            i printOn: aStream.
  282.            aStream nextPutAll: ' put: '.
  283.            (self instVarAt: i) storeOn: aStream.
  284.            aStream nextPut: $;.
  285.            hasSemi _ true ].
  286.     class isVariable ifTrue: 
  287.         [ 1 to: self basicSize do:
  288.         [ :i | aStream nextPutAll: ' basicAt: '.
  289.                i printOn: aStream.
  290.            aStream nextPutAll: ' put: '.
  291.            (self basicAt: i) storeOn: aStream.
  292.            aStream nextPut: $;.
  293.            hasSemi _ true ] ].
  294.     hasSemi ifTrue: [ aStream nextPutAll: ' yourself' ].
  295.     aStream nextPut: $)
  296. !
  297.  
  298. store
  299.     self storeOn: stdout
  300. !
  301.  
  302. storeNl
  303.     self store.
  304.     stdout nl
  305. !!
  306.  
  307.  
  308.  
  309. !Object methodsFor: 'debugging'!
  310.  
  311. inspect
  312.     | class instVars instVal |
  313.     class _ self class.
  314.     instVars _ class allInstVarNames.
  315.     stdout nextPutAll: 'An instance of '.
  316.     class printNl.
  317.     1 to: instVars size do:
  318.         [ :i | stdout nextPutAll: '  ';
  319.            nextPutAll: (instVars at: i);
  320.            nextPutAll: ': '.
  321.            (self instVarAt: i)  printNl ]
  322. !!
  323.  
  324.  
  325.  
  326. !Object methodsFor: 'private'!
  327.  
  328. classNameString
  329.     | name |
  330.     name _ self class name.
  331.     name isNil
  332.         ifTrue: [ name _ self name , ' class' ].
  333.     ^name
  334.  
  335. !!
  336.  
  337.