/[ascend]/trunk/tcltk/tk/templates/ascKeepOnTop.tcl
ViewVC logotype

Contents of /trunk/tcltk/tk/templates/ascKeepOnTop.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2022 - (show annotations) (download) (as text)
Wed Apr 29 06:20:28 2009 UTC (10 years, 9 months ago) by jpye
File MIME type: text/x-tcl
File size: 1848 byte(s)
Rename generic/interface to interface and TK to tk.
1 #
2 # a function to keep a window unobscured.
3 # Whatever widget this is bound to, it keeps the associated toplevel on top.
4 # By associated we mean for the window .a.b.c, the toplevel is .a
5 # and if .a.b.c ismapped, we keep it that way.
6 # Use this carefully or you may get into a race condition where
7 # two windows keep obscuring each other. Not normally a problem in
8 # well designed dialog sequences.
9 #
10 # Children of the toplevel (children meaning 'by name', so popups count)
11 # are not considered to obscure their toplevel.
12 #
13 # Most 'standard dialogs' are a toplevel.
14 #
15 # ifndef ascKeepOnTop
16 if {[string compare [info proc ascKeepOnTop] ""] == 0} {
17 proc ascKeepOnTop {w} {
18 if {![winfo exists $w] || ![winfo ismapped $w]} {return}
19 set tl [winfo toplevel $w]
20 set g [winfo geometry $tl]
21 scan $g "%dx%d+%d+%d" w h x y
22 # shrink into the window a little
23 incr x
24 incr y
25 incr w -2
26 incr h -2
27 set c1 "[winfo containing $x $y]"
28 set c2 "[winfo containing [expr $x+$w] $y]"
29 set c3 "[winfo containing $x [expr $y+$h]]"
30 set c4 "[winfo containing [expr $x+$w] [expr $y+$h]]"
31 if {$c1 == "" || $c2 == "" || $c3 == "" || $c4 == "" ||
32 [asctoplevelname $c1] != $tl ||
33 [asctoplevelname $c2] != $tl ||
34 [asctoplevelname $c4] != $tl ||
35 [asctoplevelname $c4] != $tl} {
36 raise $tl
37 }
38 }
39
40 # returns the first part of the widget name
41 # or the empty string if the widget name is not well formed
42 # or the toplevel implied by the first part does not exist.
43 #
44 proc asctoplevelname {w} {
45 return "[winfo toplevel $w]"
46 # if {![winfo exists $w] || [string index $w 0] != "."} {return ""}
47 # set tl [lindex [split $w .] 1]
48 # if {![winfo exists .$tl]} {return ""}
49 # set cl [lindex [.$tl configure -class] 3]
50 # if {$cl != "Toplevel"} {return ""}
51 # return .$tl
52 }
53 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22