JavaScriptCodeGeneratorTool.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 24 Sep 2013 23:18:24 +0200
branchinitialV
changeset 1180 01c6be61f29c
parent 544 4c65ee6de4e7
child 827 f4c83dd4faed
permissions -rw-r--r--
checkin from stx browser
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     1
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     2
 COPYRIGHT (c) 2011 by eXept Software AG
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     3
              All Rights Reserved
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     4
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    10
 hereby transferred.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    11
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    12
"{ Package: 'stx:libjavascript' }"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    13
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    14
CodeGeneratorTool subclass:#JavaScriptCodeGeneratorTool
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    15
	instanceVariableNames:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
	classVariableNames:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	poolDictionaries:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	category:'Interface-Browsers'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!JavaScriptCodeGeneratorTool class methodsFor:'documentation'!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
copyright
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    24
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    25
 COPYRIGHT (c) 2011 by eXept Software AG
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
              All Rights Reserved
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
 This software is furnished under a license and may be used
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
 only in accordance with the terms of that license and with the
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 inclusion of the above copyright notice.   This software may not
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 be provided or otherwise made available to, or used by, any
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 other person.  No title to or ownership of the software is
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 hereby transferred.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
documentation
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
    Code generation facilites for JavaScript
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    [author:]
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
        Claus Gittiner
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
! !
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    46
!JavaScriptCodeGeneratorTool class methodsFor:'code generation'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    47
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    48
initialMenuSpecMethodSourceForApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    49
    "return code for a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    50
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    51
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    52
'mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    53
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    54
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    55
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    56
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    57
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    58
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    59
     MenuEditor new openOnClass:%1 andSelector:#mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    60
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    61
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    62
    <resource: #menu>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    63
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    64
    ^ ',(self initialMenuSpecForApplications decodeAsLiteralArray literalArrayEncoding storeString),'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    65
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    66
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    67
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    68
initialPageMenuSpecMethodSourceForWebApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    69
    "return code for a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    70
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    71
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    72
'mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    73
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    74
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    75
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    76
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    77
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    78
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    79
     MenuEditor new openOnClass:%1 andSelector:#mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    80
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    81
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    82
    <resource: #menu>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    83
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    84
    ^ ',(self initialPageMenuSpecForWebApplications decodeAsLiteralArray literalArrayEncoding storeString),'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    85
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    86
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    87
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    88
     self initialPageMenuSpecMethodSourceForWebApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    89
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    90
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    91
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    92
initialPageSpecMethodSourceForWebApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    93
    "return an empty pageSpec"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    94
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    95
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    96
'pageSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    97
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    98
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    99
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   100
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   101
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   102
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   103
     UIPainter new openOnClass:%1 andSelector:#pageSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   104
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   105
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   106
    <resource: #canvas>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   107
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   108
    ^ ',(self initialPageSpecForWebApplications decodeAsLiteralArray literalArrayEncoding storeString),'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   109
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   110
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   111
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   112
initialToolbarMenuSpecMethodSource
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   113
    "return a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   114
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   115
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   116
'toolbarMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   117
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   118
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   119
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   120
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   121
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   122
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   123
     MenuEditor new openOnClass:%1 andSelector:#toolbarMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   124
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   125
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   126
    <resource: #menu>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   127
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   128
    ^ ',(self initialToolbarMenuSpec decodeAsLiteralArray literalArrayEncoding storeString),'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   129
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   130
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   131
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   132
     self initialToolbarMenuSpecMethodSource
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   133
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   134
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   135
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   136
initialWindowSpecMethodSourceForApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   137
    "return an empty windowSpec with an initial menubar in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   138
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   139
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   140
'windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   141
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   142
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   143
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   144
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   145
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   146
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   147
     UIPainter new openOnClass:%1 andSelector:#windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   148
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   149
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   150
    <resource: #canvas>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   151
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   152
    ^ ',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   153
        self initialWindowSpecForApplications2 decodeAsLiteralArray prettyPrintString           
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   154
.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   155
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   156
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   157
     self initialWindowSpecMethodSourceForApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   158
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   159
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   160
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   161
initialWindowSpecMethodSourceForDialogs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   162
    "return an empty windowSpec for dialogs"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   163
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   164
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   165
'windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   166
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   167
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   168
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   169
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   170
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   171
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   172
     UIPainter new openOnClass:%1 andSelector:#windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   173
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   174
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   175
    <resource: #canvas>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   176
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   177
    ^ ',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   178
        self initialWindowSpecForDialogs decodeAsLiteralArray prettyPrintString           
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   179
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   180
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   181
!JavaScriptCodeGeneratorTool class methodsFor:'code generation-menus'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   182
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   183
createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   184
    |alreadyInSuperclass method code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   185
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   186
    (aClass includesSelector:aSelector) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   187
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   188
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   189
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   190
    alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   191
    (alreadyInSuperclass and:[redefine not]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   192
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   193
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   194
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   195
    method := self methodNameTemplateFor:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   196
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   197
    code := '%1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   198
    "automatically generated by UIEditor ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   199
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   200
    "*** the code below performs no action"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   201
    "*** (except for some feedback on the Transcript)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   202
    "*** Please change as required and accept in the browser."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   203
    "*** (and replace this comment by something more useful ;-)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   204
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   205
    "action to be added ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   206
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   207
    Transcript showCR:self class name, '': action for #%2 ...''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   208
' bindWith:method with:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   209
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   210
    alreadyInSuperclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   211
        code := code, (('\    super %1\' bindWith:method) withCRs).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   212
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   213
    self compile:code forClass:aClass inCategory:(aCategory ? #actions).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   214
    ^ code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   215
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   216
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   217
createAspectMethodFor:aSelector in:aClass category:aCategory redefine:redefine
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   218
    |alreadyInSuperclass method code text|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   219
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   220
    (aClass includesSelector:aSelector) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   221
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   222
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   223
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   224
    alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   225
    (alreadyInSuperclass and:[redefine not]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   226
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   227
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   228
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   229
    method := self methodNameTemplateFor:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   230
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   231
    code := '%1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   232
    "automatically generated by UIEditor ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   233
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   234
    "*** the code below creates a default model when invoked"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   235
    "*** (which may not be the one you wanted)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   236
    "*** Please change as required and accept in the browser."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   237
    "*** (and replace this comment by something more useful ;-)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   238
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   239
    "aspect to be added ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   240
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   241
    Transcript showCR:self class name, '': aspect for #%2 ...''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   242
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   243
' bindWith:method with:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   244
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   245
    alreadyInSuperclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   246
        text := '    ^ super %1\' bindWith:method.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   247
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   248
        text := '    ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   249
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   250
    code := code, (text withCRs).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   251
    self compile:code forClass:aClass inCategory:(aCategory ? #actions).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   252
    ^ code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   253
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   254
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   255
!JavaScriptCodeGeneratorTool class methodsFor:'private'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   256
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   257
methodNameTemplateFor:aSelector
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   258
    |numArgs method|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   259
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   260
    numArgs := aSelector numArgs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   261
    numArgs == 1 ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   262
        method := aSelector, 'anArgument'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   263
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   264
        numArgs == 0 ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   265
            method := aSelector
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   266
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   267
            method := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   268
            aSelector keywords keysAndValuesDo:[:i :key|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   269
                method := method, key, 'arg', i printString, ' '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   270
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   271
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   272
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   273
    ^ method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   274
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   275
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   276
!JavaScriptCodeGeneratorTool methodsFor:'code generation'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   277
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   278
createClassInitializeMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   279
    "create a #initialize method on the class side (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   280
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   281
    |nonMetaClass metaClass className code initializer bindings|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   282
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   283
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   284
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   285
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   286
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   287
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   288
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   289
    (metaClass includesSelector:#'initialize') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   290
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   291
    "Invoked at system start or when the class is dynamically loaded."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   292
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   293
    "/ please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   294
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   295
        bindings := Dictionary new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   296
        bindings at:'INIT_CLASSINSTVARS' put:(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   297
            String streamContents:[:s |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   298
                metaClass instVarNames do:[:eachClassInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   299
                    initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   300
                    s nextPutLine:('    "/ %1 := %2.' bindWith:eachClassInstVar with:initializer).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   301
                ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   302
            ]).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   303
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   304
        bindings at:'INIT_CLASSVARS' put:(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   305
            String streamContents:[:s |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   306
                nonMetaClass classVarNames do:[:eachClassVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   307
                    initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   308
                    s nextPutLine:('    "/ %1 := %2.' bindWith:eachClassVar with:initializer).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   309
                ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   310
            ]).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   311
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   312
        code := (self codeFor_classInitialize) expandPlaceholdersWith:bindings.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   313
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   314
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   315
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   316
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   317
            inCategory:#initialization.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   318
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   319
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   320
    self executeCollectedChangesNamed:('Add Class Initializer to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   321
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   322
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   323
createClassTypeTestMethodsIn:aClass forClasses:subClasses
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   324
    "create a #isXXX test methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   325
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   326
    | code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   327
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   328
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   329
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   330
    subClasses do:[:eachSubClass |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   331
        |nm selector|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   332
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   333
        nm := eachSubClass nameWithoutPrefix.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   334
        selector := 'is' , nm.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   335
        (aClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   336
            code := (selector , '\    ^ false') withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   337
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   338
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   339
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   340
                inCategory:#testing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   341
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   342
        (eachSubClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   343
            code := (selector , '\    ^ true') withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   344
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   345
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   346
                forClass:eachSubClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   347
                inCategory:#testing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   348
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   349
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   350
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   351
    self executeCollectedChangesNamed:'Add ClassType Tests'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   352
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   353
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   354
createEnumTypeCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   355
    |nonMetaClass metaClass className enumValues code initCode runValue maxValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   356
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   357
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   358
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   359
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   360
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   361
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   362
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   363
    enumValues := nonMetaClass classVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   364
    enumValues do:[:eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   365
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   366
            createAccessMethodsFor:(Array with:eachVariableName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   367
            in:metaClass  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   368
            withChange:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   369
            asValueHolder:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   370
            readersOnly:true    
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   371
            writersOnly:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   372
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   373
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   374
    maxValue := enumValues 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   375
                    inject:0 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   376
                    into:[:maxSoFar :eachVariableName | 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   377
                            |oldVal val| 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   378
                            oldVal := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   379
                            oldVal notNil ifTrue:[ val := oldVal numericValue ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   380
                            (val ? maxSoFar) max:maxSoFar
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   381
                         ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   382
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   383
    initCode := WriteStream on: String new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   384
    initCode nextPutLine:'initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   385
    runValue := maxValue + 1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   386
    enumValues keysAndValuesDo:[:idx :eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   387
        |oldValue thisValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   388
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   389
        oldValue := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   390
        oldValue notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   391
            thisValue := oldValue numericValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   392
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   393
            thisValue := runValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   394
            runValue := runValue + 1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   395
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   396
        initCode 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   397
            nextPutAll:'    ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   398
            nextPutAll:eachVariableName;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   399
            nextPutAll:' := self basicNew'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   400
        (aClass canUnderstand:#'setNumericValue:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   401
            initCode nextPutAll:' setNumericValue: ',thisValue printString.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   402
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   403
        (aClass canUnderstand:#'setCssClassString:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   404
            initCode nextPutAll:('; setCssClassString: ''' , nonMetaClass nameWithoutPrefix asLowercaseFirst , eachVariableName , '''').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   405
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   406
        (aClass canUnderstand:#'setName:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   407
            initCode nextPutAll:('; setName: ''' , eachVariableName asLowercaseFirst , '''').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   408
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   409
        initCode nextPutLine:'.'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   410
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   411
    initCode cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   412
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   413
    initCode nextPutLine:'     ',className, ' initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   414
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   415
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   416
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   417
        compile:(initCode contents)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   418
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   419
        inCategory:#'class initialization'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   420
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   421
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   422
    code := 'allStateNames\    ^ #( ' ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   423
                ((enumValues collect:[:each | '#''',each asLowercaseFirst,'''']) asStringWith:' ') , ')',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   424
                '\\    "\' ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   425
                '     ',className, ' allStateNames\' ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   426
                '    "\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   427
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   428
        compile:code withCRs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   429
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   430
        inCategory:#queries.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   431
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   432
    self executeCollectedChangesNamed:('Generate EnumType Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   433
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   434
    aClass initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   435
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   436
    "Modified: / 1.2.1998 / 16:10:03 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   437
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   438
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   439
createExamplesMethodForViewClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   440
    "create an examples method"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   441
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   442
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   443
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   444
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   445
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   446
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   447
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   448
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   449
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   450
    (metaClass includesSelector:#examples) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   451
        code := 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   452
'examples
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   453
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   454
 Notice that everything between [exBegin] and [exEnd] is extracted by the html-doc generator
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   455
 to create nicely formatted and clickable executable examples in the generated html-doc.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   456
 (see the browsers class-documentation menu items for more)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   457
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   458
 trying the widget as standAlone view:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   459
                                                        [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   460
    %1 new open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   461
                                                        [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   462
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   463
 embedded in another view:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   464
                                                        [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   465
    |top v|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   466
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   467
    top := StandardSystemView new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   468
    top extent:300@300.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   469
    v := %1 new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   470
    v origin:10@10 corner:150@150.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   471
    top add:v.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   472
    top open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   473
                                                        [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   474
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   475
' bindWith:className.    
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   476
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   477
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   478
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   479
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   480
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   481
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   482
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   483
    self executeCollectedChangesNamed:('Add Example to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   484
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   485
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   486
createInitializationMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   487
    "create a #initialize methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   488
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   489
    |nonMetaClass metaClass className code initializer m|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   490
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   491
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   492
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   493
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   494
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   495
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   496
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   497
    (nonMetaClass includesSelector:#initialize) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   498
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   499
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   500
    "Invoked when a new instance is created."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   501
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   502
    "/ please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   503
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   504
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   505
        nonMetaClass instVarNames do:[:eachInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   506
            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   507
            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   508
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   509
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   510
        m := nonMetaClass responseTo:#initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   511
        (m notNil and:[m messagesSent size == 0]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   512
            "/ inherits an empty initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   513
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   514
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   515
    "/ super initialize.   -- commented since inherited method does nothing
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   516
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   517
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   518
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   519
    super initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   520
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   521
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   522
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   523
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   524
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   525
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   526
            inCategory:#initialization.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   527
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   528
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   529
    self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   530
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   531
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   532
createInitializedInstanceCreationMethodsIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   533
    "create a #new and #initialize methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   534
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   535
    |nonMetaClass metaClass className code m|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   536
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   537
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   538
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   539
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   540
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   541
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   542
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   543
    self createInitializationMethodIn:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   545
    (metaClass includesSelector:#new) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   546
        m := metaClass responseTo:#new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   547
        (m isNil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   548
        or:[ (m sends:#initialize) not 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   549
        or:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   550
            (Dialog 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   551
                confirmWithCancel:('The inherited #new method already seems to invoke #initialize.\Redefine ?' withCRs)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   552
                default:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   553
                onCancel:[^ self] ) 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   554
        ]]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   555
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   556
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   557
    "return an initialized instance"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   558
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   559
    ^ self basicNew initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   560
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   561
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   562
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   563
                forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   564
                inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   565
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   566
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   567
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   568
    self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   569
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   570
    "Created: / 11-10-2001 / 22:18:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   571
    "Modified: / 30-01-2011 / 00:58:04 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   572
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   573
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   574
createParametrizedInstanceCreationMethodsNamed:selector in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   575
    "create a #selector instance creation method (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   576
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   577
    |nonMetaClass metaClass className code initializer m dfn|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   578
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   579
    dfn := Method methodDefinitionTemplateForSelector:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   580
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   581
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   582
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   583
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   584
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   585
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   586
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   587
    (nonMetaClass includesSelector:selector asSymbol) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   588
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   589
'initialize',dfn asUppercaseFirst,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   590
    "Invoked when a new instance is created for arg."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   591
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   592
    "/ please change as required (and remove these comments)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   593
    "/ do something with arg here (instVar-foo := arg)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   594
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   595
        nonMetaClass instVarNames do:[:eachInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   596
            initializer := 'nil'. "/ need more intelligence here (try to guess class from messages sent to it) ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   597
            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   598
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   599
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   600
        m := nonMetaClass responseTo:#initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   601
        (m notNil and:[ m messagesSent size == 0 ]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   602
            "/ inherits an empty initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   603
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   604
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   605
    "/ super initialize.   -- commented since inherited method does nothing
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   606
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   607
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   608
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   609
    super initialize.  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   610
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   611
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   612
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   613
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   614
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   615
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   616
            inCategory:#initialization.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   617
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   618
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   619
    (metaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   620
        m := metaClass responseTo:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   621
        (m isNil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   622
        or:[ (Dialog confirmWithCancel:'The ',selector,'- method is already inherited. Redefine ?' onCancel:[^ self]) ])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   623
        ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   624
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   625
dfn,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   626
    "Create & return a new instance for arg."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   627
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   628
    ^ self basicNew initialize',dfn asUppercaseFirst,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   629
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   630
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   631
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   632
                forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   633
                inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   634
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   635
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   636
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   637
    self executeCollectedChangesNamed:('Add Parametrized Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   638
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   639
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   640
createPoolInitializationCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   641
    |nonMetaClass metaClass className poolVars initCode|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   642
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   643
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   644
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   645
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   646
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   647
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   648
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   649
    poolVars := nonMetaClass classVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   650
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   651
    initCode := WriteStream on: String new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   652
    initCode nextPutLine:'initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   653
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   654
    poolVars do:[:eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   655
        |oldValue thisValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   656
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   657
        oldValue := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   658
        oldValue notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   659
            thisValue := oldValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   660
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   661
            thisValue := nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   662
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   663
        initCode 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   664
            nextPutAll:'    ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   665
            nextPutAll:eachVariableName;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   666
            nextPutAll:' := ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   667
            nextPutAll:thisValue storeString;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   668
            nextPutLine:'.'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   669
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   670
    initCode cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   671
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   672
    initCode nextPutLine:'     ',className, ' initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   673
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   674
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   675
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   676
        compile:(initCode contents)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   677
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   678
        inCategory:#'class initialization'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   679
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   680
    self executeCollectedChangesNamed:('Generate Pool Initialization Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   681
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   682
    aClass initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   683
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   684
    "Created: / 25-10-2006 / 09:28:40 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   685
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   686
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   687
createRedefinedInstanceCreationMethodsIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   688
    "create a redefined #new methods"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   689
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   690
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   691
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   692
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   693
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   694
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   695
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   696
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   697
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   698
    (metaClass includesSelector:#'new') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   699
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   700
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   701
    ^ super new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   702
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   703
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   704
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   705
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   706
            inCategory:#'redefined instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   707
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   708
    (metaClass includesSelector:#'new:') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   709
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   710
'new:n
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   711
    ^ super new:n.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   712
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   713
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   714
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   715
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   716
            inCategory:#'redefined instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   717
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   718
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   719
    self executeCollectedChangesNamed:('Redefined Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   720
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   721
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   722
createSingletonPatternInstanceCreationMethodsIn:aClass usingVariable:varName
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   723
    "create redefined #new methods for singleton pattern.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   724
     Uses varName (typically a class-instvar) to keep the singleton instance."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   725
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   726
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   727
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   728
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   729
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   730
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   731
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   732
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   733
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   734
    (metaClass includesSelector:#theOneAndOnlyInstance) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   735
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   736
'theOneAndOnlyInstance
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   737
    "returns a singleton"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   738
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   739
    %1 isNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   740
        %1 := self basicNew initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   741
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   742
    ^ %1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   743
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   744
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   745
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   746
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   747
            inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   748
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   749
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   750
    (metaClass includesSelector:#new) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   751
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   752
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   753
    "returns a singleton"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   754
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   755
    ^ self theOneAndOnlyInstance.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   756
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   757
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   758
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   759
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   760
            inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   761
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   762
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   763
   (metaClass includesSelector:#flushSingleton) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   764
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   765
'flushSingleton
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   766
    "flushes the cached singleton"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   767
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   768
    %1 := nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   769
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   770
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   771
     self flushSingleton
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   772
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   773
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   774
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   775
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   776
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   777
            inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   778
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   779
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   780
    self executeCollectedChangesNamed:('Singleton Pattern for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   781
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   782
    "Created: / 10-02-2011 / 16:32:48 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   783
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   784
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   785
createStandardPrintOnMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   786
    "create a #printOn: method (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   787
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   788
    |code nonMetaClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   789
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   790
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   791
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   792
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   793
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   794
    (nonMetaClass includesSelector:#printOn:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   795
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   796
'printOn:aStream
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   797
    "append a printed representation if the receiver to the argument, aStream"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   798
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   799
    super printOn:aStream.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   800
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   801
        nonMetaClass instVarNames do:[:eachInstVarName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   802
            code := code , '    '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   803
            code := code , 'aStream nextPutAll:'''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   804
            code := code , eachInstVarName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   805
            code := code , ': ''.' , Character cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   806
            code := code , '    '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   807
            code := code , eachInstVarName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   808
            code := code , ' printOn:aStream.' , Character cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   809
        
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   810
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   811
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   812
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   813
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   814
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   815
            inCategory:#'printing & storing'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   816
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   817
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   818
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   819
    self executeCollectedChangesNamed:('Add #printOn: to ' , nonMetaClass name).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   820
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   821
    "Created: / 11.10.2001 / 22:18:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   822
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   823
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   824
createStartupCodeFor:aClass forStartOf:anApplicationClassOrNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   825
    "create startup code (main)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   826
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   827
    |nonMetaClass metaClass className source 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   828
     hasAplicationClass anApplicationClassNameOrStartupClassName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   829
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   830
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   831
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   832
    hasAplicationClass := anApplicationClassOrNil notNil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   833
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   834
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   835
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   836
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   837
    (metaClass includesSelector:#main:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   838
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   839
        source := String streamContents:[:stream |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   840
            stream nextPutAll: 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   841
'main:argv
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   842
    self verboseInfo:''starting %1''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   843
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   844
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   845
            hasAplicationClass ifTrue: [
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   846
                stream nextPutAll: 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   847
'    Smalltalk openDisplay.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   848
    Display notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   849
        Display exitOnLastClose:true.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   850
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   851
    %1 open.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   852
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   853
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   854
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   855
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   856
        anApplicationClassNameOrStartupClassName := hasAplicationClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   857
            ifTrue: [anApplicationClassOrNil name]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   858
            ifFalse: [className.].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   859
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   860
            compile:(source bindWith:anApplicationClassNameOrStartupClassName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   861
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   862
            inCategory:#startup.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   863
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   864
    self executeCollectedChangesNamed:('Add Startup Code to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   865
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   866
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   867
createTestCaseSampleCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   868
    "create an (almost) empty testCase class"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   869
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   870
    |nonMetaClass metaClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   871
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   872
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   873
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   874
    "/ className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   875
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   876
    ( nonMetaClass includesSelector:#test1 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   877
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   878
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   879
'test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   880
    "This is a demonstration testCase - it is meant to be removed eventually.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   881
     This testCase will PASS.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   882
     Double click on the TestCase class or open a TestRunner to see me checking...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   883
     - please add more methods like this..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   884
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   885
    |o|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   886
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   887
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   888
    self assert: ( o size == 2 ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   889
    self should: [ o at:0 ] raise:Error.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   890
    self shouldnt: [ o at:1 ] raise:Error.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   891
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   892
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   893
     self run:#test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   894
     self new test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   895
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   896
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   897
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   898
            inCategory:#tests.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   899
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   900
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   901
    ( nonMetaClass includesSelector:#test2 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   902
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   903
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   904
'test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   905
    "This is a demonstration testCase - it is meant to be removed eventually..
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   906
     This testCase WILL FAIL.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   907
     Double click on the TestCase class or open a TestRunner to see me checking...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   908
     - please add more methods like this..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   909
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   910
    |o|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   911
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   912
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   913
    self assert: ( o size == 3 ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   914
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   915
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   916
     self run:#test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   917
     self new test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   918
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   919
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   920
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   921
            inCategory:#tests.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   922
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   923
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   924
    ( nonMetaClass includesSelector:#test3 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   925
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   926
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   927
'test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   928
    "This is a demonstration testCase - it is meant to be removed eventually..
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   929
     This testCase WILL generate an ERROR.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   930
     Double click on the TestCase class or open a TestRunner to see me checking...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   931
     - please add more methods like this..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   932
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   933
    |o|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   934
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   935
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   936
    self assert: ( o foo ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   937
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   938
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   939
     self run:#test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   940
     self new test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   941
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   942
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   943
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   944
            inCategory:#tests.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   945
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   946
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   947
    ( nonMetaClass includesSelector:#setUp ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   948
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   949
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   950
'setUp
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   951
    "common setup - invoked before testing."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   952
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   953
    super setUp
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   954
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   955
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   956
            inCategory:#'initialize / release'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   957
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   958
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   959
    ( nonMetaClass includesSelector:#tearDown ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   960
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   961
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   962
'tearDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   963
    "common cleanup - invoked after testing."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   964
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   965
    super tearDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   966
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   967
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   968
            inCategory:#'initialize / release'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   969
    ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   970
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   971
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   972
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   973
    "create acceptVisitor: in visitedClass and acceptXXX in visitorClass. (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   974
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   975
    |sel|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   976
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   977
    self assert:( visitedClass isMeta not ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   978
    self assert:( visitorClass isMeta not ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   979
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   980
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   981
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   982
    sel := ('visit' , visitedClass nameWithoutPrefix , ':').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   983
    self createAcceptVisitorMethod:sel in:visitedClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   984
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   985
    (visitorClass includesSelector:sel) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   986
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   987
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   988
(('%1anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   989
    "dispatched back from the visited %2-object (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   990
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   991
    "fall back to general object-case - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   992
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   993
    ^ self visitObject:anObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   994
') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   995
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   996
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   997
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   998
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   999
    (visitorClass includesSelector:#visitObject:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1000
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1001
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1002
('visitObject:anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1003
    "dispatched back from the visited objects (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1004
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1005
    "general fallBack - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1006
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1007
    self halt:''not yet implemented''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1008
')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1009
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1010
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1011
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1012
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1013
    (visitorClass includesSelector:#visit:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1014
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1015
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1016
('visit:anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1017
    "visit anObject (visitor pattern).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1018
     The object should call back one of my visitXXXX methods."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1019
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1020
    ^ anObject acceptVisitor:self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1021
')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1022
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1023
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1024
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1025
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1026
    self executeCollectedChangesNamed:('Add Visitor Pattern').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1027
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1028
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1029
createWebApplicationCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1030
    "create an empty webApplication framework"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1031
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1032
    |nonMetaClass metaClass className txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1033
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1034
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1035
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1036
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1037
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1038
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1039
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1040
    (metaClass includesSelector:#pageSpec) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1041
        txt := self class initialPageSpecMethodSourceForWebApplications.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1042
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1043
            compile:(txt bindWith:className)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1044
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1045
            inCategory:#'page specs'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1046
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1047
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1048
    self executeCollectedChangesNamed:('Add WebApplication Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1049
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1050
    "Modified: / 1.2.1998 / 16:10:03 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1051
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1052
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1053
createWebServiceCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1054
    "create an empty webService framework"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1055
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1056
    |nonMetaClass metaClass className txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1057
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1058
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1059
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1060
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1061
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1062
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1063
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1064
    (nonMetaClass includesSelector:#page1:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1065
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1066
'page1:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1067
    "This is a sample page-generation method. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1068
     This uses the simplest possible way to generate html: generating plain HTML. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1069
     See page2 for a more structured example."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1070
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1071
    |response|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1072
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1073
    response := aRequest response.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1074
    response nextPutLine:''<HTML>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1075
    response nextPutLine:''  <HEAD>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1076
    response nextPutLine:''  <TITLE>Hello</TITLE>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1077
    response nextPutLine:''  </HEAD>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1078
    response nextPutLine:''  <BODY>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1079
    response nextPutLine:''    <H1>Hello World !!</H1>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1080
    response nextPutLine:''  </BODY>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1081
    response nextPutLine:''</HTML>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1082
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1083
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1084
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1085
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1086
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1087
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1088
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1089
    (nonMetaClass includesSelector:#page2:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1090
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1091
'page2:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1092
    "This is a sample page-generation method. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1093
     This uses a slightly more convenient way to generate html: using an HTML tree builder. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1094
     Event better examples to follow..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1095
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1096
    |page|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1097
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1098
    page := HTML::TreeBuilder newDocument.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1099
    page
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1100
        head;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1101
            title:''Hello'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1102
        headEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1103
        body;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1104
            h1:''Hello World'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1105
            div;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1106
                nlsText:''here is some text and '';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1107
                a; href:''page3''; 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1108
                    text:''an anchor'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1109
                aEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1110
                text:'' and an image: '';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1111
                img:(httpServer graphicLinkIdFor:(ToolbarIconLibrary smiley_cool) expirationTimeDelta:30 seconds);
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1112
            divEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1113
        bodyEnd.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1114
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1115
    aRequest reply:(page htmlString).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1116
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1117
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1118
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1119
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1120
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1121
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1122
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1123
    (nonMetaClass includesSelector:#page3:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1124
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1125
'page3:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1126
    "This is a sample page which generates plain text (i.e. nit html)."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1127
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1128
    aRequest response
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1129
        contentType:''text/plain'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1130
        data:''This is some plain text,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1131
without any html formatting.''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1132
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1133
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1134
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1135
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1136
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1137
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1138
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1139
    (nonMetaClass includesSelector:#process:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1140
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1141
'process:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1142
    "This is the web services main processing method.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1143
     It will be invoked for every incoming webBrowser-request.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1144
     The argument, aRequest contains the parameters (url, fields, parameters etc.); browse HTTPRequest for details.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1145
     Its response object collects any returned html or other contents. Browse HTTPResponse for more info.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1146
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1147
     Here, a simple dipatch method is used: a hardcoded switch on the URL..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1148
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1149
    |whichPage methodName method|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1150
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1151
    whichPage := aRequest pathRelativeToService.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1152
    whichPage isEmpty ifTrue:[ whichPage := ''page1'' ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1153
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1154
    "/ to prevent intruders from calling any method, check if it one
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1155
    "/ of my own methods, which is marked as a PAGE-method.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1156
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1157
    methodName := (whichPage,'':'') asSymbol.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1158
    method := self class compiledMethodAt:methodName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1159
    "/ is there such a method ?
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1160
    method notNil ifTrue:[                                 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1161
        "/ and it is marked as being a WebPage-generator ?
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1162
        (method hasResource:#''PAGE'') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1163
            self perform:methodName with:aRequest.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1164
            ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1165
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1166
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1167
    aRequest reportNotFound:''No such page in this service''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1168
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1169
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1170
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1171
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1172
            inCategory:#'response generation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1173
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1174
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1175
    (metaClass includesSelector:#linkName) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1176
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1177
'linkName
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1178
    "return the default linkName path (with slash)."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1179
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1180
    ^ ''/NewService''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1181
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1182
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1183
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1184
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1185
            inCategory:#defaults.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1186
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1187
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1188
    (metaClass includesSelector:#settingsApplicationClass) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1189
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1190
'settingsApplicationClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1191
    "a SettingsApplication class - or nil (used in the settings dialog if non-nil)."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1192
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1193
    ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1194
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1195
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1196
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1197
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1198
            inCategory:#defaults.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1199
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1200
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1201
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1202
    self executeCollectedChangesNamed:('Add WebService Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1203
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1204
    "Modified: / 02-06-2011 / 12:51:15 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1205
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1206
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1207
createWidgetCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1208
    "create usually required widget code (redraw, model update, event handling)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1209
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1210
    |nonMetaClass metaClass className compileTemplateAction|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1211
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1212
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1213
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1214
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1215
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1216
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1217
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1218
    compileTemplateAction := 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1219
        [:selector :templateSelector :category |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1220
            (nonMetaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1221
                |txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1222
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1223
                txt := self perform:templateSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1224
                self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1225
                    compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1226
                    forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1227
                    inCategory:category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1228
            ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1229
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1230
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1231
    #(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1232
        initialize               code_forWidget_initialize  #'initialization & release'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1233
        update:with:from:        code_forWidget_update      #'change & update'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1234
        redrawX:y:width:height:  code_forWidget_redraw      #'drawing'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1235
        buttonPress:x:y:         code_forWidget_buttonPress #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1236
        keyPress:x:y:            code_forWidget_keyPress    #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1237
        sizeChanged:             code_forWidget_sizeChanged #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1238
    ) inGroupsOf:3 do:compileTemplateAction.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1239
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1240
    self executeCollectedChangesNamed:('Add Widget Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1241
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1242
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1243
!JavaScriptCodeGeneratorTool methodsFor:'code generation-basic'!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1244
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1245
createAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange asValueHolder:asValueHolder readersOnly:readersOnly writersOnly:writersOnly lazyInitialization:lazyInitialization
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1246
    "workhorse for creating access methods for instvars."
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1247
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1248
    |classesClassVars generateCommentsForSetters generateCommentsForGetters|
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1249
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1250
    self startCollectChanges.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1251
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1252
    generateCommentsForSetters := userPreferences generateCommentsForSetters.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1253
    generateCommentsForGetters := userPreferences generateCommentsForGetters.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1254
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1255
    classesClassVars := aClass theNonMetaclass allClassVarNames.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1256
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1257
    aCollectionOfVarNames do:[:name |
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1258
        |source varType methodName defaultMethodName argName|
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1259
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1260
        varType := (classesClassVars includes:name) 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1261
                        ifTrue:['static'] 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1262
                        ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1263
                            (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1264
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1265
        methodName := name.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1266
        name isUppercaseFirst ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1267
            methodName := methodName asLowercaseFirst. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1268
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1269
        argName := 'something'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1270
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1271
        "/ the GETTER
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1272
        writersOnly ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1273
            lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1274
                defaultMethodName := 'default' , name asUppercaseFirst.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1275
            ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1276
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1277
            "check, if method is not already present"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1278
            (aClass includesSelector:(methodName asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1279
                asValueHolder ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1280
                    source := methodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1281
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1282
                        source := source , '    // return/create the ''%2'' value holder (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1283
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1284
                    source := source , '    if (%2 == null) {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1285
                    lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1286
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1287
                                   , '        %2 = this.class.%3.asValue;\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1288
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1289
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1290
                                   , '        %2 = new ValueHolder;\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1291
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1292
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1293
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1294
                    source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1295
                               , '        %2.addDependent(this);\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1296
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1297
                    source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1298
                               , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1299
                               , '    return %2;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1300
                               , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1301
                ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1302
                    source := methodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1303
                    lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1304
                        generateCommentsForGetters ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1305
                            source := source , '    // return the %1 instance variable ''%2'' with lazy instance creation (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1306
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1307
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1308
                                    , '    if (%2 == null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1309
                                    , '        %2 = self.class.%3;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1310
                                    , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1311
                                    , '    return %2;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1312
                                    , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1313
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1314
                        generateCommentsForGetters ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1315
                            source := source , '    // return the %1 instance variable ''%2'' (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1316
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1317
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1318
                                    , '    return %2;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1319
                                    , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1320
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1321
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1322
                source := (source bindWith:varType with:name with:defaultMethodName) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1323
                self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1324
            ] ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1325
                Transcript showCR:'method ''', methodName , ''' already present'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1326
            ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1327
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1328
            "/ default for lazy on class side
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1329
            lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1330
                (aClass theMetaclass includesSelector:(defaultMethodName asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1331
                    source := defaultMethodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1332
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1333
                        source := source , '    // default value for the ''%2'' instance variable (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1334
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1335
                    source := source    
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1336
                               , '    this.shouldImplement();\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1337
                               , '    return null;\';
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1338
                               , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1339
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1340
                    source := (source bindWith:varType with:name) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1341
                    self compile:source forClass:aClass theMetaclass inCategory:'defaults'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1342
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1343
            ].                                       
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1344
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1345
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1346
        "/ the SETTER
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1347
        readersOnly ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1348
            (aClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1349
                ((methodName size > 2) and:[ (methodName startsWith:'is') and:[ (methodName at:3) isUppercase ]])
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1350
                ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1351
                    argName := 'aBoolean'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1352
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1353
                asValueHolder ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1354
                    source := methodName , '(%3) {\'.  "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1355
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1356
                        source := source , '    // set the ''%2'' value holder' , ' (automatically generated)\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1357
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1358
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1359
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1360
                                  , '    var oldValue, newValue;\\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1361
                                  , '    if (%2 !!= null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1362
                                  , '        oldValue = %2.value;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1363
                                  , '        %2.removeDependent(this);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1364
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1365
                                  , '    %2 = %3;\'        "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1366
                                  , '    if (%2 !!= null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1367
                                  , '        %2.addDependent(self);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1368
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1369
                                  , '    newValue = %2.value;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1370
                                  , '    if (oldValue !!== newValue) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1371
                                  , '        this.update_with_from("value".asSymbol(), newValue, %2);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1372
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1373
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1374
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1375
                        source := source 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1376
                                  , '    %2 = %3;\'  "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1377
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1378
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1379
                ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1380
                    source := methodName , '(%3) {\'.    "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1381
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1382
                        generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1383
                            source := source , '    // set the value of the %1 variable ''%2''\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1384
                            source := source , '    // and send a change notification (automatically generated)\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1385
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1386
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1387
                                  , '    if (%2 !!== %3) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1388
                                  , '        %2 = %3;\'           "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1389
                                  , '        this.changed("%2".asSymbol);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1390
                                  , '     };\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1391
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1392
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1393
                        generateCommentsForSetters ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1394
                            source := source , '    // set the value of the %1 variable ''%2''\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1395
                            source := source , '    // (automatically generated)"\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1396
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1397
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1398
                                  , '    %2 = %3;\'          "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1399
                                 , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1400
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1401
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1402
                source := (source bindWith:varType with:name with:argName) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1403
                self 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1404
                    compile:source 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1405
                    forClass:aClass 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1406
                    inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1407
            ] ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1408
                Transcript showCR:'method ''', methodName , ':'' already present'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1409
            ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1410
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1411
    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1412
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1413
    self executeCollectedChangesNamed:('Add Accessors').
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1414
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1415
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1416
createCollectionAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1417
    |classesClassVars|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1418
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1419
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1420
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1421
    classesClassVars := aClass theNonMetaclass allClassVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1422
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1423
    aCollectionOfVarNames do:[:name |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1424
        |source varType methodNameBase methodName defaultMethodName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1425
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1426
        varType := (classesClassVars includes:name) 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1427
                        ifTrue:['static'] 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1428
                        ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1429
                            (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1430
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1431
        methodNameBase := name asUppercaseFirst.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1432
        (methodNameBase endsWith:'s') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1433
            methodNameBase := methodNameBase copyWithoutLast:1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1434
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1435
        methodName := 'add' , methodNameBase, ':'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1436
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1437
        "check, if method is not already present"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1438
        (aClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1439
            source := methodName , 'a%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1440
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1441
                source := source , '    "add a ',methodNameBase,'"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1442
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1443
            source := source , '    %2 isNil ifTrue:[\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1444
                source := source
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1445
                           , '        %2 := OrderedCollection new.\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1446
            source := source
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1447
                       , '    ].\'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1448
                       , '    %2 add: a%1'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1449
            source := (source bindWith:methodNameBase with:name) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1450
            self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1451
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1452
            Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1453
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1454
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1455
        methodName := 'remove' , methodNameBase, ':'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1456
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1457
        "check, if method is not already present"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1458
        (aClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1459
            source := methodName , 'a%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1460
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1461
                source := source , '    "remove a ',methodNameBase,'"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1462
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1463
            source := source
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1464
                       , '    %2 remove: a%1'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1465
            source := (source bindWith:methodNameBase with:name) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1466
            self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1467
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1468
            Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1469
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1470
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1471
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1472
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1473
        createAccessMethodsFor:aCollectionOfVarNames 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1474
        in:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1475
        withChange:withChange 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1476
        asValueHolder:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1477
        readersOnly:true
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1478
        writersOnly:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1479
        lazyInitialization:false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1480
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1481
    self executeCollectedChangesNamed:('Add Collection Access').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1482
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1483
    "Created: / 04-02-2007 / 15:52:31 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1484
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1485
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1486
createValueHoldersFor:aCollectionOfVarNames in:aClass lazyInitialization:lazyInitialization
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1487
    "workhorse for creating access methods for instvars."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1488
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1489
    |nonMetaClass metaClass classesClassVars generateCommentsForSetters generateCommentsForGetters|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1490
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1491
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1492
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1493
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1494
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1495
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1496
    generateCommentsForSetters := userPreferences generateCommentsForSetters.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1497
    generateCommentsForGetters := userPreferences generateCommentsForGetters.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1498
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1499
    classesClassVars := nonMetaClass allClassVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1500
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1501
    aCollectionOfVarNames do:[:name |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1502
        |source varType methodName holderMethodName defaultMethodName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1503
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1504
        holderMethodName := name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1505
        name isUppercaseFirst ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1506
            holderMethodName := holderMethodName asLowercaseFirst. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1507
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1508
        (holderMethodName endsWith:'Holder') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1509
            methodName := holderMethodName copyWithoutLast:6.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1510
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1511
            methodName := holderMethodName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1512
            holderMethodName := methodName , 'Holder'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1513
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1514
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1515
        methodName notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1516
            (metaClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1517
                source := '%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1518
                generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1519
                    source := source , '    "return the value in ''%2''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1520
                ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1521
                source := source , '    ^ self %2 value'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1522
                source := (source bindWith:methodName with:holderMethodName) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1523
                self compile:source forClass:nonMetaClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1524
            ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1525
                Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1526
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1527
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1528
            (metaClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1529
                source := '%1: newValue\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1530
                generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1531
                    source := source , '    "set the value in ''%2''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1532
                ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1533
                source := source , '    self %2 value: newValue'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1534
                source := (source bindWith:methodName with:holderMethodName) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1535
                self compile:source forClass:nonMetaClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1536
            ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1537
                Transcript showCR:'method ''', methodName , ':'' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1538
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1539
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1540
        (metaClass includesSelector:(holderMethodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1541
            source := '%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1542
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1543
                source := source , '    "return/create the valueHolder ''%1''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1544
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1545
            source := source , '    %1 isNil ifTrue:[\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1546
            source := source , '        %1 := ValueHolder with:nil "defaultValue here".\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1547
            source := source , '    ].\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1548
            source := source , '    ^ %1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1549
            source := (source bindWith:holderMethodName) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1550
            self compile:source forClass:nonMetaClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1551
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1552
            Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1553
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1554
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1555
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1556
    self executeCollectedChangesNamed:('Add ValueHolder').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1557
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1558
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1559
!JavaScriptCodeGeneratorTool methodsFor:'code generation-individual methods'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1560
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1561
createAcceptVisitorMethod:selector in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1562
    "create an acceptVisitor: method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1563
     (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1564
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1565
    self assert:( aClass isMeta not ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1566
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1567
    (aClass includesSelector:#'acceptVisitor:') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1568
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1569
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1570
(('acceptVisitor:aVisitor 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1571
    "Double dispatch back to the visitor, passing my type encoded in
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1572
     the selector (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1573
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1574
    "stub code automatically generated - please change if required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1575
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1576
    ^ aVisitor %1self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1577
') bindWith:selector)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1578
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1579
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1580
    ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1581
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1582
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1583
createAcceptVisitorMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1584
    "create an acceptVisitor: method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1585
     (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1586
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1587
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1588
        createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1589
        in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1590
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1591
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1592
createCopyrightMethodFor:copyRightText for:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1593
    "add copyright method containing text,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1594
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1595
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1596
    |txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1597
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1598
    (aClass includesSelector:#copyright) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1599
        copyRightText notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1600
            txt := copyRightText bindWith:(Date today year).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1601
            self compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1602
'copyright
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1603
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1604
' , txt , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1605
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1606
'             forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1607
              inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1608
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1609
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1610
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1611
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1612
createDocumentationMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1613
    "add documentation method containing doc template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1614
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1615
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1616
    |metaClass nonMetaClass userName loginName hostName emailAddress code existingComment|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1617
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1618
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1619
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1620
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1621
    (metaClass includesSelector:#documentation) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1622
        existingComment := nonMetaClass comment.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1623
        existingComment isEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1624
            (nonMetaClass isSubclassOf:HTTPService) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1625
                existingComment := '    [start Server with:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1626
        HTTPServer startServerOnPort:8080
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1627
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1628
    [start with:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1629
        (self new)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1630
            registerServiceOn:(HTTPServer runningServerOnPort:8080)'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1631
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1632
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1633
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1634
        userName := OperatingSystem getFullUserName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1635
        loginName := OperatingSystem getLoginName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1636
        hostName := OperatingSystem getHostName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1637
        emailAddress := loginName , '@' , hostName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1638
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1639
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1640
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1641
        "/ ugly; should ask the class for that    
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1642
        metaClass isJavaScriptMetaclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1643
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1644
'function documentation() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1645
/*
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1646
' , (existingComment ? '    documentation to be added.') , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1647
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1648
    [author:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1649
        ' ", userName 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1650
          , ' (' , emailAddress , ')' "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1651
        , UserPreferences current historyManagerSignature , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1652
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1653
    [instance variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1654
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1655
    [class variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1656
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1657
    [see also:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1658
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1659
*/
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1660
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1661
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1662
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1663
            code:= 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1664
'documentation
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1665
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1666
' , (existingComment ? '    documentation to be added.') , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1667
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1668
    [author:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1669
        ' ", userName 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1670
          , ' (' , emailAddress , ')' "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1671
        , UserPreferences current historyManagerSignature , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1672
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1673
    [instance variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1674
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1675
    [class variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1676
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1677
    [see also:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1678
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1679
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1680
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1681
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1682
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1683
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1684
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1685
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1686
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1687
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1688
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1689
    "Modified: / 24-11-2006 / 15:54:27 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1690
    "Modified: / 04-02-2011 / 08:24:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1691
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1692
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1693
createExamplesMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1694
    "add examples method containing examples template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1695
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1696
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1697
    |nonMetaclass fragment|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1698
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1699
    nonMetaclass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1700
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1701
    (nonMetaclass isSubclassOf:View) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1702
        self createExamplesMethodForViewClass:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1703
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1704
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1705
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1706
    (nonMetaclass isSubclassOf:ApplicationModel) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1707
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1708
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1709
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1710
    (aClass includesSelector:#examples) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1711
        (nonMetaclass isSubclassOf:ApplicationModel) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1712
            fragment := '  Starting the application:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1713
                                                                [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1714
    ' , nonMetaclass name , ' open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1715
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1716
                                                                [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1717
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1718
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1719
            fragment := ''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1720
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1721
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1722
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1723
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1724
'examples
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1725
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1726
' , fragment , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1727
  more examples to be added:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1728
                                                                [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1729
    ... add code fragment for 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1730
    ... executable example here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1731
                                                                [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1732
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1733
'                   
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1734
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1735
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1736
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1737
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1738
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1739
createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1740
    |imageStoreStream mthd imageKey category|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1741
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1742
    anImage storeOn: (imageStoreStream := WriteStream on: '').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1743
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1744
    "/ if that method already exists, do not overwrite the category
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1745
    category := #'image specs'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1746
    (mthd := aClass compiledMethodAt:sel) notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1747
        category := mthd category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1748
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1749
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1750
    imageKey :=  aClass theNonMetaclass name, ' ', sel.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1751
    Icon constantNamed: imageKey put:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1752
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1753
        compile: ((sel,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1754
            '\', comment,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1755
            '\\' , 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1756
            '    "\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1757
            '     self ' , sel , ' inspect\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1758
            '     ImageEditor openOnClass:self andSelector:#', sel, '\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1759
            '     Icon flushCachedIcons', 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1760
            '\    "',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1761
            '\\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1762
            '    <resource: #image>',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1763
            '\\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1764
            '    ^Icon\') withCRs, 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1765
            '        constantNamed:''', imageKey, '''\' withCRs,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1766
            '        ifAbsentPut:[', imageStoreStream contents, ']')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1767
        forClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1768
        inCategory: category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1769
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1770
    "Modified: / 01-07-2011 / 12:31:12 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1771
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1772
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1773
createInitialHistoryMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1774
    "add history method containing created-entry
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1775
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1776
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1777
    |code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1778
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1779
    (aClass includesSelector:#history) ifFalse:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1780
        HistoryManager notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1781
            code := HistoryManager codeForInitialHistoryMethodIn:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1782
            self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1783
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1784
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1785
                inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1786
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1787
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1788
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1789
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1790
createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1791
    "add an inst-creation method"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1792
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1793
    |template instMthd argNames|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1794
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1795
    (aMetaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1796
        instMthd := aMetaClass theNonMetaclass compiledMethodAt:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1797
        (instMthd notNil     
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1798
        and:[  (argNames := instMthd methodArgNames) notEmptyOrNil ])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1799
        ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1800
            template := Parser methodSpecificationForSelector:selector argNames:argNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1801
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1802
            template := Parser methodSpecificationForSelector:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1803
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1804
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1805
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1806
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1807
template , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1808
    ^ self new ' , template , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1809
'                   
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1810
            forClass:aMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1811
            inCategory:category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1812
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1813
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1814
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1815
createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1816
    "create a multi-setter method for instvars."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1817
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1818
    |source|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1819
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1820
    source := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1821
    aCollectionOfVarNames do:[:eachVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1822
        source := source , (eachVar , ':' , eachVar , 'Arg ').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1823
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1824
    source := source , Character cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1825
    (userPreferences generateCommentsForSetters) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1826
        source := source , ('    "set instance variables"' , Character cr , Character cr).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1827
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1828
    aCollectionOfVarNames do:[:eachVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1829
        source := source , ('    ' , eachVar , ' := ' , eachVar , 'Arg.' , Character cr).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1830
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1831
    self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1832
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1833
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1834
createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1835
    "add a subclassResponsibility method;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1836
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1837
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1838
    (aClass includesSelector:aSelector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1839
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1840
        self compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1841
(Method methodDefinitionTemplateForSelector:aSelector) ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1842
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1843
    "raise an error: must be redefined in concrete subclass(es)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1844
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1845
    ^ self subclassResponsibility
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1846
' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1847
              forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1848
              inCategory:cat.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1849
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1850
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1851
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1852
createUpdateMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1853
    "create an update:with:from:-method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1854
     (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1855
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1856
    |code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1857
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1858
    (aClass includesSelector:#update:with:from:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1859
        generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1860
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1861
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1862
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1863
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1864
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1865
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1866
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1867
    "Invoked when an object that I depend upon sends a change notification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1868
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1869
    "stub code automatically generated - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1870
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1871
    "/ changedObject == someOfMyValueHolders ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1872
    "/     self doSomethingApropriate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1873
    "/     ^ self.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1874
    "/ ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1875
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1876
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1877
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1878
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1879
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1880
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1881
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1882
            inCategory:#'change & update'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1883
    ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1884
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1885
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1886
createVersionMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1887
    <resource: #obsolete>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1888
    "add a version method containing RCS template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1889
     but only if not already present and it's not a private class."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1890
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1891
    |code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1892
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1893
    self obsoleteMethodWarning.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1894
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1895
    aClass isPrivate ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1896
        (aClass includesSelector:#version) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1897
            code := aClass programmingLanguage versionMethodTemplateForCVS.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1898
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1899
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1900
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1901
                inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1902
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1903
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1904
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1905
    "Modified (comment): / 21-08-2012 / 11:54:57 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1906
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1907
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1908
!JavaScriptCodeGeneratorTool methodsFor:'code templates'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1909
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1910
anyApplicationClassInProjectOf:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1911
    |prjDefinition|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1912
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1913
    prjDefinition := aClass projectDefinitionClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1914
    prjDefinition isNil ifTrue:[ ^ nil ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1915
    ^ (prjDefinition allClasses 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1916
        select:[:cls | cls isSubclassOf:ApplicationModel])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1917
            firstIfEmpty:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1918
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1919
    "Created: / 21-01-2012 / 13:24:12 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1920
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1921
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1922
codeFor_classInitialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1923
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1924
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1925
'function initialize() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1926
%(INIT_CLASSINSTVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1927
%(INIT_CLASSVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1928
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1929
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1930
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1931
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1932
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1933
'function initialize() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1934
    // Invoked at system start or when the class is dynamically loaded.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1935
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1936
    // please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1937
%(INIT_CLASSINSTVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1938
%(INIT_CLASSVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1939
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1940
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1941
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1942
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1943
codeFor_closeAccept
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1944
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1945
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1946
'function closeAccept() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1947
    return super.closeAccept();
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1948
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1949
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1950
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1951
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1952
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1953
'function closeAccept() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1954
    // This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1955
    // It will be invoked when your dialog-window is closed with OK."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1956
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1957
    // add any actions as required here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1958
    Transcript.showCR("dialog accepted");
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1959
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1960
    // do not remove the one below (otherwise, the dialog will not close itself)...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1961
    return super.closeAccept();
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1962
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1963
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1964
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1965
    "Created: / 27-10-2006 / 10:03:31 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1966
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1967
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1968
codeFor_closeDownViews
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1969
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1970
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1971
'function closeDownViews() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1972
    ^ super closeDownViews
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1973
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1974
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1975
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1976
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1977
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1978
'function closeDownViews() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1979
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1980
     It will be invoked when your app/dialog-window is really closed.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1981
     See also #closeDownViews, which is invoked before and may suppress the close
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1982
     or ask the user for confirmation."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1983
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1984
    "/ change the code below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1985
    "/ This should cleanup any leftover resources
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1986
    "/ (for example, temporary files)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1987
    "/ super closeRequest will initiate the closeDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1988
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1989
    "/ add your code here
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1990
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1991
    "/ do not remove the one below ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1992
    ^ super closeDownViews
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1993
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1994
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1995
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1996
    "Created: / 27-10-2006 / 10:01:32 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1997
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1998
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1999
codeFor_closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2000
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2001
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2002
'closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2003
    self hasUnsavedChanges ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2004
        (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2005
            ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2006
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2007
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2008
    ^ super closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2009
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2010
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2011
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2012
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2013
'closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2014
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2015
     It will be invoked when your app/dialog-window is about to be
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2016
     closed (this method has a chance to suppress the close).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2017
     See also #closeDownViews, which is invoked when the close is really done."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2018
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2019
    "/ change the code below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2020
    "/ Closing can be suppressed, by simply returning.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2021
    "/ The ''super closeRequest'' at the end will initiate the real closeDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2022
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2023
    self hasUnsavedChanges ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2024
        (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2025
            ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2026
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2027
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2028
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2029
    ^ super closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2030
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2031
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2032
    "Created: / 27-10-2006 / 10:01:06 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2033
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2034
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2035
codeFor_emptyMenuActionCodeFor:selector menuItem:item
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2036
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2037
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2038
selector,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2039
    self warn:''no action for ''''',item,''''' defined.''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2040
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2041
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2042
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2043
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2044
selector,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2045
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2046
     It will be invoked when the menu-item ''',item,''' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2047
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2048
    "/ change below and add any actions as required here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2049
    self warn:''no action for ''''',item,''''' defined.''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2050
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2051
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2052
    "Created: / 27-10-2006 / 10:16:43 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2053
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2054
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2055
codeFor_hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2056
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2057
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2058
'hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2059
    ^ false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2060
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2061
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2062
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2063
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2064
'hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2065
    "Return true, if any unsaved changes are present 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2066
     (i.e. the contents needs to be saved or else will be lost)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2067
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2068
    "/ add real code as required (or remove the halt and always return false)...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2069
    "/ self halt:''check this code''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2070
    ^ false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2071
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2072
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2073
    "Created: / 27-10-2006 / 10:00:36 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2074
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2075
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2076
codeFor_menuSaveAs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2077
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2078
'menuSaveAs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2079
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2080
     It will be invoked when the menu-item ''saveAs'' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2081
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2082
    "/ change below as required... (see examples in Dialog class for more options)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2083
    Dialog
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2084
        requestSaveFileName:(resources string:''Save'') 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2085
        default:''foo.txt'' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2086
        fromDirectory:nil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2087
        action:[:fileName | self doSaveAs:fileName] 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2088
        appendAction:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2089
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2090
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2091
    "Created: / 27-10-2006 / 10:01:57 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2092
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2093
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2094
codeFor_openAboutThisApplication
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2095
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2096
'openAboutThisApplication
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2097
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2098
     It will be invoked when the menu-item ''help-about'' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2099
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2100
    "/ could open a customized aboutBox here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2101
    super openAboutThisApplication
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2102
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2103
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2104
    "Created: / 27-10-2006 / 10:03:13 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2105
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2106
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2107
codeFor_openDocumentation
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2108
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2109
'openDocumentation
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2110
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2111
     It will be invoked when the menu-item ''help-documentation'' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2112
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2113
    "/ change below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2114
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2115
    "/ to open an HTML viewer on some document (under ''doc/online/<language>/'' ):
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2116
    self openDocumentationFile:''TOP.html''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2117
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2118
    "/ add application-specific help files under the ''doc/online/<language>/help/appName''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2119
    "/ directory, and open a viewer with:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2120
    "/ self openDocumentationFile:''help/<MyApplication>/TOP.html''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2121
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2122
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2123
    "Created: / 27-10-2006 / 10:02:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2124
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2125
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2126
codeFor_postBuildWith
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2127
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2128
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2129
'postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2130
    ^ super postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2131
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2132
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2133
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2134
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2135
'postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2136
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2137
     It will be invoked during the initialization of your app/dialog,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2138
     after all of the visual components have been built, 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2139
     but BEFORE the top window is made visible.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2140
     Add any app-specific actions here (reading files, setting up values etc.)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2141
     See also #postOpenWith:, which is invoked after opening."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2142
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2143
    "/ add any code here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2144
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2145
    ^ super postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2146
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2147
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2148
    "Created: / 27-10-2006 / 09:59:33 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2149
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2150
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2151
codeFor_postOpenWith
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2152
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2153
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2154
'postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2155
    ^ super postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2156
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2157
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2158
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2159
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2160
'postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2161
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2162
     It will be invoked right after the applications window has been opened.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2163
     Add any app-specific actions here (starting background processes etc.).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2164
     See also #postBuildWith:, which is invoked before opening."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2165
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2166
    "/ add any code here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2167
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2168
    ^ super postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2169
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2170
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2171
    "Created: / 27-10-2006 / 09:59:56 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2172
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2173
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2174
codeFor_standAloneApplicationRegistryPathFor:aClassOrNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2175
    |pkg appClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2176
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2177
    pkg := 'someUniqueName'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2178
    aClassOrNil notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2179
        (appClass := self anyApplicationClassInProjectOf:aClassOrNil) notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2180
            pkg := appClass nameWithoutPrefix.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2181
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2182
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2183
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2184
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2185
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2186
'applicationRegistryPath
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2187
    ^ #(''stx'' ''%1'') 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2188
' bindWith:pkg.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2189
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2190
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2191
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2192
'applicationRegistryPath
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2193
    "the key under which this application stores its process ID in the registry
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2194
     as a collection of path-components.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2195
     i.e. if #(''foo'' ''bar'' ''baz'') is returned here, the current applications ID will be stored
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2196
     in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2197
     (would also be used as a relative path for a temporary lock file under unix).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2198
     Used to detect if another instance of this application is already running."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2199
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2200
    ^ #(''stx'' ''%1'')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2201
'  bindWith:pkg.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2202
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2203
    "Created: / 21-01-2012 / 11:23:40 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2204
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2205
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2206
codeFor_standAloneApplicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2207
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2208
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2209
'applicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2210
    ^ UUID fromString:''', UUID genUUID printString, ''' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2211
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2212
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2213
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2214
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2215
'applicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2216
    "answer an application-specific unique uuid.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2217
     This is used as the name of some exclusive OS-resource, which is used to find out,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2218
     if another instance of this application is already running.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2219
     Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2220
     If redefined, please return a real UUID (i.e. UUID fromString:''.....'') and not a string or 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2221
     similar possibly conflicting identifier.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2222
     You can paste a fresh worldwide unique id via the editor''s more-misc-paste UUID menuFunction."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2223
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2224
    ^ UUID fromString:''', UUID genUUID printString, ''' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2225
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2226
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2227
    "Created: / 19-08-2011 / 02:13:19 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2228
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2229
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2230
codeFor_standAloneMain
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2231
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2232
'main:argv
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2233
    "main entry; argv is the array of command arguments (as array of words from space-separated command line).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2234
     Parse arguments, and proceed to the real work function"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2235
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2236
    "you may want to put those into instvars, in order to be accessable from the doRealWork function"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2237
    |aArgs bArgs cOption fileArgs helpOption|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2238
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2239
    aArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2240
    bArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2241
    fileArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2242
    cOption := helpOption := false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2243
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2244
    (GetOpt new)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2245
        at:$a
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2246
            put:[:opt :arg | aArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2247
        at:$b
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2248
            put:[:opt :arg | bArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2249
        at:$b
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2250
            put:[:opt | cOption := true];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2251
        at:$h
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2252
            put:[:opt | helpOption := true];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2253
        at:$? 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2254
            put:[:arg | self usage. Smalltalk exit:0];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2255
        default:[:arg | fileArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2256
        parse:argv.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2257
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2258
    helpOption ifTrue:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2259
        self usage. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2260
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2261
        self realMain:argv.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2262
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2263
    "/ do not exit here; caller will go into event loop when returning
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2264
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2265
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2266
    "Created: / 19-08-2011 / 02:18:49 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2267
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2268
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2269
codeFor_standAloneRealMainMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2270
    |appClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2271
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2272
    (appClass := self anyApplicationClassInProjectOf:aClass) notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2273
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2274
'realMain:args
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2275
    "opens the application"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2276
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2277
    %1 open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2278
' bindWith:appClass name
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2279
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2280
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2281
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2282
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2283
'realMain:argsToEcho
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2284
    "just a dummy example - does nothing but echo its arguments"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2285
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2286
    Stdout nextPutLine:''Hello World''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2287
    Stdout nextPutLine:(argsToEcho asStringWith:Character space)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2288
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2289
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2290
    "Created: / 21-01-2012 / 12:28:48 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2291
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2292
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2293
codeFor_standAloneUsage
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2294
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2295
'usage
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2296
    Stderr nextPutLine:''usage: '',self applicationName,'' [options...]''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2297
    Stderr nextPutLine:''  -h .................. output this message''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2298
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2299
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2300
    "Created: / 19-08-2011 / 02:22:46 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2301
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2302
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2303
code_forWidget_buttonPress
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2304
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2305
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2306
'buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2307
    Transcript show:''button: ''; showCR:button.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2308
    super buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2309
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2310
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2311
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2312
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2313
'buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2314
    "called when a mouse-button is pressed. button is the button-nr (1 for left-button).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2315
     x/y are the mouse position at the time of the click.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2316
     There are also corresponding buttonRelease and buttonMotion methods which could be
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2317
     redefined...."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2318
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2319
    Transcript show:''button: ''; showCR:button.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2320
    "/ super-code handles middleButtonMenu, if it was assigned (with middleButtonmenu:)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2321
    super buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2322
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2323
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2324
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2325
code_forWidget_initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2326
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2327
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2328
    super initialize "/ to initialize inherited state
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2329
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2330
    "/ add code to initialize private variables,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2331
    "/ and sub-components as required.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2332
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2333
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2334
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2335
code_forWidget_keyPress
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2336
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2337
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2338
'keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2339
"/    key == #Copy ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2340
"/    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2341
"/    key == #Cut ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2342
"/    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2343
    Transcript show:''key: ''; showCR:key.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2344
    super keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2345
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2346
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2347
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2348
'keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2349
    "called when a keyboard-key was pressed. key is either a character (for ordinary keys)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2350
     or a symbol, such as #Copy, #Cut or #Paste.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2351
     x/y are the mouse position at the time of the key-press.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2352
     There is also a corresponding keyRelease method which could be redefined...."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2353
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2354
    Transcript show:''key: ''; showCR:key.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2355
    super keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2356
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2357
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2358
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2359
code_forWidget_redraw
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2360
    |sel comment code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2361
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2362
    sel := 'redrawX:x y:y width:w height:h'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2363
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2364
        comment := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2365
    ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2366
        comment := '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2367
    "called to redraw a part of the widgets area. x/y define the origin, w/h the size of
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2368
     that area. The clipping region has already been set by the caller, so even if the code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2369
     below draws outside the redraw-area, it will not affect what is on the screen. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2370
     Therefore, the example below can fill the rectangle in the redraw area, but still draw
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2371
     the cross in the outside regions."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2372
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2373
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2374
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2375
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2376
    code := '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2377
    self paint:Color red.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2378
    self fillRectangleX:x y:y width:w height:h.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2379
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2380
    self paint:Color yellow.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2381
    self displayLineFrom:0@0 to:(width@height).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2382
    self displayLineFrom:width@0 to:(0@height).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2383
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2384
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2385
    ^ sel,comment,code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2386
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2387
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2388
code_forWidget_sizeChanged
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2389
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2390
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2391
'sizeChanged:how
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2392
    self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2393
    super sizeChanged:how.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2394
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2395
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2396
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2397
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2398
'sizeChanged:how
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2399
    "Invoked whenever the size of the view changes. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2400
     Here, we force a full redraw, which might not be needed all the time"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2401
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2402
    self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2403
    super sizeChanged:how.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2404
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2405
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2406
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2407
code_forWidget_update
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2408
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2409
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2410
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2411
    changedObject == model ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2412
        self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2413
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2414
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2415
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2416
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2417
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2418
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2419
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2420
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2421
    "Invoked when an object that I depend upon sends a change notification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2422
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2423
    "stub code automatically generated - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2424
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2425
    changedObject == model ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2426
        self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2427
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2428
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2429
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2430
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2431
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2432
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2433
!JavaScriptCodeGeneratorTool methodsFor:'private'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2434
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2435
codeFor_shouldImplementFor:selector inClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2436
    "used in the 'generate required protocol' to generate a shouldImplement-sending
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2437
     method for each subclassClassresponsibility method above aClass."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2438
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2439
    |mthd comment implClass methodBodyStream searcher errorMessageString|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2440
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2441
    (aClass notNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2442
    and:[ aClass superclass notNil ]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2443
        implClass := aClass superclass whichClassImplements:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2444
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2445
    implClass isNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2446
        ^ ((Method methodDefinitionTemplateForSelector:selector),'\    ^ self shouldImplement\') withCRs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2447
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2448
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2449
    mthd := implClass compiledMethodAt:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2450
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2451
    methodBodyStream := '' writeStream.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2452
    methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2453
        nextPutAll:mthd methodDefinitionTemplate; cr;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2454
        nextPutAll:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2455
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2456
    "/ include the comment of the subclassResponsibility-sending method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2457
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2458
    comment := mthd methodComment.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2459
    comment isEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2460
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2461
            nextPutAll:('superclass <1s> says that I am responsible to implement this method'  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2462
                        expandMacrosWith:implClass name)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2463
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2464
        comment 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2465
            asStringCollection do:[:eachLine|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2466
                methodBodyStream nextPutAll:eachLine.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2467
            ] separatedBy:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2468
                methodBodyStream cr; nextPutAll:'     '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2469
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2470
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2471
    methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2472
        nextPut:$"; cr; cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2473
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2474
    "/ include the argument of the subclassResponsibility:-sending method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2475
    self canUseRefactoringSupport ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2476
        (mthd sends:#subclassResponsibility:) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2477
            searcher := ParseTreeSearcher new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2478
            searcher
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2479
                    matches: 'self subclassResponsibility: `''.*'''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2480
                    do:[:node :answer | 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2481
                        errorMessageString := node arguments first value.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2482
                        true.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2483
                    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2484
            searcher executeTree: (mthd parseTree) initialAnswer: false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2485
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2486
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2487
    errorMessageString notEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2488
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2489
            nextPutAll:'    ^ self shouldImplement:'; 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2490
            nextPutLine:(errorMessageString storeString)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2491
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2492
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2493
            nextPutLine:'    ^ self shouldImplement'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2494
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2495
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2496
    ^ methodBodyStream contents
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2497
! !
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2498
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2499
!JavaScriptCodeGeneratorTool class methodsFor:'documentation'!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2500
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2501
version_CVS
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2502
    ^ '$Header$'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2503
! !