UISpecificationTool.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3221 0bd301f4d1e1
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

- All source *.st files are now Unicode UTF8 without BOM
Files are in two groups (fileOut works this way in Smalltalk/X):
- containing a unicode character have "{ Encoding: utf8 }" at the header
- ASCII only are without the header
ca@164
     1
"
ca@164
     2
 COPYRIGHT (c) 1995 by eXept Software AG
ca@164
     3
              All Rights Reserved
ca@164
     4
ca@164
     5
 This software is furnished under a license and may be used
ca@164
     6
 only in accordance with the terms of that license and with the
ca@164
     7
 inclusion of the above copyright notice.   This software may not
ca@164
     8
 be provided or otherwise made available to, or used by, any
ca@164
     9
 other person.  No title to or ownership of the software is
ca@164
    10
 hereby transferred.
ca@164
    11
"
cg@1386
    12
"{ Package: 'stx:libtool2' }"
cg@1386
    13
cg@3214
    14
"{ NameSpace: Smalltalk }"
cg@3214
    15
ca@164
    16
ApplicationModel subclass:#UISpecificationTool
ca@759
    17
	instanceVariableNames:'modifiedHolder aspects specification selection specChannel
ca@1307
    18
		buildInView listOfSpecViews'
ca@164
    19
	classVariableNames:''
ca@164
    20
	poolDictionaries:''
ca@164
    21
	category:'Interface-UIPainter'
ca@164
    22
!
ca@164
    23
ca@1307
    24
ViewScroller subclass:#BuildInView
ca@1573
    25
	instanceVariableNames:''
ca@1307
    26
	classVariableNames:''
ca@1307
    27
	poolDictionaries:''
ca@1307
    28
	privateIn:UISpecificationTool
ca@1307
    29
!
ca@1307
    30
ca@164
    31
!UISpecificationTool class methodsFor:'documentation'!
ca@164
    32
ca@164
    33
copyright
ca@164
    34
"
ca@164
    35
 COPYRIGHT (c) 1995 by eXept Software AG
ca@164
    36
              All Rights Reserved
ca@164
    37
ca@164
    38
 This software is furnished under a license and may be used
ca@164
    39
 only in accordance with the terms of that license and with the
ca@164
    40
 inclusion of the above copyright notice.   This software may not
ca@164
    41
 be provided or otherwise made available to, or used by, any
ca@164
    42
 other person.  No title to or ownership of the software is
ca@164
    43
 hereby transferred.
ca@164
    44
"
ca@164
    45
ca@164
    46
ca@164
    47
ca@164
    48
!
ca@164
    49
ca@164
    50
documentation
ca@164
    51
"
ca@164
    52
    used by the UIPainter to manipulate the specifications of the selected component
ca@164
    53
ca@164
    54
    [author:]
ca@164
    55
        Claus Atzkern
ca@164
    56
ca@164
    57
    [see also:]
ca@164
    58
        UIPainter
ca@164
    59
        UILayoutTool
ca@164
    60
        UIHelpTool
ca@164
    61
"
ca@164
    62
! !
ca@164
    63
cg@1963
    64
!UISpecificationTool class methodsFor:'help specs'!
cg@1963
    65
cg@1963
    66
helpSpec
cg@1963
    67
    "This resource specification was automatically generated
cg@1963
    68
     by the UIHelpTool of ST/X."
cg@1963
    69
cg@1963
    70
    "Do not manually edit this!! If it is corrupted,
cg@1963
    71
     the UIHelpTool may not be able to read the specification."
cg@1963
    72
cg@1963
    73
    "
cg@1963
    74
     UIHelpTool openOnClass:UISpecificationTool    
cg@1963
    75
    "
cg@1963
    76
cg@1963
    77
    <resource: #help>
cg@1963
    78
cg@1963
    79
    ^ super helpSpec addPairsFrom:#(
cg@1963
    80
cg@3214
    81
#addTabAction
cg@3214
    82
''
cg@3214
    83
cg@2830
    84
#allowNilColor
cg@2830
    85
'Add an option to allow a nil-Color to be choosen'
cg@2830
    86
sv@2316
    87
#allowSymbolicColors
cg@2335
    88
'ColorMenu is allowed to return a symbolic color name'
cg@2335
    89
cg@2335
    90
#allowSymbolicFonts
cg@2335
    91
'FontMenu is allowed to return a symbolic font name'
sv@2316
    92
cg@2209
    93
#browseAction
cg@2902
    94
'Browse/Create the Action method'
cg@2209
    95
cg@2237
    96
#browseAspectMethod
cg@2902
    97
'Browse/Create the Aspect method'
cg@2237
    98
sv@2283
    99
#editListSpec
sv@2283
   100
'Edit the contents of the list (inline)'
sv@2283
   101
sv@2316
   102
#labelsAreColored
cg@2830
   103
'Draw the labels in their color (otherwise, draw the background)'
sv@2316
   104
cg@2377
   105
#showFrame
cg@2377
   106
'Show the frame'
cg@2377
   107
cg@2830
   108
#showUseDefaultToggle
cg@2830
   109
'Add a toggle to choose the "default" color (resulting color will be nil)'
cg@2830
   110
cg@1963
   111
)
cg@1963
   112
! !
cg@1963
   113
cg@2209
   114
!UISpecificationTool class methodsFor:'image specs'!
cg@2209
   115
cg@2209
   116
browseActionImage
cg@2209
   117
    ^ UIPainter browseActionImage
sv@2283
   118
!
sv@2283
   119
sv@2283
   120
editTableIcon
sv@2283
   121
    ^ UIPainter editTableIcon
cg@2209
   122
! !
cg@2209
   123
ca@164
   124
!UISpecificationTool class methodsFor:'interface specs'!
ca@164
   125
ca@164
   126
windowSpec
ca@1307
   127
    "This resource specification was automatically generated
ca@1307
   128
     by the UIPainter of ST/X."
ca@164
   129
ca@1307
   130
    "Do not manually edit this!! If it is corrupted,
ca@1307
   131
     the UIPainter may not be able to read the specification."
ca@164
   132
ca@164
   133
    "
ca@164
   134
     UIPainter new openOnClass:UISpecificationTool andSelector:#windowSpec
ca@164
   135
     UISpecificationTool new openInterface:#windowSpec
ca@1307
   136
     UISpecificationTool open
ca@164
   137
    "
ca@164
   138
ca@164
   139
    <resource: #canvas>
ca@164
   140
ca@1307
   141
    ^ 
cg@3107
   142
    #(FullSpec
cg@3107
   143
       name: windowSpec
cg@3107
   144
       window: 
cg@3107
   145
      (WindowSpec
cg@3107
   146
         label: 'unnamed canvas'
cg@3107
   147
         name: 'unnamed canvas'
cg@3107
   148
         bounds: (Rectangle 0 0 300 300)
cg@3107
   149
       )
cg@3107
   150
       component: 
cg@3107
   151
      (SpecCollection
cg@3107
   152
         collection: (
cg@3107
   153
          (ArbitraryComponentSpec
cg@3107
   154
             name: 'BuildInView'
cg@3107
   155
             layout: (LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
cg@3107
   156
             hasVerticalScrollBar: false
cg@3107
   157
             miniScrollerVertical: false
cg@3107
   158
             autoHideScrollBars: true
cg@3107
   159
             hasBorder: false
cg@3107
   160
             component: buildInView
ca@1307
   161
           )
cg@3107
   162
          )
cg@3107
   163
        
cg@3107
   164
       )
cg@3107
   165
     )
ca@164
   166
! !
ca@164
   167
cg@1781
   168
!UISpecificationTool class methodsFor:'resources'!
cg@1781
   169
cg@1781
   170
classResources
cg@1781
   171
    "my translations are found in the UIPainter classes resources"
cg@1781
   172
cg@1781
   173
    ^ UIPainter classResources 
cg@1781
   174
! !
cg@1781
   175
cg@1331
   176
!UISpecificationTool methodsFor:'accessing-channels'!
ca@164
   177
ca@1315
   178
modifiedHolder:aValueHolder
ca@1315
   179
    "set the value holder set to true in case of modifying attributes
ca@1315
   180
    "
cg@1063
   181
ca@1315
   182
    modifiedHolder removeDependent:self.
ca@1315
   183
ca@1315
   184
    (modifiedHolder := aValueHolder) notNil ifTrue:[
ca@1315
   185
        modifiedHolder addDependent:self.
ca@1315
   186
    ].
ca@1315
   187
ca@1315
   188
! !
ca@1315
   189
cg@1331
   190
!UISpecificationTool methodsFor:'accessing-specification'!
cg@1063
   191
cg@2245
   192
listOfAspects
cg@2245
   193
    ^ masterApplication listOfAspects
cg@2245
   194
cg@2245
   195
    "Created: / 12-01-2008 / 19:24:39 / cg"
cg@2245
   196
!
cg@2245
   197
cg@2245
   198
listOfCallbacks
cg@2245
   199
    ^ masterApplication listOfCallbacks
cg@2245
   200
cg@2245
   201
    "Created: / 12-01-2008 / 19:25:05 / cg"
cg@2245
   202
!
cg@2245
   203
ca@172
   204
specification
ca@172
   205
    "gets current edit specification
ca@172
   206
    "
ca@172
   207
    ^ specification
ca@172
   208
ca@172
   209
ca@172
   210
!
ca@172
   211
ca@172
   212
specification:aSpec
ca@172
   213
    "sets current edit specification
ca@172
   214
    "
ca@1315
   215
    aSpec notNil ifTrue:[
ca@1315
   216
        "/ same type of spec - simply change the spec;  no need to setup everything
ca@1315
   217
        specification class == aSpec class ifTrue:[
ca@1315
   218
            specification := aSpec.
ca@1315
   219
            specChannel value:specification.
ca@1315
   220
          ^ self
ca@1315
   221
        ]
ca@1307
   222
    ].
ca@428
   223
ca@1315
   224
    "/ release resources
ca@1315
   225
    specChannel release.
ca@1315
   226
    aspects     release.
ca@1315
   227
    selection := listOfSpecViews := nil.
ca@1573
   228
    buildInView destroyAllClientViews.
ca@1315
   229
ca@1315
   230
    (specification := aSpec) isNil ifTrue:[
ca@1315
   231
        aspects := specChannel := nil.
ca@1315
   232
      ^ self
ca@1307
   233
    ].
ca@1307
   234
    
ca@1307
   235
    "/ some tricky specs need the builder during the addBindings phase.
ca@1307
   236
    "/ This is passed down in a special UIBindingsDictionary
ca@1307
   237
    "/ (remain backward compatible)
ca@428
   238
ca@1307
   239
    aspects := UISpecification newBindingsDictionary.
ca@1307
   240
    aspects builder:builder.
ca@1307
   241
    aspects at:#modifiedChannel put:modifiedHolder.
ca@1307
   242
    aspects at:#acceptChannel   put:self acceptChannel.
cg@893
   243
cg@2245
   244
    aspects at:#listOfAspects put:[self listOfAspects].
cg@2245
   245
    aspects at:#listOfCallbacks put:[self listOfCallbacks].
cg@2245
   246
ca@1307
   247
    specChannel := specification asValue.
ca@1307
   248
    specification class addBindingsTo:aspects for:specification channel:specChannel.
cg@893
   249
ca@1307
   250
    "/ arrange for being notified, if any aspect changes
ca@1307
   251
    aspects do:[:el| el addDependent:self ].
cg@2245
   252
cg@2245
   253
    "Modified: / 12-01-2008 / 19:28:47 / cg"
ca@172
   254
! !
ca@172
   255
cg@364
   256
!UISpecificationTool methodsFor:'actions'!
cg@364
   257
cg@364
   258
setMaxExtent
cg@364
   259
    "set the windows maxExtent from its current extent"
cg@364
   260
cg@364
   261
    |canvas currentExtent|
cg@364
   262
cg@2211
   263
    canvas := self masterApplication canvas.
cg@364
   264
    currentExtent := canvas extent.
cg@364
   265
    (self aspectFor:#maxX) value:currentExtent x.
cg@364
   266
    (self aspectFor:#maxY) value:currentExtent y.
cg@364
   267
cg@364
   268
    "Modified: / 29.10.1997 / 18:29:17 / cg"
cg@364
   269
!
cg@364
   270
cg@364
   271
setMinExtent
cg@364
   272
    "set the windows minExtent from its current extent"
cg@364
   273
cg@364
   274
    |canvas currentExtent|
cg@364
   275
cg@2211
   276
    canvas := self masterApplication canvas.
cg@364
   277
    currentExtent := canvas extent.
cg@364
   278
    (self aspectFor:#minX) value:currentExtent x.
cg@364
   279
    (self aspectFor:#minY) value:currentExtent y.
cg@364
   280
cg@364
   281
    "Created: / 29.10.1997 / 18:17:55 / cg"
cg@364
   282
    "Modified: / 29.10.1997 / 18:28:53 / cg"
cg@364
   283
! !
cg@364
   284
ca@164
   285
!UISpecificationTool methodsFor:'bindings'!
ca@164
   286
ca@1315
   287
acceptChannel
cg@2245
   288
    ^ masterApplication acceptChannel
ca@1315
   289
cg@2245
   290
    "Modified: / 12-01-2008 / 11:28:38 / cg"
ca@1315
   291
!
ca@1315
   292
ca@164
   293
aspectFor:aKey
cg@2245
   294
    "returns the aspect for a key or nil"
cg@2245
   295
ca@164
   296
    aspects notNil ifTrue:[
ca@164
   297
        ^ aspects at:aKey ifAbsent:nil
ca@164
   298
    ].
ca@164
   299
    ^ super aspectFor:aKey
ca@164
   300
cg@2245
   301
    "Modified: / 12-01-2008 / 11:28:52 / cg"
ca@428
   302
!
ca@428
   303
ca@1313
   304
buildInView
ca@1313
   305
    ^ buildInView
ca@1307
   306
!
ca@1307
   307
sv@584
   308
specificationFor:aKey
sv@584
   309
    "this is called if our current specification contains 
sv@584
   310
     subspecifications or subcanvases.
sv@584
   311
     Get the subspecification from the current specification"
sv@584
   312
ca@1307
   313
    specification notNil ifTrue:[
ca@1307
   314
        ^ specification class perform:aKey ifNotUnderstood:nil
sv@584
   315
    ].
sv@584
   316
    ^ nil
ca@164
   317
! !
ca@164
   318
ca@164
   319
!UISpecificationTool methodsFor:'change & update'!
ca@164
   320
ca@172
   321
update
ca@172
   322
    "reload specification
ca@172
   323
    "
ca@172
   324
    specChannel notNil ifTrue:[
ca@172
   325
        specChannel value:specification.
ca@172
   326
    ]
ca@172
   327
ca@172
   328
ca@172
   329
!
ca@172
   330
ca@164
   331
update:something with:someArgument from:someone
ca@164
   332
    "any attribute changed its state in the current specification
ca@164
   333
    "
ca@164
   334
    someone ~~ modifiedHolder ifTrue:[
cg@893
   335
        "/ any in the spec has changed.
cg@893
   336
        "/ update my modified holders value
cg@893
   337
cg@1071
   338
        modifiedHolder value:true
ca@164
   339
    ]
ca@164
   340
cg@893
   341
    "Modified: / 16.7.1998 / 19:25:59 / cg"
ca@164
   342
! !
ca@164
   343
cg@1956
   344
!UISpecificationTool methodsFor:'help'!
cg@1956
   345
cg@2524
   346
basicFlyByHelpTextForKey:aKey
cg@2524
   347
    "activeHelp interface: return some help text for a key.
cg@2524
   348
     Redefined to ask the current components Spec first."
cg@2524
   349
cg@2524
   350
    |helpText|
cg@2524
   351
cg@2524
   352
    "/ first, ask the master (a hook for expecco, to provide different help texts)
cg@2524
   353
    masterApplication notNil ifTrue:[
cg@2524
   354
        helpText := masterApplication basicFlyByHelpTextForKey:aKey.
cg@2524
   355
        helpText notNil ifTrue:[^ helpText ].
cg@2545
   356
cg@2545
   357
        "/ then, ask the master about the spec
cg@2545
   358
        helpText := masterApplication basicHelpTextFromSpecification:specification forKey:aKey.
cg@2545
   359
    ] ifFalse:[
cg@2545
   360
        "/ then, ask the spec
cg@2545
   361
        helpText := (specification helpSpec) at:aKey ifAbsent:nil.
cg@2524
   362
    ].
cg@2524
   363
    helpText notNil ifTrue:[^ helpText ].
cg@2524
   364
cg@2524
   365
    "/ finally, ask myself...
cg@2524
   366
    ^ super basicFlyByHelpTextForKey:aKey.
cg@2524
   367
!
cg@2524
   368
cg@1956
   369
basicHelpTextForKey:aKey
cg@1956
   370
    "activeHelp interface: return some help text for a key.
cg@1956
   371
     Redefined to ask the current components Spec first."
cg@1956
   372
cg@1956
   373
    |helpText|
cg@1956
   374
cg@2524
   375
    "/ first, ask the master (a hook for expecco, to provide different help texts)
cg@2524
   376
    masterApplication notNil ifTrue:[
cg@2524
   377
        helpText := masterApplication basicHelpTextForKey:aKey.
cg@2524
   378
        helpText notNil ifTrue:[^ helpText ].
cg@2545
   379
cg@2545
   380
        "/ then, ask the master about the spec
cg@2545
   381
        helpText := masterApplication basicHelpTextFromSpecification:specification forKey:aKey.
cg@2545
   382
    ] ifFalse:[
cg@2545
   383
        "/ then, ask the spec
cg@2545
   384
        helpText := (specification helpSpec) at:aKey ifAbsent:nil.
cg@2524
   385
    ].
cg@2524
   386
    helpText notNil ifTrue:[^ helpText ].
cg@1956
   387
cg@2524
   388
    "/ finally, ask myself...
cg@2524
   389
    ^ super basicHelpTextForKey:aKey.
cg@1956
   390
! !
cg@1956
   391
ca@1315
   392
!UISpecificationTool methodsFor:'initialization'!
ca@1315
   393
ca@1315
   394
initialize
ca@1315
   395
    super initialize.
ca@1315
   396
    buildInView := BuildInView new.
ca@1573
   397
    buildInView keepViews:true.
ca@1315
   398
! !
ca@1315
   399
ca@164
   400
!UISpecificationTool methodsFor:'selection'!
ca@164
   401
ca@164
   402
selection:something
cg@2743
   403
    "selection changed"
cg@2743
   404
ca@1307
   405
    |slices index spec window|
ca@164
   406
ca@172
   407
    specification notNil ifTrue:[
ca@172
   408
        slices := specification class slices.
ca@1307
   409
        index  := slices findFirst:[:aSlice| aSlice first = something ].
ca@164
   410
ca@1307
   411
        index ~~ 0 ifTrue:[
ca@1307
   412
            spec := specification class perform:((slices at:index) last)
ca@428
   413
        ]
ca@164
   414
    ].
ca@164
   415
ca@172
   416
    spec ~= selection ifTrue:[
ca@1307
   417
        (selection := spec) notNil ifTrue:[
ca@1307
   418
            listOfSpecViews isNil ifTrue:[
ca@1307
   419
                listOfSpecViews := Array new:(slices size).
ca@1307
   420
            ] ifFalse:[
ca@1307
   421
                window := listOfSpecViews at:index
ca@1307
   422
            ].
ca@1307
   423
            window isNil ifTrue:[
ca@1307
   424
                builder buildFromSpec:spec in:(window := SimpleView new).
ca@1307
   425
                listOfSpecViews at:index put:window.
ca@1307
   426
            ].
ca@1307
   427
        ].
ca@1315
   428
        buildInView scrolledView:window.
ca@164
   429
    ].
ca@164
   430
! !
ca@164
   431
ca@1307
   432
!UISpecificationTool::BuildInView methodsFor:'accessing'!
ca@759
   433
ca@2160
   434
mapped
ca@2160
   435
    super mapped.
ca@2160
   436
ca@2160
   437
    scrolledView notNil ifTrue:[
ca@2160
   438
        scrolledView beVisible.
ca@2160
   439
        scrolledView raise.
ca@2160
   440
    ].
ca@2160
   441
!
ca@2160
   442
ca@1307
   443
scrolledView:aView
ca@1307
   444
    "set the view to be scrolled"
ca@1573
   445
    |wrapper y|
ca@759
   446
ca@1307
   447
    scrolledView == aView ifTrue:[^ self].
ca@759
   448
ca@2160
   449
    scrolledView notNil ifTrue:[
ca@2160
   450
        scrolledView unmap.
ca@2160
   451
    ].
ca@2160
   452
    (scrolledView := aView) notNil ifTrue:[
ca@2160
   453
        scrolledView superView ~~ frame ifTrue:[
cg@3107
   454
            frame addSubView:scrolledView.
cg@3107
   455
        ].
cg@3107
   456
        true ifTrue:[
ca@2160
   457
            scrolledView borderWidth:0; level:0.
ca@2160
   458
            scrolledView subViews size == 1 ifTrue:[
ca@2160
   459
                wrapper := scrolledView subViews first.
ca@2160
   460
                wrapper isScrollWrapper ifTrue:[
ca@2160
   461
                    "/ give it a full-relative size, and let it do
ca@2160
   462
                    "/ the scrolling itself.
ca@2160
   463
                    y := 1.0
ca@2160
   464
                ]
ca@2160
   465
            ].
ca@2160
   466
            y isNil ifTrue:[
cg@2350
   467
                y := scrolledView preferredHeight
ca@2160
   468
            ].
cg@3107
   469
            scrolledView allViewBackground:(self viewBackground).
ca@2160
   470
            scrolledView origin:0@0 corner:1.0 @ y.
cg@1351
   471
        ].
ca@2160
   472
    ].    
ca@2160
   473
    shown ifTrue:[
ca@2160
   474
        scrolledView beVisible.
ca@2160
   475
        scrolledView raise.
ca@1307
   476
        self sizeChanged:nil.
ca@1307
   477
    ].
ca@1573
   478
    model value:scrolledView.
ca@759
   479
! !
ca@759
   480
ca@1313
   481
!UISpecificationTool::BuildInView methodsFor:'initialization'!
ca@1313
   482
cg@3107
   483
initialize
cg@3107
   484
    super initialize.
cg@3107
   485
    resizeScrolledViewHorizontal := true.
cg@3107
   486
    resizeScrolledViewVertical   := true.
ca@1313
   487
!
ca@1313
   488
ca@1313
   489
realize
ca@1315
   490
ca@1313
   491
    super realize.
cg@3107
   492
   superView notNil ifTrue:[superView level:0].
ca@1313
   493
! !
ca@1313
   494
ca@164
   495
!UISpecificationTool class methodsFor:'documentation'!
ca@164
   496
ca@164
   497
version
ca@164
   498
    ^ '$Header$'
cg@2631
   499
!
cg@2631
   500
cg@2631
   501
version_CVS
cg@2631
   502
    ^ '$Header$'
ca@164
   503
! !
cg@3107
   504