~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/snitbutton/snitbutton.tcl

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
ImportĀ upstreamĀ versionĀ 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
 #
 
2
 #   snitbutton.tcl
 
3
 #
 
4
 #   Copyright (c) 2001-2002 by Steve Landers <steve (at) digital-smarties.com>
 
5
 #   Copyright (c) 2004 by Dr. Detlef Groth <detlef (at) dgroth.de>
 
6
 #                      porting to the snit framework
 
7
 #   Copyright (c) 2004 by Uwe Koloska <uwe (at) koloro.de>
 
8
 #                      removing the errors taken from the original
 
9
 #
 
10
 # Changes:
 
11
 # - width is now the width of the buttons
 
12
 # - the background of the standardbuttons is transparent
 
13
 #   and thus the background of the widget is now visible
 
14
 # - options are now interpreted if used as gButton
 
15
 # - sizes are now calculated the right way and honoured
 
16
 #
 
17
 # Bugs:
 
18
 # - there is no "#auto" and thus this package cannot replace gbutton in
 
19
 #   wikit, fixed this by adding a gButton namespace [DDG]
 
20
 
 
21
 package provide snitButton 0.4
 
22
 package provide gbutton 0.4
 
23
 package require Tk
 
24
 package require snit 0.93
 
25
 
 
26
 # this is a wrapper namespace for the gButton command, simply remove the gbutton dir and
 
27
 # add the snitbutton and the snit-dir to replace the itcl based gbutton.
 
28
 namespace eval gButton { }
 
29
 proc ::gButton {cmd path args} {
 
30
     set sb [eval snitButton $path.p $args]
 
31
     pack $sb -side left -fill x -expand no
 
32
     return $sb
 
33
 }
 
34
 proc gButton::modify {args} { eval ::snitButton::modify $args }
 
35
 proc gButton::cget {args} { eval ::snitButton::cget $args }
 
36
 proc gButton::init {args} { }
 
37
 
 
38
 snit::widget snitButton {
 
39
     variable canvas ""
 
40
     variable over
 
41
     variable numbut 0
 
42
     variable wid
 
43
     variable ht
 
44
     variable command
 
45
 
 
46
     option -padx 0
 
47
     option -pady 0
 
48
     option -font ""
 
49
     option -bg ""
 
50
     option -fill ""
 
51
     option -activefill ""
 
52
     option -disabledfill ""
 
53
 
 
54
     typevariable numobj 0
 
55
     typevariable textopts
 
56
     typevariable imageopts
 
57
     typevariable button
 
58
     typevariable up_img ""
 
59
     typevariable down_img ""
 
60
     typevariable disabled_img ""
 
61
     typevariable path ""
 
62
 
 
63
     constructor {args} {
 
64
        #installhull $win
 
65
        $self configurelist $args
 
66
        set ht [expr {[image height $up_img] + 2*$options(-pady)}]
 
67
        set wid [expr {[image width $up_img] + 2*$options(-padx)}]
 
68
        set canvas [canvas $win.c$numobj -height $ht -width $wid \
 
69
                        -highlightthickness 0]
 
70
        if { $options(-bg) ne ""} {
 
71
            $canvas configure -background $options(-bg)
 
72
        }
 
73
        pack $canvas -padx 0 -pady 0
 
74
        incr numobj
 
75
     }
 
76
 
 
77
     proc path {dir} {
 
78
        set path $dir
 
79
     }
 
80
 
 
81
     proc init_opts {canv text} {
 
82
        foreach arg [lsort [$canv itemconfigure img_$text]] {
 
83
            set imageopts([lindex $arg 0]) 1
 
84
        }
 
85
        foreach arg [lsort [$canv itemconfigure txt_$text]] {
 
86
            set textopts([lindex $arg 0]) 1
 
87
        }
 
88
     }
 
89
 
 
90
     proc locate {text} {
 
91
        return $button($text)
 
92
     }
 
93
 
 
94
     proc modify {text args} {
 
95
        if {[info exists button($text)]} {
 
96
            #puts "$text  $args"
 
97
            eval $button($text) config $text $args
 
98
        }
 
99
     }
 
100
 
 
101
     proc cget {text opt} {
 
102
        if {[info exists button($text)]} {
 
103
            eval $button($text) get $text $opt
 
104
        }
 
105
     }
 
106
 
 
107
     method new {text {cmd ""}} {
 
108
        set x [expr {$numbut * $wid + $options(-padx)}]
 
109
        set y $options(-pady)
 
110
        set tag0 [$canvas create image $x $y -image $up_img -tag img_$text \
 
111
                      -anchor nw]
 
112
        $canvas bind $tag0 <ButtonPress-1> [list $self press $text down]
 
113
        $canvas bind $tag0 <ButtonRelease-1> [list $self release $text]
 
114
        set command($text) $cmd
 
115
        set x [expr {$x + $wid/2 - $options(-padx)}]
 
116
        set y [expr {$y + $ht/2 - $options(-pady)}]
 
117
        set tag1 [$canvas create text $x $y -tag txt_$text -anchor center \
 
118
                      -text $text]
 
119
        $canvas bind $tag1 <ButtonPress-1> [list $self press $text down]
 
120
        $canvas bind $tag1 <ButtonRelease-1> [list $self release $text]
 
121
        if {$disabled_img != ""} {
 
122
            $canvas itemconfigure $tag0 -disabledimage $disabled_img
 
123
        }
 
124
        if {$options(-fill) != ""} {
 
125
            $canvas itemconfigure $tag1 -fill $options(-fill)
 
126
        }
 
127
        if {$options(-activefill) != ""} {
 
128
            $canvas itemconfigure $tag1 -activefill $options(-activefill)
 
129
        }
 
130
        if {$options(-disabledfill) != ""} {
 
131
            $canvas itemconfigure $tag1 -disabledfill $options(-disabledfill)
 
132
        }
 
133
        if {$options(-font) != ""} {
 
134
            $canvas itemconfigure $tag1 -font $options(-font)
 
135
        }
 
136
        set button($text) [list $self]
 
137
        incr numbut
 
138
        if {[array size textopts] == 0} {
 
139
            init_opts $canvas $text
 
140
        }
 
141
        $self size
 
142
     }
 
143
 
 
144
     method config {text args} {
 
145
        foreach {opt arg} $args {
 
146
            if {$opt == "-command"} {
 
147
                set command($text) $arg
 
148
            } else {
 
149
                if {[info exists imageopts($opt)]} {
 
150
                    $canvas itemconfigure img_$text $opt $arg
 
151
                }
 
152
                if {[info exists textopts($opt)]} {
 
153
                    $canvas itemconfigure txt_$text $opt $arg
 
154
                }
 
155
            }
 
156
        }
 
157
     }
 
158
 
 
159
     method get {text opt} {
 
160
        set result ""
 
161
        if {[info exists textopts($opt)]} {
 
162
            set result [$canvas itemcget txt_$text $opt]
 
163
        } elseif {[info exists imageopts($opt)]} {
 
164
            set result [$canvas itemcget img_$text $opt]
 
165
        }
 
166
        return $result
 
167
     }
 
168
 
 
169
     method press {text event} {
 
170
        if {[string equal $event up]} {
 
171
            $canvas itemconfigure img_$text -image $up_img
 
172
        } else {
 
173
            $canvas itemconfigure img_$text -image $down_img
 
174
        }
 
175
     }
 
176
 
 
177
     method release {text}  {
 
178
        $self press $text up
 
179
        # Do we need to make this "after idle", in case the command is
 
180
        # long running?  Perhaps it is best done in the calling
 
181
        # application if needed
 
182
        uplevel #0 $command($text)
 
183
     }
 
184
 
 
185
     method size {} {
 
186
        $canvas configure -width [expr {$numbut * $wid}]
 
187
     }
 
188
     typeconstructor {
 
189
        set path [file dirname [info script]]
 
190
        set up_img [image create photo -data {
 
191
            R0lGODlhRQAeAMYAAP////v7++zs7N/f39XV1dHR0c3NzcLCwrm5uby8vMfH
 
192
            x7S0tL29vcDAwMHBwbi4uLe3t8vLy8/Pz9DQ0Ojo6MbGxtjY2PLy8rOzs+Tk
 
193
            5Lu7u66urtPT0/b29q+vr6urq8PDw6SkpKampra2trq6upycnKCgoKWlpaen
 
194
            p6mpqZiYmJubm6GhoZeXl7+/v56enqKioqioqJ2dnZ+fn62traOjo6ysrJaW
 
195
            ltra2pGRkYyMjLGxsb6+vtTU1MrKysTExP//////////////////////////
 
196
            ////////////////////////////////////////////////////////////
 
197
            ////////////////////////////////////////////////////////////
 
198
            ////////////////////////////////////////////////////////////
 
199
            /////////////////////////////////////////////////yH5BAEKAB0A
 
200
            LAAAAABFAB4AAAf+gB2Cg4SFhoeIiYqLjI2Oj5CRkpOUlZaXiwIDBAUFBp+g
 
201
            oaKjpKWdBAMClQIFBwgJCa+ws7S1tre4CQw8Lgc9qpEDCgsICAwNDsnKy8zN
 
202
            zs/LDQ0MEQOQAwcPEA4REhPf4OHi4+Tl4RISPg4uCtaNFNkPFRMW9fb3+Pn6
 
203
            +/wTFewUGhXAgKGBBAL8EipcaI9AhGkFGGXQsAEDtwkcCHDYyLGjx48gQ24k
 
204
            QFLjhIcIXGRYVMDDBw8JHFSYSbOmzZs4c+qs8KPBA4IRFYH4EEKEBwwjHihd
 
205
            yrSp06dQoxKkkcKDAkUCSHwoYeLECRQoUoBNQbas2bNo06o1C/aECRP+H0gA
 
206
            O0RhhAgVK0ro3cu3r9+/gAP3XaEibkBEFEiwWNGisePHkCNLnkxZ8goWJA4f
 
207
            yuDiRYnKoEOLjlzihcpEGRTAMKGitevXsGPLnk1btgkYClYiLhBDxgzBwIML
 
208
            5ztDRowCmg1RIEDixQwTfn8Pny74+YwXJAgkL6RJAQ0VMNy+HU++vPnz6NN3
 
209
            haGCRru5mwu4qNGiBA0bMfLr38+/v////dlAw2c1uFCAboloYgAJMdygQgkw
 
210
            0EDQhBRWaOGFGE5IAwwlqHBDDCQYkAojFOCwIA013JCDDiy26OKLMMYoo4s5
 
211
            3FADDSHisB1qJoJAwg405FfDkEQWaeSRSCZTmR8NO5AAggE4IPjOAJ6A4AIJ
 
212
            JIyg5ZZcdunll2Bi6cKTBQywIyMCZLBJJ6W06eabpwyQAXyRCEBBBmoOoOee
 
213
            fPbp55+AypkBBXRiYuihiCb6SCAAOw==
 
214
        }]
 
215
        set disabled_img [image create photo -data {
 
216
            R0lGODlhRQAeAKUAAP////39/ff39/Hx8e3t7ezs7Orq6uXl5eLi4uPj4+Tk
 
217
            5Ofn5+Dg4Onp6eHh4evr6/X19e/v7/n5+d/f3/T09N3d3fv7+9zc3Obm5tnZ
 
218
            2dra2tvb29bW1tfX19TU1NXV1djY2NPT09HR0c/Pz97e3v//////////////
 
219
            ////////////////////////////////////////////////////////////
 
220
            /////////////////////////////////yH5BAEKAD8ALAAAAABFAB4AAAb+
 
221
            wJ9wSCwaj8ikcslsOp/QqHRKrVqvzkLBwO16v+CwWIv9FQ6IRCKtbrvf8Lhc
 
222
            rVAcqgsGIn3o+/+AgYKDggkNUgcODgcND46PkJGSk5STDQcKC1CJDgsPEaCh
 
223
            oqOkpaanDwuZWRMTBw8Ep7KztKEElwkFTQgVro0FBFrCw8TFxsfCBMrBD5cI
 
224
            CkwFFRcVCQcL2Nna29zd3t8LGImtukoYFxkavQyK7e7v8PHy8w6tFRsVmkoI
 
225
            FxwdGek0bNAgcIPBgwgTKlzI8CDBDB06XECwhIEGDx84aNzIsaPHjyBDdvzg
 
226
            YeISBCBIeljJsqXLlzBjynz5AQRFJQo0ztzJs+e+S43QlCwA0cGn0aMwO4DQ
 
227
            l6TABn8io0qdyrEDhw3l9vmz2pEr1a8hI1q9uWRBBQ8gIIpdy7at27dwxWYA
 
228
            4SFfkwIKMnjgMK2h37+AqXHwkEFB1iUGEGwIsRdEr1aQI0ueTLmyPRCDQ2xA
 
229
            YABK4goZQogYQbq06dOoU6s2LSJEhgqcpRjAgIDEvQ0Ac+vezbu37wwGK5BA
 
230
            gKHzlC0YFOxhwLy58+fQo0vfo6D4YSpaxGjfzp1Mme/gw4sfTx5LEAA7
 
231
        }
 
232
                         ]
 
233
        set down_img [image create photo -data {
 
234
            R0lGODlhRQAeAMYAAP////n5+eXl5dLS0sXFxb+/v7i4uKWrsZGfsZGluIul
 
235
            xYufxZGlxZelv5+lsb/FxauxuIuXsZGly5Gry5ery5eluLG4uIufuIWfv6W4
 
236
            2au/2bG/2aW40pelxd/f34WfxZ+x0rjL3+zs7IuXq36Xv7jF37/L39nZ2Z+f
 
237
            q3eRuLHF36Wlq/Ly8oWRpXGLuHeRv5ex0ouXpaurq3eLq2SFsWuFuH6XxX6f
 
238
            xXGRv2uLuH6RsbGxsZ+fn1d3sV1+uGSFuGuFv2uLv5eXl1FxsVF3uFd3uGR+
 
239
            q0pxuKWlpWt3l1F3v0pxv3d+i1d+xUpxxYWFi2R3pVF+0kp30nF3hV13v1F+
 
240
            2Up32Up+2YuLi2RxhWR+v1eF2X5+fmRxd113pWSR312R31eL34WFhWtrcWRx
 
241
            fmR3l2uR0nGX38vLy2tra2RkZF1dXZGRkf//////////////////////////
 
242
            /////////////////////////////////////////////////yH5BAEKAH8A
 
243
            LAAAAABFAB4AAAf+gH+Cg4SFhoeIiYqLjI2Oj5CRkpOUlZaXiwIDBAUFBp+g
 
244
            oaKjpKWdBAMClQIFBwgJCgsKs7S1tre4uQoMDQ4HD6qRAxARCwsSExTKy8zN
 
245
            zs/QzBMTFRYDkAMHFxgUGRob4OHi4+Tl5uIaGhwUHRDXjR7aHyAbIfb3+Pn6
 
246
            +/z9GyDtPDASUWAEiQkaSoQwwbChw4cQI0qMGKJEBmoFRCw6gSIFiW4bVJRQ
 
247
            QbKkyZMoU6okWaLlyA0XF6w4sahACxcvFFAAwbOnz59AgwodCgLGhA8kYhRQ
 
248
            JELGDBo1Xti48aGq1atYs2rdytWGDRw5dOzQiEgADxc9fPz4AQRIkLb+QeLK
 
249
            nUu3rt27c9v+8OHDBY9ghzwIqTGESJHDiBMrXsy4sWPFRIb4FXhIhAceRogc
 
250
            2cy5s+fPoEOLBk3ECA8PZAuJOIEkiZIlsGPLnk27tu3btZUkQXIiNaHVO5g0
 
251
            cUK8uPHjyJMrX568CZMdvSt7KPAEShQp2LNr3869u/fv26NAeVIANSIPBHhM
 
252
            oVLFivv3V97Ln0+/vv36V6pQmcKDAOVDmuyARRZabFHFgQgmqOCCDDboYBVb
 
253
            aJEFFjukkshqBSDBRRdefAFGGCCGKOKIJJZoIolgfOFFF1wgUUB0iWhiAA9i
 
254
            jEFGGVqYccaOPPbo449ABrmjGVqUQcYYYvCXYICFTHmAxoxYcJGGGmtUaeWV
 
255
            WGap5ZZXqpEGF1goiYZ5i6z2pAw8sIGFGGJw4eabcMYp55x0sokFGzzIYAAa
 
256
            MA7kwQCeyIAEDzwIYeihiCaq6KKMEoqEngUMQKYjIghwwiadlKLpppyeMsAJ
 
257
            Avj2SKUenHDpAKimquqqrLbq6qcneBAqJiLUauutuOaq6665YuLrr4gEAgA7
 
258
        }
 
259
                     ]
 
260
     }
 
261
 
 
262
 }