CodeGeneratorTool.st
author Claus Gittinger <cg@exept.de>
Thu, 02 Jun 2005 18:49:46 +0200
changeset 6313 e73b5d2d07f9
parent 6159 2707b35f964c
child 6341 200c762ce0ed
permissions -rw-r--r--
enumType generator
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5141
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     1
"
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     2
 COPYRIGHT (c) 2002 by eXept Software AG
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     3
              All Rights Reserved
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     4
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     5
 This software is furnished under a license and may be used
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     6
 only in accordance with the terms of that license and with the
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     8
 be provided or otherwise made available to, or used by, any
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
     9
 other person.  No title to or ownership of the software is
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    10
 hereby transferred.
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    11
"
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    12
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
"{ Package: 'stx:libtool' }"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
Object subclass:#CodeGeneratorTool
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    16
	instanceVariableNames:'compositeChangeCollector compositeChangeNesting'
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    17
	classVariableNames:'GenerateCommentsForGetters GenerateCommentsForSetters'
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	poolDictionaries:''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	category:'Interface-Browsers'
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
3719
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    22
!CodeGeneratorTool class methodsFor:'documentation'!
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    23
5141
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    24
copyright
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    25
"
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    26
 COPYRIGHT (c) 2002 by eXept Software AG
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    27
              All Rights Reserved
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    28
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    29
 This software is furnished under a license and may be used
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    30
 only in accordance with the terms of that license and with the
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    32
 be provided or otherwise made available to, or used by, any
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    33
 other person.  No title to or ownership of the software is
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    34
 hereby transferred.
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    35
"
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    36
!
ffd2a0198999 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5124
diff changeset
    37
3719
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    38
documentation
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    39
"
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    40
    This utility class contains various code generation facilites;
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    41
    these were extracted from the old and newBrowser.
3719
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    42
    There is probably more to gome...
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    43
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    44
    [author:]
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    45
        Claus Gittiner
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    46
"
d7f6eb94a693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3716
diff changeset
    47
! !
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    48
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    49
!CodeGeneratorTool class methodsFor:'code generation'!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    50
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    51
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    52
    "create accessors in aClass"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    53
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    54
    ^ self new 
6313
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    55
        createAccessMethodsFor:aCollectionOfVarNames 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    56
        in:aClass 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    57
        withChange:withChange 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    58
        asValueHolder:asValueHolder 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    59
        readersOnly:readersOnly 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    60
        writersOnly:writersOnly
4444
6b077945517c generate instvar accessors with lazy-init
Claus Gittinger <cg@exept.de>
parents: 4351
diff changeset
    61
!
6b077945517c generate instvar accessors with lazy-init
Claus Gittinger <cg@exept.de>
parents: 4351
diff changeset
    62
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    63
createApplicationCodeFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    64
    "create an empty application framework"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    65
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    66
    ^ self new createApplicationCodeFor:aClass
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    67
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    68
3804
d2bc07d678f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3800
diff changeset
    69
createClassResponsibleProtocolFor:aClass
d2bc07d678f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3800
diff changeset
    70
    "create stubs for the required protocol"
d2bc07d678f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3800
diff changeset
    71
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    72
    ^ self new createClassResponsibleProtocolFor:aClass
3804
d2bc07d678f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3800
diff changeset
    73
!
d2bc07d678f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3800
diff changeset
    74
5124
487a63f34ac0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5013
diff changeset
    75
createClassTypeTestMethodsIn:aClass forClasses:subClasses
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    76
    "create a #isXXX test methods (I'm tired of typing)"
4351
cc4739c4797b create test methods
Claus Gittinger <cg@exept.de>
parents: 4108
diff changeset
    77
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    78
    ^ self new createClassTypeTestMethodsIn:aClass forClasses:subClasses
4351
cc4739c4797b create test methods
Claus Gittinger <cg@exept.de>
parents: 4108
diff changeset
    79
!
cc4739c4797b create test methods
Claus Gittinger <cg@exept.de>
parents: 4108
diff changeset
    80
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    81
createDocumentationMethodsFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    82
    "create empty documentation methods"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    83
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    84
    ^ self new createDocumentationMethodsFor:aClass
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    85
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    86
6313
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    87
createEnumTypeCodeFor:aClass
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    88
    ^ self new createEnumTypeCodeFor:aClass
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    89
!
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
    90
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    91
createStandardInitializationMethodsIn:aClass
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
    92
    "create a #new and #initialize methods (I'm tired of typing)"
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    93
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
    94
    ^ self new createStandardInitializationMethodsIn:aClass
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    95
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    96
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    97
createTestCaseSampleCodeFor:aClass
4590
2447e35a81d4 testCase stub code
Claus Gittinger <cg@exept.de>
parents: 4512
diff changeset
    98
    "create an (almost) empty testCase class"
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    99
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   100
    ^ self new createTestCaseSampleCodeFor:aClass
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   101
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   102
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   103
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   104
    "create acceptVisitor: in visitedClass and acceptXXX in visitorClass. (I'm tired of typing)"
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   105
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   106
    ^ self new createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   107
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   108
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   109
createWebApplicationCodeFor:aClass
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   110
    "create an empty webApplication framework"
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   111
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   112
    ^ self new createWebApplicationCodeFor:aClass
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   113
!
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   114
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   115
initialMenuSpecMethodSourceForApplications
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   116
    "return a menuSpec with typical stuff in it"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   117
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   118
    ^
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   119
'mainMenu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   120
    "This resource specification was automatically generated by the CodeGeneratorTool."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   121
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   122
    "Do not manually edit this!! If it is corrupted,
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   123
     the MenuEditor may not be able to read the specification."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   124
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   125
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   126
     MenuEditor new openOnClass:%1 andSelector:#mainMenu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   127
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   128
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   129
    <resource: #menu>
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   130
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   131
    ^ #(#Menu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   132
           #(
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   133
             #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   134
                #label: ''File''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   135
                #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   136
                #submenu: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   137
                 #(#Menu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   138
                     #(
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   139
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   140
                          #label: ''New''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   141
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   142
                          #value: #menuNew
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   143
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   144
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   145
                          #label: ''-''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   146
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   147
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   148
                          #label: ''Open...''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   149
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   150
                          #value: #menuOpen
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   151
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   152
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   153
                          #label: ''-''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   154
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   155
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   156
                          #label: ''Save''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   157
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   158
                          #value: #menuSave
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   159
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   160
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   161
                          #label: ''Save As...''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   162
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   163
                          #value: #menuSaveAs
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   164
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   165
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   166
                          #label: ''-''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   167
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   168
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   169
                          #label: ''Exit''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   170
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   171
                          #value: #closeRequest
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   172
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   173
                    ) nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   174
                    nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   175
                )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   176
            )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   177
             #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   178
                #label: ''Help''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   179
                #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   180
                #startGroup: #right
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   181
                #submenu: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   182
                 #(#Menu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   183
                     #(
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   184
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   185
                          #label: ''Documentation''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   186
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   187
                          #value: #openDocumentation
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   188
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   189
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   190
                          #label: ''-''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   191
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   192
                       #(#MenuItem
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   193
                          #label: ''About this Application''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   194
                          #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   195
                          #value: #openAboutThisApplication
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   196
                      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   197
                    ) nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   198
                    nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   199
                )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   200
            )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   201
          ) nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   202
          nil
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   203
      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   204
'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   205
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   206
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   207
initialWindowSpecMethodSourceForApplications
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   208
    "return an empty windowSpec with an initial menubar in it"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   209
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   210
    ^
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   211
'windowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   212
    "This resource specification was automatically generated by the CodeGeneratorTool."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   213
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   214
    "Do not manually edit this!! If it is corrupted,
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   215
     the UIPainter may not be able to read the specification."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   216
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   217
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   218
     UIPainter new openOnClass:%1 andSelector:#windowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   219
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   220
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   221
    <resource: #canvas>
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   222
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   223
    ^ #(#FullSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   224
          #window: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   225
           #(#WindowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   226
              #name: ''%1''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   227
              #layout: #(#LayoutFrame 204 0 162 0 503 0 461 0)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   228
              #label: ''%1''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   229
              #min: #(#Point 10 10)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   230
              #max: #(#Point 1024 768)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   231
              #bounds: #(#Rectangle 204 162 504 462)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   232
              #menu: #mainMenu
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   233
              #usePreferredExtent: false
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   234
          )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   235
          #component: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   236
           #(#SpecCollection
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   237
              #collection: #()
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   238
          )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   239
      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   240
'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   241
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   242
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   243
initialWindowSpecMethodSourceForDialogs
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   244
    "return an empty windowSpec for dialogs"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   245
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   246
    ^
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   247
'windowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   248
    "This resource specification was automatically generated by the CodeGeneratorTool."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   249
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   250
    "Do not manually edit this!! If it is corrupted,
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   251
     the UIPainter may not be able to read the specification."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   252
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   253
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   254
     UIPainter new openOnClass:%1 andSelector:#windowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   255
    "
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   256
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   257
    <resource: #canvas>
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   258
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   259
    ^
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   260
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   261
       #(#FullSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   262
          #window: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   263
           #(#WindowSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   264
              #name: ''%1''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   265
              #layout: #(#LayoutFrame 221 0 118 0 520 0 417 0)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   266
              #level: 0
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   267
              #label: ''%1''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   268
              #min: #(#Point 10 10)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   269
              #max: #(#Point 1024 768)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   270
              #bounds: #(#Rectangle 221 118 521 418)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   271
              #usePreferredExtent: false
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   272
          )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   273
          #component: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   274
           #(#SpecCollection
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   275
              #collection: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   276
               #(
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   277
                 #(#HorizontalPanelViewSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   278
                    #name: ''buttonPanel''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   279
                    #layout: #(#LayoutFrame 0 0.0 -45 1 0 1.0 0 1.0)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   280
                    #component: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   281
                     #(#SpecCollection
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   282
                        #collection: 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   283
                         #(
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   284
                          #(#ActionButtonSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   285
                             #name: ''cancelButton''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   286
                             #label: ''Cancel''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   287
                             #tabable: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   288
                             #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   289
                             #model: #cancel
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   290
                             #extent: #(#Point 125 22)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   291
                           )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   292
                           #(#ActionButtonSpec
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   293
                              #name: ''okButton''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   294
                              #label: ''OK''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   295
                              #tabable: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   296
                              #translateLabel: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   297
                              #isDefault: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   298
                              #model: #accept
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   299
                              #extent: #(#Point 125 22)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   300
                          )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   301
                        )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   302
                    )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   303
                    #reverseOrderIfOKAtLeft: true
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   304
                    #horizontalLayout: #spreadSpaceMax
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   305
                    #verticalLayout: #center
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   306
                    #horizontalSpace: 3
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   307
                    #verticalSpace: 3
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   308
                )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   309
              )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   310
          )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   311
      )
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   312
'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   313
! !
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
   314
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   315
!CodeGeneratorTool class methodsFor:'code generation-basic'!
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   316
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   317
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   318
    "workhorse for creating access methods for instvars."
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
   319
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   320
    ^ self new 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   321
        createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   322
! !
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   323
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   324
!CodeGeneratorTool class methodsFor:'code generation-individual methods'!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   325
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   326
createAcceptVisitorMethod:selector in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   327
    "create an acceptVisitor: method
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   328
     (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   329
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   330
    ^ self new createAcceptVisitorMethod:selector in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   331
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   332
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   333
createAcceptVisitorMethodIn:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   334
    "create an acceptVisitor: method
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   335
     (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   336
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   337
    ^ self new createAcceptVisitorMethodIn:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   338
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   339
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   340
createCopyrightMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   341
    "add copyright method containing your/your companies
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   342
     copyright template but only if not already present.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   343
     this is only added, if specified in the 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   344
     COPYRIGHT_TEMPLATE_FILE resources."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   345
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   346
    ^ self new createCopyrightMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   347
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   348
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   349
createDocumentationMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   350
    "add documentation method containing doc template
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   351
     but only if not already present."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   352
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   353
    ^ self new createDocumentationMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   354
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   355
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   356
createExamplesMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   357
    "add examples method containing examples template
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   358
     but only if not already present."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   359
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   360
    ^ self new createExamplesMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   361
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   362
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   363
createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   364
    ^ self new createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   365
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   366
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   367
createInitialHistoryMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   368
    "add history method containing created-entry
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   369
     but only if not already present."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   370
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   371
    ^ self new createInitialHistoryMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   372
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   373
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   374
createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   375
    "add an inst-creation method"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   376
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   377
    ^ self new createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   378
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   379
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   380
createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   381
    "create a multi-setter method for instvars."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   382
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   383
    ^ self new createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   384
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   385
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   386
createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   387
    "add a subclassResponsibility method;
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   388
     but only if not already present."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   389
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   390
    ^ self new createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   391
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   392
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   393
createUpdateMethodIn:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   394
    "create an update:with:from:-method
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   395
     (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   396
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   397
    ^ self new createUpdateMethodIn:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   398
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   399
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   400
createVersionMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   401
    "add version method containing RCS template
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   402
     but only if not already present and its not a private class."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   403
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   404
    ^ self new createVersionMethodFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   405
! !
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   406
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   407
!CodeGeneratorTool class methodsFor:'compilation'!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   408
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   409
compile:theCode forClass:aClass inCategory:cat 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   410
    "install some code for a class.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   411
     If refactory browser stuff is avaliable the refactory tools are used to support undo"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   412
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   413
    ^ self new compile:theCode forClass:aClass inCategory:cat
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   414
! !
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   415
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   416
!CodeGeneratorTool class methodsFor:'private'!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   417
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   418
canUseRefactoringSupport
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   419
    "check if refactory browser stuff is avaliable"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   420
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   421
     ^ RefactoryChangeManager notNil 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   422
    and:[RefactoryChangeManager isLoaded
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   423
    and:[UserPreferences current useRefactoringSupport]]
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   424
! !
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   425
5759
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   426
!CodeGeneratorTool methodsFor:'buld changes'!
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   427
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
   428
addChange:aChange
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
   429
    compositeChangeCollector addChange:aChange
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
   430
!
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
   431
5759
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   432
executeCollectedChangesNamed:name
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   433
    compositeChangeCollector notNil ifTrue:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   434
        compositeChangeNesting := compositeChangeNesting - 1.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   435
        compositeChangeNesting == 0 ifTrue:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   436
            compositeChangeCollector name:name.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   437
            compositeChangeCollector changesSize == 0 ifTrue:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   438
                self information:'Nothing generated.'.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   439
            ] ifFalse:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   440
                RefactoryChangeManager instance performChange:compositeChangeCollector.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   441
            ].
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   442
            compositeChangeCollector := nil.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   443
        ]
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   444
    ]
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   445
!
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   446
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   447
startCollectChanges
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   448
    (self canUseRefactoringSupport) ifTrue:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   449
        compositeChangeCollector isNil ifTrue:[
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   450
            compositeChangeCollector := CompositeRefactoryChange new.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   451
            compositeChangeNesting := 0.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   452
        ].
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   453
        compositeChangeNesting := compositeChangeNesting + 1.
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   454
    ]
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   455
! !
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   456
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   457
!CodeGeneratorTool methodsFor:'code generation'!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   458
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   459
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   460
    "create accessors in aClass"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   461
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   462
    self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   463
        createAccessMethodsFor:aCollectionOfVarNames 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   464
        in:aClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   465
        withChange:withChange 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   466
        asValueHolder:asValueHolder 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   467
        readersOnly:readersOnly 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   468
        writersOnly:writersOnly 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   469
        lazyInitialization:false
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   470
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   471
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   472
createApplicationCodeFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   473
    "create an empty application framework"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   474
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   475
    |nonMetaClass metaClass className txt isDialog categoryForMenuActionsMethods|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   476
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   477
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   478
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   479
    categoryForMenuActionsMethods := UserPreferences current categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   480
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   481
    nonMetaClass := aClass theNonMetaclass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   482
    metaClass := aClass theMetaclass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   483
    className := nonMetaClass name.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   484
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   485
    isDialog := (nonMetaClass isSubclassOf:SimpleDialog).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   486
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   487
    "/ add a windowSpec method for an empty applicationWindow,
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   488
    "/ with a menuPanel.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   489
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   490
    (metaClass includesSelector:#windowSpec) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   491
        isDialog ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   492
            txt := self class initialWindowSpecMethodSourceForDialogs.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   493
        ] ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   494
            txt := self class initialWindowSpecMethodSourceForApplications.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   495
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   496
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   497
            compile:(txt bindWith:className)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   498
            forClass:metaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   499
            inCategory:'interface specs'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   500
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   501
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   502
    isDialog ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   503
        "/ add a topMenu method 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   504
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   505
        (metaClass includesSelector:#mainMenu) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   506
            txt := self class initialMenuSpecMethodSourceForApplications.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   507
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   508
                compile:(txt bindWith:className)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   509
                forClass:metaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   510
                inCategory:'menu specs'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   511
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   512
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   513
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   514
    (nonMetaClass includesSelector:#postBuildWith:) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   515
        txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   516
'postBuildWith:aBuilder
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   517
    "This is a hook method generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   518
     It will be invoked during the initialization of your app/dialog,
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   519
     after all of the visual components have been built, 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   520
     but BEFORE the top window is made visible.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   521
     Add any app-specific actions here (reading files, setting up values etc.)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   522
     See also #postOpenWith:, which is invoked after opening."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   523
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   524
    "/ add any code here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   525
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   526
    ^ super postBuildWith:aBuilder
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   527
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   528
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   529
            compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   530
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   531
            inCategory:'initialization & release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   532
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   533
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   534
    (nonMetaClass includesSelector:#postOpenWith:) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   535
        txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   536
'postOpenWith:aBuilder
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   537
    "This is a hook method generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   538
     It will be invoked right after the applications window has been opened.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   539
     Add any app-specific actions here (starting background processes etc.).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   540
     See also #postBuildWith:, which is invoked before opening."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   541
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   542
    "/ add any code here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   543
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   544
    ^ super postOpenWith:aBuilder
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   545
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   546
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   547
            compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   548
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   549
            inCategory:'initialization & release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   550
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   551
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   552
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   553
        (nonMetaClass includesSelector:#closeRequest) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   554
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   555
'closeRequest
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   556
    "This is a hook method generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   557
     It will be invoked when your app/dialog-window is about to be
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   558
     closed (this method has a chance to suppress the close).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   559
     See also #closeDownViews, which is invoked when the close is really done."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   560
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   561
    "/ change the code below as required ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   562
    "/ Closing can be suppressed, by simply returning.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   563
    "/ The ''super closeRequest'' at the end will initiate the real closeDown
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   564
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   565
    ("self hasUnsavedChanges" true) ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   566
        (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   567
            ^ self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   568
        ]
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   569
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   570
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   571
    ^ super closeRequest
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   572
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   573
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   574
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   575
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   576
                inCategory:'initialization & release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   577
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   578
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   579
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   580
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   581
        (nonMetaClass includesSelector:#closeDownViews) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   582
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   583
'closeDownViews
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   584
    "This is a hook method generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   585
     It will be invoked when your app/dialog-window is really closed.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   586
     See also #closeDownViews, which is invoked before and may suppress the close
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   587
     or ask the user for confirmation."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   588
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   589
    "/ change the code below as required ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   590
    "/ This should cleanup any leftover resources
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   591
    "/ (for example, temporary files)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   592
    "/ super closeRequest will initiate the closeDown
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   593
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   594
    "/ add your code here
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   595
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   596
    "/ do not remove the one below ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   597
    ^ super closeDownViews
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   598
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   599
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   600
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   601
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   602
                inCategory:'initialization & release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   603
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   604
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   605
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   606
    isDialog ifTrue:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   607
        (nonMetaClass includesSelector:#accept) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   608
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   609
'closeAccept
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   610
    "This is a hook method generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   611
     It will be invoked when your dialog-window is closed with OK."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   612
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   613
    "/ add any actions as required here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   614
    Transcript showCR:''dialog accepted''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   615
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   616
    "/ do not remove the one below ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   617
    ^ super closeAccept
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   618
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   619
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   620
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   621
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   622
                inCategory:'user actions'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   623
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   624
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   625
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   626
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   627
        (nonMetaClass includesSelector:#menuNew) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   628
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   629
'menuNew
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   630
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   631
     It will be invoked when the menu-item ''new'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   632
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   633
    "/ change below and add any actions as required here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   634
    self warn:''no action for ''''new'''' available.''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   635
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   636
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   637
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   638
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   639
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   640
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   641
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   642
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   643
        (nonMetaClass includesSelector:#menuOpen) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   644
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   645
'menuOpen
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   646
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   647
     It will be invoked when the menu-item ''open'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   648
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   649
    "/ change below and add any actions as required here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   650
    self warn:''no action for ''''open'''' available.''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   651
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   652
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   653
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   654
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   655
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   656
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   657
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   658
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   659
        (nonMetaClass includesSelector:#menuSave) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   660
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   661
'menuSave
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   662
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   663
     It will be invoked when the menu-item ''save'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   664
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   665
    "/ change below and add any actions as required here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   666
    self warn:''no action for ''''save'''' available.''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   667
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   668
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   669
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   670
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   671
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   672
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   673
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   674
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   675
        (nonMetaClass includesSelector:#menuSaveAs) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   676
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   677
'menuSaveAs
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   678
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   679
     It will be invoked when the menu-item ''saveAs'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   680
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   681
    "/ change below and add any actions as required here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   682
    self warn:''no action for ''''saveAs'''' available.''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   683
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   684
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   685
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   686
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   687
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   688
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   689
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   690
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   691
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   692
        (nonMetaClass includesSelector:#openDocumentation) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   693
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   694
'openDocumentation
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   695
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   696
     It will be invoked when the menu-item ''help-documentation'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   697
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   698
    "/ change below as required ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   699
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   700
    "/ to open an HTML viewer on some document (under ''doc/online/<language>/'' ):
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   701
    HTMLDocumentView openFullOnDocumentationFile:''TOP.html''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   702
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   703
    "/ add application-specific help files under the ''doc/online/<language>/help/appName''
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   704
    "/ directory, and open a viewer with:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   705
    "/ HTMLDocumentView openFullOnDocumentationFile:''help/<MyApplication>/TOP.html''.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   706
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   707
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   708
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   709
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   710
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   711
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   712
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   713
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   714
    isDialog ifFalse:[
5817
a6f77e2713d5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5792
diff changeset
   715
        (nonMetaClass includesSelector:#openAboutThisApplication) ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   716
            txt :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   717
'openAboutThisApplication
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   718
    "This method was generated by the Browser.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   719
     It will be invoked when the menu-item ''help-about'' is selected."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   720
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   721
    "/ could open a customized aboutBox here ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   722
    super openAboutThisApplication
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   723
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   724
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   725
                compile:txt
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   726
                forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   727
                inCategory:categoryForMenuActionsMethods.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   728
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   729
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   730
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   731
    self executeCollectedChangesNamed:('Add Application Code for ' , className).
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   732
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   733
    "Modified: / 1.2.1998 / 16:10:03 / cg"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   734
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   735
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   736
createClassResponsibleProtocolFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   737
    "create stubs for the required protocol"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   738
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   739
    |nonMetaClass metaClass className|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   740
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   741
    nonMetaClass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   742
    metaClass := aClass theMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   743
    className := nonMetaClass name.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   744
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   745
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   746
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   747
    self privCreateClassResponsibleProtocolFor:nonMetaClass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   748
    self privCreateClassResponsibleProtocolFor:metaClass.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   749
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   750
    self executeCollectedChangesNamed:('Add Required Protocol to ' , className).
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   751
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   752
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   753
createClassTypeTestMethodsIn:aClass forClasses:subClasses
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   754
    "create a #isXXX test methods (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   755
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   756
    | code|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   757
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   758
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   759
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   760
    subClasses do:[:eachSubClass |
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   761
        |nm selector|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   762
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   763
        nm := eachSubClass nameWithoutPrefix.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   764
        selector := 'is' , nm.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   765
        (aClass includesSelector:selector) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   766
            code := (selector , '\    ^ false') withCRs.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   767
            self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   768
                compile:code
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   769
                forClass:aClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   770
                inCategory:'testing'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   771
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   772
        (eachSubClass includesSelector:selector) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   773
            code := (selector , '\    ^ true') withCRs.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   774
            self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   775
                compile:code
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   776
                forClass:eachSubClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   777
                inCategory:'testing'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   778
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   779
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   780
5759
b6cea74440db *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5758
diff changeset
   781
    self executeCollectedChangesNamed:'Add ClassType Tests'
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   782
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   783
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   784
createDocumentationMethodsFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   785
    "create empty documentation methods"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   786
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   787
    |nonMetaClass metaClass className|
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   788
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   789
    nonMetaClass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   790
    metaClass := aClass theMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   791
    className := nonMetaClass name.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   792
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   793
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   794
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   795
    self createVersionMethodFor:metaClass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   796
    self createCopyrightMethodFor:metaClass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   797
    self createDocumentationMethodFor:metaClass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   798
    self createInitialHistoryMethodFor:metaClass.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   799
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   800
    self executeCollectedChangesNamed:('Add Documentation to ' , className).
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   801
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   802
6313
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   803
createEnumTypeCodeFor:aClass
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   804
    |nonMetaClass metaClass className enumValues code initCode runValue maxValue|
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   805
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   806
    self startCollectChanges.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   807
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   808
    nonMetaClass := aClass theNonMetaclass.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   809
    metaClass := aClass theMetaclass.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   810
    className := nonMetaClass name.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   811
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   812
    enumValues := nonMetaClass classVarNames.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   813
    enumValues do:[:eachVariableName |
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   814
        self 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   815
            createAccessMethodsFor:(Array with:eachVariableName)
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   816
            in:metaClass  
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   817
            withChange:false
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   818
            asValueHolder:false
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   819
            readersOnly:true    
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   820
            writersOnly:false
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   821
    ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   822
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   823
    maxValue := enumValues inject:0 into:[:maxSoFar :eachVariableName | |oldVal val| 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   824
                                                                                oldVal := nonMetaClass classVarAt:eachVariableName.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   825
                                                                                oldVal notNil ifTrue:[ val := oldVal numericValue ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   826
                                                                                (val ? maxSoFar) max:maxSoFar].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   827
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   828
    initCode := WriteStream on: String new.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   829
    initCode nextPutLine:'initialize'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   830
    runValue := maxValue + 1.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   831
    enumValues keysAndValuesDo:[:idx :eachVariableName |
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   832
        |oldValue thisValue|
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   833
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   834
        oldValue := nonMetaClass classVarAt:eachVariableName.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   835
        oldValue notNil ifTrue:[
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   836
            thisValue := oldValue numericValue.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   837
        ] ifFalse:[
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   838
            thisValue := runValue.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   839
            runValue := runValue + 1.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   840
        ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   841
        initCode 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   842
            nextPutAll:'    ';
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   843
            nextPutAll:eachVariableName;
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   844
            nextPutAll:' := self basicNew'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   845
        (aClass canUnderstand:#'setNumericValue:') ifTrue:[
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   846
            initCode nextPutAll:' setNumericValue: ',thisValue printString.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   847
        ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   848
        (aClass canUnderstand:#'setCssClassString:') ifTrue:[
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   849
            initCode nextPutAll:('; setCssClassString: ''' , nonMetaClass nameWithoutPrefix asLowercaseFirst , eachVariableName , '''').
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   850
        ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   851
        (aClass canUnderstand:#'setName:') ifTrue:[
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   852
            initCode nextPutAll:('; setName: ''' , eachVariableName asLowercaseFirst , '''').
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   853
        ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   854
        initCode nextPutLine:'.'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   855
    ].
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   856
    initCode cr.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   857
    initCode nextPutLine:'    "'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   858
    initCode nextPutLine:'     ',className, ' initialize'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   859
    initCode nextPutLine:'    "'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   860
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   861
    self
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   862
        compile:(initCode contents)
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   863
        forClass:metaClass 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   864
        inCategory:'class initialization'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   865
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   866
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   867
    code := 'allStateNames\    ^ #( ' ,
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   868
                ((enumValues collect:[:each | '''',each asLowercaseFirst,'''']) asStringWith:' ') , ')',
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   869
                '\\    "\' ,
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   870
                '     ',className, ' allStateNames\' ,
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   871
                '    "\'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   872
    self
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   873
        compile:code withCRs
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   874
        forClass:metaClass 
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   875
        inCategory:'queries'.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   876
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   877
    self executeCollectedChangesNamed:('Generate EnumType Code for ' , className).
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   878
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   879
    aClass initialize.
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   880
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   881
    "Modified: / 1.2.1998 / 16:10:03 / cg"
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   882
!
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
   883
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   884
createStandardInitializationMethodsIn:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   885
    "create a #new and #initialize methods (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   886
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   887
    |nonMetaClass metaClass className code initializer m|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   888
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   889
    nonMetaClass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   890
    metaClass := aClass theMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   891
    className := nonMetaClass name.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   892
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   893
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   894
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   895
    (nonMetaClass includesSelector:#'initialize') ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   896
        code :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   897
'initialize
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   898
    "Invoked when a new instance is created."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   899
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   900
    super initialize.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   901
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   902
    "/ please change as required (and remove this comment)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   903
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   904
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   905
        m := nonMetaClass responseTo:#initialize.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   906
        m notNil ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   907
            m messagesSent size == 0 ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   908
                "/ inherits an empty initialize.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   909
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   910
                code :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   911
'initialize
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   912
    "Invoked when a new instance is created."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   913
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   914
    "/ please change as required (and remove this comment)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   915
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   916
    "/ super initialize.   -- commented since inherited method does nothing
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   917
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   918
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   919
            ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   920
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   921
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   922
        nonMetaClass instVarNames do:[:eachInstVar |
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   923
            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   924
            code := code , ('    ' , eachInstVar , ' := ' , initializer , Character cr).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   925
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   926
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   927
        self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   928
            compile:code
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   929
            forClass:nonMetaClass 
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   930
            inCategory:'initialization'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   931
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   932
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   933
    (metaClass includesSelector:#'new') ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   934
        m := metaClass responseTo:#new.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   935
        m notNil ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   936
            (m sends:#initialize) ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   937
                (self confirm:'The inherited #new method already seems to invoke #initialize. Redefine ?')
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   938
                ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   939
                    ^ self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   940
                ]
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   941
            ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   942
        ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   943
        code :=
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   944
'new
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   945
    ^ self basicNew initialize.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   946
'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   947
        self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   948
            compile:code
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   949
            forClass:metaClass 
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   950
            inCategory:'instance creation'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   951
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   952
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   953
    self executeCollectedChangesNamed:('Add Initialization to ' , className).
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   954
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   955
    "Created: / 11.10.2001 / 22:18:55 / cg"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   956
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   957
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   958
createStandardPrintOnMethodIn:aClass
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   959
    "create a #printOn: method (I'm tired of typing)"
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   960
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   961
    |code nonMetaClass|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   962
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   963
    nonMetaClass := aClass theNonMetaclass.
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   964
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   965
    self startCollectChanges.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   966
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   967
    (nonMetaClass includesSelector:#'printOn:') ifFalse:[
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   968
        code :=
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   969
'printOn:aStream
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   970
    "append a printed representation if the receiver to the argument, aStream"
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   971
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   972
    super printOn:aStream.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   973
'.
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   974
        nonMetaClass instVarNames do:[:eachInstVarName |
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   975
            code := code , '    '.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   976
            code := code , 'aStream nextPutAll:'''.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   977
            code := code , eachInstVarName.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   978
            code := code , ': ''.' , Character cr.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   979
            code := code , '    '.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   980
            code := code , eachInstVarName.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   981
            code := code , ' printOn:aStream.' , Character cr.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   982
        
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   983
        ].
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   984
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   985
        self 
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   986
            compile:code
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   987
            forClass:nonMetaClass 
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   988
            inCategory:'printing & storing'.
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   989
    ].
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   990
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   991
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
   992
    self executeCollectedChangesNamed:('Add #printOn: to ' , nonMetaClass name).
5953
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   993
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   994
    "Created: / 11.10.2001 / 22:18:55 / cg"
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   995
!
bf6cdc968a53 *** empty log message ***
ca
parents: 5817
diff changeset
   996
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   997
createTestCaseSampleCodeFor:aClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   998
    "create an (almost) empty testCase class"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
   999
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1000
    |nonMetaClass metaClass|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1001
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1002
    nonMetaClass := aClass theNonMetaclass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1003
    metaClass := aClass theMetaclass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1004
    "/ className := nonMetaClass name.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1005
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1006
    ( nonMetaClass includesSelector:#test1 ) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1007
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1008
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1009
'test1
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1010
    "This is a demonstration testCase - it is meant to be removed eventually.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1011
     This testCase will PASS.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1012
     Double click on the TestCase class or open a TestRunner to see me checking...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1013
     - please add more methods like this..."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1014
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1015
    |o|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1016
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1017
    o := Array new:2.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1018
    self assert: ( o size == 2 ).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1019
    self should: [ o at:0 ] raise:Error.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1020
    self shouldnt: [ o at:1 ] raise:Error.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1021
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1022
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1023
     self run:#test1
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1024
     self new test1
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1025
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1026
'
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1027
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1028
            inCategory:'tests'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1029
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1030
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1031
    ( nonMetaClass includesSelector:#test2 ) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1032
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1033
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1034
'test2
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1035
    "This is a demonstration testCase - it is meant to be removed eventually..
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1036
     This testCase WILL FAIL.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1037
     Double click on the TestCase class or open a TestRunner to see me checking...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1038
     - please add more methods like this..."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1039
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1040
    |o|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1041
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1042
    o := Array new:2.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1043
    self assert: ( o size == 3 ).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1044
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1045
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1046
     self run:#test2
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1047
     self new test2
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1048
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1049
'
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1050
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1051
            inCategory:'tests'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1052
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1053
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1054
    ( nonMetaClass includesSelector:#test3 ) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1055
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1056
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1057
'test3
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1058
    "This is a demonstration testCase - it is meant to be removed eventually..
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1059
     This testCase WILL generate an ERROR.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1060
     Double click on the TestCase class or open a TestRunner to see me checking...
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1061
     - please add more methods like this..."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1062
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1063
    |o|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1064
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1065
    o := Array new:2.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1066
    self assert: ( o foo ).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1067
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1068
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1069
     self run:#test3
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1070
     self new test3
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1071
    "
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1072
'
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1073
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1074
            inCategory:'tests'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1075
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1076
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1077
    ( nonMetaClass includesSelector:#setUp ) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1078
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1079
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1080
'setUp
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1081
    "common setup - invoked before testing."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1082
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1083
    super setUp
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1084
'
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1085
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1086
            inCategory:'initialize / release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1087
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1088
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1089
    ( nonMetaClass includesSelector:#tearDown ) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1090
        self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1091
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1092
'tearDown
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1093
    "common cleanup - invoked after testing."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1094
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1095
    super tearDown
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1096
'
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1097
            forClass:nonMetaClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1098
            inCategory:'initialize / release'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1099
    ]
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1100
!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1101
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1102
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1103
    "create acceptVisitor: in visitedClass and acceptXXX in visitorClass. (I'm tired of typing)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1104
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1105
    |sel|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1106
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1107
    visitedClass isMeta ifTrue:[self halt].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1108
    visitorClass isMeta ifTrue:[self halt].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1109
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1110
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1111
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1112
    sel := ('visit' , visitedClass nameWithoutPrefix , ':').
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1113
    self createAcceptVisitorMethod:sel in:visitedClass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1114
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1115
    (visitorClass includesSelector:sel) ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1116
        self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1117
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1118
(('%1anObject 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1119
    "dispatched back from the visited %2-object (visitor pattern)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1120
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1121
    "fall back to general object-case - please change as required"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1122
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1123
    ^ self visitObject:anObject
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1124
') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1125
            forClass:visitorClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1126
            inCategory:'visiting'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1127
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1128
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1129
    (visitorClass includesSelector:#'visitObject:') ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1130
        self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1131
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1132
('visitObject:anObject 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1133
    "dispatched back from the visited objects (visitor pattern)"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1134
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1135
    "general fallBack - please change as required"
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1136
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1137
    self halt:''not yet implemented''
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1138
')
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1139
            forClass:visitorClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1140
            inCategory:'visiting'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1141
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1142
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1143
    (visitorClass includesSelector:#'visit:') ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1144
        self 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1145
            compile:
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1146
('visit:anObject 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1147
    "visit anObject (visitor pattern).
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1148
     The object should call back one of my visitXXXX methods."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1149
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1150
    ^ anObject acceptVisitor:self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1151
')
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1152
            forClass:visitorClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1153
            inCategory:'visiting'.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1154
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1155
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1156
    self executeCollectedChangesNamed:('Add Visitor Pattern').
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1157
!
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1158
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1159
createWebApplicationCodeFor:aClass
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1160
    "create an empty webApplication framework"
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1161
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1162
    |nonMetaClass metaClass className txt|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1163
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1164
    self startCollectChanges.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1165
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1166
    nonMetaClass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1167
    metaClass := aClass theMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1168
    className := nonMetaClass name.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1169
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1170
    (nonMetaClass includesSelector:#process:) ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1171
        txt :=
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1172
'process:aRequest
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1173
    "This is the web applications main processing method.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1174
     It will be invoked for every incoming webBrowser-request.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1175
     The argument, aRequest contains the parameters (url, fields, parameters etc.)."
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1176
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1177
    |response|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1178
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1179
    response := aRequest response.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1180
    response nextPutLine:''<HTML>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1181
    response nextPutLine:''  <HEAD>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1182
    response nextPutLine:''  <TITLE>Hello</TITLE>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1183
    response nextPutLine:''  </HEAD>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1184
    response nextPutLine:''  <BODY>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1185
    response nextPutLine:''    <H1>Hello World !!</H1>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1186
    response nextPutLine:''  </BODY>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1187
    response nextPutLine:''</HTML>''.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1188
'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1189
        self
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1190
            compile:txt
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1191
            forClass:nonMetaClass 
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1192
            inCategory:'response generation'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1193
    ].
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1194
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1195
    (metaClass includesSelector:#linkName) ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1196
        txt :=
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1197
'linkName
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1198
    "return the default linkName path (with slash)."
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1199
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1200
    ^ ''/NewService''
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1201
'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1202
        self
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1203
            compile:txt
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1204
            forClass:metaClass 
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1205
            inCategory:'defaults'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1206
    ].
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1207
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1208
    (metaClass includesSelector:#settingsApplicationClass) ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1209
        txt :=
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1210
'settingsApplicationClass
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1211
    "a SettingsApplication class - or nil (used in the settings dialog if non-nil)."
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1212
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1213
    ^ nil
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1214
'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1215
        self
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1216
            compile:txt
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1217
            forClass:metaClass 
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1218
            inCategory:'defaults'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1219
    ].
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1220
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1221
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1222
    self executeCollectedChangesNamed:('Add WebApplication Code for ' , className).
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1223
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1224
    "Modified: / 1.2.1998 / 16:10:03 / cg"
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1225
! !
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1226
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1227
!CodeGeneratorTool methodsFor:'code generation-basic'!
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1228
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1229
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1230
    "workhorse for creating access methods for instvars."
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1231
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1232
    |classesClassVars generateComments generateCommentsForSetters generateCommentsForGetters|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1233
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1234
    self startCollectChanges.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1235
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1236
    generateComments := UserPreferences current generateComments.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1237
    generateCommentsForSetters := UserPreferences current generateCommentsForSetters.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1238
    generateCommentsForGetters := UserPreferences current generateCommentsForGetters.
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1239
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1240
    classesClassVars := aClass theNonMetaclass allClassVarNames.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1241
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1242
    aCollectionOfVarNames do:[:name |
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1243
        |source varType methodName defaultMethodName|
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1244
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1245
        varType := (classesClassVars includes:name) 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1246
                        ifTrue:['static'] 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1247
                        ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1248
                            (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1249
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1250
        methodName := name.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1251
        name first isUppercase ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1252
            methodName := methodName asLowercaseFirst. 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1253
        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1254
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1255
        "/ the GETTER
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1256
        writersOnly ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1257
            lazyInitialization ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1258
                defaultMethodName := 'default' , name asUppercaseFirst.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1259
            ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1260
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1261
            "check, if method is not already present"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1262
            (aClass includesSelector:(methodName asSymbol)) ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1263
                asValueHolder ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1264
                    source := methodName , '\'.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1265
                    generateComments ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1266
                        source := source , '    "return/create the ''%2'' value holder (automatically generated)"\\'. 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1267
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1268
                    source := source , '    %2 isNil ifTrue:[\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1269
                    lazyInitialization ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1270
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1271
                                   , '        %2 := self class %3 asValue.\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1272
                    ] ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1273
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1274
                                   , '        %2 := ValueHolder new.\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1275
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1276
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1277
                    withChange ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1278
                    source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1279
                               , '        %2 addDependent:self.\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1280
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1281
                    source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1282
                               , '    ].\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1283
                               , '    ^ %2'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1284
                ] ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1285
                    source := methodName , '\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1286
                    lazyInitialization ifTrue:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1287
                        generateCommentsForGetters ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1288
                            source := source , '    "return the %1 instance variable ''%2'' with lazy instance creation (automatically generated)"\\'. 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1289
                        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1290
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1291
                                    , '    %2 isNil ifTrue:[\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1292
                                    , '        %2 := self class %3.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1293
                                    , '    ].\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1294
                                    , '    ^ %2'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1295
                    ] ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1296
                        generateCommentsForGetters ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1297
                            source := source , '    "return the %1 instance variable ''%2'' (automatically generated)"\\'. 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1298
                        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1299
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1300
                                    , '    ^ %2'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1301
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1302
                ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1303
                source := (source bindWith:varType with:name with:defaultMethodName) withCRs.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1304
                self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1305
            ] ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1306
                Transcript showCR:'method ''', methodName , ''' already present'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1307
            ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1308
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1309
            "/ default for lazy on class side
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1310
            lazyInitialization ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1311
                (aClass class includesSelector:(defaultMethodName asSymbol)) ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1312
                    source := defaultMethodName , '\'.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1313
                    generateComments ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1314
                        source := source , '    "default value for the ''%2'' instance variable (automatically generated)"\\'. 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1315
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1316
                    source := source    
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1317
                               , '    self halt:''unfinished code''.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1318
                               , '    ^ nil.'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1319
                    source := (source bindWith:varType with:name) withCRs.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1320
                    self compile:source forClass:aClass class inCategory:'defaults'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1321
                ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1322
            ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1323
        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1324
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1325
        "/ the SETTER
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1326
        readersOnly ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1327
            (aClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1328
                asValueHolder ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1329
                    source := methodName , ':something\'.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1330
                    generateComments ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1331
                        source := source , '    "set the ''%2'' value holder' , ' (automatically generated)"\\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1332
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1333
                    withChange ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1334
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1335
                                  , '    |oldValue newValue|\\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1336
                                  , '    %2 notNil ifTrue:[\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1337
                                  , '        oldValue := %2 value.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1338
                                  , '        %2 removeDependent:self.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1339
                                  , '    ].\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1340
                                  , '    %2 := something.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1341
                                  , '    %2 notNil ifTrue:[\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1342
                                  , '        %2 addDependent:self.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1343
                                  , '    ].\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1344
                                  , '    newValue := %2 value.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1345
                                  , '    oldValue ~~ newValue ifTrue:[\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1346
                                  , '        self update:#value with:newValue from:%2.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1347
                                  , '    ].\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1348
                    ] ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1349
                        source := source 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1350
                                  , '    %2 := something.'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1351
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1352
                ] ifFalse:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1353
                    source := methodName , ':something\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1354
                    withChange ifTrue:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1355
                        generateComments ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1356
                            source := source , '    "set the value of the %1 variable ''%2'''.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1357
                            source := source , ' and send a change notification (automatically generated)"\\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1358
                        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1359
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1360
                                  , '    (%2 ~~ something) ifTrue:[\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1361
                                  , '        %2 := something.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1362
                                  , '        self changed:#%2.\'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1363
                                  , '     ].\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1364
                    ] ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1365
                        generateCommentsForSetters ifTrue:[
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1366
                            source := source , '    "set the value of the %1 variable ''%2'''.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1367
                            source := source , ' (automatically generated)"\\'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1368
                        ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1369
                        source := source
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1370
                                  , '    %2 := something.'.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1371
                    ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1372
                ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1373
                source := (source bindWith:varType with:name) withCRs.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1374
                self 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1375
                    compile:source 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1376
                    forClass:aClass 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1377
                    inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1378
            ] ifTrue:[
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1379
                Transcript showCR:'method ''', methodName , ':'' already present'
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1380
            ].
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1381
        ].
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1382
    ].
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1383
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1384
    self executeCollectedChangesNamed:('Add Accessors').
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1385
!
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1386
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1387
createValueHoldersFor:aCollectionOfVarNames in:aClass lazyInitialization:lazyInitialization
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1388
    "workhorse for creating access methods for instvars."
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1389
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1390
    |nonMetaClass metaClass classesClassVars generateComments generateCommentsForSetters generateCommentsForGetters|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1391
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1392
    nonMetaClass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1393
    metaClass := aClass theMetaclass.
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1394
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1395
    self startCollectChanges.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1396
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1397
    generateComments := UserPreferences current generateComments.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1398
    generateCommentsForSetters := UserPreferences current generateCommentsForSetters.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1399
    generateCommentsForGetters := UserPreferences current generateCommentsForGetters.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1400
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1401
    classesClassVars := nonMetaClass allClassVarNames.
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1402
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1403
    aCollectionOfVarNames do:[:name |
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1404
        |source varType methodName holderMethodName defaultMethodName|
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1405
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1406
        holderMethodName := name.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1407
        name first isUppercase ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1408
            holderMethodName := holderMethodName asLowercaseFirst. 
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1409
        ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1410
        (holderMethodName endsWith:'Holder') ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1411
            methodName := holderMethodName copyWithoutLast:6.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1412
        ] ifFalse:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1413
            methodName := holderMethodName.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1414
            holderMethodName := methodName , 'Holder'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1415
        ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1416
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1417
        methodName notNil ifTrue:[
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1418
            (metaClass includesSelector:(methodName asSymbol)) ifFalse:[
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1419
                source := '%1\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1420
                generateComments ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1421
                    source := source , '    "return the value in ''%2''"\\'. 
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1422
                ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1423
                source := source , '    ^ self %2 value'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1424
                source := (source bindWith:methodName with:holderMethodName) withCRs.
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1425
                self compile:source forClass:nonMetaClass inCategory:('accessing').
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1426
            ] ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1427
                Transcript showCR:'method ''', methodName , ''' already present'
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1428
            ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1429
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1430
            (metaClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1431
                source := '%1: newValue\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1432
                generateComments ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1433
                    source := source , '    "set the value in ''%2''"\\'. 
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1434
                ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1435
                source := source , '    self %2 value: newValue'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1436
                source := (source bindWith:methodName with:holderMethodName) withCRs.
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1437
                self compile:source forClass:nonMetaClass inCategory:('accessing').
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1438
            ] ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1439
                Transcript showCR:'method ''', methodName , ':'' already present'
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1440
            ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1441
        ].
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1442
        (metaClass includesSelector:(holderMethodName asSymbol)) ifFalse:[
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1443
            source := '%1\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1444
            generateComments ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1445
                source := source , '    "return/create the valueHolder ''%1''"\\'. 
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1446
            ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1447
            source := source , '    %1 isNil ifTrue:[\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1448
            source := source , '        %1 := ValueHolder with:nil "defaultValue here".\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1449
            source := source , '    ].\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1450
            source := source , '    ^ %1\'.
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1451
            source := (source bindWith:holderMethodName) withCRs.
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1452
            self compile:source forClass:nonMetaClass inCategory:('accessing').
5763
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1453
        ] ifTrue:[
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1454
            Transcript showCR:'method ''', methodName , ''' already present'
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1455
        ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1456
    ].
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1457
8cce359fd150 add valueHolder
Claus Gittinger <cg@exept.de>
parents: 5759
diff changeset
  1458
    self executeCollectedChangesNamed:('Add ValueHolder').
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1459
! !
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1460
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1461
!CodeGeneratorTool methodsFor:'code generation-individual methods'!
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1462
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1463
createAcceptVisitorMethod:selector in:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1464
    "create an acceptVisitor: method
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1465
     (I'm tired of typing)"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1466
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1467
    aClass isMeta ifTrue:[self halt].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1468
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1469
    (aClass includesSelector:#'acceptVisitor:') ifFalse:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1470
        self 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1471
            compile:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1472
(('acceptVisitor:aVisitor 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1473
    "Double dispatch back to the visitor, passing my type encoded in
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1474
     the selector (visitor pattern)"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1475
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1476
    "stub code automatically generated - please change if required"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1477
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1478
    ^ aVisitor %1self
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1479
') bindWith:selector)
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1480
            forClass:aClass 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1481
            inCategory:'visiting'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1482
    ]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1483
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1484
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1485
createAcceptVisitorMethodIn:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1486
    "create an acceptVisitor: method
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1487
     (I'm tired of typing)"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1488
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1489
    self
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1490
        createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1491
        in:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1492
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1493
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1494
createCopyrightMethodFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1495
    "add copyright method containing your/your companies
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1496
     copyright template but only if not already present.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1497
     this is only added, if specified in the 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1498
     COPYRIGHT_TEMPLATE_FILE resources."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1499
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1500
    |fn txt|
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1501
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1502
    (aClass includesSelector:#copyright) ifFalse:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1503
        fn := SystemBrowser classResources at:#'COPYRIGHT_TEMPLATE_FILE' default:nil.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1504
        fn notNil ifTrue:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1505
            fn := fn asFilename.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1506
            fn exists ifTrue:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1507
                txt := fn contents asString
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1508
            ]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1509
        ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1510
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1511
        txt notNil ifTrue:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1512
            txt := txt bindWith:(Date today year).
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1513
            self compile:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1514
'copyright
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1515
"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1516
' , txt , '
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1517
"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1518
'             forClass:aClass 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1519
              inCategory:'documentation'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1520
        ]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1521
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1522
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1523
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1524
createDocumentationMethodFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1525
    "add documentation method containing doc template
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1526
     but only if not already present."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1527
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1528
    |metaClass nonMetaClass userName loginName hostName emailAddress code existingComment|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1529
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1530
    metaClass := aClass theMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1531
    nonMetaClass := aClass theNonMetaclass.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1532
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1533
    (metaClass includesSelector:#documentation) ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1534
        existingComment := nonMetaClass comment.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1535
        existingComment isEmptyOrNil ifTrue:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1536
            (nonMetaClass isSubclassOf:HTTPService) ifTrue:[
6159
2707b35f964c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6050
diff changeset
  1537
                existingComment := '    [start Server with:]
2707b35f964c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6050
diff changeset
  1538
        HTTPServer startServerOnPort:9090
2707b35f964c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6050
diff changeset
  1539
2707b35f964c *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6050
diff changeset
  1540
    [start with:]
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1541
        (self new)
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1542
            registerServiceOn:(HTTPServer runningServerOnPort:9090)'.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1543
            ].
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1544
        ].
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1545
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1546
        userName := OperatingSystem getFullUserName.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1547
        loginName := OperatingSystem getLoginName.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1548
        hostName := OperatingSystem getHostName.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1549
        emailAddress := loginName , '@' , hostName.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1550
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1551
        "/ ugly; should ask the class for that    
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1552
        metaClass isJavaScriptClass ifTrue:[
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1553
            code :=
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1554
'function documentation() {
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1555
/*
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1556
' , (existingComment ? '    documentation to be added.') , '
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1557
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1558
    [author:]
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1559
        ' , userName 
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1560
          , ' (' , emailAddress , ')' , '
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1561
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1562
    [instance variables:]
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1563
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1564
    [class variables:]
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1565
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1566
    [see also:]
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1567
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1568
*/
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1569
}
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1570
'
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1571
        ] ifFalse:[
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1572
            code:= 
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1573
'documentation
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1574
"
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1575
' , (existingComment ? '    documentation to be added.') , '
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1576
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1577
    [author:]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1578
        ' , userName 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1579
          , ' (' , emailAddress , ')' , '
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1580
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1581
    [instance variables:]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1582
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1583
    [class variables:]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1584
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1585
    [see also:]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1586
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1587
"
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1588
'
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1589
        ].
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1590
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1591
        self 
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1592
            compile:code
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1593
            forClass:metaClass 
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1594
            inCategory:'documentation'.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1595
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1596
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1597
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1598
createExamplesMethodFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1599
    "add examples method containing examples template
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1600
     but only if not already present."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1601
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1602
    |nonMetaclass fragment|
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1603
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1604
    nonMetaclass := aClass theNonMetaclass.
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1605
    (nonMetaclass isSubclassOf:ApplicationModel) ifFalse:[
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1606
        ^ self
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1607
    ].
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1608
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1609
    (aClass includesSelector:#examples) ifFalse:[
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1610
        (nonMetaclass isSubclassOf:ApplicationModel) ifTrue:[
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1611
            fragment := '  Starting the application:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1612
                                                                [exBegin]
6050
300b21c10c71 *** empty log message ***
ca
parents: 5953
diff changeset
  1613
    ' , nonMetaclass name , ' open
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1614
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1615
                                                                [exEnd]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1616
'
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1617
        ] ifFalse:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1618
            fragment := ''
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1619
        ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1620
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1621
        self 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1622
            compile:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1623
'examples
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1624
"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1625
' , fragment , '
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1626
  more examples to be added:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1627
                                                                [exBegin]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1628
    ... add code fragment for 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1629
    ... executable example here ...
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1630
                                                                [exEnd]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1631
"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1632
'                   
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1633
            forClass:aClass 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1634
            inCategory:'documentation'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1635
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1636
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1637
3822
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1638
createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1639
    |imageStoreStream mthd imageKey category|
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1640
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1641
    anImage storeOn: (imageStoreStream := WriteStream on: '').
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1642
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1643
    "/ if that method already exists, do not overwrite the category
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1644
    category := 'image specs'.
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1645
    (mthd := aClass compiledMethodAt:sel) notNil ifTrue:[
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1646
        category := mthd category.
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1647
    ].
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1648
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1649
    imageKey :=  (aClass name, ' ', sel) asSymbol.
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1650
    Icon constantNamed: imageKey put:nil.
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1651
    aClass
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1652
        compile: ((sel,
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1653
            '\', comment,
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1654
            '\\' , 
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1655
            '    "\',
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1656
            '     self ' , sel , ' inspect\',
3823
1ed101fe88a9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3822
diff changeset
  1657
            '     ImageEditor openOnClass:self andSelector:#', sel, '\',
3822
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1658
            '     Icon flushCachedIcons', 
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1659
            '\    "',
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1660
            '\\',
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1661
            '    <resource: #image>',
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1662
            '\\',
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1663
            '    ^Icon\') withCRs, 
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1664
            '        constantNamed:#''', imageKey, '''\' withCRs,
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1665
            '        ifAbsentPut:[', imageStoreStream contents, ']')
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1666
       classified: category.
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1667
!
4e9f2f69875f code generation for icons moved from ImageEditor
Claus Gittinger <cg@exept.de>
parents: 3804
diff changeset
  1668
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1669
createInitialHistoryMethodFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1670
    "add history method containing created-entry
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1671
     but only if not already present."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1672
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1673
    |code|
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1674
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1675
    (aClass includesSelector:#history) ifFalse:[ 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1676
        HistoryManager notNil ifTrue:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1677
            code := HistoryManager codeForInitialHistoryMethodIn:aClass.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1678
            self
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1679
                compile:code
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1680
                forClass:aClass 
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1681
                inCategory:'documentation'.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1682
        ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1683
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1684
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1685
4512
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1686
createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1687
    "add an inst-creation method"
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1688
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1689
    |template|
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1690
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1691
    (aMetaClass includesSelector:selector) ifFalse:[
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1692
        template := Parser methodSpecificationForSelector:selector.
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1693
        self 
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1694
            compile:
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1695
template , '
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1696
    ^ self new ' , template , '
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1697
'                   
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1698
            forClass:aMetaClass 
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1699
            inCategory:category.
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1700
    ].
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1701
!
117fa43d16eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 4444
diff changeset
  1702
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1703
createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1704
    "create a multi-setter method for instvars."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1705
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1706
    |source|
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1707
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1708
    source := ''.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1709
    aCollectionOfVarNames do:[:eachVar |
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1710
        source := source , (eachVar , ':' , eachVar , 'Arg ').
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1711
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1712
    source := source , Character cr.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1713
    source := source , ('    "set instance variables (automatically generated)"' , Character cr , Character cr).
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1714
    aCollectionOfVarNames do:[:eachVar |
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1715
        source := source , ('    ' , eachVar , ' := ' , eachVar , 'Arg.' , Character cr).
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1716
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1717
    self compile:source forClass:aClass inCategory:'accessing'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1718
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1719
3800
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1720
createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1721
    "add a subclassResponsibility method;
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1722
     but only if not already present."
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1723
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1724
    (aClass includesSelector:aSelector) ifFalse:[
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1725
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1726
        self compile:
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1727
(Method methodDefinitionTemplateForSelector:aSelector) ,
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1728
'
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1729
    "raise an error: must be redefined in concrete subclass(es)"
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1730
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1731
    ^ self subclassResponsibility
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1732
' 
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1733
              forClass:aClass 
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1734
              inCategory:cat.
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1735
    ].
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1736
!
a5c75c369855 added generateSubclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 3719
diff changeset
  1737
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1738
createUpdateMethodIn:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1739
    "create an update:with:from:-method
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1740
     (I'm tired of typing)"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1741
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1742
    (aClass includesSelector:#'update:with:from:') ifFalse:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1743
        self 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1744
            compile:
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1745
'update:something with:aParameter from:changedObject
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1746
    "Invoked when an object that I depend upon sends a change notification."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1747
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1748
    "stub code automatically generated - please change as required"
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1749
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1750
    "/ changedObject == someOfMyValueHolders ifTrue:[
4926
f0ab6bb01771 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4908
diff changeset
  1751
    "/     self doSomethingApropriate.
f0ab6bb01771 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 4908
diff changeset
  1752
    "/     ^ self.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1753
    "/ ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1754
    super update:something with:aParameter from:changedObject
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1755
'
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1756
            forClass:aClass 
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1757
            inCategory:'change & update'.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1758
    ]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1759
!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1760
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1761
createVersionMethodFor:aClass
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1762
    "add version method containing RCS template
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1763
     but only if not already present and its not a private class."
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1764
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1765
    |code|
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1766
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1767
    aClass isPrivate ifFalse:[
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1768
        (aClass includesSelector:#version) ifFalse:[
5756
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1769
            "/ ugly; should ask the class for that    
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1770
            aClass isJavaScriptClass ifTrue:[
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1771
                code:= ('function version() {\    return ("$' , 'Header$");\}') withCRs
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1772
            ] ifFalse:[
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1773
                code:= ('version\    ^ ''$' , 'Header$''') withCRs
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1774
            ].
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1775
            self 
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1776
                compile:code
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1777
                forClass:aClass 
66261b5c4659 *** empty log message ***
ca
parents: 5494
diff changeset
  1778
                inCategory:'documentation'.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1779
        ]
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1780
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1781
! !
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1782
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1783
!CodeGeneratorTool methodsFor:'compilation'!
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1784
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1785
compile:theCode forClass:aClass inCategory:cat 
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1786
    "install some code for a class.
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1787
     If refactory browser stuff is avaliable the refactory tools are used to support undo"
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1788
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1789
    |change|
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1790
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1791
    self canUseRefactoringSupport ifFalse:[
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1792
        "/ compile immediately
3716
cbaffbf250f5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3712
diff changeset
  1793
        aClass compile:theCode classified:cat.
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1794
        ^ self.
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1795
    ].
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1796
3716
cbaffbf250f5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3712
diff changeset
  1797
    change := InteractiveAddMethodChange compile:(theCode asString) in:aClass classified:cat.
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1798
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1799
    "/ if collecting, add to changes (to be executed as one change at the end,
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1800
    "/ in order to have only one change in the undo-list (instead of many)
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1801
    compositeChangeCollector notNil ifTrue:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1802
        compositeChangeCollector addChange:change
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1803
    ] ifFalse:[
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1804
        RefactoryChangeManager instance performChange:change.
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1805
    ]
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1806
! !
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1807
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1808
!CodeGeneratorTool methodsFor:'private'!
4108
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1809
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1810
canUseRefactoringSupport
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1811
    "check if refactory browser stuff is avaliable"
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1812
5758
8f88193a4a93 collect changes
Claus Gittinger <cg@exept.de>
parents: 5756
diff changeset
  1813
     ^ self class canUseRefactoringSupport
5013
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1814
!
0f2c39fc6e8c comments; allow for comments to be suppressed
Claus Gittinger <cg@exept.de>
parents: 4926
diff changeset
  1815
4108
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1816
privCreateClassResponsibleProtocolFor:aClass
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1817
    "create stubs for the required protocol aClass may be a a MetaClass
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1818
     or a NonMetaClass"
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1819
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1820
    |selectors|
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1821
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1822
    selectors := IdentitySet new.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1823
    aClass allSuperclassesDo:[:cls |
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1824
        cls methodDictionary keysAndValuesDo:[:sel :mthd |
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1825
            (mthd sends:#subclassResponsibility) ifTrue:[
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1826
                selectors add:sel.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1827
            ]
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1828
        ]
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1829
    ].
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1830
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1831
    selectors do:[:eachSelector |
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1832
        |cat comment mthd implClass|
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1833
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1834
        implClass := aClass whichClassImplements:eachSelector.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1835
        implClass ~~ aClass ifTrue:[
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1836
            mthd := implClass compiledMethodAt:eachSelector.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1837
            (mthd sends:#subclassResponsibility) ifTrue:[
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1838
                cat := mthd category.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1839
                comment := mthd methodComment.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1840
                comment size == 0 ifTrue:[
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1841
                    comment := 'Superclass says that I am responsible to implement this method'
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1842
                ].
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1843
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1844
                self 
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1845
                    compile:
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1846
(Method methodDefinitionTemplateForSelector:eachSelector), Character cr, '    "', comment,
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1847
'"
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1848
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1849
    self shouldImplement
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1850
' 
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1851
                    forClass:aClass 
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1852
                    inCategory:cat.
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1853
            ].
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1854
        ].
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1855
    ].
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1856
! !
19af32811dfd Generate minimal protocol classes for metaclass.
Stefan Vogel <sv@exept.de>
parents: 3823
diff changeset
  1857
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1858
!CodeGeneratorTool class methodsFor:'documentation'!
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1859
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1860
version
6313
e73b5d2d07f9 enumType generator
Claus Gittinger <cg@exept.de>
parents: 6159
diff changeset
  1861
    ^ '$Header: /cvs/stx/stx/libtool/CodeGeneratorTool.st,v 1.32 2005-06-02 16:49:46 cg Exp $'
3712
293c44b3c910 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1862
! !