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