ColorMenu.st
author Jan Vrany <jan.vrany@labware.com>
Fri, 02 Sep 2022 11:25:39 +0100
branchjv
changeset 6261 9b7eb7159d29
parent 5970 53fd42d2c814
permissions -rw-r--r--
Fix loong standing bug with some menus not being translated / resolved This has happened with browser "View" menu when sometimes it had the slice resolved and sometimes not. It turned out that it was because the code disabled resources (and therefore slices) resolution when processing shortcuts, so the menu was created and cached unresolved. This fixes the issue. eXept apparently run into the same problem.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     1
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     2
 COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     3
              All Rights Reserved
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     4
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     5
 This software is furnished under a license and may be used
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     6
 only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     8
 be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     9
 other person.  No title to or ownership of the software is
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    10
 hereby transferred.
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    11
"
2935
e3fa9d1a7a64 Moved ColorMenu and FontMenu from libtool2
Stefan Vogel <sv@exept.de>
parents: 2704
diff changeset
    12
"{ Package: 'stx:libwidg2' }"
1803
ad801646be62 category change
Claus Gittinger <cg@exept.de>
parents: 1676
diff changeset
    13
4705
63975d17295d class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
    14
"{ NameSpace: Smalltalk }"
63975d17295d class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
    15
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    16
MenuPanel subclass:#ColorMenu
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
    17
	instanceVariableNames:'overwriteDefaultToggleChannel enabledChannel labelsAreColored
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
    18
		color colorName allowSymbolicColors showDefaultToggle
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
    19
		acceptAction useDefaultColorToggleVisibleHolder allowNilColor
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
    20
		hasNilColorHolder'
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    21
	classVariableNames:'ColorMenuSpec RecentlyUsedColors'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    22
	poolDictionaries:''
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    23
	category:'Interface-UIPainter'
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    24
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    25
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    26
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    27
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    28
copyright
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    29
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    30
 COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    31
              All Rights Reserved
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    32
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    33
 This software is furnished under a license and may be used
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    34
 only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    35
 inclusion of the above copyright notice.   This software may not
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    36
 be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    37
 other person.  No title to or ownership of the software is
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    38
 hereby transferred.
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    39
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    40
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    41
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    42
!
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    43
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    44
documentation
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    45
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    46
    A simple ColorMenu used by the UIPainter
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    47
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    48
    [see also:]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    49
        UIPainter
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    50
        ColorMenuSpec
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    51
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    52
    [author:]
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    53
        Claus Atzkern
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    54
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    55
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    56
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    57
examples
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    58
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    59
  very simple example
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    60
                                                                                [exBegin]                                      
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    61
    |tool top channel|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    62
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    63
    top := StandardSystemView new.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    64
    top extent:250@30.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    65
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    66
    channel := (Color red) asValue.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    67
    tool := self origin:0.0@0.0 corner:1.0@1.0 in:top.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    68
    tool model:channel.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    69
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    70
    top open.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    71
                                                                                [exEnd]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    72
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    73
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    74
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    75
!ColorMenu class methodsFor:'instance creation'!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    76
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    77
colorMenu:labelsAreColored value:aValue
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    78
    "returns a color menu"
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    79
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    80
    |menu|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    81
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    82
    menu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    83
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    84
    self colorMenu itemsDo:[:el|
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    85
        menu addItem:(self resolveMenuItem:el value:aValue labelsAreColored:labelsAreColored).
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    86
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    87
    ^ menu
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    88
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    89
    "
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    90
     (ColorMenu colorMenu:true  value:nil) startUp
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    91
     (ColorMenu colorMenu:false value:#aSelector:) startUp
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    92
    "
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    93
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
    94
    "Modified: / 23-01-2011 / 14:58:32 / cg"
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    95
! !
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    96
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    97
!ColorMenu class methodsFor:'adding & removing user defined items'!
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
    98
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
    99
addUserDefinedColors:aColors labels:labelsOrNil title:aTitle
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   100
    "add user colors to ALL colormenus"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   101
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   102
    "cg: I think this is a bad hack, as it is too global."
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   103
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   104
    |size submenu item label fgColor bgColor labels defLabel|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   105
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   106
    submenu := self userDefinedSubmenu.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   107
    size    := aColors size.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   108
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   109
    size == 0 ifTrue:[  "/ separator
3862
754cfd6ed4b5 changed: #addUserDefinedColors:labels:title:
Claus Gittinger <cg@exept.de>
parents: 3738
diff changeset
   110
        submenu addSeparator.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   111
        ^ self
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   112
    ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   113
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   114
    labels   := labelsOrNil ? #().
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   115
    bgColor  := aColors first.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   116
    defLabel := '        '.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   117
4156
7ee9d00b78f7 class: Color
Stefan Vogel <sv@exept.de>
parents: 4143
diff changeset
   118
    fgColor := bgColor contrastingBlackOrWhite.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   119
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   120
    aTitle isEmptyOrNil ifTrue:[ label := labels at:1 ifAbsent:defLabel ]
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   121
                       ifFalse:[ label := aTitle ].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   122
3294
da0fdfe54c4e *** empty log message ***
ca
parents: 3293
diff changeset
   123
    label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:bgColor.
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   124
    item  := MenuItem label:label.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   125
    submenu addItem:item.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   126
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   127
    size == 1 ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   128
        item argument:bgColor.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   129
    ] ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   130
        item submenu:(submenu := Menu new).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   131
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   132
        aColors keysAndValuesDo:[:idx :aBgColor|
4156
7ee9d00b78f7 class: Color
Stefan Vogel <sv@exept.de>
parents: 4143
diff changeset
   133
            fgColor := aBgColor contrastingBlackOrWhite.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   134
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   135
            label := labels at:idx ifAbsent:defLabel.
3294
da0fdfe54c4e *** empty log message ***
ca
parents: 3293
diff changeset
   136
            label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:aBgColor.
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   137
            item  := MenuItem label:label.
3293
1ae2428ad1e5 *** empty log message ***
ca
parents: 3292
diff changeset
   138
            item argument:aBgColor.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   139
            
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   140
            submenu addItem:item.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   141
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   142
    ].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   143
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   144
"
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   145
    ColorMenu  removeAllUserDefinedColors.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   146
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   147
    #(
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   148
        #(  Black       16r000000 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   149
        #(  Red         16rff0000 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   150
        nil
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   151
        #(  Rust        16rff6600 16rff8533 16rffa366 16rffc299 16rffe0cc )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   152
        #(  Tangerine   16rff9933 16rffad5c 16rffc285 16rffd6ad 16rffebd6 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   153
        #(  Sunflower   16rffcc00 16rfed633 16rfee066 16rffeb99 16rfff5cc )  
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   154
        #(  Mango       16rffcc99 16rffd6ad 16rffe0c2 16rffebd6 16rfff5eb )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   155
        #(  Buttercup   16rffff66 16rffff85 16rffffa3 16rffffc2 16rffffe0 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   156
        #(  Lemon       16rffffcc 16rffffd6 16rffffe0 16rffffeb 16rfffff5 )
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   157
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   158
    ) do:[:aDef| |colors title labels percentage|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   159
        aDef isEmptyOrNil ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   160
            colors := labels := title := nil.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   161
        ] ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   162
            title      := aDef first.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   163
            colors     := OrderedCollection new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   164
            labels     := OrderedCollection new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   165
            percentage := 100.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   166
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   167
            aDef from:2 do:[:rgb|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   168
                colors add:(Color rgbValue:rgb).
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   169
                labels add:('%1    %2 %%' bindWith:title with:percentage).
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   170
                percentage := percentage - 20.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   171
            ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   172
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   173
        ColorMenu addUserDefinedColors:colors labels:labels title:title.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   174
    ].
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   175
"
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   176
!
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   177
3283
a0388721f027 *** empty log message ***
ca
parents: 3280
diff changeset
   178
removeAllUserDefinedColors
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   179
    "flush user defined colors"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   180
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   181
    ColorMenuSpec := nil.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   182
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   183
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   184
userDefinedSubmenu
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   185
    <resource: #programMenu >
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   186
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   187
    "answer the menu entry under which the userdefined color entries are placed"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   188
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   189
    |menu submenu item icon|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   190
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   191
    menu := self colorMenu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   192
    item := menu detectItem:[:el| (el nameKey == #userDefined and:[el submenu notNil]) ]
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   193
                     ifNone:nil.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   194
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   195
    item isNil ifTrue:[
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   196
        icon := ToolbarIconLibrary colorHistory16x16Icon.
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   197
        item := MenuItem label:icon.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   198
        item nameKey:#userDefined.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   199
        item activeHelpKey:#userDefinedColors.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   200
        menu addItem:item beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   201
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   202
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   203
    (submenu := item submenu) isNil ifTrue:[
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   204
        submenu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   205
        item submenu:submenu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   206
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   207
    ^ submenu
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   208
! !
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   209
3709
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   210
!ColorMenu class methodsFor:'history'!
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   211
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   212
rememberRecentlyUsedColor:aColor
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   213
    aColor notNil ifTrue:[
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   214
        RecentlyUsedColors isNil ifTrue:[
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   215
            RecentlyUsedColors := OrderedCollection new.
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   216
        ].
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   217
        RecentlyUsedColors remove:aColor ifAbsent:[].
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   218
        RecentlyUsedColors addFirst:aColor.
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   219
        RecentlyUsedColors size > 20 ifTrue:[
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   220
            RecentlyUsedColors removeLast
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   221
        ].
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   222
    ].
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   223
! !
d8f3b30013c0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3708
diff changeset
   224
3341
9a89b1f33d2a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3323
diff changeset
   225
!ColorMenu class methodsFor:'menu specs'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   226
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   227
colorMenuSpec
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   228
    "color definitions used to build a color menu
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   229
    "
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   230
"because it is cached, you have to:
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   231
    ColorMenuSpec := nil.
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   232
when changing
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   233
"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   234
  ^ #(
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   235
        #(  gray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   236
            gray:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   237
            #(  white
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   238
                veryLightGray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   239
                lightGray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   240
                gray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   241
                darkGray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   242
                veryDarkGray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   243
                black 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   244
             )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   245
        )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   246
"/ nil                         "/ separator
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   247
        #(  red
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   248
            red:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   249
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   250
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   251
        #(  green
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   252
            green:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   253
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   254
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   255
        #(  blue
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   256
            blue:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   257
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   258
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   259
"/ nil                         "/ separator
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   260
        #(  cyan
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   261
            cyan:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   262
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   263
        )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   264
        #(  magenta
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   265
            magenta:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   266
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   267
        )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   268
        #(  yellow
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   269
            yellow:
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   270
            #( veryLight lightened 100 87 67 50 33 25)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   271
        )
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   272
        #(  brown
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   273
            brown:
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   274
            #( veryLight lightened brown darkened veryDark)
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   275
        )
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   276
    )
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   277
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   278
    "Modified: / 23-01-2011 / 16:33:33 / cg"
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   279
! !
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   280
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   281
!ColorMenu class methodsFor:'private'!
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   282
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   283
colorMenu
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   284
    <resource: #programMenu >
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   285
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   286
    |menu menuItem subItem baseColor color label getColSel submenu colorId|
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   287
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   288
    "
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   289
     ColorMenuSpec := nil
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   290
    "
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   291
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   292
    ColorMenuSpec notNil ifTrue:[ ^ ColorMenuSpec ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   293
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   294
    menu := Menu new.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   295
    self colorMenuSpec do:[:aSlice|
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   296
        menu addItem:(menuItem := MenuItem new).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   297
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   298
        aSlice notNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   299
            colorId   := aSlice at:1.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   300
            getColSel := aSlice at:2.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   301
            baseColor := Color perform:colorId.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   302
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   303
            menuItem label:(Text string:' ' emphasis:(#backgroundColor->baseColor)).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   304
            menuItem submenu:(submenu := Menu new).
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   305
            menuItem isButton:true.
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   306
            menuItem activeHelpKey:('shadesOf',colorId asUppercaseFirst) asSymbol.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   307
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   308
            aSlice last do:[:el|         
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   309
                color := label := nil.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   310
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   311
                el isSymbol ifTrue:[
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   312
                    el == #veryLight ifTrue:[ 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   313
                        color := baseColor lightened lightened
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   314
                    ] ifFalse:[ el == #lightened ifTrue:[ 
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   315
                        color := baseColor lightened 
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   316
                    ] ifFalse:[ el == #darkened ifTrue:[ 
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   317
                        color := baseColor darkened 
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   318
                    ] ifFalse:[ el == #veryDark ifTrue:[ 
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   319
                        color := baseColor darkened darkened 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   320
                    ] ifFalse:[ 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   321
                        color := Color perform:el 
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   322
                    ]]]].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   323
                    colorId == #gray ifTrue:[ label := el ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   324
                ] ifFalse:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   325
                    el isNumber ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   326
                        color := Color perform:getColSel with:el.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   327
                    ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   328
                ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   329
                color notNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   330
                    label isNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   331
                        label := getColSel, ' ', el printString.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   332
                    ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   333
                    subItem := MenuItem label:' ',label,' '.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   334
                    subItem argument:color.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   335
                    submenu addItem:subItem.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   336
                ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   337
            ]
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   338
        ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   339
    ].
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   340
    ColorMenuSpec := menu.
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   341
    ^ menu
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   342
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   343
    "Modified: / 23-01-2011 / 16:34:45 / cg"
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   344
!
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   345
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   346
resolveMenuItem:aMenuItem value:aValue labelsAreColored:labelsAreColored
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   347
    <resource: #programMenu >
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   348
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   349
    |menuItem label color fgColor submenu|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   350
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   351
    label    := aMenuItem rawLabel ? ''.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   352
    menuItem := MenuItem label:label.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   353
    menuItem isButton:(aMenuItem isButton).
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   354
    menuItem activeHelpKey:(aMenuItem activeHelpKey).
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   355
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   356
    aMenuItem hasSubmenu ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   357
        color := aMenuItem argument.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   358
        menuItem argument:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   359
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   360
        (color isColor and:[label isText not]) ifTrue:[
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   361
            labelsAreColored ifTrue:[
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   362
                label := Text string:label color:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   363
            ] ifFalse:[
4156
7ee9d00b78f7 class: Color
Stefan Vogel <sv@exept.de>
parents: 4143
diff changeset
   364
                fgColor := color contrastingBlackOrWhite.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   365
                label := Text string:label foregroundColor:fgColor backgroundColor:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   366
            ].
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   367
            menuItem label:label itemValue:aValue.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   368
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   369
        ^ menuItem
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   370
    ].
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   371
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   372
    submenu := Menu new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   373
    aMenuItem submenu itemsDo:[:el|
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   374
        submenu addItem:(self resolveMenuItem:el value:aValue labelsAreColored:labelsAreColored).
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   375
    ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   376
    menuItem submenu:submenu.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   377
    ^ menuItem
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   378
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   379
    "Created: / 23-01-2011 / 14:59:19 / cg"
592
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   380
! !
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   381
1808
e8628b502a49 methodCategory change
Claus Gittinger <cg@exept.de>
parents: 1803
diff changeset
   382
!ColorMenu methodsFor:'accepting'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   383
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   384
accept
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   385
    "must be ignored, as sent by dialogBox's doAccept
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   386
     and is defined in superclass to call accept: with nil argument"
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   387
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   388
    "Created: / 26-07-2013 / 20:43:26 / cg"
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   389
!
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   390
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   391
accept:anItem
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   392
    "accept the current selected item (called from my pulldown menus)"
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   393
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   394
    |holder colorAccepted|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   395
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   396
    super accept:anItem.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   397
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   398
    (anItem notNil and:[((anItem nameKey ? '') startsWith:'pseudo') not]) ifTrue:[
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   399
        holder := self colorHolder.
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   400
        holder == anItem ifTrue:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   401
            self overwriteDefaultToggleChannel value ifTrue:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   402
                colorAccepted := self color.
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   403
            ] ifFalse:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   404
                holder label:'   '.
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   405
                model value:nil withoutNotifying:self
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   406
            ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   407
        ] ifFalse:[  
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   408
            anItem value == #hasNilColorHolder: ifTrue:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   409
                self overwriteDefaultToggleChannel value ifFalse:[
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   410
                    model value:nil withoutNotifying:self
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   411
                ].
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   412
            ] ifFalse:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   413
                colorAccepted := anItem argument.
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   414
                holder label:(Text string:'   ' emphasis:(#backgroundColor->colorAccepted)).
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   415
                self chooseColor:colorAccepted.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   416
            ].
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   417
        ].
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   418
        self class rememberRecentlyUsedColor:colorAccepted.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   419
        acceptAction notNil ifTrue:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   420
            acceptAction value:colorAccepted
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   421
        ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   422
    ]
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   423
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   424
    "Modified: / 17-08-2011 / 08:57:12 / cg"
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   425
    "Modified (comment): / 26-07-2013 / 20:43:19 / cg"
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   426
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   427
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   428
chooseColor:aColor
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   429
    "accept the current selected item"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   430
3350
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   431
    (model notNil 
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   432
    and:[ model isSymbol not]) ifTrue:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   433
        model value:aColor.
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   434
    ].
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   435
    aColor isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   436
        hasNilColorHolder value:true
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   437
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   438
        color := aColor.
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   439
    ].
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   440
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   441
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   442
!ColorMenu methodsFor:'accessing'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   443
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   444
acceptAction:something
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   445
    acceptAction := something.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   446
!
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   447
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   448
allowNilColor
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   449
    ^ allowNilColor
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   450
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   451
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   452
allowNilColor:aBoolean
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   453
    allowNilColor ~~ aBoolean ifTrue:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   454
        allowNilColor := aBoolean.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   455
        allowNilColor ifTrue:[      
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   456
            self overwriteDefaultToggleChannel value:true.
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   457
            self hasNilColorHolder value:(color notNil).
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   458
        ].
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   459
        self setupMenu.
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   460
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   461
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   462
    "Created: / 24-01-2011 / 10:02:25 / cg"
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   463
    "Modified: / 24-01-2011 / 20:06:28 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   464
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   465
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   466
allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   467
    ^ allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   468
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   469
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   470
allowSymbolicColors:aBoolean
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   471
    allowSymbolicColors := aBoolean.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   472
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   473
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   474
color
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   475
    "get current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   476
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   477
    self overwriteDefaultToggleChannel value ifFalse:[^ nil].
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   478
    ^ color
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   479
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   480
    "Modified: / 24-01-2011 / 20:14:27 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   481
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   482
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   483
color:aColor
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   484
    "set current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   485
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   486
    |label newColor|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   487
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   488
"/    aColor isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   489
"/        color notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   490
"/            self halt
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   491
"/        ]
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   492
"/    ].
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   493
    
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   494
    self hasNilColorHolder setValue:aColor isNil.
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   495
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   496
    (aColor isColor or:[aColor isSymbol]) ifFalse:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   497
        self overwriteDefaultToggleChannel value:false.
3445
714802384d86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3439
diff changeset
   498
        self colorHolder label:'   '.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   499
        (aColor isNil and:[allowNilColor]) ifTrue:[
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   500
            self chooseColor:aColor
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   501
        ]
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   502
    ] ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   503
        newColor := aColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   504
        aColor isSymbol ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   505
            allowSymbolicColors ifTrue:[
3412
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   506
                label  := aColor.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   507
            ] ifFalse:[
3412
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   508
                "our caller does not handle symbolic colors (UIPainter does) - convert now.
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   509
                 Be careful - for security reasons - do not perform arbitrary symbols here 
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   510
                (could be #halt, #error)!!"
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   511
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   512
                newColor := Color name:aColor ifIllegal:[color "keep old"].
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   513
            ].
3412
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   514
        ].
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   515
        newColor isSymbol ifFalse:[
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   516
            "show the selected color in the label"
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   517
            label  := Text string: '   ' emphasis:(#backgroundColor->newColor).
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   518
        ].
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   519
        color := newColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   520
        self disabledRedrawDo:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   521
            self overwriteDefaultToggleChannel value:true.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   522
            self colorHolder label:label.
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   523
            self chooseColor:aColor
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   524
        ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   525
    ]
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   526
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   527
    "Modified: / 24-01-2011 / 20:09:39 / cg"
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   528
!
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   529
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   530
colorHolder
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   531
    "returns the item which keeps the selected color in its label"
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   532
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   533
    ^ self itemAt:#selection
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   534
!
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   535
3698
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   536
contents
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   537
    ^ self color
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   538
!
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   539
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   540
enableChannel:aValueHolder
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   541
    super enableChannel:aValueHolder.
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   542
    self updateEnableChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   543
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   544
    "Created: / 23-01-2011 / 16:08:52 / cg"
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   545
!
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   546
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   547
enabledChannel
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   548
    ^ self overwriteDefaultToggleChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   549
"/    ^ enabledChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   550
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   551
    "Modified: / 23-01-2011 / 16:24:12 / cg"
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   552
!
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   553
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   554
hasNilColorHolder
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   555
    hasNilColorHolder isNil ifTrue:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   556
        hasNilColorHolder := false asValue.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   557
        hasNilColorHolder onChangeSend:#hasNilColorHolderChanged to:self.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   558
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   559
    ^ hasNilColorHolder
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   560
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   561
    "Created: / 24-01-2011 / 19:22:49 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   562
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   563
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   564
labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   565
    "controls if labels or their backgrounds will be colored"
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   566
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   567
    ^ labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   568
!
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   569
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   570
labelsAreColored: aBoolean
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   571
    "sets whether labels or their backgrounds will be colored"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   572
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   573
    |bool|
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   574
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   575
    bool := aBoolean ? false.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   576
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   577
    labelsAreColored ~~ bool ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   578
        labelsAreColored := bool.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   579
        self setupMenu
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   580
    ].
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   581
!
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   582
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   583
overwriteDefaultToggleChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   584
    overwriteDefaultToggleChannel isNil ifTrue:[
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   585
        overwriteDefaultToggleChannel := false asValue.
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   586
    ].
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   587
    ^ overwriteDefaultToggleChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   588
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   589
    "Modified: / 23-01-2011 / 16:24:00 / cg"
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   590
!
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   591
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   592
useDefaultColorToggleVisibleHolder
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   593
    useDefaultColorToggleVisibleHolder isNil ifTrue:[
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   594
        useDefaultColorToggleVisibleHolder := true asValue
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   595
    ].
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   596
    ^ useDefaultColorToggleVisibleHolder
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   597
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   598
    "Created: / 18-12-2010 / 13:03:48 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   599
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   600
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
   601
!ColorMenu methodsFor:'accessing-channels'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   602
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   603
model:aValueHolder
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   604
    "set my color channel"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   605
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   606
    super model:aValueHolder.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   607
    model notNil ifTrue:[
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   608
        self updateFromModel
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   609
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   610
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   611
4003
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   612
!ColorMenu methodsFor:'accessing-dimensions'!
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   613
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   614
preferredExtent
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   615
    "workaround: will change the preferredExtent !!!!
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   616
        same in FontMenu"
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   617
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   618
    |extent|
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   619
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   620
    preferredExtent notNil ifTrue:[
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   621
        ^ super preferredExtent.
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   622
    ].
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   623
    extent := super preferredExtent.
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   624
    preferredExtent := nil.
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   625
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   626
    ^ extent
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   627
! !
ed34e80d3840 added: #preferredExtent
ca
parents: 3998
diff changeset
   628
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   629
!ColorMenu methodsFor:'change & update'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   630
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   631
hasNilColorHolderChanged
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   632
    |hasNoColor|
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   633
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   634
    hasNoColor := self hasNilColorHolder value.    
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   635
    self overwriteDefaultToggleChannel value:(hasNoColor not).
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   636
    allowNilColor ifTrue:[
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   637
        hasNoColor ifTrue:[
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   638
            model value:nil withoutNotifying:self
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   639
        ] ifFalse:[
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   640
            color isNil ifTrue:[
5171
a5634271a7a1 #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 4849
diff changeset
   641
                color := self whiteColor.
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   642
                self chooseColor:color.
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   643
            ].    
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   644
            model value:color withoutNotifying:self
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   645
        ].
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   646
    ].
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   647
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   648
    "Modified: / 23-03-2011 / 20:02:18 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   649
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   650
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   651
updateFromModel
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   652
    self color:(model value)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   653
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   654
3439
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   655
!ColorMenu methodsFor:'help'!
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   656
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   657
flyByHelpSpec
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   658
    "This resource specification was automatically generated
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   659
     by the UIHelpTool of ST/X."
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   660
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   661
    "Do not manually edit this!! If it is corrupted,
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   662
     the UIHelpTool may not be able to read the specification."
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   663
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   664
    "
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   665
     UIHelpTool openOnClass:ColorEditDialog    
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   666
    "
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   667
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   668
    <resource: #help>
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   669
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   670
    ^ super flyByHelpSpec addPairsFrom:#(
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   671
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   672
#useDefaultColorToggle
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   673
'Turn on, to specify the color here. Turn off to use the default'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   674
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   675
#toggleSymbolicColor
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   676
'Turn on, to specify a symbolic color. Turn off to specify a concrete color'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   677
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   678
#recentlyUsedColors
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   679
'Recently used colors'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   680
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   681
#openColorEditor
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   682
'Open a color editor'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   683
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   684
#pickColorFromScreen
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   685
'Pick a color from the screen'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   686
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   687
)
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   688
! !
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   689
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   690
!ColorMenu methodsFor:'initialization'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   691
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   692
colorHistorySubmenu
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   693
    <resource: #programMenu >
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   694
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   695
    |menu|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   696
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   697
    RecentlyUsedColors isEmptyOrNil ifTrue:[^ nil].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   698
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   699
    menu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   700
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   701
    RecentlyUsedColors do:[:eachRecentlyUsedColor |
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   702
        |label fgColor item|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   703
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   704
        eachRecentlyUsedColor isSymbol ifTrue:[
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   705
            label := eachRecentlyUsedColor  .
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   706
        ] ifFalse:[
4156
7ee9d00b78f7 class: Color
Stefan Vogel <sv@exept.de>
parents: 4143
diff changeset
   707
            fgColor := eachRecentlyUsedColor contrastingBlackOrWhite.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   708
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   709
            label := eachRecentlyUsedColor htmlPrintString.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   710
            label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:eachRecentlyUsedColor.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   711
        ].
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   712
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   713
        item := MenuItem label:label.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   714
        item argument:eachRecentlyUsedColor.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   715
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   716
        menu addItem:item.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   717
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   718
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   719
    ^ menu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   720
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   721
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   722
destroy
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   723
    "release color channel dependency"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   724
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   725
    self model:nil.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   726
    super destroy
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   727
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   728
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   729
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   730
initialize
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   731
    super initialize.
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   732
    labelsAreColored    := false.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   733
    verticalLayout      := false.
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   734
    allowSymbolicColors := false.
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   735
    allowNilColor       := true.
2254
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   736
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   737
    self fitFirstPanel:false.
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   738
    "/ enabledChannel := ValueHolder with:false.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   739
    self setupMenu.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   740
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   741
    "Modified: / 17-07-2011 / 11:02:07 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   742
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   743
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   744
setupMenu
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   745
    |menu toggleItem|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   746
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   747
    menu := self class colorMenu:labelsAreColored value:nil.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   748
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   749
    menu 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   750
        addItem:(
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   751
            (MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   752
                    label:nil
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   753
                    itemValue:[ self openColorEditDialog ] 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   754
            ) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   755
                labelImage:(ToolbarIconLibrary palette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   756
                nameKey:#pseudoDef;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   757
                activeHelpKey:#openColorEditor;
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   758
                isButton: true) 
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   759
        beforeIndex:1.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   760
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   761
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   762
        addItem:(
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   763
            (MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   764
                label:nil
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   765
                itemValue:[ self pickColorFromScreen ] 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   766
            ) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   767
                labelImage:(ToolbarIconLibrary pipette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   768
                nameKey:#pseudoPick;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   769
                activeHelpKey:#pickColorFromScreen;
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   770
                isButton: true) 
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   771
        beforeIndex:1.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   772
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   773
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   774
        addItem:(
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   775
            (MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   776
                label:nil
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   777
                submenuChannel:[ self colorHistorySubmenu ] 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   778
            )
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   779
                labelImage:(ToolbarIconLibrary colorHistory16x16Icon);
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   780
                nameKey:#pseudoHistory;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   781
                activeHelpKey:#recentlyUsedColors;
3995
4917660dba28 added: #resolveMenuItem:value:labelsAreColored:
Claus Gittinger <cg@exept.de>
parents: 3981
diff changeset
   782
                isButton: true) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   783
        beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   784
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   785
    "/ menu addItem:(MenuItem label:'') beforeIndex:1.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   786
"/    (showDefaultToggle ? true) ifTrue:[
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   787
        toggleItem := MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   788
                        label:(Text string:' ' emphasis:(#backgroundColor->DefaultViewBackgroundColor))
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   789
                        itemValue:#selection.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   790
        toggleItem isButton: false.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   791
        toggleItem activeHelpKey:#useDefaultColorToggle.    
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   792
        toggleItem isVisible:(self useDefaultColorToggleVisibleHolder).    
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   793
        menu addItem:toggleItem beforeIndex:1.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   794
"/    ].
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   795
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   796
    allowNilColor ifTrue:[
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   797
        toggleItem := MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   798
                        label:'No Color'
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   799
                        itemValue:#'hasNilColorHolder:'.
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   800
        toggleItem isButton:false.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   801
        toggleItem activeHelpKey:#noColor.    
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   802
        toggleItem indication:self hasNilColorHolder.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   803
        menu addItem:toggleItem.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   804
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   805
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   806
    self menu:menu.
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   807
    self updateEnableChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   808
4143
c979a5bea623 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 4068
diff changeset
   809
    "Modified: / 09-09-2012 / 13:27:15 / cg"
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   810
!
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   811
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   812
updateEnableChannel
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   813
    self do:[:anItem|
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   814
        anItem value == #selection ifTrue:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   815
            anItem indication:self overwriteDefaultToggleChannel.
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   816
            "/ anItem enabled:enabledChannel.
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   817
        ] ifFalse:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   818
            anItem value == #hasNilColorHolder: ifTrue:[
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   819
            ] ifFalse:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   820
                anItem enabled:self overwriteDefaultToggleChannel.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   821
            ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   822
        ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   823
    ]
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   824
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   825
    "Created: / 23-01-2011 / 16:08:06 / cg"
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   826
    "Modified: / 24-01-2011 / 19:35:52 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   827
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   828
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   829
!ColorMenu methodsFor:'user actions'!
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   830
3530
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   831
keepColorHolderIndicationAlwaysEnabled
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   832
    self colorHolder indication:true.
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   833
    self colorHolder isButton:true.
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   834
!
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   835
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   836
openColorEditDialog
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   837
    |defineColorDialog|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   838
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   839
    defineColorDialog := ColorEditDialog new color: self color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   840
    defineColorDialog open.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   841
    defineColorDialog accept value ifTrue: [
4705
63975d17295d class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4643
diff changeset
   842
        self color:defineColorDialog color
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   843
    ]
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   844
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   845
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   846
pickColorFromScreen
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   847
    |color|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   848
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   849
    color := Color fromUser.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   850
    color notNil ifTrue:[
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   851
        self color:color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   852
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   853
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   854
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   855
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   856
3862
754cfd6ed4b5 changed: #addUserDefinedColors:labels:title:
Claus Gittinger <cg@exept.de>
parents: 3738
diff changeset
   857
version_CVS
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   858
    ^ '$Header$'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   859
! !
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   860