SmalltalkCodeGeneratorTool.st
changeset 18422 e53c5e8ee417
parent 18375 85e3084484fa
child 18798 2534c610f0d0
equal deleted inserted replaced
18421:bf7b09e826a9 18422:e53c5e8ee417
   736 !
   736 !
   737 
   737 
   738 createInitializedInstanceCreationMethodsIn:aClass
   738 createInitializedInstanceCreationMethodsIn:aClass
   739     "create a #new and #initialize methods (I'm tired of typing)"
   739     "create a #new and #initialize methods (I'm tired of typing)"
   740 
   740 
   741     |nonMetaClass metaClass className code m|
   741     |nonMetaClass metaClass className code m selector|
   742 
   742 
   743     nonMetaClass := aClass theNonMetaclass.
   743     nonMetaClass := aClass theNonMetaclass.
   744     metaClass := aClass theMetaclass.
   744     metaClass := aClass theMetaclass.
   745     className := nonMetaClass name.
   745     className := nonMetaClass name.
   746 
   746 
   747     self startCollectChanges.
   747     self startCollectChanges.
   748 
   748 
   749     self createInitializationMethodIn:aClass.
   749     self createInitializationMethodIn:aClass.
   750 
   750 
   751     (metaClass includesSelector:#new) ifFalse:[
   751     selector := aClass isVariable
   752         m := metaClass responseTo:#new.
   752                     ifTrue:[#'new:']
       
   753                     ifFalse:[#new].
       
   754                     
       
   755     (metaClass includesSelector:selector) ifFalse:[
       
   756         m := metaClass responseTo:selector.
   753         (m isNil 
   757         (m isNil 
   754         or:[ (m sendsSelector:#initialize) not 
   758         or:[ (m sendsSelector:#initialize) not 
   755         or:[ 
   759         or:[ 
   756             (Dialog 
   760             (Dialog 
   757                 confirmWithCancel:('The inherited #new method already seems to invoke #initialize.\Redefine ?' withCRs)
   761                 confirmWithCancel:('The inherited ',selector,' method already seems to invoke #initialize.\Redefine ?' withCRs)
   758                 default:false
   762                 default:false
   759                 onCancel:[^ self] ) 
   763                 onCancel:[^ self] ) 
   760         ]]) ifTrue:[
   764         ]]) ifTrue:[
   761             code :=
   765             code :=
       
   766                 aClass isVariable
       
   767                     ifTrue:[
       
   768 'new:size
       
   769     "return an initialized instance"
       
   770 
       
   771     ^ (self basicNew:size) initialize.
       
   772 '
       
   773                     ]
       
   774                     ifFalse:[
   762 'new
   775 'new
   763     "return an initialized instance"
   776     "return an initialized instance"
   764 
   777 
   765     ^ self basicNew initialize.
   778     ^ self basicNew initialize.
   766 '.
   779 '
       
   780                     ]
       
   781 .
   767             self 
   782             self 
   768                 compile:code
   783                 compile:code
   769                 forClass:metaClass 
   784                 forClass:metaClass 
   770                 inCategory:#'instance creation'.
   785                 inCategory:#'instance creation'.
   771         ].
   786         ].
   773 
   788 
   774     self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
   789     self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
   775 
   790 
   776     "Created: / 11-10-2001 / 22:18:55 / cg"
   791     "Created: / 11-10-2001 / 22:18:55 / cg"
   777     "Modified: / 05-02-2017 / 01:25:06 / cg"
   792     "Modified: / 05-02-2017 / 01:25:06 / cg"
       
   793     "Modified: / 22-09-2018 / 16:12:45 / Claus Gittinger"
   778 !
   794 !
   779 
   795 
   780 createIsAbstractMethodIn:aClass
   796 createIsAbstractMethodIn:aClass
   781     "create a #isAbstract query method (I'm tired of typing)"
   797     "create a #isAbstract query method (I'm tired of typing)"
   782 
   798