ColorMenu.st
author Stefan Vogel <sv@exept.de>
Tue, 27 May 2008 13:34:53 +0200
changeset 3413 c7be2e00d9bc
parent 3412 edde712ea6ed
child 3439 e6af2a8f0cd4
permissions -rw-r--r--
Bug D000092: if mark is switched off, show transparent background
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
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    14
MenuPanel subclass:#ColorMenu
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
    15
	instanceVariableNames:'enabledChannel labelsAreColored color colorName
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
    16
		allowSymbolicColors'
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    17
	classVariableNames:'ColorMenuSpec RecentlyUsedColors'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    18
	poolDictionaries:''
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    19
	category:'Interface-UIPainter'
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    20
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    21
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    22
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    23
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    24
copyright
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    25
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    26
 COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    27
              All Rights Reserved
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    28
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    29
 This software is furnished under a license and may be used
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    30
 only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    31
 inclusion of the above copyright notice.   This software may not
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    32
 be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    33
 other person.  No title to or ownership of the software is
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    34
 hereby transferred.
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    35
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    36
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    37
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    38
!
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    39
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    40
documentation
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    41
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    42
    A simple ColorMenu used by the UIPainter
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    43
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    44
    [see also:]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    45
        UIPainter
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    46
        ColorMenuSpec
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    47
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    48
    [author:]
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    49
        Claus Atzkern
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    50
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    51
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    52
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    53
examples
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    54
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    55
  very simple example
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    56
                                                                                [exBegin]                                      
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    57
    |tool top channel|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    58
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    59
    top := StandardSystemView new.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    60
    top extent:250@30.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    61
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    62
    channel := (Color red) asValue.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    63
    tool := self origin:0.0@0.0 corner:1.0@1.0 in:top.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    64
    tool model:channel.
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
    top open.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    67
                                                                                [exEnd]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    68
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    69
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    70
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    71
!ColorMenu class methodsFor:'instance creation'!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    72
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    73
colorMenu:labelAreColored value:aValue
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    74
    "returns a color menu
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    75
    "
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    76
    |menu|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    77
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    78
    menu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    79
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    80
    self colorMenu itemsDo:[:el|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    81
        menu addItem:(self resolveMenuItem:el value:aValue labelAreColored:labelAreColored).
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    82
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    83
    ^ menu
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    84
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    85
    "
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    86
     (ColorMenu colorMenu:true  value:nil) startUp
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    87
     (ColorMenu colorMenu:false value:#aSelector:) startUp
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
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    91
!ColorMenu class methodsFor:'adding & removing user defined items'!
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
    92
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
    93
addUserDefinedColors:aColors labels:labelsOrNil title:aTitle
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
    94
    "add user colors to ALL colormenus"
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
    "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
    97
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
    98
    |size submenu item label fgColor bgColor labels defLabel|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
    99
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   100
    submenu := self userDefinedSubmenu.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   101
    size    := aColors size.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   102
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   103
    size == 0 ifTrue:[  "/ separator
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   104
        submenu addItem:(MenuItem label:'-').
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   105
        ^ self
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   106
    ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   107
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   108
    labels   := labelsOrNil ? #().
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   109
    bgColor  := aColors first.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   110
    defLabel := '        '.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   111
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   112
    bgColor brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   113
                            ifFalse:[ fgColor := Color black ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   114
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   115
    aTitle isEmptyOrNil ifTrue:[ label := labels at:1 ifAbsent:defLabel ]
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   116
                       ifFalse:[ label := aTitle ].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   117
3294
da0fdfe54c4e *** empty log message ***
ca
parents: 3293
diff changeset
   118
    label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:bgColor.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   119
    item  := MenuItem labeled:label.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   120
    submenu addItem:item.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   121
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   122
    size == 1 ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   123
        item argument:bgColor.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   124
    ] ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   125
        item submenu:(submenu := Menu new).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   126
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   127
        aColors keysAndValuesDo:[:idx :aBgColor|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   128
            aBgColor brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   129
                                     ifFalse:[ fgColor := Color black ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   130
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   131
            label := labels at:idx ifAbsent:defLabel.
3294
da0fdfe54c4e *** empty log message ***
ca
parents: 3293
diff changeset
   132
            label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:aBgColor.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   133
            item  := MenuItem labeled:label.
3293
1ae2428ad1e5 *** empty log message ***
ca
parents: 3292
diff changeset
   134
            item argument:aBgColor.
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   135
            
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   136
            submenu addItem:item.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   137
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   138
    ].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   139
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   140
"
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   141
    ColorMenu  removeAllUserDefinedColors.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   142
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   143
    #(
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   144
        #(  Black       16r000000 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   145
        #(  Red         16rff0000 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   146
        nil
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   147
        #(  Rust        16rff6600 16rff8533 16rffa366 16rffc299 16rffe0cc )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   148
        #(  Tangerine   16rff9933 16rffad5c 16rffc285 16rffd6ad 16rffebd6 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   149
        #(  Sunflower   16rffcc00 16rfed633 16rfee066 16rffeb99 16rfff5cc )  
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   150
        #(  Mango       16rffcc99 16rffd6ad 16rffe0c2 16rffebd6 16rfff5eb )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   151
        #(  Buttercup   16rffff66 16rffff85 16rffffa3 16rffffc2 16rffffe0 )
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   152
        #(  Lemon       16rffffcc 16rffffd6 16rffffe0 16rffffeb 16rfffff5 )
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   153
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   154
    ) do:[:aDef| |colors title labels percentage|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   155
        aDef isEmptyOrNil ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   156
            colors := labels := title := nil.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   157
        ] ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   158
            title      := aDef first.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   159
            colors     := OrderedCollection new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   160
            labels     := OrderedCollection new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   161
            percentage := 100.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   162
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   163
            aDef from:2 do:[:rgb|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   164
                colors add:(Color rgbValue:rgb).
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   165
                labels add:('%1    %2 %%' bindWith:title with:percentage).
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   166
                percentage := percentage - 20.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   167
            ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   168
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   169
        ColorMenu addUserDefinedColors:colors labels:labels title:title.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   170
    ].
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   171
"
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   172
!
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   173
3283
a0388721f027 *** empty log message ***
ca
parents: 3280
diff changeset
   174
removeAllUserDefinedColors
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   175
    "flush user defined colors"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   176
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   177
    ColorMenuSpec := nil.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   178
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   179
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   180
userDefinedSubmenu
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   181
    "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
   182
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   183
    |menu submenu item icon|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   184
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   185
    menu := self colorMenu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   186
    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
   187
                     ifNone:nil.
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
    item isNil ifTrue:[
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   190
        icon := ToolbarIconLibrary colorHistory16x16Icon.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   191
        item := MenuItem labeled:icon.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   192
        item nameKey:#userDefined.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   193
        item activeHelpKey:#userDefinedColors.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   194
        menu addItem:item beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   195
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   196
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   197
    (submenu := item submenu) isNil ifTrue:[
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   198
        submenu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   199
        item submenu:submenu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   200
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   201
    ^ submenu
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   202
! !
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   203
3341
9a89b1f33d2a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3323
diff changeset
   204
!ColorMenu class methodsFor:'menu specs'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   205
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   206
colorMenuSpec
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   207
    "color definitions used to build a color menu
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   208
    "
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   209
"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   210
ColorMenuSpec := nil.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   211
"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   212
  ^ #(
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   213
        #(  gray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   214
            gray:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   215
            #(  white
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   216
                veryLightGray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   217
                lightGray
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   218
                gray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   219
                darkGray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   220
                veryDarkGray 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   221
                black 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   222
             )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   223
        )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   224
"/ nil                         "/ separator
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   225
        #(  red
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   226
            red:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   227
            #( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   228
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   229
        #(  green
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   230
            green:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   231
            #( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   232
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   233
        #(  blue
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   234
            blue:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   235
            #( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   236
         )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   237
"/ nil                         "/ separator
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   238
        #(  cyan
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   239
            cyan:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   240
            #( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   241
        )
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   242
        #(  magenta
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   243
            magenta:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   244
            #( veryLight lightened 100 87 67 50 33)
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
        #(  yellow
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   247
            yellow:
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   248
            #( veryLight lightened 100 87 67 50 33)
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   249
        )
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   250
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   251
    )
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   252
! !
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   253
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   254
!ColorMenu class methodsFor:'private'!
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   255
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   256
colorMenu
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   257
    |menu menuItem subItem baseColor color label getColSel submenu colorId|
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   258
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   259
    "ColorMenuSpec := nil"
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   260
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   261
    ColorMenuSpec notNil ifTrue:[ ^ ColorMenuSpec ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   262
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   263
    menu := Menu new.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   264
    self colorMenuSpec do:[:aSlice|
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   265
        menu addItem:(menuItem := MenuItem new).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   266
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   267
        aSlice notNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   268
            colorId   := aSlice at:1.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   269
            getColSel := aSlice at:2.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   270
            baseColor := Color perform:colorId.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   271
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   272
            menuItem label:(Text string:' ' emphasis:(#backgroundColor->baseColor)).
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   273
            menuItem submenu:(submenu := Menu new).
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   274
            menuItem isButton:true.
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   275
            menuItem activeHelpKey:('shadesOf',colorId asUppercaseFirst) asSymbol.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   276
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   277
            aSlice last do:[:el|         
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   278
                color := label := nil.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   279
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   280
                el isSymbol ifTrue:[
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   281
                    el == #veryLight ifTrue:[ 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   282
                        color := baseColor lightened lightened
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   283
                    ] ifFalse:[ el == #lightened ifTrue:[ 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   284
                        color := baseColor perform:el 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   285
                    ] ifFalse:[ 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   286
                        color := Color perform:el 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   287
                    ]].
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   288
                    colorId == #gray ifTrue:[ label := el ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   289
                ] ifFalse:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   290
                    el isNumber ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   291
                        color := Color perform:getColSel with:el.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   292
                    ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   293
                ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   294
                color notNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   295
                    label isNil ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   296
                        label := getColSel, ' ', el printString.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   297
                    ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   298
                    subItem := MenuItem label:' ',label,' '.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   299
                    subItem argument:color.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   300
                    submenu addItem:subItem.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   301
                ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   302
            ]
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   303
        ].
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   304
    ].
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   305
    ColorMenuSpec := menu.
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   306
    ^ menu
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
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   309
resolveMenuItem:aMenuItem value:aValue labelAreColored:labelAreColored
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   310
    |menuItem label color fgColor submenu|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   311
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   312
    label    := aMenuItem rawLabel ? ''.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   313
    menuItem := MenuItem label:label.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   314
    menuItem isButton:(aMenuItem isButton).
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   315
    menuItem activeHelpKey:(aMenuItem activeHelpKey).
3292
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   316
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   317
    aMenuItem hasSubmenu ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   318
        color := aMenuItem argument.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   319
        menuItem argument:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   320
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   321
        (color isColor and:[label isText not]) ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   322
            labelAreColored ifTrue:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   323
                label := Text string:label color:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   324
            ] ifFalse:[
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   325
                color brightness < 0.5 ifTrue:[ fgColor := Color white ]
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   326
                                      ifFalse:[ fgColor := Color black ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   327
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   328
                label := Text string:label foregroundColor:fgColor backgroundColor:color.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   329
            ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   330
            menuItem label:label.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   331
            menuItem value:aValue.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   332
        ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   333
        ^ menuItem
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   334
    ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   335
    submenu := Menu new.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   336
    aMenuItem submenu itemsDo:[:el|
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   337
        submenu addItem:(self resolveMenuItem:el value:aValue labelAreColored:labelAreColored).
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   338
    ].
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   339
    menuItem submenu:submenu.
07786876f1fa *** empty log message ***
ca
parents: 3283
diff changeset
   340
    ^ menuItem
592
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   341
! !
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   342
1808
e8628b502a49 methodCategory change
Claus Gittinger <cg@exept.de>
parents: 1803
diff changeset
   343
!ColorMenu methodsFor:'accepting'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   344
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   345
accept:anItem
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   346
    "accept the current selected item"
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   347
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   348
    |item holder color|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   349
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   350
    item := super accept:anItem.
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   351
    (item notNil and:[((item nameKey ? '') startsWith:'pseudo') not]) ifTrue:[
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   352
        holder := self colorHolder.
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   353
        holder == item ifTrue:[
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   354
            enabledChannel value ifTrue:[
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   355
                color := self color.
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   356
            ] ifFalse:[
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   357
                holder label:(Text string:'   ').
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   358
            ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   359
        ] ifFalse:[  
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   360
            color := item argument.
692
fbf4503f8bc5 selection bug fixed
tz
parents: 668
diff changeset
   361
            holder label:(Text string:'   ' emphasis:(#backgroundColor->color)).
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   362
        ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   363
        self choseColor:color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   364
    ]
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   365
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   366
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   367
choseColor:aColor
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   368
    "accept the current selected item"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   369
3350
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   370
    (model notNil 
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   371
    and:[ model isSymbol not]) ifTrue:[
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   372
        model value:aColor.
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   373
        aColor notNil ifTrue:[
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   374
            RecentlyUsedColors isNil ifTrue:[
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   375
                RecentlyUsedColors := OrderedCollection new.
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   376
            ].
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   377
            RecentlyUsedColors remove:aColor ifAbsent:[].
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   378
            RecentlyUsedColors addFirst:aColor.
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   379
            RecentlyUsedColors size > 20 ifTrue:[
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   380
                RecentlyUsedColors removeLast
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   381
            ].
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   382
        ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   383
    ]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   384
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   385
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   386
!ColorMenu methodsFor:'accessing'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   387
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   388
allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   389
    ^ allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   390
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   391
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   392
allowSymbolicColors:aBoolean
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   393
    allowSymbolicColors := aBoolean.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   394
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   395
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   396
color
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   397
    "get current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   398
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   399
    ^ color
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   400
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   401
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   402
color:aColor
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   403
    "set current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   404
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   405
    |label newColor|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   406
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   407
    (aColor isColor or:[aColor isSymbol]) ifFalse:[
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   408
        enabledChannel value:false
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   409
    ] ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   410
        newColor := aColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   411
        aColor isSymbol ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   412
            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
   413
                label  := aColor.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   414
            ] 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
   415
                "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
   416
                 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
   417
                (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
   418
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   419
                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
   420
            ].
3412
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   421
        ].
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   422
        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
   423
            "show the selected color in the label"
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   424
            label  := Text string: '   ' emphasis:(#backgroundColor->newColor).
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   425
        ].
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   426
        color := newColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   427
        self disabledRedrawDo:[
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   428
            enabledChannel value:true.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   429
            self colorHolder label:label.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   430
            self choseColor:aColor
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   431
        ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   432
    ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   433
!
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   434
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   435
colorHolder
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   436
    "returns the item which keeps the selected color in its label"
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   437
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   438
  ^ self itemAt:#selection
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   439
!
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   440
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   441
labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   442
    "controls if labels or their backgrounds will be colored"
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   443
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   444
    ^ labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   445
!
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   446
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   447
labelsAreColored: aBoolean
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   448
    "sets whether labels or their backgrounds will be colored"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   449
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   450
    |bool|
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   451
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   452
    bool := aBoolean ? false.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   453
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   454
    labelsAreColored ~~ bool ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   455
        labelsAreColored := bool.
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   456
        self setupMenu
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   457
    ].
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   458
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   459
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
   460
!ColorMenu methodsFor:'accessing-channels'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   461
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   462
model:aValueHolder
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   463
    "set my color channel"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   464
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   465
    super model:aValueHolder.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   466
    model notNil ifTrue:[
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   467
        self updateFromModel
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   468
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   469
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   470
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   471
!ColorMenu methodsFor:'change & update'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   472
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   473
updateFromModel
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   474
    self color:(model value)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   475
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   476
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   477
!ColorMenu methodsFor:'initialization'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   478
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   479
colorHistorySubmenu
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   480
    |menu|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   481
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   482
    RecentlyUsedColors isEmptyOrNil ifTrue:[^ nil].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   483
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   484
    menu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   485
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   486
    RecentlyUsedColors do:[:eachRecentlyUsedColor |
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   487
        |label fgColor item|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   488
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   489
        eachRecentlyUsedColor isSymbol ifTrue:[
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   490
            label := eachRecentlyUsedColor  .
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   491
        ] ifFalse:[
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   492
            eachRecentlyUsedColor brightness < 0.5 
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   493
                ifTrue:[ fgColor := Color white ]
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   494
                ifFalse:[ fgColor := Color black ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   495
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   496
            label := eachRecentlyUsedColor htmlPrintString.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   497
            label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:eachRecentlyUsedColor.
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   498
        ].
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   499
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   500
        item := MenuItem labeled:label.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   501
        item argument:eachRecentlyUsedColor.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   502
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   503
        menu addItem:item.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   504
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   505
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   506
    ^ menu.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   507
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   508
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   509
destroy
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   510
    "release color channel dependency"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   511
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   512
    self model:nil.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   513
    super destroy
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   514
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   515
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   516
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   517
initialize
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   518
    super initialize.
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   519
    labelsAreColored    := false.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   520
    verticalLayout      := false.
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   521
    allowSymbolicColors := false.
2254
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   522
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   523
    self fitFirstPanel:false.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   524
    enabledChannel := ValueHolder with:false.
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   525
    self setupMenu.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   526
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   527
    "Modified: / 21.5.1998 / 03:07:26 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   528
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   529
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   530
setupMenu
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   531
    |menu item toggleItem|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   532
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   533
    menu := self class colorMenu:labelsAreColored value:nil.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   534
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   535
    menu 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   536
        addItem:(
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   537
            (MenuItem labeled:nil) 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   538
                labelImage:(ToolbarIconLibrary palette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   539
                value:[ self openColorEditDialog ]; 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   540
                nameKey:#pseudoDef;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   541
                activeHelpKey:#openColorEditor;
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   542
                isButton: true) 
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   543
        beforeIndex:1.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   544
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   545
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   546
        addItem:(
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   547
            (MenuItem labeled:nil) 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   548
                labelImage:(ToolbarIconLibrary pipette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   549
                value:[ self pickColorFromScreen ]; 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   550
                nameKey:#pseudoPick;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   551
                activeHelpKey:#pickColorFromScreen;
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   552
                isButton: true) 
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   553
        beforeIndex:1.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   554
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   555
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   556
        addItem:(
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   557
            (MenuItem labeled:nil)
3323
b4aef3ba5d24 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3322
diff changeset
   558
                labelImage:(ToolbarIconLibrary history16x16Icon);
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   559
                submenuChannel:[ self colorHistorySubmenu ]; 
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   560
                nameKey:#pseudoHistory;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   561
                activeHelpKey:#recentlyUsedColors;
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   562
                isButton: false) 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   563
        beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   564
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   565
    "/ menu addItem:(MenuItem label:'') beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   566
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   567
    toggleItem := MenuItem labeled:(Text string:' ' emphasis:(#backgroundColor->DefaultViewBackgroundColor)).
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   568
    toggleItem value:#selection.
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   569
    toggleItem isButton: false.
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   570
    toggleItem activeHelpKey:#useDefaultColorToggle.    
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   571
    menu addItem:toggleItem beforeIndex:1.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   572
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   573
    self menu:menu.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   574
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   575
    self do:[:anItem|
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   576
        anItem value == #selection ifTrue:[
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   577
            anItem indication:enabledChannel
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   578
        ] ifFalse:[
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   579
            anItem enabled:enabledChannel.
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   580
        ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   581
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   582
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   583
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   584
!ColorMenu methodsFor:'user actions'!
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   585
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   586
openColorEditDialog
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   587
    |defineColorDialog|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   588
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   589
    defineColorDialog := ColorEditDialog new color: self color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   590
    defineColorDialog open.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   591
    defineColorDialog accept value ifTrue: [
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   592
        self color:defineColorDialog color
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   593
    ]
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   594
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   595
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   596
pickColorFromScreen
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   597
    |color|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   598
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   599
    color := Color fromUser.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   600
    color notNil ifTrue:[
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   601
        self color:color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   602
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   603
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   604
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   605
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   606
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   607
version
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   608
    ^ '$Header: /cvs/stx/stx/libwidg2/ColorMenu.st,v 1.54 2008-05-27 11:34:53 stefan Exp $'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   609
! !