1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
2 | # ---------------------------------------------------------------------- |
---|
3 | # COMPONENT: grab - improved version of the Tk grab command |
---|
4 | # |
---|
5 | # This version of "grab" keeps a stack of grab windows, so one |
---|
6 | # window can steal and release the grab, and the grab will revert |
---|
7 | # to the previous window. If things get jammed up, you can press |
---|
8 | # <Escape> three times to release the grab. |
---|
9 | # ====================================================================== |
---|
10 | # AUTHOR: Michael McLennan, Purdue University |
---|
11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
12 | # |
---|
13 | # See the file "license.terms" for information on usage and |
---|
14 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
15 | # ====================================================================== |
---|
16 | package require BLT |
---|
17 | |
---|
18 | namespace eval Rappture { # forward declaration } |
---|
19 | namespace eval Rappture::grab { |
---|
20 | variable state "" ;# local ("") or global ("-global") grab |
---|
21 | variable stack "" ;# stack of grab windows |
---|
22 | } |
---|
23 | |
---|
24 | proc Rappture::grab::init {} { # used for autoloading this module } |
---|
25 | |
---|
26 | bind all <Escape><Escape><Escape> Rappture::grab::reset |
---|
27 | |
---|
28 | # ---------------------------------------------------------------------- |
---|
29 | # USAGE: grab ?-global? <window> |
---|
30 | # USAGE: grab set ?-global? <window> |
---|
31 | # USAGE: grab release <window> |
---|
32 | # USAGE: grab current ?<window>? |
---|
33 | # USAGE: grab status <window> |
---|
34 | # |
---|
35 | # This is a replacement for the usual Tk grab command. It works |
---|
36 | # exactly the same way, but supports a stack of grab windows, so |
---|
37 | # one window can steal grab from another, and then give it back |
---|
38 | # later. |
---|
39 | # ---------------------------------------------------------------------- |
---|
40 | rename grab _tk_grab |
---|
41 | proc grab {args} { |
---|
42 | set op [lindex $args 0] |
---|
43 | if {[winfo exists $op]} { |
---|
44 | set op "set" |
---|
45 | } elseif {$op == "-global" && [winfo exists [lindex $args end]]} { |
---|
46 | set op "set" |
---|
47 | } |
---|
48 | |
---|
49 | if {$op == "set"} { |
---|
50 | # |
---|
51 | # Handle GRAB SET specially. |
---|
52 | # Add the new grab window to the grab stack. |
---|
53 | # |
---|
54 | set state $::Rappture::grab::state |
---|
55 | set window [lindex $args end] |
---|
56 | if {[lsearch -exact $args -global] >= 0} { |
---|
57 | set state "-global" |
---|
58 | } |
---|
59 | |
---|
60 | if {"" != $state} { |
---|
61 | # if it's a global grab, store the -global flag away for later |
---|
62 | set window [linsert $window 0 $state] |
---|
63 | |
---|
64 | # all grabs from now on are global |
---|
65 | set ::Rappture::grab::state "-global" |
---|
66 | } |
---|
67 | |
---|
68 | # if the window is already on the stack, then skip it |
---|
69 | if {[string equal [lindex $::Rappture::grab::stack 0] $window]} { |
---|
70 | return $window |
---|
71 | } |
---|
72 | |
---|
73 | # add the current configuration to the grab stack |
---|
74 | set ::Rappture::grab::stack \ |
---|
75 | [linsert $::Rappture::grab::stack 0 $window] |
---|
76 | |
---|
77 | return [eval _grabset $window] |
---|
78 | |
---|
79 | } elseif {$op == "release"} { |
---|
80 | # |
---|
81 | # Handle GRAB RELEASE specially. |
---|
82 | # Release the current grab and grab the next window on the stack. |
---|
83 | # Note that the current grab is on the top of the stack. The |
---|
84 | # next one down is the one we want to revert to. |
---|
85 | # |
---|
86 | set window [lindex $::Rappture::grab::stack 1] |
---|
87 | set ::Rappture::grab::stack [lrange $::Rappture::grab::stack 1 end] |
---|
88 | |
---|
89 | # release the current grab |
---|
90 | eval _tk_grab $args |
---|
91 | |
---|
92 | # and set the next one |
---|
93 | if {"" != $window} { |
---|
94 | if {[lindex $window 0] != "-global"} { |
---|
95 | # no more global grabs -- resume local grabs |
---|
96 | set ::Rappture::grab::state "" |
---|
97 | } |
---|
98 | eval _grabset $window |
---|
99 | } |
---|
100 | return "" |
---|
101 | } |
---|
102 | |
---|
103 | # perform any other grab operation as usual... |
---|
104 | return [eval _tk_grab $args] |
---|
105 | } |
---|
106 | |
---|
107 | proc _grabset {args} { |
---|
108 | # give it 3 tries, if necessary |
---|
109 | for {set i 0} {$i < 3} {incr i} { |
---|
110 | set status [catch {eval _tk_grab set $args} result] |
---|
111 | if {$status == 0} { |
---|
112 | return $result |
---|
113 | } |
---|
114 | after 100; update |
---|
115 | } |
---|
116 | # oh well, we tried... |
---|
117 | return "" |
---|
118 | } |
---|
119 | |
---|
120 | # ---------------------------------------------------------------------- |
---|
121 | # USAGE: Rappture::grab::reset |
---|
122 | # |
---|
123 | # Used internally to reset the grab whenever the user presses |
---|
124 | # Escape a bunch of times to break out of the grab. |
---|
125 | # ---------------------------------------------------------------------- |
---|
126 | proc Rappture::grab::reset {} { |
---|
127 | set w [_tk_grab current] |
---|
128 | if {"" != $w} { |
---|
129 | _tk_grab release $w |
---|
130 | } |
---|
131 | set Rappture::grab::stack "" |
---|
132 | set Rappture::grab::state "" |
---|
133 | |
---|
134 | foreach win [blt::busy windows] { |
---|
135 | blt::busy release $win |
---|
136 | } |
---|
137 | } |
---|