← Back to branch summary

~ubuntu-branches/ubuntu/vivid/grass/vivid-proposed

« back to all changes in this revision

Viewing changes to lib/external/bwidget/dropsite.tcl

  • Committer: Package Import Robot
  • Author(s): Bas Couwenberg
  • Date: 2015-02-20 23:12:08 UTC
  • mfrom: (8.2.6 experimental)
  • Revision ID: package-import@ubuntu.com-20150220231208-1u6qvqm84v430b10
Tags: 7.0.0-1~exp1
* New upstream release.
* Update python-ctypes-ternary.patch to use if/else instead of and/or.
* Drop check4dev patch, rely on upstream check.
* Add build dependency on libpq-dev to grass-dev for libpq-fe.h.
* Drop patches applied upstream, refresh remaining patches.
* Update symlinks for images switched from jpg to png.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/external/bwidget/dropsite.tcl
1
 
# ------------------------------------------------------------------------------
2
 
#  dropsite.tcl
3
 
#  This file is part of Unifix BWidget Toolkit
4
 
#  $Id: dropsite.tcl 10192 2002-01-24 19:25:32Z radim $
5
 
# ------------------------------------------------------------------------------
6
 
#  Index of commands:
7
 
#     - DropSite::include
8
 
#     - DropSite::setdrop
9
 
#     - DropSite::register
10
 
#     - DropSite::setcursor
11
 
#     - DropSite::setoperation
12
 
#     - DropSite::_update_operation
13
 
#     - DropSite::_compute_operation
14
 
#     - DropSite::_draw_operation
15
 
#     - DropSite::_init_drag
16
 
#     - DropSite::_motion
17
 
#     - DropSite::_release
18
 
# ------------------------------------------------------------------------------
19
 
 
20
 
 
21
 
namespace eval DropSite {
22
 
    Widget::declare DropSite {
23
 
        {-dropovercmd String "" 0}
24
 
        {-dropcmd     String "" 0}
25
 
        {-droptypes   String "" 0}
26
 
    }
27
 
 
28
 
    proc use { } {}
29
 
 
30
 
    variable _top  ".drag"
31
 
    variable _opw  ".drag.\#op"
32
 
    variable _target  ""
33
 
    variable _status  0
34
 
    variable _tabops
35
 
    variable _defops
36
 
    variable _source
37
 
    variable _type
38
 
    variable _data
39
 
    variable _evt
40
 
    # key       win    unix
41
 
    # shift       1   |   1    ->  1
42
 
    # control     4   |   4    ->  4
43
 
    # alt         8   |  16    -> 24
44
 
    # meta            |  64    -> 88
45
 
 
46
 
    array set _tabops {
47
 
        mod,none    0
48
 
        mod,shift   1
49
 
        mod,control 4
50
 
        mod,alt     24
51
 
        ops,copy    1
52
 
        ops,move    1
53
 
        ops,link    1
54
 
    }
55
 
 
56
 
    if { $tcl_platform(platform) == "unix" } {
57
 
        set _tabops(mod,alt) 8
58
 
    } else {
59
 
        set _tabops(mod,alt) 16
60
 
    }
61
 
    array set _defops \
62
 
        [list \
63
 
             copy,mod  shift   \
64
 
             move,mod  control \
65
 
             link,mod  alt     \
66
 
             copy,img  @[file join $env(BWIDGET_LIBRARY) "images" "opcopy.xbm"] \
67
 
             move,img  @[file join $env(BWIDGET_LIBRARY) "images" "opmove.xbm"] \
68
 
             link,img  @[file join $env(BWIDGET_LIBRARY) "images" "oplink.xbm"]]
69
 
 
70
 
    bind DragTop <KeyPress-Shift_L>     {DropSite::_update_operation [expr %s | 1]}
71
 
    bind DragTop <KeyPress-Shift_R>     {DropSite::_update_operation [expr %s | 1]}
72
 
    bind DragTop <KeyPress-Control_L>   {DropSite::_update_operation [expr %s | 4]}
73
 
    bind DragTop <KeyPress-Control_R>   {DropSite::_update_operation [expr %s | 4]}
74
 
    if { $tcl_platform(platform) == "unix" } {
75
 
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 8]}
76
 
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 8]}
77
 
    } else {
78
 
        bind DragTop <KeyPress-Alt_L>       {DropSite::_update_operation [expr %s | 16]}
79
 
        bind DragTop <KeyPress-Alt_R>       {DropSite::_update_operation [expr %s | 16]}
80
 
    }
81
 
 
82
 
    bind DragTop <KeyRelease-Shift_L>   {DropSite::_update_operation [expr %s & ~1]}
83
 
    bind DragTop <KeyRelease-Shift_R>   {DropSite::_update_operation [expr %s & ~1]}
84
 
    bind DragTop <KeyRelease-Control_L> {DropSite::_update_operation [expr %s & ~4]}
85
 
    bind DragTop <KeyRelease-Control_R> {DropSite::_update_operation [expr %s & ~4]}
86
 
    if { $tcl_platform(platform) == "unix" } {
87
 
        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~8]}
88
 
        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~8]}
89
 
    } else {
90
 
        bind DragTop <KeyRelease-Alt_L>     {DropSite::_update_operation [expr %s & ~16]}
91
 
        bind DragTop <KeyRelease-Alt_R>     {DropSite::_update_operation [expr %s & ~16]}
92
 
    }
93
 
}
94
 
 
95
 
 
96
 
# ------------------------------------------------------------------------------
97
 
#  Command DropSite::include
98
 
# ------------------------------------------------------------------------------
99
 
proc DropSite::include { class types } {
100
 
    set dropoptions {
101
 
        {-dropenabled Boolean 0  0}
102
 
        {-dropovercmd String  "" 0}
103
 
        {-dropcmd     String  "" 0}
104
 
    }
105
 
    lappend dropoptions [list -droptypes String $types 0]
106
 
    Widget::declare $class $dropoptions
107
 
}
108
 
 
109
 
 
110
 
# ------------------------------------------------------------------------------
111
 
#  Command DropSite::setdrop
112
 
#  Widget interface to register
113
 
# ------------------------------------------------------------------------------
114
 
proc DropSite::setdrop { path subpath dropover drop {force 0}} {
115
 
    set cen    [Widget::hasChanged $path -dropenabled en]
116
 
    set ctypes [Widget::hasChanged $path -droptypes   types]
117
 
    if { $en } {
118
 
        if { $force || $cen || $ctypes } {
119
 
            register $subpath \
120
 
                -droptypes   $types \
121
 
                -dropcmd     $drop  \
122
 
                -dropovercmd $dropover
123
 
        }
124
 
    } else {
125
 
        register $subpath
126
 
    }
127
 
}
128
 
 
129
 
 
130
 
# ------------------------------------------------------------------------------
131
 
#  Command DropSite::register
132
 
# ------------------------------------------------------------------------------
133
 
proc DropSite::register { path args } {
134
 
    variable _tabops
135
 
    variable _defops
136
 
    upvar \#0 DropSite::$path drop
137
 
 
138
 
    Widget::init DropSite .drop$path $args
139
 
    if { [info exists drop] } {
140
 
        unset drop
141
 
    }
142
 
    set dropcmd [Widget::getoption .drop$path -dropcmd]
143
 
    set types   [Widget::getoption .drop$path -droptypes]
144
 
    set overcmd [Widget::getoption .drop$path -dropovercmd]
145
 
    Widget::destroy .drop$path
146
 
    if { $dropcmd != "" && $types != "" } {
147
 
        set drop(dropcmd) $dropcmd
148
 
        set drop(overcmd) $overcmd
149
 
        foreach {type ops} $types {
150
 
            set drop($type,ops) {}
151
 
            foreach {descop lmod} $ops {
152
 
                if { ![llength $descop] || [llength $descop] > 3 } {
153
 
                    return -code error "invalid operation description \"$descop\""
154
 
                }
155
 
                foreach {subop baseop imgop} $descop {
156
 
                    set subop [string trim $subop]
157
 
                    if { ![string length $subop] } {
158
 
                        return -code error "sub operation is empty"
159
 
                    }
160
 
                    if { ![string length $baseop] } {
161
 
                        set baseop $subop
162
 
                    }
163
 
                    if { [info exists drop($type,ops,$subop)] } {
164
 
                        return -code error "operation \"$subop\" already defined"
165
 
                    }
166
 
                    if { ![info exists _tabops(ops,$baseop)] } {
167
 
                        return -code error "invalid base operation \"$baseop\""
168
 
                    }
169
 
                    if { [string compare $subop $baseop] &&
170
 
                         [info exists _tabops(ops,$subop)] } {
171
 
                        return -code error "sub operation \"$subop\" is a base operation"
172
 
                    }
173
 
                    if { ![string length $imgop] } {
174
 
                        set imgop $_defops($baseop,img)
175
 
                    }
176
 
                }
177
 
                if { ![string compare $lmod "program"] } {
178
 
                    set drop($type,ops,$subop) $baseop
179
 
                    set drop($type,img,$subop) $imgop
180
 
                } else {
181
 
                    if { ![string length $lmod] } {
182
 
                        set lmod $_defops($baseop,mod)
183
 
                    }
184
 
                    set mask 0
185
 
                    foreach mod $lmod {
186
 
                        if { ![info exists _tabops(mod,$mod)] } {
187
 
                            return -code error "invalid modifier \"$mod\""
188
 
                        }
189
 
                        set mask [expr {$mask | $_tabops(mod,$mod)}]
190
 
                    }
191
 
                    if { ($mask == 0) != ([string compare $subop "default"] == 0) } {
192
 
                        return -code error "sub operation default can only be used with modifier \"none\""
193
 
                    }
194
 
                    set drop($type,mod,$mask)  $subop
195
 
                    set drop($type,ops,$subop) $baseop
196
 
                    set drop($type,img,$subop) $imgop
197
 
                    lappend masklist $mask
198
 
                }
199
 
            }
200
 
            if { ![info exists drop($type,mod,0)] } {
201
 
                set drop($type,mod,0)       default
202
 
                set drop($type,ops,default) copy
203
 
                set drop($type,img,default) $_defops(copy,img)
204
 
                lappend masklist 0
205
 
            }
206
 
            set drop($type,ops,force) copy
207
 
            set drop($type,img,force) $_defops(copy,img)
208
 
            foreach mask [lsort -integer -decreasing $masklist] {
209
 
                lappend drop($type,ops) $mask $drop($type,mod,$mask)
210
 
            }
211
 
        }
212
 
    }
213
 
}
214
 
 
215
 
 
216
 
# ------------------------------------------------------------------------------
217
 
#  Command DropSite::setcursor
218
 
# ------------------------------------------------------------------------------
219
 
proc DropSite::setcursor { cursor } {
220
 
    catch {.drag configure -cursor $cursor}
221
 
}
222
 
 
223
 
 
224
 
# ------------------------------------------------------------------------------
225
 
#  Command DropSite::setoperation
226
 
# ------------------------------------------------------------------------------
227
 
proc DropSite::setoperation { op } {
228
 
    variable _curop
229
 
    variable _dragops
230
 
    variable _target
231
 
    variable _type
232
 
    upvar \#0 DropSite::$_target drop
233
 
 
234
 
    if { [info exist drop($_type,ops,$op)] &&
235
 
         $_dragops($drop($_type,ops,$op)) } {
236
 
        set _curop $op
237
 
    } else {
238
 
        # force to a copy operation
239
 
        set _curop force
240
 
    }
241
 
}
242
 
 
243
 
 
244
 
# ------------------------------------------------------------------------------
245
 
#  Command DropSite::_init_drag
246
 
# ------------------------------------------------------------------------------
247
 
proc DropSite::_init_drag { top evt source state X Y type ops data } {
248
 
    variable _top
249
 
    variable _source
250
 
    variable _type
251
 
    variable _data
252
 
    variable _target
253
 
    variable _status
254
 
    variable _state
255
 
    variable _dragops
256
 
    variable _opw
257
 
    variable _evt
258
 
 
259
 
    catch {unset _dragops}
260
 
    array set _dragops {copy 1 move 0 link 0}
261
 
    foreach op $ops {
262
 
        set _dragops($op) 1
263
 
    }
264
 
    set _target ""
265
 
    set _status  0
266
 
    set _top     $top
267
 
    set _source  $source
268
 
    set _type    $type
269
 
    set _data    $data
270
 
 
271
 
    label $_opw -relief flat -bd 0 -highlightthickness 0 \
272
 
        -foreground black -background white
273
 
 
274
 
    bind $top <ButtonRelease-$evt> {DropSite::_release %X %Y}
275
 
    bind $top <B$evt-Motion>       {DropSite::_motion  %X %Y}
276
 
    bind $top <Motion>             {DropSite::_release %X %Y}
277
 
    set _state $state
278
 
    set _evt   $evt
279
 
    _motion $X $Y
280
 
}
281
 
 
282
 
 
283
 
# ------------------------------------------------------------------------------
284
 
#  Command DropSite::_update_operation
285
 
# ------------------------------------------------------------------------------
286
 
proc DropSite::_update_operation { state } {
287
 
    variable _top
288
 
    variable _status
289
 
    variable _state
290
 
 
291
 
    if { $_status & 3 } {
292
 
        set _state $state
293
 
        _motion [winfo pointerx $_top] [winfo pointery $_top]
294
 
    }
295
 
}
296
 
 
297
 
 
298
 
# ------------------------------------------------------------------------------
299
 
#  Command DropSite::_compute_operation
300
 
# ------------------------------------------------------------------------------
301
 
proc DropSite::_compute_operation { target state type } {
302
 
    variable  _curop
303
 
    variable  _dragops
304
 
    upvar \#0 DropSite::$target drop
305
 
 
306
 
    foreach {mask op} $drop($type,ops) {
307
 
        if { ($state & $mask) == $mask } {
308
 
            if { $_dragops($drop($type,ops,$op)) } {
309
 
                set _curop $op
310
 
                return
311
 
            }
312
 
        }
313
 
    }
314
 
    set _curop force
315
 
}
316
 
 
317
 
 
318
 
# ------------------------------------------------------------------------------
319
 
#  Command DropSite::_draw_operation
320
 
# ------------------------------------------------------------------------------
321
 
proc DropSite::_draw_operation { target type } {
322
 
    variable _opw
323
 
    variable _curop
324
 
    variable _dragops
325
 
    variable _tabops
326
 
    variable _status
327
 
 
328
 
    upvar \#0 DropSite::$target drop
329
 
 
330
 
    if { !($_status & 1) } {
331
 
        catch {place forget $_opw}
332
 
        return
333
 
    }
334
 
 
335
 
    if { 0 } {
336
 
    if { ![info exist drop($type,ops,$_curop)] ||
337
 
         !$_dragops($drop($type,ops,$_curop)) } {
338
 
        # force to a copy operation
339
 
        set _curop copy
340
 
        catch {
341
 
            $_opw configure -bitmap $_tabops(img,copy)
342
 
            place $_opw -relx 1 -rely 1 -anchor se
343
 
        }
344
 
    }
345
 
    } elseif { ![string compare $_curop "default"] } {
346
 
        catch {place forget $_opw}
347
 
    } else {
348
 
        catch {
349
 
            $_opw configure -bitmap $drop($type,img,$_curop)
350
 
            place $_opw -relx 1 -rely 1 -anchor se
351
 
        }
352
 
    }
353
 
}
354
 
 
355
 
 
356
 
# ------------------------------------------------------------------------------
357
 
#  Command DropSite::_motion
358
 
# ------------------------------------------------------------------------------
359
 
proc DropSite::_motion { X Y } {
360
 
    variable _top
361
 
    variable _target
362
 
    variable _status
363
 
    variable _state
364
 
    variable _curop
365
 
    variable _type
366
 
    variable _data
367
 
    variable _source
368
 
    variable _evt
369
 
 
370
 
    set script [bind $_top <B$_evt-Motion>]
371
 
    bind $_top <B$_evt-Motion> {}
372
 
    bind $_top <Motion>        {}
373
 
    wm geometry $_top "+[expr {$X+1}]+[expr {$Y+1}]"
374
 
    update
375
 
    if { ![winfo exists $_top] } {
376
 
        return
377
 
    }
378
 
    set path [winfo containing $X $Y]
379
 
    if { [string compare $path $_target] } {
380
 
        # path != current target
381
 
        if { $_status & 2 } {
382
 
            # current target is valid and has recall status
383
 
            # generate leave event
384
 
            upvar   \#0 DropSite::$_target drop
385
 
            uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data]
386
 
        }
387
 
        set _target $path
388
 
        upvar \#0 DropSite::$_target drop
389
 
        if { [info exists drop($_type,ops)] } {
390
 
            # path is a valid target
391
 
            _compute_operation $_target $_state $_type
392
 
            if { $drop(overcmd) != "" } {
393
 
                set arg     [list $_target $_source enter $X $Y $_curop $_type $_data]
394
 
                set _status [uplevel \#0 $drop(overcmd) $arg]
395
 
            } else {
396
 
                set _status 1
397
 
                catch {$_top configure -cursor based_arrow_down}
398
 
            }
399
 
            _draw_operation $_target $_type
400
 
            update
401
 
            catch {
402
 
                bind $_top <B$_evt-Motion> {DropSite::_motion  %X %Y}
403
 
                bind $_top <Motion>        {DropSite::_release %X %Y}
404
 
            }
405
 
            return
406
 
        } else {
407
 
            set _status 0
408
 
            catch {$_top configure -cursor dot}
409
 
            _draw_operation "" ""
410
 
        }
411
 
    } elseif { $_status & 2 } {
412
 
        upvar \#0 DropSite::$_target drop
413
 
        _compute_operation $_target $_state $_type
414
 
        set arg     [list $_target $_source motion $X $Y $_curop $_type $_data]
415
 
        set _status [uplevel \#0 $drop(overcmd) $arg]
416
 
        _draw_operation $_target $_type
417
 
    }
418
 
    update
419
 
    catch {
420
 
        bind $_top <B$_evt-Motion> {DropSite::_motion  %X %Y}
421
 
        bind $_top <Motion>        {DropSite::_release %X %Y}
422
 
    }
423
 
}
424
 
 
425
 
 
426
 
 
427
 
# ------------------------------------------------------------------------------
428
 
#  Command DropSite::_release
429
 
# ------------------------------------------------------------------------------
430
 
proc DropSite::_release { X Y } {
431
 
    variable _target
432
 
    variable _status
433
 
    variable _curop
434
 
    variable _source
435
 
    variable _type
436
 
    variable _data
437
 
 
438
 
    if { $_status & 1 } {
439
 
        upvar \#0 DropSite::$_target drop
440
 
 
441
 
        set res [uplevel \#0 $drop(dropcmd) [list $_target $_source $X $Y $_curop $_type $_data]]
442
 
        DragSite::_end_drag $_source $_target $drop($_type,ops,$_curop) $_type $_data $res
443
 
    } else {
444
 
        if { $_status & 2 } {
445
 
            # notify leave event
446
 
            upvar \#0 DropSite::$_target drop
447
 
            uplevel \#0 $drop(overcmd) [list $_target $_source leave $X $Y $_curop $_type $_data]
448
 
        }
449
 
        DragSite::_end_drag $_source "" "" $_type $_data 0
450
 
    }
451
 
}