ColorMenu.st
author Claus Gittinger <cg@exept.de>
Sat, 02 May 2020 19:50:29 +0200
changeset 6244 2050c2ab251c
parent 6170 9a8cb71d6859
permissions -rw-r--r--
#REFACTORING by cg class: HierarchicalItem::Example changed: #children (send #label:icon: instead of #labeled:icon:, send #label: instead of #labeled:) class: HierarchicalItem::Example class added: #label: #label:icon: changed: #labeled: #labeled:icon:
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
5769
c628056bc5b3 #BUGFIX by sr
sr
parents: 5681
diff changeset
   384
accept:anItem isUserAction:isUserAction
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   385
    "accept the current selected item (called from my pulldown menus)"
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   386
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   387
    |holder colorAccepted|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   388
5769
c628056bc5b3 #BUGFIX by sr
sr
parents: 5681
diff changeset
   389
    super accept:anItem isUserAction:isUserAction.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   390
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   391
    (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
   392
        holder := self colorHolder.
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   393
        holder == anItem ifTrue:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   394
            self overwriteDefaultToggleChannel value ifTrue:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   395
                colorAccepted := self color.
3413
c7be2e00d9bc Bug D000092: if mark is switched off, show transparent background
Stefan Vogel <sv@exept.de>
parents: 3412
diff changeset
   396
            ] ifFalse:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   397
                holder label:'   '.
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   398
                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
   399
            ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   400
        ] ifFalse:[  
4052
89c60a2b31ae changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4024
diff changeset
   401
            anItem value == #hasNilColorHolder: ifTrue:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   402
                self overwriteDefaultToggleChannel value ifFalse:[
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   403
                    model value:nil withoutNotifying:self
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   404
                ].
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   405
            ] ifFalse:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   406
                colorAccepted := anItem argument.
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   407
                holder label:(Text string:'   ' emphasis:(#backgroundColor->colorAccepted)).
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   408
                self chooseColor:colorAccepted.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   409
            ].
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   410
        ].
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   411
        self class rememberRecentlyUsedColor:colorAccepted.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   412
        acceptAction notNil ifTrue:[
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   413
            acceptAction value:colorAccepted
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   414
        ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   415
    ]
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   416
4068
b4641443cef0 changed: #accept:
Claus Gittinger <cg@exept.de>
parents: 4057
diff changeset
   417
    "Modified: / 17-08-2011 / 08:57:12 / cg"
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   418
    "Modified (comment): / 26-07-2013 / 20:43:19 / cg"
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   419
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   420
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   421
chooseColor:aColor
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   422
    "accept the current selected item"
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   423
3350
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   424
    (model notNil 
5950d4d4a57c care for symbolic color
Claus Gittinger <cg@exept.de>
parents: 3349
diff changeset
   425
    and:[ model isSymbol not]) ifTrue:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   426
        model value:aColor.
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   427
    ].
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   428
    aColor isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   429
        hasNilColorHolder value:true
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   430
    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   431
        color := aColor.
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   432
    ].
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   433
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   434
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   435
!ColorMenu methodsFor:'accessing'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   436
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   437
acceptAction:something
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   438
    acceptAction := something.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   439
!
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   440
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   441
allowNilColor
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   442
    ^ allowNilColor
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   443
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   444
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   445
allowNilColor:aBoolean
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   446
    allowNilColor ~~ aBoolean ifTrue:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   447
        allowNilColor := aBoolean.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   448
        allowNilColor ifTrue:[      
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   449
            self overwriteDefaultToggleChannel value:true.
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   450
            self hasNilColorHolder value:(color notNil).
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   451
        ].
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   452
        self setupMenu.
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   453
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   454
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   455
    "Created: / 24-01-2011 / 10:02:25 / cg"
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   456
    "Modified: / 24-01-2011 / 20:06:28 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   457
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   458
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   459
allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   460
    ^ allowSymbolicColors
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   461
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   462
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   463
allowSymbolicColors:aBoolean
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   464
    allowSymbolicColors := aBoolean.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   465
!
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   466
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   467
color
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   468
    "get current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   469
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   470
    self overwriteDefaultToggleChannel value ifFalse:[^ nil].
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   471
    ^ color
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   472
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   473
    "Modified: / 24-01-2011 / 20:14:27 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   474
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   475
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   476
color:aColor
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   477
    "set current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   478
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   479
    |label newColor|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   480
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   481
"/    aColor isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   482
"/        color notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   483
"/            self halt
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   484
"/        ]
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   485
"/    ].
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   486
    
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   487
    self hasNilColorHolder setValue:aColor isNil.
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   488
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   489
    (aColor isColor or:[aColor isSymbol]) ifFalse:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   490
        self overwriteDefaultToggleChannel value:false.
3445
714802384d86 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3439
diff changeset
   491
        self colorHolder label:'   '.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   492
        (aColor isNil and:[allowNilColor]) ifTrue:[
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   493
            self chooseColor:aColor
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   494
        ]
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   495
    ] ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   496
        newColor := aColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   497
        aColor isSymbol ifTrue:[
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   498
            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
   499
                label  := aColor.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   500
            ] 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
   501
                "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
   502
                 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
   503
                (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
   504
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   505
                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
   506
            ].
3412
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   507
        ].
edde712ea6ed If allowSymbolicColors is false, do not allow 'color names' like halt or error.
Stefan Vogel <sv@exept.de>
parents: 3406
diff changeset
   508
        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
   509
            "show the selected color in the label"
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   510
            label  := Text string: '   ' emphasis:(#backgroundColor->newColor).
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   511
        ].
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   512
        color := newColor.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   513
        self disabledRedrawDo:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   514
            self overwriteDefaultToggleChannel value:true.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   515
            self colorHolder label:label.
3708
de8fd46e5363 changes to use ColorMenu for expecco
Claus Gittinger <cg@exept.de>
parents: 3707
diff changeset
   516
            self chooseColor:aColor
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   517
        ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   518
    ]
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   519
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   520
    "Modified: / 24-01-2011 / 20:09:39 / cg"
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   521
!
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   522
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   523
colorHolder
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   524
    "returns the item which keeps the selected color in its label"
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   525
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   526
    ^ self itemAt:#selection
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   527
!
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   528
3698
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   529
contents
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   530
    ^ self color
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   531
!
bd2778e6a26b +contents
Claus Gittinger <cg@exept.de>
parents: 3530
diff changeset
   532
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   533
hasNilColorHolder
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   534
    hasNilColorHolder isNil ifTrue:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   535
        hasNilColorHolder := false asValue.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   536
        hasNilColorHolder onChangeSend:#hasNilColorHolderChanged to:self.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   537
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   538
    ^ hasNilColorHolder
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   539
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   540
    "Created: / 24-01-2011 / 19:22:49 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   541
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   542
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   543
labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   544
    "controls if labels or their backgrounds will be colored"
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   545
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   546
    ^ labelsAreColored
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   547
!
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   548
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   549
labelsAreColored: aBoolean
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   550
    "sets whether labels or their backgrounds will be colored"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   551
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   552
    |bool|
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   553
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   554
    bool := aBoolean ? false.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   555
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   556
    labelsAreColored ~~ bool ifTrue:[
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   557
        labelsAreColored := bool.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   558
        self setupMenu
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   559
    ].
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   560
!
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   561
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   562
useDefaultColorToggleVisibleHolder
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   563
    useDefaultColorToggleVisibleHolder isNil ifTrue:[
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   564
        useDefaultColorToggleVisibleHolder := true asValue
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   565
    ].
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   566
    ^ useDefaultColorToggleVisibleHolder
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   567
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   568
    "Created: / 18-12-2010 / 13:03:48 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   569
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   570
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
   571
!ColorMenu methodsFor:'accessing-channels'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   572
5643
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   573
enableChannel:aValueHolder
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   574
    super enableChannel:aValueHolder.
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   575
    self updateEnableChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   576
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   577
    "Created: / 23-01-2011 / 16:08:52 / cg"
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   578
!
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   579
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   580
enabledChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   581
    ^ self overwriteDefaultToggleChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   582
"/    ^ enabledChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   583
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   584
    "Modified: / 23-01-2011 / 16:24:12 / cg"
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   585
!
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   586
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   587
model:aValueHolder
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   588
    "set my color channel"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   589
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   590
    super model:aValueHolder.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   591
    model notNil ifTrue:[
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   592
        self updateFromModel
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   593
    ]
5643
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   594
!
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   595
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   596
overwriteDefaultToggleChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   597
    overwriteDefaultToggleChannel isNil ifTrue:[
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   598
        overwriteDefaultToggleChannel := false asValue.
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   599
    ].
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   600
    ^ overwriteDefaultToggleChannel
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   601
ce73dd6f7740 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 5171
diff changeset
   602
    "Modified: / 23-01-2011 / 16:24:00 / cg"
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 methodsFor:'change & update'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   606
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   607
hasNilColorHolderChanged
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   608
    |hasNoColor|
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   609
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   610
    hasNoColor := self hasNilColorHolder value.    
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   611
    self overwriteDefaultToggleChannel value:(hasNoColor not).
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   612
    allowNilColor ifTrue:[
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   613
        hasNoColor ifTrue:[
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   614
            model value:nil withoutNotifying:self
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   615
        ] ifFalse:[
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   616
            color isNil ifTrue:[
5171
a5634271a7a1 #OTHER by stefan
Stefan Vogel <sv@exept.de>
parents: 4849
diff changeset
   617
                color := self whiteColor.
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   618
                self chooseColor:color.
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   619
            ].    
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   620
            model value:color withoutNotifying:self
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   621
        ].
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   622
    ].
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   623
4024
86fe84612950 changed: #hasNilColorHolderChanged
Claus Gittinger <cg@exept.de>
parents: 4003
diff changeset
   624
    "Modified: / 23-03-2011 / 20:02:18 / cg"
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   625
!
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   626
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   627
updateFromModel
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   628
    self color:(model value)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   629
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   630
6170
9a8cb71d6859 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 5981
diff changeset
   631
!ColorMenu methodsFor:'help specs'!
3439
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   632
5681
3d5226f8d4ed #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 5643
diff changeset
   633
helpSpec
3439
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   634
    "This resource specification was automatically generated
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   635
     by the UIHelpTool of ST/X."
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   636
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   637
    "Do not manually edit this!! If it is corrupted,
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   638
     the UIHelpTool may not be able to read the specification."
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   639
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   640
    "
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   641
     UIHelpTool openOnClass:ColorEditDialog    
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   642
    "
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   643
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   644
    <resource: #help>
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   645
5681
3d5226f8d4ed #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 5643
diff changeset
   646
    ^ super helpSpec addPairsFrom:#(
3439
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   647
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   648
#useDefaultColorToggle
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   649
'Turn on, to specify the color here. Turn off to use the default'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   650
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   651
#toggleSymbolicColor
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   652
'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
   653
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   654
#recentlyUsedColors
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   655
'Recently used colors'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   656
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   657
#openColorEditor
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   658
'Open a color editor'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   659
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   660
#pickColorFromScreen
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   661
'Pick a color from the screen'
e6af2a8f0cd4 flybyhelp
Claus Gittinger <cg@exept.de>
parents: 3413
diff changeset
   662
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
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   666
!ColorMenu methodsFor:'initialization'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   667
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   668
colorHistorySubmenu
4643
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   669
    <resource: #programMenu >
a658eca5de88 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4357
diff changeset
   670
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   671
    |menu item|
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   672
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   673
    menu := Menu new.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   674
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   675
    item := MenuItem label:'Copy Color' itemValue:[ self copyColor ].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   676
    item enabled:[ self color notNil ].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   677
    menu addItem:item.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   678
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   679
    item := MenuItem label:'Paste Color' itemValue:[ self pasteColor ].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   680
    item enabled:[ self getClipboardObject isColor].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   681
    menu addItem:item.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   682
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   683
    RecentlyUsedColors notEmptyOrNil ifTrue:[
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   684
        menu addSeparator.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   685
        RecentlyUsedColors do:[:eachRecentlyUsedColor |
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   686
            |label fgColor|
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   687
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   688
            eachRecentlyUsedColor isSymbol ifTrue:[
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   689
                label := eachRecentlyUsedColor  .
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   690
            ] ifFalse:[
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   691
                fgColor := eachRecentlyUsedColor contrastingBlackOrWhite.
3344
cd9cf0a541f3 symbolic colors
Stefan Vogel <sv@exept.de>
parents: 3341
diff changeset
   692
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   693
                label := eachRecentlyUsedColor htmlPrintString.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   694
                label := Text string:(' ', label, ' ') foregroundColor:fgColor backgroundColor:eachRecentlyUsedColor.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   695
            ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   696
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   697
            item := MenuItem label:label argument:eachRecentlyUsedColor.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   698
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   699
            menu addItem:item.
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   700
        ].
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   701
    ].
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   702
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   703
    ^ menu.
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   704
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   705
    "Modified: / 27-12-2018 / 16:35:03 / Claus Gittinger"
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   706
!
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   707
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   708
destroy
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   709
    "release color channel dependency"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   710
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   711
    self model:nil.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   712
    super destroy
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   713
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   714
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   715
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   716
initialize
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   717
    super initialize.
3397
e2ed0ef2c908 default for labelsAreColored is FALSE
Claus Gittinger <cg@exept.de>
parents: 3350
diff changeset
   718
    labelsAreColored    := false.
3349
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   719
    verticalLayout      := false.
fb7d0dea3876 Configure wether symbolic colors are allowed
Stefan Vogel <sv@exept.de>
parents: 3348
diff changeset
   720
    allowSymbolicColors := false.
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   721
    allowNilColor       := true.
2254
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   722
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   723
    self fitFirstPanel:false.
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   724
    "/ enabledChannel := ValueHolder with:false.
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   725
    self setupMenu.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   726
4057
a5e1c40ecf26 changed:
Claus Gittinger <cg@exept.de>
parents: 4052
diff changeset
   727
    "Modified: / 17-07-2011 / 11:02:07 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   728
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   729
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   730
setupMenu
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   731
    |menu toggleItem|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   732
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   733
    menu := self class colorMenu:labelsAreColored value:nil.
3280
c42ab6572f32 support adding user defined colors
ca
parents: 3129
diff changeset
   734
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   735
    menu 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   736
        addItem:(
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   737
            (MenuItem label:nil itemValue:[ self openColorEditDialog ]) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   738
                labelImage:(ToolbarIconLibrary palette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   739
                nameKey:#pseudoDef;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   740
                activeHelpKey:#openColorEditor;
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   741
                isButton:true;
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   742
                yourself) 
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   743
        beforeIndex:1.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   744
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   745
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   746
        addItem:(
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   747
            (MenuItem label:nil itemValue:[ self pickColorFromScreen ]) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   748
                labelImage:(ToolbarIconLibrary pipette16x16Icon);
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   749
                nameKey:#pseudoPick;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   750
                activeHelpKey:#pickColorFromScreen;
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   751
                isButton:true;
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   752
                yourself) 
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   753
        beforeIndex:1.
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   754
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   755
    menu 
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   756
        addItem:(
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   757
            (MenuItem label:nil submenuChannel:[ self colorHistorySubmenu ])
3707
380dcd111024 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3698
diff changeset
   758
                labelImage:(ToolbarIconLibrary colorHistory16x16Icon);
3401
583c48ec0ab8 ongoing work - dont use
Claus Gittinger <cg@exept.de>
parents: 3397
diff changeset
   759
                nameKey:#pseudoHistory;
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   760
                activeHelpKey:#recentlyUsedColors;
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   761
                isButton:true;
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   762
                yourself) 
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   763
        beforeIndex:1.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   764
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   765
    "/ menu addItem:(MenuItem label:'') beforeIndex:1.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   766
"/    (showDefaultToggle ? true) ifTrue:[
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   767
        toggleItem := MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   768
                        label:(Text string:' ' emphasis:(#backgroundColor->DefaultViewBackgroundColor))
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   769
                        itemValue:#selection.
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   770
        toggleItem isButton: false.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   771
        toggleItem activeHelpKey:#useDefaultColorToggle.    
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   772
        toggleItem isVisible:(self useDefaultColorToggleVisibleHolder).    
3738
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   773
        menu addItem:toggleItem beforeIndex:1.
d05d10503c67 halfway fix
sr
parents: 3736
diff changeset
   774
"/    ].
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   775
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   776
    allowNilColor ifTrue:[
4357
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   777
        toggleItem := MenuItem 
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   778
                        label:'No Color'
f828b5cb3bc6 class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4307
diff changeset
   779
                        itemValue:#'hasNilColorHolder:'.
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   780
        toggleItem isButton:false.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   781
        toggleItem activeHelpKey:#noColor.    
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   782
        toggleItem indication:self hasNilColorHolder.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   783
        menu addItem:toggleItem.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   784
    ].
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   785
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   786
    self menu:menu.
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   787
    self updateEnableChannel
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   788
4143
c979a5bea623 menuitem protocol
Claus Gittinger <cg@exept.de>
parents: 4068
diff changeset
   789
    "Modified: / 09-09-2012 / 13:27:15 / cg"
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   790
    "Modified: / 27-12-2018 / 16:24:14 / Claus Gittinger"
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   791
!
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   792
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   793
updateEnableChannel
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   794
    self do:[:anItem|
3404
18dae88f0f2d help spec
Claus Gittinger <cg@exept.de>
parents: 3401
diff changeset
   795
        anItem value == #selection ifTrue:[
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   796
            anItem indication:self overwriteDefaultToggleChannel.
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   797
            "/ anItem enabled:enabledChannel.
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   798
        ] ifFalse:[
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   799
            anItem value == #hasNilColorHolder: ifTrue:[
3997
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   800
            ] ifFalse:[
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   801
                anItem enabled:self overwriteDefaultToggleChannel.
35c107962304 class definition
Claus Gittinger <cg@exept.de>
parents: 3996
diff changeset
   802
            ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   803
        ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   804
    ]
3981
d6cb72181559 enableChan
Claus Gittinger <cg@exept.de>
parents: 3862
diff changeset
   805
3996
4ef9b35afcdc class definition
Claus Gittinger <cg@exept.de>
parents: 3995
diff changeset
   806
    "Created: / 23-01-2011 / 16:08:06 / cg"
3998
b0ef8a3d446c class definition
Claus Gittinger <cg@exept.de>
parents: 3997
diff changeset
   807
    "Modified: / 24-01-2011 / 19:35:52 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   808
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   809
3406
28d99375fcc7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3404
diff changeset
   810
!ColorMenu methodsFor:'user actions'!
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   811
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   812
copyColor
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   813
    |clr|
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   814
    
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   815
    (clr := self color) notNil ifTrue:[
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   816
        self setClipboardObject:clr
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   817
    ].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   818
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   819
    "Created: / 27-12-2018 / 16:25:37 / Claus Gittinger"
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   820
!
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   821
3530
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   822
keepColorHolderIndicationAlwaysEnabled
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   823
    self colorHolder indication:true.
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   824
    self colorHolder isButton:true.
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   825
!
8c5d769c024c keepColorHolderIndicationAlwaysEnabled
sr
parents: 3445
diff changeset
   826
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   827
openColorEditDialog
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   828
    |defineColorDialog|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   829
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   830
    defineColorDialog := ColorEditDialog new color:(self color).
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   831
    defineColorDialog open.
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   832
    defineColorDialog accepted ifTrue: [
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   833
        self color:(defineColorDialog color)
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   834
    ]
5981
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   835
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   836
    "Modified: / 27-12-2018 / 16:27:01 / Claus Gittinger"
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   837
!
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   838
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   839
pasteColor
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   840
    |clr|
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   841
    
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   842
    (clr := self getClipboardObject) isColor ifTrue:[
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   843
        self color:clr
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   844
    ].
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   845
c5f5e1469128 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 5963
diff changeset
   846
    "Created: / 27-12-2018 / 16:25:44 / Claus Gittinger"
3322
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   847
!
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
pickColorFromScreen
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   850
    |color|
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   851
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   852
    color := Color fromUser.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   853
    color notNil ifTrue:[
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   854
        self color:color.
1a51da8de402 much improved; code cleanup
Claus Gittinger <cg@exept.de>
parents: 3304
diff changeset
   855
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   856
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   857
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   858
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   859
3862
754cfd6ed4b5 changed: #addUserDefinedColors:labels:title:
Claus Gittinger <cg@exept.de>
parents: 3738
diff changeset
   860
version_CVS
4849
Claus Gittinger <cg@exept.de>
parents: 4705
diff changeset
   861
    ^ '$Header$'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   862
! !
4307
e6c7520c455e class: ColorMenu
Claus Gittinger <cg@exept.de>
parents: 4156
diff changeset
   863