summaryrefslogtreecommitdiffstats
path: root/library/tk.tcl
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-11-24 20:59:06 (GMT)
committerhobbs <hobbs>1999-11-24 20:59:06 (GMT)
commit94012d8b33fb70354482798323f2ecb417d7e68b (patch)
treedc708b4fa277d706bc2ccbfdb606642ff7eb615f /library/tk.tcl
parent41d379d476d743aa2f72c66183e7acee581f29fe (diff)
downloadtk-94012d8b33fb70354482798323f2ecb417d7e68b.zip
tk-94012d8b33fb70354482798323f2ecb417d7e68b.tar.gz
tk-94012d8b33fb70354482798323f2ecb417d7e68b.tar.bz2
* library/clrpick.tcl:
* library/msgbox.tcl: * library/tk.tcl: * library/tkfbox.tcl: * library/xmfbox.tcl: fixed dialogs to center over -parent, added utility functions ::tk::PlaceWindow, ::tk::SetFocusGrab, ::tk::RestoreFocusGrab to tk.tcl to help
Diffstat (limited to 'library/tk.tcl')
-rw-r--r--library/tk.tcl82
1 files changed, 81 insertions, 1 deletions
diff --git a/library/tk.tcl b/library/tk.tcl
index b68d31b..30eb70a 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.12 1999/10/01 22:45:19 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.13 1999/11/24 20:59:06 hobbs Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -29,6 +29,86 @@ if {[info exists auto_path] && [string compare {} $tk_library] && \
set tk_strictMotif 0
+# Create a ::tk namespace
+
+namespace eval ::tk {
+}
+
+# ::tk::PlaceWindow --
+# place a toplevel at a particular position
+# Arguments:
+# toplevel name of toplevel window
+# ?placement? pointer ?center? ; places $w centered on the pointer
+# widget widgetPath ; centers $w over widget_name
+# defaults to placing toplevel in the middle of the screen
+# ?anchor? center or widgetPath
+# Results:
+# Returns nothing
+#
+proc ::tk::PlaceWindow {w {placement ""} {anchor ""}} {
+ wm withdraw $w
+ update idletasks
+ if {[string match p* $placement]} {
+ ## place at POINTER (centered if $anchor == center)
+ if {[string match "c*" $anchor]} {
+ set x [expr {[winfo pointerx $w]-[winfo reqwidth $w]/2}]
+ set y [expr {[winfo pointery $w]-[winfo reqheight $w]/2}]
+ } else {
+ set x [winfo pointerx $w]
+ set y [winfo pointery $w]
+ }
+ } elseif {[string match w* $placement] && \
+ [winfo exists $anchor] && [winfo ismapped $anchor]} {
+ ## center about WIDGET $anchor, widget must be mapped
+ set x [expr {[winfo rootx $anchor] + \
+ ([winfo width $anchor]-[winfo reqwidth $w])/2}]
+ set y [expr {[winfo rooty $anchor] + \
+ ([winfo height $anchor]-[winfo reqheight $w])/2}]
+ } else {
+ set x [expr {([winfo screenwidth $w]-[winfo reqwidth $w])/2}]
+ set y [expr {([winfo screenheight $w]-[winfo reqheight $w])/2}]
+ }
+ wm geometry +$x+$y
+ wm deiconify $w
+}
+
+proc ::tk::SetFocusGrab {grab {focus {}}} {
+ set index "$grab,$focus"
+ upvar ::tk::FocusGrab($index) data
+
+ lappend data [focus]
+ set oldGrab [grab current $grab]
+ lappend data $oldGrab
+ if {[winfo exists $oldGrab]} {
+ lappend data [grab status $oldGrab]
+ }
+ grab $grab
+ if {[winfo exists $focus]} {
+ focus $focus
+ }
+}
+
+proc ::tk::RestoreFocusGrab {grab focus {destroy destroy}} {
+ set index "$grab,$focus"
+ foreach {oldFocus oldGrab oldStatus} $::tk::FocusGrab($index) { break }
+ unset ::tk::FocusGrab($index)
+
+ catch {focus $oldFocus}
+ grab release $grab
+ if {[string equal $destroy "withdraw"]} {
+ wm withdraw $grab
+ } else {
+ destroy $grab
+ }
+ if {[winfo exists $oldGrab] && [winfo ismapped $oldGrab]} {
+ if {[string equal $oldStatus "global"]} {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+}
+
# tkScreenChanged --
# This procedure is invoked by the binding mechanism whenever the
# "current" screen is changing. The procedure does two things.