JavaScriptCodeGeneratorTool.st
author Claus Gittinger <cg@exept.de>
Fri, 21 Feb 2020 20:48:14 +0100
changeset 1231 b7d945ef967a
parent 1083 72246e1dc405
permissions -rw-r--r--
#REFACTORING by exept class: JavaScriptParser changed: #forStatement class: JavaScriptParser class added: #forOfAllowed comment/format in: #forInAllowed
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
895
mawalch
parents: 827
diff changeset
    14
"{ NameSpace: Smalltalk }"
mawalch
parents: 827
diff changeset
    15
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    16
CodeGeneratorTool subclass:#JavaScriptCodeGeneratorTool
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    17
	instanceVariableNames:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    18
	classVariableNames:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    19
	poolDictionaries:''
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    20
	category:'Interface-Browsers'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    21
!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    22
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    23
!JavaScriptCodeGeneratorTool class methodsFor:'documentation'!
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
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    26
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    27
 COPYRIGHT (c) 2011 by eXept Software AG
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    28
              All Rights Reserved
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    29
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    30
 This software is furnished under a license and may be used
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    31
 only in accordance with the terms of that license and with the
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    32
 inclusion of the above copyright notice.   This software may not
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    33
 be provided or otherwise made available to, or used by, any
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    34
 other person.  No title to or ownership of the software is
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    35
 hereby transferred.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    36
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    37
!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    38
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    39
documentation
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    40
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    41
    Code generation facilites for JavaScript
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    42
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    43
    [author:]
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    44
        Claus Gittiner
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    45
"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    46
! !
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
    47
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    48
!JavaScriptCodeGeneratorTool class methodsFor:'code generation'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    49
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    50
initialMenuSpecMethodSourceForApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    51
    "return code for a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    52
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    53
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    54
'mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    55
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    56
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    57
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    58
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    59
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
     MenuEditor new openOnClass:%1 andSelector:#mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    62
    "
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
    <resource: #menu>
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
    ^ ',(self initialMenuSpecForApplications decodeAsLiteralArray literalArrayEncoding storeString),'
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    69
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    70
initialPageMenuSpecMethodSourceForWebApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    71
    "return code for a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    72
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    73
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    74
'mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    75
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    76
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    77
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    78
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    79
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
     MenuEditor new openOnClass:%1 andSelector:#mainMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    82
    "
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
    <resource: #menu>
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
    ^ ',(self initialPageMenuSpecForWebApplications decodeAsLiteralArray literalArrayEncoding storeString),'
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
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
     self initialPageMenuSpecMethodSourceForWebApplications
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    93
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    94
initialPageSpecMethodSourceForWebApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    95
    "return an empty pageSpec"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    96
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    97
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    98
'pageSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
    99
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   100
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   101
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   102
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   103
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
     UIPainter new openOnClass:%1 andSelector:#pageSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   106
    "
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
    <resource: #canvas>
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
    ^ ',(self initialPageSpecForWebApplications decodeAsLiteralArray literalArrayEncoding storeString),'
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   113
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   114
initialToolbarMenuSpecMethodSource
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   115
    "return a menuSpec with typical stuff in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   116
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   117
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   118
'toolbarMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   119
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   120
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   121
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   122
     the MenuEditor may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   123
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
     MenuEditor new openOnClass:%1 andSelector:#toolbarMenu
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   126
    "
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
    <resource: #menu>
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
    ^ ',(self initialToolbarMenuSpec decodeAsLiteralArray literalArrayEncoding storeString),'
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
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
     self initialToolbarMenuSpecMethodSource
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   137
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   138
initialWindowSpecMethodSourceForApplications
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   139
    "return an empty windowSpec with an initial menubar in it"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   140
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   141
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   142
'windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   143
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   144
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   145
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   146
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   147
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
     UIPainter new openOnClass:%1 andSelector:#windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   150
    "
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
    <resource: #canvas>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   153
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
        self initialWindowSpecForApplications2 decodeAsLiteralArray prettyPrintString           
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
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
     self initialWindowSpecMethodSourceForApplications
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   162
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   163
initialWindowSpecMethodSourceForDialogs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   164
    "return an empty windowSpec for dialogs"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   165
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   166
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   167
'windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   168
    "This resource specification was automatically generated by the CodeGeneratorTool."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   169
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   170
    "Do not manually edit this!! If it is corrupted,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   171
     the UIPainter may not be able to read the specification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   172
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
     UIPainter new openOnClass:%1 andSelector:#windowSpec
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   175
    "
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
    <resource: #canvas>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   178
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
        self initialWindowSpecForDialogs decodeAsLiteralArray prettyPrintString           
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   181
! !
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
!JavaScriptCodeGeneratorTool class methodsFor:'code generation-menus'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   184
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   185
createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   186
    |alreadyInSuperclass method code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   187
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   188
    (aClass includesSelector:aSelector) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   189
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   190
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   191
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   192
    alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   193
    (alreadyInSuperclass and:[redefine not]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   194
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   195
    ].
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
    method := self methodNameTemplateFor:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   198
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   199
    code := '%1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   200
    "automatically generated by UIEditor ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   201
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   202
    "*** the code below performs no action"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   203
    "*** (except for some feedback on the Transcript)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   204
    "*** Please change as required and accept in the browser."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   205
    "*** (and replace this comment by something more useful ;-)"
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
    "action to be added ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   208
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   209
    Transcript showCR:self class name, '': action for #%2 ...''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   210
' bindWith:method with:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   211
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   212
    alreadyInSuperclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   213
        code := code, (('\    super %1\' bindWith:method) withCRs).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   214
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   215
    self compile:code forClass:aClass inCategory:(aCategory ? #actions).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   216
    ^ code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   217
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   218
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   219
createAspectMethodFor:aSelector in:aClass category:aCategory redefine:redefine
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   220
    |alreadyInSuperclass method code text|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   221
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   222
    (aClass includesSelector:aSelector) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   223
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   224
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   225
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   226
    alreadyInSuperclass := aClass superclass canUnderstand:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   227
    (alreadyInSuperclass and:[redefine not]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   228
        ^ nil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   229
    ].
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
    method := self methodNameTemplateFor:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   232
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   233
    code := '%1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   234
    "automatically generated by UIEditor ..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   235
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   236
    "*** the code below creates a default model when invoked"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   237
    "*** (which may not be the one you wanted)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   238
    "*** Please change as required and accept in the browser."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   239
    "*** (and replace this comment by something more useful ;-)"
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
    "aspect to be added ..."
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
    Transcript showCR:self class name, '': aspect for #%2 ...''.
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
' bindWith:method with:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   246
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   247
    alreadyInSuperclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   248
        text := '    ^ super %1\' bindWith:method.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   249
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   250
        text := '    ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:aSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   251
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   252
    code := code, (text withCRs).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   253
    self compile:code forClass:aClass inCategory:(aCategory ? #actions).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   254
    ^ code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   255
! !
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
!JavaScriptCodeGeneratorTool class methodsFor:'private'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   258
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   259
methodNameTemplateFor:aSelector
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   260
    |numArgs method|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   261
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   262
    numArgs := aSelector numArgs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   263
    numArgs == 1 ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   264
        method := aSelector, 'anArgument'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   265
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   266
        numArgs == 0 ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   267
            method := aSelector
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   268
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   269
            method := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   270
            aSelector keywords keysAndValuesDo:[:i :key|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   271
                method := method, key, 'arg', i printString, ' '.
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
        ]
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
    ^ method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   276
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   277
1018
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   278
!JavaScriptCodeGeneratorTool class methodsFor:'utilities - source code'!
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   279
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   280
methodSourceForVersionMethodCVS:versionString
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   281
    "careful to avoid expansion by cvs here!!"
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   282
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   283
    ^ ('function version_CVS() {\    return("',versionString,'");\}') withCRs
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   284
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   285
    "Created: / 28-08-2018 / 11:54:29 / Claus Gittinger"
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   286
! !
5ab4e00186ff #REFACTORING by cg
Claus Gittinger <cg@exept.de>
parents: 905
diff changeset
   287
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   288
!JavaScriptCodeGeneratorTool methodsFor:'code generation'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   289
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   290
createClassInitializeMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   291
    "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
   292
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   293
    |nonMetaClass metaClass className code initializer bindings|
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
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   296
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   297
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   298
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   299
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   300
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   301
    (metaClass includesSelector:#'initialize') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   302
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   303
    "Invoked at system start or when the class is dynamically loaded."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   304
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   305
    "/ please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   306
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   307
        bindings := Dictionary new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   308
        bindings at:'INIT_CLASSINSTVARS' put:(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   309
            String streamContents:[:s |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   310
                metaClass instVarNames do:[:eachClassInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   311
                    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
   312
                    s nextPutLine:('    "/ %1 := %2.' bindWith:eachClassInstVar with:initializer).
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
            ]).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   315
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   316
        bindings at:'INIT_CLASSVARS' put:(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   317
            String streamContents:[:s |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   318
                nonMetaClass classVarNames do:[:eachClassVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   319
                    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
   320
                    s nextPutLine:('    "/ %1 := %2.' bindWith:eachClassVar with:initializer).
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   324
        code := (self codeFor_classInitialize) expandPlaceholdersWith:bindings.
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
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   327
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   328
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   329
            inCategory:#initialization.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   330
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   331
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   332
    self executeCollectedChangesNamed:('Add Class Initializer to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   333
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   334
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   335
createClassTypeTestMethodsIn:aClass forClasses:subClasses
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   336
    "create a #isXXX test methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   337
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   338
    | code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   339
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   340
    self startCollectChanges.
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
    subClasses do:[:eachSubClass |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   343
        |nm selector|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   344
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   345
        nm := eachSubClass nameWithoutPrefix.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   346
        selector := 'is' , nm.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   347
        (aClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   348
            code := (selector , '\    ^ false') withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   349
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   350
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   351
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   352
                inCategory:#testing.
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
        (eachSubClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   355
            code := (selector , '\    ^ true') withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   356
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   357
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   358
                forClass:eachSubClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   359
                inCategory:#testing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   360
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   361
    ].
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
    self executeCollectedChangesNamed:'Add ClassType Tests'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   364
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   365
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   366
createEnumTypeCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   367
    |nonMetaClass metaClass className enumValues code initCode runValue maxValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   368
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   369
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   370
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   371
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   372
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   373
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   374
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   375
    enumValues := nonMetaClass classVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   376
    enumValues do:[:eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   377
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   378
            createAccessMethodsFor:(Array with:eachVariableName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   379
            in:metaClass  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   380
            withChange:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   381
            asValueHolder:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   382
            readersOnly:true    
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   383
            writersOnly:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   384
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   385
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   386
    maxValue := enumValues 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   387
                    inject:0 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   388
                    into:[:maxSoFar :eachVariableName | 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   389
                            |oldVal val| 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   390
                            oldVal := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   391
                            oldVal notNil ifTrue:[ val := oldVal numericValue ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   392
                            (val ? maxSoFar) max:maxSoFar
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   393
                         ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   394
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   395
    initCode := WriteStream on: String new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   396
    initCode nextPutLine:'initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   397
    runValue := maxValue + 1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   398
    enumValues keysAndValuesDo:[:idx :eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   399
        |oldValue thisValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   400
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   401
        oldValue := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   402
        oldValue notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   403
            thisValue := oldValue numericValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   404
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   405
            thisValue := runValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   406
            runValue := runValue + 1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   407
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   408
        initCode 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   409
            nextPutAll:'    ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   410
            nextPutAll:eachVariableName;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   411
            nextPutAll:' := self basicNew'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   412
        (aClass canUnderstand:#'setNumericValue:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   413
            initCode nextPutAll:' setNumericValue: ',thisValue printString.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   414
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   415
        (aClass canUnderstand:#'setCssClassString:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   416
            initCode nextPutAll:('; setCssClassString: ''' , nonMetaClass nameWithoutPrefix asLowercaseFirst , eachVariableName , '''').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   417
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   418
        (aClass canUnderstand:#'setName:') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   419
            initCode nextPutAll:('; setName: ''' , eachVariableName asLowercaseFirst , '''').
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
        initCode nextPutLine:'.'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   422
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   423
    initCode cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   424
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   425
    initCode nextPutLine:'     ',className, ' initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   426
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   427
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   428
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   429
        compile:(initCode contents)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   430
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   431
        inCategory:#'class initialization'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   432
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
    code := 'allStateNames\    ^ #( ' ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   435
                ((enumValues collect:[:each | '#''',each asLowercaseFirst,'''']) asStringWith:' ') , ')',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   436
                '\\    "\' ,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   437
                '     ',className, ' allStateNames\' ,
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
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   440
        compile:code withCRs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   441
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   442
        inCategory:#queries.
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
    self executeCollectedChangesNamed:('Generate EnumType Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   445
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   446
    aClass initialize.
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
    "Modified: / 1.2.1998 / 16:10:03 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   451
createExamplesMethodForViewClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   452
    "create an examples method"
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
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   455
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   456
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   457
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   458
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   459
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   460
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   461
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   462
    (metaClass includesSelector:#examples) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   463
        code := 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   464
'examples
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   465
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   466
 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
   467
 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
   468
 (see the browsers class-documentation menu items for more)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   469
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   470
 trying the widget as standAlone view:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   471
                                                        [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   472
    %1 new 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
 embedded in another view:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   476
                                                        [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   477
    |top v|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   478
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   479
    top := StandardSystemView new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   480
    top extent:300@300.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   481
    v := %1 new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   482
    v origin:10@10 corner:150@150.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   483
    top add:v.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   484
    top open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   485
                                                        [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   486
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   487
' bindWith:className.    
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
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   490
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   491
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   492
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   493
    ].
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 executeCollectedChangesNamed:('Add Example to ' , className).
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   498
createInitializationMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   499
    "create a #initialize methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   500
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   501
    |nonMetaClass metaClass className code initializer m|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   502
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   503
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   504
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   505
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   506
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   507
    self startCollectChanges.
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
    (nonMetaClass includesSelector:#initialize) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   510
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   511
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   512
    "Invoked when a new instance is created."
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
    "/ please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   515
'.
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
        nonMetaClass instVarNames do:[:eachInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   518
            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
   519
            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
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
        m := nonMetaClass responseTo:#initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   523
        (m notNil and:[m messagesSent size == 0]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   524
            "/ inherits an empty initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   525
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   526
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   527
    "/ super initialize.   -- commented since inherited method does nothing
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
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   530
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   531
    super initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   532
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   533
        ].
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
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   536
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   537
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   538
            inCategory:#initialization.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   539
    ].
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 executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   544
createInitializedInstanceCreationMethodsIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   545
    "create a #new and #initialize methods (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   546
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   547
    |nonMetaClass metaClass className code m|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   548
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   549
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   550
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   551
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   552
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   553
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   554
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   555
    self createInitializationMethodIn:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   556
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   557
    (metaClass includesSelector:#new) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   558
        m := metaClass responseTo:#new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   559
        (m isNil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   560
        or:[ (m sends:#initialize) not 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   561
        or:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   562
            (Dialog 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   563
                confirmWithCancel:('The inherited #new method already seems to invoke #initialize.\Redefine ?' withCRs)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   564
                default:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   565
                onCancel:[^ self] ) 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   566
        ]]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   567
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   568
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   569
    "return an initialized instance"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   570
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   571
    ^ self basicNew initialize.
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
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   574
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   575
                forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   576
                inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   577
        ].
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   580
    self executeCollectedChangesNamed:('Add Initialized Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   581
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   582
    "Created: / 11-10-2001 / 22:18:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   583
    "Modified: / 30-01-2011 / 00:58:04 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   586
createParametrizedInstanceCreationMethodsNamed:selector in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   587
    "create a #selector instance creation method (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   588
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   589
    |nonMetaClass metaClass className code initializer m dfn|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   590
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   591
    dfn := Method methodDefinitionTemplateForSelector:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   592
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   593
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   594
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   595
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   596
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   597
    self startCollectChanges.
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
    (nonMetaClass includesSelector:selector asSymbol) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   600
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   601
'initialize',dfn asUppercaseFirst,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   602
    "Invoked when a new instance is created for arg."
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
    "/ please change as required (and remove these comments)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   605
    "/ do something with arg here (instVar-foo := arg)
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
        nonMetaClass instVarNames do:[:eachInstVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   608
            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
   609
            code := code , ('    "/ ' , eachInstVar , ' := ' , initializer , '.' , Character cr).
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
        m := nonMetaClass responseTo:#initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   613
        (m notNil and:[ m messagesSent size == 0 ]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   614
            "/ inherits an empty initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   615
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   616
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   617
    "/ super initialize.   -- commented since inherited method does nothing
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
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   620
            code := code , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   621
    super initialize.  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   622
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   623
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   624
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   625
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   626
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   627
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   628
            inCategory:#initialization.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   631
    (metaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   632
        m := metaClass responseTo:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   633
        (m isNil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   634
        or:[ (Dialog confirmWithCancel:'The ',selector,'- method is already inherited. Redefine ?' onCancel:[^ self]) ])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   635
        ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   636
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   637
dfn,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   638
    "Create & return a new instance for arg."
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
    ^ self basicNew initialize',dfn asUppercaseFirst,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   641
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   642
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   643
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   644
                forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   645
                inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   646
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   647
    ].
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
    self executeCollectedChangesNamed:('Add Parametrized Instance Creation to ' , className).
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   652
createPoolInitializationCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   653
    |nonMetaClass metaClass className poolVars initCode|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   654
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   655
    self startCollectChanges.
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
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   658
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   659
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   660
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   661
    poolVars := nonMetaClass classVarNames.
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 := WriteStream on: String new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   664
    initCode nextPutLine:'initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   665
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   666
    poolVars do:[:eachVariableName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   667
        |oldValue thisValue|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   668
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   669
        oldValue := nonMetaClass classVarAt:eachVariableName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   670
        oldValue notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   671
            thisValue := oldValue.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   672
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   673
            thisValue := nil.
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
        initCode 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   676
            nextPutAll:'    ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   677
            nextPutAll:eachVariableName;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   678
            nextPutAll:' := ';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   679
            nextPutAll:thisValue storeString;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   680
            nextPutLine:'.'.
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
    initCode cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   683
    initCode nextPutLine:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   684
    initCode nextPutLine:'     ',className, ' initialize'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   685
    initCode nextPutLine:'    "'.
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
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   688
        compile:(initCode contents)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   689
        forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   690
        inCategory:#'class initialization'.
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
    self executeCollectedChangesNamed:('Generate Pool Initialization Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   693
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   694
    aClass initialize.
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
    "Created: / 25-10-2006 / 09:28:40 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   699
createRedefinedInstanceCreationMethodsIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   700
    "create a redefined #new methods"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   701
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   702
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   703
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   704
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   705
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   706
    className := nonMetaClass name.
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
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   709
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   710
    (metaClass includesSelector:#'new') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   711
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   712
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   713
    ^ super new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   714
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   715
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   716
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   717
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   718
            inCategory:#'redefined instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   719
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   720
    (metaClass includesSelector:#'new:') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   721
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   722
'new:n
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   723
    ^ super new:n.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   724
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   725
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   726
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   727
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   728
            inCategory:#'redefined instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   729
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   730
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   731
    self executeCollectedChangesNamed:('Redefined Instance Creation to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   732
!
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
createSingletonPatternInstanceCreationMethodsIn:aClass usingVariable:varName
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   735
    "create redefined #new methods for singleton pattern.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   736
     Uses varName (typically a class-instvar) to keep the singleton instance."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   737
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   738
    |nonMetaClass metaClass className code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   739
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   740
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   741
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   742
    className := nonMetaClass name.
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 startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   745
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   746
    (metaClass includesSelector:#theOneAndOnlyInstance) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   747
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   748
'theOneAndOnlyInstance
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   749
    "returns a singleton"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   750
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   751
    %1 isNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   752
        %1 := self basicNew initialize.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   753
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   754
    ^ %1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   755
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   756
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   757
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   758
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   759
            inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   760
    ].
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
    (metaClass includesSelector:#new) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   763
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   764
'new
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   765
    "returns a singleton"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   766
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   767
    ^ self theOneAndOnlyInstance.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   768
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   769
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   770
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   771
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   772
            inCategory:#'instance creation'.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   775
   (metaClass includesSelector:#flushSingleton) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   776
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   777
'flushSingleton
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   778
    "flushes the cached singleton"
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
    %1 := nil
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
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   783
     self flushSingleton
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
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   786
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   787
            compile:(code bindWith:varName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   788
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   789
            inCategory:#'instance creation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   790
    ].
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 executeCollectedChangesNamed:('Singleton Pattern for ' , className).
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
    "Created: / 10-02-2011 / 16:32:48 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   795
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   796
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   797
createStandardPrintOnMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   798
    "create a #printOn: method (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   799
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   800
    |code nonMetaClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   801
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   802
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   803
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   804
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   805
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   806
    (nonMetaClass includesSelector:#printOn:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   807
        code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   808
'printOn:aStream
905
c0218bc4f64b #DOCUMENTATION by mawalch
mawalch
parents: 895
diff changeset
   809
    "append a printed representation of the receiver to the argument, aStream"
544
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
    super printOn:aStream.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   812
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   813
        nonMetaClass instVarNames do:[:eachInstVarName |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   814
            code := code , '    '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   815
            code := code , 'aStream nextPutAll:'''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   816
            code := code , eachInstVarName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   817
            code := code , ': ''.' , Character cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   818
            code := code , '    '.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   819
            code := code , eachInstVarName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   820
            code := code , ' printOn:aStream.' , Character cr.
905
c0218bc4f64b #DOCUMENTATION by mawalch
mawalch
parents: 895
diff changeset
   821
544
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
905
c0218bc4f64b #DOCUMENTATION by mawalch
mawalch
parents: 895
diff changeset
   824
        self
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   825
            compile:code
905
c0218bc4f64b #DOCUMENTATION by mawalch
mawalch
parents: 895
diff changeset
   826
            forClass:nonMetaClass
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   827
            inCategory:#'printing & storing'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   828
    ].
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   831
    self executeCollectedChangesNamed:('Add #printOn: to ' , nonMetaClass name).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   832
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   833
    "Created: / 11.10.2001 / 22:18:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   834
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   835
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   836
createStartupCodeFor:aClass forStartOf:anApplicationClassOrNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   837
    "create startup code (main)"
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
    |nonMetaClass metaClass className source 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   840
     hasAplicationClass anApplicationClassNameOrStartupClassName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   841
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   842
    self startCollectChanges.
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
    hasAplicationClass := anApplicationClassOrNil notNil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   845
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   846
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   847
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   848
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   849
    (metaClass includesSelector:#main:) ifFalse:[
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
        source := String streamContents:[:stream |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   852
            stream nextPutAll: 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   853
'main:argv
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   854
    self verboseInfo:''starting %1''.
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
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   857
            hasAplicationClass ifTrue: [
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   858
                stream nextPutAll: 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   859
'    Smalltalk openDisplay.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   860
    Display notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   861
        Display exitOnLastClose:true.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   862
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   863
    %1 open.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   864
'.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   868
        anApplicationClassNameOrStartupClassName := hasAplicationClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   869
            ifTrue: [anApplicationClassOrNil name]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   870
            ifFalse: [className.].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   871
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   872
            compile:(source bindWith:anApplicationClassNameOrStartupClassName)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   873
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   874
            inCategory:#startup.
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
    self executeCollectedChangesNamed:('Add Startup Code to ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   877
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   878
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   879
createTestCaseSampleCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   880
    "create an (almost) empty testCase class"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   881
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   882
    |nonMetaClass metaClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   883
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   884
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   885
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   886
    "/ className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   887
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   888
    ( nonMetaClass includesSelector:#test1 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   889
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   890
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   891
'test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   892
    "This is a demonstration testCase - it is meant to be removed eventually.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   893
     This testCase will PASS.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   894
     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
   895
     - please add more methods like this..."
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
    |o|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   898
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   899
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   900
    self assert: ( o size == 2 ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   901
    self should: [ o at:0 ] raise:Error.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   902
    self shouldnt: [ o at:1 ] raise:Error.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   903
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   904
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   905
     self run:#test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   906
     self new test1
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   907
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   908
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   909
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   910
            inCategory:#tests.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   913
    ( nonMetaClass includesSelector:#test2 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   914
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   915
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   916
'test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   917
    "This is a demonstration testCase - it is meant to be removed eventually..
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   918
     This testCase WILL FAIL.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   919
     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
   920
     - please add more methods like this..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   921
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   922
    |o|
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
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   925
    self assert: ( o size == 3 ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   926
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   927
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   928
     self run:#test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   929
     self new test2
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   930
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   931
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   932
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   933
            inCategory:#tests.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   936
    ( nonMetaClass includesSelector:#test3 ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   937
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   938
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   939
'test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   940
    "This is a demonstration testCase - it is meant to be removed eventually..
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   941
     This testCase WILL generate an ERROR.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   942
     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
   943
     - please add more methods like this..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   944
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   945
    |o|
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
    o := Array new:2.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   948
    self assert: ( o foo ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   949
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   950
    "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   951
     self run:#test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   952
     self new test3
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   953
    "
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:#tests.
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:#setUp ) 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
'setUp
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   963
    "common setup - invoked before 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 setUp
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
    ( nonMetaClass includesSelector:#tearDown ) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   972
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   973
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   974
'tearDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   975
    "common cleanup - invoked after testing."
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
    super tearDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   978
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   979
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   980
            inCategory:#'initialize / release'.
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   983
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   984
createVisitorMethodsIn:visitedClass andVisitorClass:visitorClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   985
    "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
   986
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   987
    |sel|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   988
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   989
    self assert:( visitedClass isMeta not ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   990
    self assert:( visitorClass isMeta not ).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   991
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   992
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   993
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   994
    sel := ('visit' , visitedClass nameWithoutPrefix , ':').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   995
    self createAcceptVisitorMethod:sel in:visitedClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   996
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   997
    (visitorClass includesSelector:sel) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   998
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
   999
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1000
(('%1anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1001
    "dispatched back from the visited %2-object (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1002
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1003
    "fall back to general object-case - please change as required"
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
    ^ self visitObject:anObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1006
') bindWith:sel with:visitedClass nameWithoutPrefix asLowercaseFirst)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1007
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1008
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1009
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1010
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1011
    (visitorClass includesSelector:#visitObject:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1012
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1013
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1014
('visitObject:anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1015
    "dispatched back from the visited objects (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1016
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1017
    "general fallBack - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1018
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1019
    self halt:''not yet implemented''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1020
')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1021
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1022
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1023
    ].
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
    (visitorClass includesSelector:#visit:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1026
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1027
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1028
('visit:anObject 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1029
    "visit anObject (visitor pattern).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1030
     The object should call back one of my visitXXXX methods."
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
    ^ anObject acceptVisitor:self
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
            forClass:visitorClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1035
            inCategory:#visiting.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1036
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1037
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1038
    self executeCollectedChangesNamed:('Add Visitor Pattern').
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1041
createWebApplicationCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1042
    "create an empty webApplication framework"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1043
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1044
    |nonMetaClass metaClass className txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1045
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1046
    self startCollectChanges.
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
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1049
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1050
    className := nonMetaClass name.
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
    (metaClass includesSelector:#pageSpec) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1053
        txt := self class initialPageSpecMethodSourceForWebApplications.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1054
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1055
            compile:(txt bindWith:className)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1056
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1057
            inCategory:#'page specs'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1058
    ].
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
    self executeCollectedChangesNamed:('Add WebApplication Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1061
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1062
    "Modified: / 1.2.1998 / 16:10:03 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1065
createWebServiceCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1066
    "create an empty webService framework"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1067
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1068
    |nonMetaClass metaClass className txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1069
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1070
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1071
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1072
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1073
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1074
    className := nonMetaClass name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1075
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1076
    (nonMetaClass includesSelector:#page1:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1077
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1078
'page1:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1079
    "This is a sample page-generation method. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1080
     This uses the simplest possible way to generate html: generating plain HTML. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1081
     See page2 for a more structured example."
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
    |response|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1084
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1085
    response := aRequest response.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1086
    response nextPutLine:''<HTML>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1087
    response nextPutLine:''  <HEAD>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1088
    response nextPutLine:''  <TITLE>Hello</TITLE>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1089
    response nextPutLine:''  </HEAD>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1090
    response nextPutLine:''  <BODY>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1091
    response nextPutLine:''    <H1>Hello World !!</H1>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1092
    response nextPutLine:''  </BODY>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1093
    response nextPutLine:''</HTML>''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1094
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1095
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1096
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1097
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1098
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1099
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1100
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1101
    (nonMetaClass includesSelector:#page2:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1102
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1103
'page2:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1104
    "This is a sample page-generation method. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1105
     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
  1106
     Event better examples to follow..."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1107
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1108
    |page|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1109
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1110
    page := HTML::TreeBuilder newDocument.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1111
    page
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1112
        head;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1113
            title:''Hello'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1114
        headEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1115
        body;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1116
            h1:''Hello World'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1117
            div;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1118
                nlsText:''here is some text and '';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1119
                a; href:''page3''; 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1120
                    text:''an anchor'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1121
                aEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1122
                text:'' and an image: '';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1123
                img:(httpServer graphicLinkIdFor:(ToolbarIconLibrary smiley_cool) expirationTimeDelta:30 seconds);
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1124
            divEnd;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1125
        bodyEnd.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1126
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1127
    aRequest reply:(page htmlString).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1128
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1129
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1130
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1131
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1132
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1133
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1134
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1135
    (nonMetaClass includesSelector:#page3:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1136
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1137
'page3:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1138
    "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
  1139
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1140
    aRequest response
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1141
        contentType:''text/plain'';
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1142
        data:''This is some plain text,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1143
without any html formatting.''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1144
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1145
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1146
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1147
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1148
            inCategory:#'response generation - pages'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1149
    ].
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
    (nonMetaClass includesSelector:#process:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1152
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1153
'process:aRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1154
    "This is the web services main processing method.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1155
     It will be invoked for every incoming webBrowser-request.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1156
     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
  1157
     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
  1158
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1159
     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
  1160
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1161
    |whichPage methodName method|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1162
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1163
    whichPage := aRequest pathRelativeToService.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1164
    whichPage isEmpty ifTrue:[ whichPage := ''page1'' ].
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
    "/ to prevent intruders from calling any method, check if it one
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1167
    "/ of my own methods, which is marked as a PAGE-method.
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
    methodName := (whichPage,'':'') asSymbol.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1170
    method := self class compiledMethodAt:methodName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1171
    "/ is there such a method ?
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1172
    method notNil ifTrue:[                                 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1173
        "/ and it is marked as being a WebPage-generator ?
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1174
        (method hasResource:#''PAGE'') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1175
            self perform:methodName with:aRequest.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1176
            ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1177
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1178
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1179
    aRequest reportNotFound:''No such page in this service''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1180
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1181
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1182
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1183
            forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1184
            inCategory:#'response generation'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1185
    ].
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
    (metaClass includesSelector:#linkName) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1188
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1189
'linkName
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1190
    "return the default linkName path (with slash)."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1191
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1192
    ^ ''/NewService''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1193
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1194
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1195
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1196
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1197
            inCategory:#defaults.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1198
    ].
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
    (metaClass includesSelector:#settingsApplicationClass) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1201
        txt :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1202
'settingsApplicationClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1203
    "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
  1204
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1205
    ^ nil
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
        self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1208
            compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1209
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1210
            inCategory:#defaults.
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
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
    self executeCollectedChangesNamed:('Add WebService Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1215
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1216
    "Modified: / 02-06-2011 / 12:51:15 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1219
createWidgetCodeFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1220
    "create usually required widget code (redraw, model update, event handling)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1221
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1222
    |nonMetaClass metaClass className compileTemplateAction|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1223
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1224
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1225
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1226
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1227
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1228
    className := nonMetaClass name.
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
    compileTemplateAction := 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1231
        [:selector :templateSelector :category |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1232
            (nonMetaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1233
                |txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1234
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1235
                txt := self perform:templateSelector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1236
                self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1237
                    compile:txt
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1238
                    forClass:nonMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1239
                    inCategory:category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1240
            ]
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1243
    #(
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1244
        initialize               code_forWidget_initialize  #'initialization & release'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1245
        update:with:from:        code_forWidget_update      #'change & update'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1246
        redrawX:y:width:height:  code_forWidget_redraw      #'drawing'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1247
        buttonPress:x:y:         code_forWidget_buttonPress #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1248
        keyPress:x:y:            code_forWidget_keyPress    #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1249
        sizeChanged:             code_forWidget_sizeChanged #'event handling'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1250
    ) inGroupsOf:3 do:compileTemplateAction.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1251
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1252
    self executeCollectedChangesNamed:('Add Widget Code for ' , className).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1253
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1254
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1255
!JavaScriptCodeGeneratorTool methodsFor:'code generation-basic'!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1256
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1257
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
  1258
    "workhorse for creating access methods for instvars."
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1259
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1260
    |classesClassVars generateCommentsForSetters generateCommentsForGetters|
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1261
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1262
    self startCollectChanges.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1263
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1264
    generateCommentsForSetters := userPreferences generateCommentsForSetters.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1265
    generateCommentsForGetters := userPreferences generateCommentsForGetters.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1266
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1267
    classesClassVars := aClass theNonMetaclass allClassVarNames.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1268
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1269
    aCollectionOfVarNames do:[:name |
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1270
        |source varType methodName defaultMethodName argName|
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1271
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1272
        varType := (classesClassVars includes:name) 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1273
                        ifTrue:['static'] 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1274
                        ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1275
                            (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1276
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1277
        methodName := name.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1278
        name isUppercaseFirst ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1279
            methodName := methodName asLowercaseFirst. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1280
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1281
        argName := 'something'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1282
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1283
        "/ the GETTER
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1284
        writersOnly ifFalse:[
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
                defaultMethodName := 'default' , name asUppercaseFirst.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1287
            ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1288
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1289
            "check, if method is not already present"
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1290
            (aClass includesSelector:(methodName asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1291
                asValueHolder ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1292
                    source := methodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1293
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1294
                        source := source , '    // return/create the ''%2'' value holder (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1295
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1296
                    source := source , '    if (%2 == null) {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1297
                    lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1298
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1299
                                   , '        %2 = this.class.%3.asValue;\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1300
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1301
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1302
                                   , '        %2 = new ValueHolder;\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1303
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1304
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1305
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1306
                    source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1307
                               , '        %2.addDependent(this);\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1308
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1309
                    source := source
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
                    source := methodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1315
                    lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1316
                        generateCommentsForGetters ifTrue:[
1083
72246e1dc405 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 1028
diff changeset
  1317
                            source := source , '    // return the value of the %1 variable ''%2'' with lazy instance creation (automatically generated)\\'. 
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1318
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1319
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1320
                                    , '    if (%2 == null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1321
                                    , '        %2 = self.class.%3;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1322
                                    , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1323
                                    , '    return %2;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1324
                                    , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1325
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1326
                        generateCommentsForGetters ifTrue:[
1083
72246e1dc405 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 1028
diff changeset
  1327
                            source := source , '    // return the value of the %1 variable ''%2'' (automatically generated)\\'. 
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1328
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1329
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1330
                                    , '    return %2;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1331
                                    , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1332
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1333
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1334
                source := (source bindWith:varType with:name with:defaultMethodName) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1335
                self compile:source forClass:aClass inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1336
            ] ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1337
                Transcript showCR:'method ''', methodName , ''' already present'
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
            "/ default for lazy on class side
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1341
            lazyInitialization ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1342
                (aClass theMetaclass includesSelector:(defaultMethodName asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1343
                    source := defaultMethodName , '() {\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1344
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1345
                        source := source , '    // default value for the ''%2'' instance variable (automatically generated)\\'. 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1346
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1347
                    source := source    
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1348
                               , '    this.shouldImplement();\'
1028
669f7146c07d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 1018
diff changeset
  1349
                               , '    return null;\'
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1350
                               , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1351
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1352
                    source := (source bindWith:varType with:name) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1353
                    self compile:source forClass:aClass theMetaclass inCategory:'defaults'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1354
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1355
            ].                                       
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1356
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1357
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1358
        "/ the SETTER
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1359
        readersOnly ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1360
            (aClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1361
                ((methodName size > 2) and:[ (methodName startsWith:'is') and:[ (methodName at:3) isUppercase ]])
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1362
                ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1363
                    argName := 'aBoolean'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1364
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1365
                asValueHolder ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1366
                    source := methodName , '(%3) {\'.  "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1367
                    generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1368
                        source := source , '    // set the ''%2'' value holder' , ' (automatically generated)\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1369
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1370
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1371
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1372
                                  , '    var oldValue, newValue;\\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1373
                                  , '    if (%2 !!= null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1374
                                  , '        oldValue = %2.value;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1375
                                  , '        %2.removeDependent(this);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1376
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1377
                                  , '    %2 = %3;\'        "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1378
                                  , '    if (%2 !!= null) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1379
                                  , '        %2.addDependent(self);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1380
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1381
                                  , '    newValue = %2.value;\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1382
                                  , '    if (oldValue !!== newValue) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1383
                                  , '        this.update_with_from("value".asSymbol(), newValue, %2);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1384
                                  , '    }\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1385
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1386
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1387
                        source := source 
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
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1390
                    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1391
                ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1392
                    source := methodName , '(%3) {\'.    "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1393
                    withChange ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1394
                        generateComments ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1395
                            source := source , '    // set the value of the %1 variable ''%2''\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1396
                            source := source , '    // and send a change notification (automatically generated)\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1397
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1398
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1399
                                  , '    if (%2 !!== %3) {\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1400
                                  , '        %2 = %3;\'           "/ argName
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1401
                                  , '        this.changed("%2".asSymbol);\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1402
                                  , '     };\'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1403
                                  , '}'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1404
                    ] ifFalse:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1405
                        generateCommentsForSetters ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1406
                            source := source , '    // set the value of the %1 variable ''%2''\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1407
                            source := source , '    // (automatically generated)"\\'.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1408
                        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1409
                        source := source
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1410
                                  , '    %2 = %3;\'          "/ argName
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
                ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1414
                source := (source bindWith:varType with:name with:argName) withCRs.
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1415
                self 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1416
                    compile:source 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1417
                    forClass:aClass 
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1418
                    inCategory:(asValueHolder ifTrue:['aspects'] ifFalse:['accessing']).
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1419
            ] ifTrue:[
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1420
                Transcript showCR:'method ''', methodName , ':'' already present'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1421
            ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1422
        ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1423
    ].
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1424
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  1425
    self executeCollectedChangesNamed:('Add Accessors').
1028
669f7146c07d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 1018
diff changeset
  1426
669f7146c07d #BUGFIX by cg
Claus Gittinger <cg@exept.de>
parents: 1018
diff changeset
  1427
    "Modified: / 25-09-2018 / 12:01:22 / Claus Gittinger"
1083
72246e1dc405 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 1028
diff changeset
  1428
    "Modified: / 07-06-2019 / 16:08:39 / Stefan Vogel"
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1429
!
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
createCollectionAccessMethodsFor:aCollectionOfVarNames in:aClass withChange:withChange
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1432
    |classesClassVars|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1433
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1434
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1435
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1436
    classesClassVars := aClass theNonMetaclass allClassVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1437
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1438
    aCollectionOfVarNames do:[:name |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1439
        |source varType methodNameBase methodName defaultMethodName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1440
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1441
        varType := (classesClassVars includes:name) 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1442
                        ifTrue:['static'] 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1443
                        ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1444
                            (aClass isMeta ifTrue:['classInstVar'] ifFalse:['instance'])].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1445
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1446
        methodNameBase := name asUppercaseFirst.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1447
        (methodNameBase endsWith:'s') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1448
            methodNameBase := methodNameBase copyWithoutLast:1.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1449
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1450
        methodName := 'add' , methodNameBase, ':'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1451
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1452
        "check, if method is not already present"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1453
        (aClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1454
            source := methodName , 'a%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1455
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1456
                source := source , '    "add a ',methodNameBase,'"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1457
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1458
            source := source , '    %2 isNil ifTrue:[\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1459
                source := source
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1460
                           , '        %2 := OrderedCollection new.\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1461
            source := source
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
                       , '    %2 add: a%1'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1464
            source := (source bindWith:methodNameBase with:name) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1465
            self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1466
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1467
            Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1468
        ].
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
        methodName := 'remove' , methodNameBase, ':'. 
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
        "check, if method is not already present"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1473
        (aClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1474
            source := methodName , 'a%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1475
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1476
                source := source , '    "remove a ',methodNameBase,'"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1477
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1478
            source := source
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1479
                       , '    %2 remove: a%1'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1480
            source := (source bindWith:methodNameBase with:name) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1481
            self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1482
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1483
            Transcript showCR:'method ''', methodName , ''' already present'
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1487
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1488
        createAccessMethodsFor:aCollectionOfVarNames 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1489
        in:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1490
        withChange:withChange 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1491
        asValueHolder:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1492
        readersOnly:true
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1493
        writersOnly:false
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1494
        lazyInitialization:false.
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
    self executeCollectedChangesNamed:('Add Collection Access').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1497
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1498
    "Created: / 04-02-2007 / 15:52:31 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1499
!
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
createValueHoldersFor:aCollectionOfVarNames in:aClass lazyInitialization:lazyInitialization
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1502
    "workhorse for creating access methods for instvars."
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
    |nonMetaClass metaClass classesClassVars generateCommentsForSetters generateCommentsForGetters|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1505
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1506
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1507
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1508
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1509
    self startCollectChanges.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1510
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1511
    generateCommentsForSetters := userPreferences generateCommentsForSetters.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1512
    generateCommentsForGetters := userPreferences generateCommentsForGetters.
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
    classesClassVars := nonMetaClass allClassVarNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1515
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1516
    aCollectionOfVarNames do:[:name |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1517
        |source varType methodName holderMethodName defaultMethodName|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1518
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1519
        holderMethodName := name.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1520
        name isUppercaseFirst ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1521
            holderMethodName := holderMethodName asLowercaseFirst. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1522
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1523
        (holderMethodName endsWith:'Holder') ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1524
            methodName := holderMethodName copyWithoutLast:6.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1525
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1526
            methodName := holderMethodName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1527
            holderMethodName := methodName , 'Holder'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1528
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1529
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1530
        methodName notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1531
            (metaClass includesSelector:(methodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1532
                source := '%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1533
                generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1534
                    source := source , '    "return the value in ''%2''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1535
                ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1536
                source := source , '    ^ self %2 value'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1537
                source := (source bindWith:methodName with:holderMethodName) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1538
                self compile:source forClass:nonMetaClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1539
            ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1540
                Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1541
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1542
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1543
            (metaClass includesSelector:((methodName , ':') asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1544
                source := '%1: newValue\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1545
                generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1546
                    source := source , '    "set the value in ''%2''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1547
                ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1548
                source := source , '    self %2 value: newValue'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1549
                source := (source bindWith:methodName with: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
        (metaClass includesSelector:(holderMethodName asSymbol)) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1556
            source := '%1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1557
            generateComments ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1558
                source := source , '    "return/create the valueHolder ''%1''"\\'. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1559
            ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1560
            source := source , '    %1 isNil ifTrue:[\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1561
            source := source , '        %1 := ValueHolder with:nil "defaultValue here".\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1562
            source := source , '    ].\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1563
            source := source , '    ^ %1\'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1564
            source := (source bindWith:holderMethodName) withCRs.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1565
            self compile:source forClass:nonMetaClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1566
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1567
            Transcript showCR:'method ''', methodName , ''' already present'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1568
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1569
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1570
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1571
    self executeCollectedChangesNamed:('Add ValueHolder').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1572
! !
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
!JavaScriptCodeGeneratorTool methodsFor:'code generation-individual methods'!
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
createAcceptVisitorMethod:selector in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1577
    "create an acceptVisitor: method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1578
     (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1579
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1580
    self assert:( aClass isMeta not ).
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
    (aClass includesSelector:#'acceptVisitor:') ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1583
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1584
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1585
(('acceptVisitor:aVisitor 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1586
    "Double dispatch back to the visitor, passing my type encoded in
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1587
     the selector (visitor pattern)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1588
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1589
    "stub code automatically generated - please change if required"
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
    ^ aVisitor %1self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1592
') bindWith:selector)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1593
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1594
            inCategory:#visiting.
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
!
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
createAcceptVisitorMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1599
    "create an acceptVisitor: method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1600
     (I'm tired of typing)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1601
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1602
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1603
        createAcceptVisitorMethod:('visit' , aClass nameWithoutPrefix , ':') asSymbol
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1604
        in:aClass
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1607
createCopyrightMethodFor:copyRightText for:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1608
    "add copyright method containing text,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1609
     but only if not already present."
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
    |txt|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1612
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1613
    (aClass includesSelector:#copyright) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1614
        copyRightText notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1615
            txt := copyRightText bindWith:(Date today year).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1616
            self compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1617
'copyright
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1618
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1619
' , txt , '
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
'             forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1622
              inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1623
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1624
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1625
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1626
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1627
createDocumentationMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1628
    "add documentation method containing doc template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1629
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1630
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1631
    |metaClass nonMetaClass userName loginName hostName emailAddress code existingComment|
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
    metaClass := aClass theMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1634
    nonMetaClass := aClass theNonMetaclass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1635
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1636
    (metaClass includesSelector:#documentation) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1637
        existingComment := nonMetaClass comment.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1638
        existingComment isEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1639
            (nonMetaClass isSubclassOf:HTTPService) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1640
                existingComment := '    [start Server with:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1641
        HTTPServer startServerOnPort:8080
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1642
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1643
    [start with:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1644
        (self new)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1645
            registerServiceOn:(HTTPServer runningServerOnPort:8080)'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1646
            ].
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1649
        userName := OperatingSystem getFullUserName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1650
        loginName := OperatingSystem getLoginName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1651
        hostName := OperatingSystem getHostName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1652
        emailAddress := loginName , '@' , hostName.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1653
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1656
        "/ ugly; should ask the class for that    
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1657
        metaClass isJavaScriptMetaclass ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1658
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1659
'function documentation() {
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
' , (existingComment ? '    documentation to be added.') , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1662
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1663
    [author:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1664
        ' ", userName 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1665
          , ' (' , emailAddress , ')' "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1666
        , UserPreferences current historyManagerSignature , '
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
    [instance variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1669
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1670
    [class variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1671
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1672
    [see also:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1673
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
}
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
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1678
            code:= 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1679
'documentation
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
' , (existingComment ? '    documentation to be added.') , '
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
    [author:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1684
        ' ", userName 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1685
          , ' (' , emailAddress , ')' "
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1686
        , UserPreferences current historyManagerSignature , '
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
    [instance variables:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1689
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1690
    [class variables:]
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
    [see also:]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1693
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1694
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1695
'
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1698
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1699
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1700
            forClass:metaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1701
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1702
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1703
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1704
    "Modified: / 24-11-2006 / 15:54:27 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1705
    "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
  1706
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1707
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1708
createExamplesMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1709
    "add examples method containing examples template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1710
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1711
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1712
    |nonMetaclass fragment|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1713
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1714
    nonMetaclass := aClass theNonMetaclass.
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
    (nonMetaclass isSubclassOf:View) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1717
        self createExamplesMethodForViewClass:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1718
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1719
    ].
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
    (nonMetaclass isSubclassOf:ApplicationModel) ifFalse:[
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
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1724
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1725
    (aClass includesSelector:#examples) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1726
        (nonMetaclass isSubclassOf:ApplicationModel) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1727
            fragment := '  Starting the application:
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
    ' , nonMetaclass name , ' open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1730
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
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1734
            fragment := ''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1735
        ].
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
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1738
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1739
'examples
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1740
"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1741
' , fragment , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1742
  more examples to be added:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1743
                                                                [exBegin]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1744
    ... add code fragment for 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1745
    ... executable example here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1746
                                                                [exEnd]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1747
"
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
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1750
            inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1751
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1752
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1753
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1754
createImageSpecMethodFor:anImage comment:comment in:aClass selector:sel
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1755
    |imageStoreStream mthd imageKey category|
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
    anImage storeOn: (imageStoreStream := WriteStream on: '').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1758
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1759
    "/ if that method already exists, do not overwrite the category
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1760
    category := #'image specs'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1761
    (mthd := aClass compiledMethodAt:sel) notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1762
        category := mthd category.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1765
    imageKey :=  aClass theNonMetaclass name, ' ', sel.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1766
    Icon constantNamed: imageKey put:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1767
    self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1768
        compile: ((sel,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1769
            '\', comment,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1770
            '\\' , 
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
            '     self ' , sel , ' inspect\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1773
            '     ImageEditor openOnClass:self andSelector:#', sel, '\',
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1774
            '     Icon flushCachedIcons', 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1775
            '\    "',
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
            '    <resource: #image>',
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
            '    ^Icon\') withCRs, 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1780
            '        constantNamed:''', imageKey, '''\' withCRs,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1781
            '        ifAbsentPut:[', imageStoreStream contents, ']')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1782
        forClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1783
        inCategory: category.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1784
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1785
    "Modified: / 01-07-2011 / 12:31:12 / cg"
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
createInitialHistoryMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1789
    "add history method containing created-entry
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1790
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1791
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1792
    |code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1793
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1794
    (aClass includesSelector:#history) ifFalse:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1795
        HistoryManager notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1796
            code := HistoryManager codeForInitialHistoryMethodIn:aClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1797
            self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1798
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1799
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1800
                inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1801
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1802
    ].
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
createInstanceCreationMethodWithSetupFor:selector category:category in:aMetaClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1806
    "add an inst-creation method"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1807
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1808
    |template instMthd argNames|
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
    (aMetaClass includesSelector:selector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1811
        instMthd := aMetaClass theNonMetaclass compiledMethodAt:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1812
        (instMthd notNil     
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1813
        and:[  (argNames := instMthd methodArgNames) notEmptyOrNil ])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1814
        ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1815
            template := Parser methodSpecificationForSelector:selector argNames:argNames.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1816
        ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1817
            template := Parser methodSpecificationForSelector:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1818
        ].
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
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1821
            compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1822
template , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1823
    ^ self new ' , template , '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1824
'                   
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1825
            forClass:aMetaClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1826
            inCategory:category.
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1829
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1830
createMultiSetterMethodFor:aCollectionOfVarNames in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1831
    "create a multi-setter method for instvars."
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
    |source|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1834
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1835
    source := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1836
    aCollectionOfVarNames do:[:eachVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1837
        source := source , (eachVar , ':' , eachVar , 'Arg ').
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1838
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1839
    source := source , Character cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1840
    (userPreferences generateCommentsForSetters) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1841
        source := source , ('    "set instance variables"' , Character cr , Character cr).
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
    aCollectionOfVarNames do:[:eachVar |
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1844
        source := source , ('    ' , eachVar , ' := ' , eachVar , 'Arg.' , Character cr).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1845
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1846
    self compile:source forClass:aClass inCategory:#accessing.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1847
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1848
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1849
createSubclassResponsibilityMethodFor:aSelector category:cat in:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1850
    "add a subclassResponsibility method;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1851
     but only if not already present."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1852
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1853
    (aClass includesSelector:aSelector) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1854
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1855
        self compile:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1856
(Method methodDefinitionTemplateForSelector:aSelector) ,
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
    "raise an error: must be redefined in concrete subclass(es)"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1859
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1860
    ^ self subclassResponsibility
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1861
' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1862
              forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1863
              inCategory:cat.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1864
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1865
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1866
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1867
createUpdateMethodIn:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1868
    "create an update:with:from:-method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1869
     (I'm tired of typing)"
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
    |code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1872
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1873
    (aClass includesSelector:#update:with:from:) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1874
        generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1875
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1876
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1877
    super update:something with:aParameter from:changedObject
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
        ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1880
            code :=
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1881
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1882
    "Invoked when an object that I depend upon sends a change notification."
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
    "stub code automatically generated - please change as required"
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
    "/ changedObject == someOfMyValueHolders ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1887
    "/     self doSomethingApropriate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1888
    "/     ^ self.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1889
    "/ ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1890
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1891
'
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1894
        self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1895
            compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1896
            forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1897
            inCategory:#'change & update'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1898
    ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1899
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1900
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1901
createVersionMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1902
    <resource: #obsolete>
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1903
    "add a version method containing RCS template
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1904
     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
  1905
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1906
    |code|
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
    self obsoleteMethodWarning.
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
    aClass isPrivate ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1911
        (aClass includesSelector:#version) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1912
            code := aClass programmingLanguage versionMethodTemplateForCVS.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1913
            self 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1914
                compile:code
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1915
                forClass:aClass 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1916
                inCategory:#documentation.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1917
        ]
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1920
    "Modified (comment): / 21-08-2012 / 11:54:57 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1923
!JavaScriptCodeGeneratorTool methodsFor:'code templates'!
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
anyApplicationClassInProjectOf:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1926
    |prjDefinition|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1927
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1928
    prjDefinition := aClass projectDefinitionClass.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1929
    prjDefinition isNil ifTrue:[ ^ nil ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1930
    ^ (prjDefinition allClasses 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1931
        select:[:cls | cls isSubclassOf:ApplicationModel])
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1932
            firstIfEmpty:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1933
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1934
    "Created: / 21-01-2012 / 13:24:12 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1937
codeFor_classInitialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1938
    generateComments ifFalse:[
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
'function initialize() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1941
%(INIT_CLASSINSTVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1942
%(INIT_CLASSVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1943
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1944
'.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1947
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1948
'function initialize() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1949
    // Invoked at system start or when the class is dynamically loaded.
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
    // please change as required (and remove this comment)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1952
%(INIT_CLASSINSTVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1953
%(INIT_CLASSVARS)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1954
}
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1955
'.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1958
codeFor_closeAccept
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1959
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1960
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1961
'function closeAccept() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1962
    return super.closeAccept();
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
    ].
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
'function closeAccept() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1969
    // This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1970
    // It will be invoked when your dialog-window is closed with OK."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1971
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1972
    // add any actions as required here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1973
    Transcript.showCR("dialog accepted");
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
    // 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
  1976
    return super.closeAccept();
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
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1979
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1980
    "Created: / 27-10-2006 / 10:03:31 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1981
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1982
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1983
codeFor_closeDownViews
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1984
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1985
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1986
'function closeDownViews() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1987
    ^ super closeDownViews
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
'.
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1992
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1993
'function closeDownViews() {
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1994
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1995
     It will be invoked when your app/dialog-window is really closed.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1996
     See also #closeDownViews, which is invoked before and may suppress the close
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  1997
     or ask the user for confirmation."
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
    "/ change the code below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2000
    "/ This should cleanup any leftover resources
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2001
    "/ (for example, temporary files)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2002
    "/ super closeRequest will initiate the closeDown
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2003
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2004
    "/ add your code here
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2005
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2006
    "/ do not remove the one below ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2007
    ^ super closeDownViews
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2008
}
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
    "Created: / 27-10-2006 / 10:01:32 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2014
codeFor_closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2015
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2016
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2017
'closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2018
    self hasUnsavedChanges ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2019
        (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2020
            ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2021
        ]
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
    ^ super closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2024
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2025
    ].
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
'closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2029
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2030
     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
  2031
     closed (this method has a chance to suppress the close).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2032
     See also #closeDownViews, which is invoked when the close is really done."
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
    "/ change the code below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2035
    "/ Closing can be suppressed, by simply returning.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2036
    "/ The ''super closeRequest'' at the end will initiate the real closeDown
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
    self hasUnsavedChanges ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2039
        (self confirm:(resources string:''Close without saving ?'')) ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2040
            ^ self
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
    ^ super closeRequest
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2045
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2046
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2047
    "Created: / 27-10-2006 / 10:01:06 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2048
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2049
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2050
codeFor_emptyMenuActionCodeFor:selector menuItem:item
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2051
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2052
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2053
selector,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2054
    self warn:''no action for ''''',item,''''' defined.''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2055
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2056
    ].
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2059
selector,'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2060
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2061
     It will be invoked when the menu-item ''',item,''' is selected."
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
    "/ change below and add any actions as required here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2064
    self warn:''no action for ''''',item,''''' defined.''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2065
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2066
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2067
    "Created: / 27-10-2006 / 10:16:43 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2068
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2069
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2070
codeFor_hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2071
    generateComments ifFalse:[
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
'hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2074
    ^ false.
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
    ].
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2079
'hasUnsavedChanges
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2080
    "Return true, if any unsaved changes are present 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2081
     (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
  2082
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2083
    "/ 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
  2084
    "/ self halt:''check this code''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2085
    ^ false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2086
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2087
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2088
    "Created: / 27-10-2006 / 10:00:36 / cg"
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
codeFor_menuSaveAs
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
'menuSaveAs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2094
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2095
     It will be invoked when the menu-item ''saveAs'' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2096
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2097
    "/ change below as required... (see examples in Dialog class for more options)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2098
    Dialog
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2099
        requestSaveFileName:(resources string:''Save'') 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2100
        default:''foo.txt'' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2101
        fromDirectory:nil 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2102
        action:[:fileName | self doSaveAs:fileName] 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2103
        appendAction:nil.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2104
'.
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
    "Created: / 27-10-2006 / 10:01:57 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2107
!
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
codeFor_openAboutThisApplication
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2110
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2111
'openAboutThisApplication
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2112
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2113
     It will be invoked when the menu-item ''help-about'' is selected."
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
    "/ could open a customized aboutBox here ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2116
    super openAboutThisApplication
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2119
    "Created: / 27-10-2006 / 10:03:13 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2120
!
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
codeFor_openDocumentation
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2123
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2124
'openDocumentation
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2125
    "This method was generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2126
     It will be invoked when the menu-item ''help-documentation'' is selected."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2127
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2128
    "/ change below as required ...
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2129
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2130
    "/ to open an HTML viewer on some document (under ''doc/online/<language>/'' ):
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2131
    self openDocumentationFile:''TOP.html''.
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
    "/ add application-specific help files under the ''doc/online/<language>/help/appName''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2134
    "/ directory, and open a viewer with:
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2135
    "/ self openDocumentationFile:''help/<MyApplication>/TOP.html''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2136
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2137
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2138
    "Created: / 27-10-2006 / 10:02:55 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2139
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2140
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2141
codeFor_postBuildWith
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2142
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2143
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2144
'postBuildWith:aBuilder
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
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
'postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2151
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2152
     It will be invoked during the initialization of your app/dialog,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2153
     after all of the visual components have been built, 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2154
     but BEFORE the top window is made visible.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2155
     Add any app-specific actions here (reading files, setting up values etc.)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2156
     See also #postOpenWith:, which is invoked after opening."
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
    "/ add any code here ...
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
    ^ super postBuildWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2161
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2162
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2163
    "Created: / 27-10-2006 / 09:59:33 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2164
!
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
codeFor_postOpenWith
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2167
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2168
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2169
'postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2170
    ^ super postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2171
'.
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2175
'postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2176
    "This is a hook method generated by the Browser/CodeGeneratorTool.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2177
     It will be invoked right after the applications window has been opened.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2178
     Add any app-specific actions here (starting background processes etc.).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2179
     See also #postBuildWith:, which is invoked before opening."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2180
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2181
    "/ add any code here ...
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
    ^ super postOpenWith:aBuilder
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2184
'.
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
    "Created: / 27-10-2006 / 09:59:56 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2187
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2188
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2189
codeFor_standAloneApplicationRegistryPathFor:aClassOrNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2190
    |pkg appClass|
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
    pkg := 'someUniqueName'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2193
    aClassOrNil notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2194
        (appClass := self anyApplicationClassInProjectOf:aClassOrNil) notNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2195
            pkg := appClass nameWithoutPrefix.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2196
        ]
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2197
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2198
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2199
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2200
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2201
'applicationRegistryPath
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2202
    ^ #(''stx'' ''%1'') 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2203
' bindWith:pkg.
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2207
'applicationRegistryPath
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2208
    "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
  2209
     as a collection of path-components.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2210
     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
  2211
     in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2212
     (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
  2213
     Used to detect if another instance of this application is already running."
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
    ^ #(''stx'' ''%1'')
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2216
'  bindWith:pkg.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2217
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2218
    "Created: / 21-01-2012 / 11:23:40 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2219
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2220
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2221
codeFor_standAloneApplicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2222
    generateComments ifFalse:[
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
'applicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2225
    ^ UUID fromString:''', UUID genUUID printString, ''' 
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
    ].
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
'applicationUUID
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2231
    "answer an application-specific unique uuid.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2232
     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
  2233
     if another instance of this application is already running.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2234
     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
  2235
     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
  2236
     similar possibly conflicting identifier.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2237
     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
  2238
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2239
    ^ UUID fromString:''', UUID genUUID printString, ''' 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2240
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2241
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2242
    "Created: / 19-08-2011 / 02:13:19 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2245
codeFor_standAloneMain
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2246
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2247
'main:argv
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2248
    "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
  2249
     Parse arguments, and proceed to the real work function"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2250
895
mawalch
parents: 827
diff changeset
  2251
    "you may want to put those into instvars, in order to be accessible from the doRealWork function"
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2252
    |aArgs bArgs cOption fileArgs helpOption|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2253
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2254
    aArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2255
    bArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2256
    fileArgs := OrderedCollection new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2257
    cOption := helpOption := false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2258
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2259
    (GetOpt new)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2260
        at:$a
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2261
            put:[:opt :arg | aArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2262
        at:$b
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2263
            put:[:opt :arg | bArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2264
        at:$b
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2265
            put:[:opt | cOption := true];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2266
        at:$h
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2267
            put:[:opt | helpOption := true];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2268
        at:$? 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2269
            put:[:arg | self usage. Smalltalk exit:0];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2270
        default:[:arg | fileArgs add:arg];
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2271
        parse:argv.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2272
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2273
    helpOption ifTrue:[ 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2274
        self usage. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2275
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2276
        self realMain:argv.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2277
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2278
    "/ do not exit here; caller will go into event loop when returning
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
    "Created: / 19-08-2011 / 02:18:49 / cg"
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2284
codeFor_standAloneRealMainMethodFor:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2285
    |appClass|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2286
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2287
    (appClass := self anyApplicationClassInProjectOf:aClass) notNil ifTrue:[
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
'realMain:args
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2290
    "opens the application"
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
    %1 open
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2293
' bindWith:appClass name
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
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2296
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2297
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2298
'realMain:argsToEcho
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2299
    "just a dummy example - does nothing but echo its arguments"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2300
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2301
    Stdout nextPutLine:''Hello World''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2302
    Stdout nextPutLine:(argsToEcho asStringWith:Character space)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2303
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2304
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2305
    "Created: / 21-01-2012 / 12:28:48 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2306
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2307
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2308
codeFor_standAloneUsage
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
'usage
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2311
    Stderr nextPutLine:''usage: '',self applicationName,'' [options...]''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2312
    Stderr nextPutLine:''  -h .................. output this message''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2313
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2314
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2315
    "Created: / 19-08-2011 / 02:22:46 / cg"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2316
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2317
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2318
code_forWidget_buttonPress
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2319
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2320
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2321
'buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2322
    Transcript show:''button: ''; showCR:button.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2323
    super buttonPress:button x:x y:y
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
    ].
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2328
'buttonPress:button x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2329
    "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
  2330
     x/y are the mouse position at the time of the click.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2331
     There are also corresponding buttonRelease and buttonMotion methods which could be
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2332
     redefined...."
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
    Transcript show:''button: ''; showCR:button.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2335
    "/ super-code handles middleButtonMenu, if it was assigned (with middleButtonmenu:)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2336
    super buttonPress:button x:x y:y
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2339
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2340
code_forWidget_initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2341
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2342
'initialize
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2343
    super initialize "/ to initialize inherited state
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2344
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2345
    "/ add code to initialize private variables,
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2346
    "/ and sub-components as required.
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2349
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2350
code_forWidget_keyPress
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2351
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2352
        ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2353
'keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2354
"/    key == #Copy ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2355
"/    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2356
"/    key == #Cut ifTrue:[
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
    Transcript show:''key: ''; showCR:key.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2359
    super keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2360
'
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
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2363
'keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2364
    "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
  2365
     or a symbol, such as #Copy, #Cut or #Paste.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2366
     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
  2367
     There is also a corresponding keyRelease method which could be redefined...."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2368
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2369
    Transcript show:''key: ''; showCR:key.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2370
    super keyPress:key x:x y:y
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2371
'
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
code_forWidget_redraw
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2375
    |sel comment code|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2376
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2377
    sel := 'redrawX:x y:y width:w height:h'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2378
    generateComments ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2379
        comment := ''.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2380
    ] ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2381
        comment := '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2382
    "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
  2383
     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
  2384
     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
  2385
     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
  2386
     the cross in the outside regions."
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
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2389
    ].
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
    code := '
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2392
    self paint:Color red.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2393
    self fillRectangleX:x y:y width:w height:h.
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
    self paint:Color yellow.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2396
    self displayLineFrom:0@0 to:(width@height).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2397
    self displayLineFrom:width@0 to:(0@height).
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2398
'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2399
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2400
    ^ sel,comment,code
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
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2403
code_forWidget_sizeChanged
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2404
    generateComments ifFalse:[
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
'sizeChanged:how
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2407
    self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2408
    super sizeChanged:how.
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
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2411
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2412
    ^
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2413
'sizeChanged:how
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2414
    "Invoked whenever the size of the view changes. 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2415
     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
  2416
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2417
    self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2418
    super sizeChanged:how.
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
!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2421
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2422
code_forWidget_update
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2423
    generateComments ifFalse:[
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
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2426
    changedObject == model ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2427
        self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2428
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2429
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2430
    super update:something with:aParameter from:changedObject
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
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
'update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2436
    "Invoked when an object that I depend upon sends a change notification."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2437
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2438
    "stub code automatically generated - please change as required"
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2439
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2440
    changedObject == model ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2441
        self invalidate.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2442
        ^ self
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2443
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2444
    super update:something with:aParameter from:changedObject
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2445
'
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2446
! !
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2447
827
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2448
!JavaScriptCodeGeneratorTool methodsFor:'compilation'!
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2449
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2450
compilerClass
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2451
    "Return a real compiler classto use to compile code"
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2452
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2453
    ^ JavaScriptCompiler
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2454
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2455
    "Created: / 05-08-2014 / 21:03:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2456
! !
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2457
544
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2458
!JavaScriptCodeGeneratorTool methodsFor:'private'!
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2459
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2460
codeFor_shouldImplementFor:selector inClass:aClass
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2461
    "used in the 'generate required protocol' to generate a shouldImplement-sending
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2462
     method for each subclassClassresponsibility method above aClass."
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2463
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2464
    |mthd comment implClass methodBodyStream searcher errorMessageString|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2465
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2466
    (aClass notNil
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2467
    and:[ aClass superclass notNil ]) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2468
        implClass := aClass superclass whichClassImplements:selector.
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
    implClass isNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2471
        ^ ((Method methodDefinitionTemplateForSelector:selector),'\    ^ self shouldImplement\') withCRs
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2472
    ].
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
    mthd := implClass compiledMethodAt:selector.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2475
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2476
    methodBodyStream := '' writeStream.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2477
    methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2478
        nextPutAll:mthd methodDefinitionTemplate; cr;
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2479
        nextPutAll:'    "'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2480
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2481
    "/ include the comment of the subclassResponsibility-sending method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2482
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2483
    comment := mthd methodComment.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2484
    comment isEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2485
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2486
            nextPutAll:('superclass <1s> says that I am responsible to implement this method'  
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2487
                        expandMacrosWith:implClass name)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2488
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2489
        comment 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2490
            asStringCollection do:[:eachLine|
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2491
                methodBodyStream nextPutAll:eachLine.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2492
            ] separatedBy:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2493
                methodBodyStream cr; nextPutAll:'     '.
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 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2497
        nextPut:$"; cr; cr.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2498
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2499
    "/ include the argument of the subclassResponsibility:-sending method
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2500
    self canUseRefactoringSupport ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2501
        (mthd sends:#subclassResponsibility:) ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2502
            searcher := ParseTreeSearcher new.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2503
            searcher
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2504
                    matches: 'self subclassResponsibility: `''.*'''
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2505
                    do:[:node :answer | 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2506
                        errorMessageString := node arguments first value.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2507
                        true.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2508
                    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2509
            searcher executeTree: (mthd parseTree) initialAnswer: false.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2510
        ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2511
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2512
    errorMessageString notEmptyOrNil ifTrue:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2513
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2514
            nextPutAll:'    ^ self shouldImplement:'; 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2515
            nextPutLine:(errorMessageString storeString)
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2516
    ] ifFalse:[
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2517
        methodBodyStream 
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2518
            nextPutLine:'    ^ self shouldImplement'.
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2519
    ].
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2520
4c65ee6de4e7 class definition
Claus Gittinger <cg@exept.de>
parents: 493
diff changeset
  2521
    ^ methodBodyStream contents
493
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2522
! !
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2523
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2524
!JavaScriptCodeGeneratorTool class methodsFor:'documentation'!
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2525
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2526
version_CVS
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2527
    ^ '$Header$'
e04ae3729851 initial checkin
Claus Gittinger <cg@exept.de>
parents:
diff changeset
  2528
! !
827
f4c83dd4faed Fixes in CodeGeneatorTool for to handle properly mixed-language classes.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 544
diff changeset
  2529