summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--library/clrpick.tcl32
-rw-r--r--library/msgbox.tcl34
-rw-r--r--library/tk.tcl82
-rw-r--r--library/tkfbox.tcl65
-rw-r--r--library/xmfbox.tcl38
5 files changed, 120 insertions, 131 deletions
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index 9fa56ff..76c2e99 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
# Color selection dialog for platforms that do not support a
# standard color selection dialog.
#
-# RCS: @(#) $Id: clrpick.tcl,v 1.6 1999/09/02 17:02:52 hobbs Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.7 1999/11/24 20:59:06 hobbs Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -65,30 +65,16 @@ proc tkColorDialog {args} {
}
wm transient $w $data(-parent)
-
# 5. Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w +$x+$y
- wm deiconify $w
+ ::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
# 6. Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {[string compare $oldGrab ""]} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(okBtn)
+ ::tk::SetFocusGrab $w $data(okBtn)
# 7. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
@@ -97,17 +83,9 @@ proc tkColorDialog {args} {
# restore any grab that was in effect.
tkwait variable tkPriv(selectColor)
- catch {focus $oldFocus}
- grab release $w
- destroy $w
+ ::tk::RestoreFocusGrab $w $data(okBtn)
unset data
- if {[string compare $oldGrab ""]} {
- if {[string equal $grabStatus "global"]} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+
return $tkPriv(selectColor)
}
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 2497a47..1456f1c 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# RCS: @(#) $Id: msgbox.tcl,v 1.6 1999/09/02 17:02:53 hobbs Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.7 1999/11/24 20:59:06 hobbs Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -226,28 +226,16 @@ proc tkMessageBox {args} {
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w +$x+$y
- wm deiconify $w
+ ::tk::PlaceWindow $w widget $data(-parent)
# 8. Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {[string compare $oldGrab ""]} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
if {[string compare $data(-default) ""]} {
- focus $w.$data(-default)
+ set focus $w.$data(-default)
} else {
- focus $w
+ set focus $w
}
+ ::tk::SetFocusGrab $w $focus
# 9. Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
@@ -256,14 +244,8 @@ proc tkMessageBox {args} {
# restore any grab that was in effect.
tkwait variable tkPriv(button)
- catch {focus $oldFocus}
- destroy $w
- if {[string compare $oldGrab ""]} {
- if {[string equal $grabStatus "global"]} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+
+ ::tk::RestoreFocusGrab $w $focus
+
return $tkPriv(button)
}
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.
diff --git a/library/tkfbox.tcl b/library/tkfbox.tcl
index 0ffe6c3..0c614a1 100644
--- a/library/tkfbox.tcl
+++ b/library/tkfbox.tcl
@@ -11,7 +11,7 @@
# files by clicking on the file icons or by entering a filename
# in the "Filename:" entry.
#
-# RCS: @(#) $Id: tkfbox.tcl,v 1.10 1999/09/02 17:02:53 hobbs Exp $
+# RCS: @(#) $Id: tkfbox.tcl,v 1.11 1999/11/24 20:59:06 hobbs Exp $
#
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
@@ -693,29 +693,15 @@ proc tkFDialog {type args} {
# so we know how big it wants to be, then center the window in the
# display and de-iconify it.
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w [winfo reqwidth $w]x[winfo reqheight $w]+$x+$y
- wm deiconify $w
+ ::tk::PlaceWindow $w widget $data(-parent)
wm title $w $data(-title)
# Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {[string compare $oldGrab ""]} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(ent)
+ ::tk::SetFocusGrab $w $data(ent)
$data(ent) delete 0 end
$data(ent) insert 0 $data(selectFile)
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
# Wait for the user to respond, then restore the focus and
@@ -725,16 +711,8 @@ proc tkFDialog {type args} {
# restore any grab that was in effect.
tkwait variable tkPriv(selectFilePath)
- catch {focus $oldFocus}
- grab release $w
- wm withdraw $w
- if {[string compare $oldGrab ""]} {
- if {[string equal $grabStatus "global"]} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+
+ ::tk::RestoreFocusGrab $w $data(ent) withdraw
return $tkPriv(selectFilePath)
}
@@ -1282,8 +1260,7 @@ proc tkFDialog_ActivateEnt {w} {
if {[string equal $data(type) open]} {
tk_messageBox -icon warning -type ok -parent $data(-parent) \
-message "File \"[file join $path $file]\" does not exist."
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
} else {
tkFDialog_SetPathSilently $w $path
@@ -1294,24 +1271,21 @@ proc tkFDialog_ActivateEnt {w} {
PATH {
tk_messageBox -icon warning -type ok -parent $data(-parent) \
-message "Directory \"$path\" does not exist."
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
CHDIR {
tk_messageBox -type ok -parent $data(-parent) -message \
"Cannot change to the directory \"$path\".\nPermission denied."\
-icon warning
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
ERROR {
tk_messageBox -type ok -parent $data(-parent) -message \
"Invalid file name \"$path\"."\
-icon warning
- $data(ent) select from 0
- $data(ent) select to end
+ $data(ent) selection range 0 end
$data(ent) icursor end
}
}
@@ -1447,18 +1421,15 @@ proc tkFDialog_Done {w {selectFilePath ""}} {
set tkPriv(selectFile) $data(selectFile)
set tkPriv(selectPath) $data(selectPath)
- if {[file exists $selectFilePath] &&
- [string equal $data(type) save]} {
-
- set reply [tk_messageBox -icon warning -type yesno\
- -parent $data(-parent) -message "File\
- \"$selectFilePath\" already exists.\nDo\
- you want to overwrite it?"]
- if {[string equal $reply "no"]} {
- return
- }
+ if {[file exists $selectFilePath] && [string equal $data(type) save]} {
+ set reply [tk_messageBox -icon warning -type yesno\
+ -parent $data(-parent) -message "File\
+ \"$selectFilePath\" already exists.\nDo\
+ you want to overwrite it?"]
+ if {[string equal $reply "no"]} {
+ return
+ }
}
}
set tkPriv(selectFilePath) $selectFilePath
}
-
diff --git a/library/xmfbox.tcl b/library/xmfbox.tcl
index 30932b2..02e18f1 100644
--- a/library/xmfbox.tcl
+++ b/library/xmfbox.tcl
@@ -4,7 +4,7 @@
# Unix platform. This implementation is used only if the
# "tk_strictMotif" flag is set.
#
-# RCS: @(#) $Id: xmfbox.tcl,v 1.8 1999/09/02 17:02:53 hobbs Exp $
+# RCS: @(#) $Id: xmfbox.tcl,v 1.9 1999/11/24 20:59:06 hobbs Exp $
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
@@ -35,15 +35,8 @@ proc tkMotifFDialog {type args} {
# Set a grab and claim the focus too.
- set oldFocus [focus]
- set oldGrab [grab current $w]
- if {[string compare $oldGrab ""]} {
- set grabStatus [grab status $oldGrab]
- }
- grab $w
- focus $data(sEnt)
- $data(sEnt) select from 0
- $data(sEnt) select to end
+ ::tk::SetFocusGrab $w $data(sEnt)
+ $data(sEnt) selection range 0 end
# Wait for the user to respond, then restore the focus and
# return the index of the selected button. Restore the focus
@@ -52,16 +45,8 @@ proc tkMotifFDialog {type args} {
# restore any grab that was in effect.
tkwait variable tkPriv(selectFilePath)
- catch {focus $oldFocus}
- grab release $w
- wm withdraw $w
- if {[string compare $oldGrab ""]} {
- if {[string equal $grabStatus "global"]} {
- grab -global $oldGrab
- } else {
- grab $oldGrab
- }
- }
+ ::tk::RestoreFocusGrab $w $data(sEnt) withdraw
+
return $tkPriv(selectFilePath)
}
@@ -119,16 +104,9 @@ proc tkMotifFDialog_Create {dataName type argList} {
# Withdraw the window, then update all the geometry information
# so we know how big it wants to be, then center the window in the
- # display and de-iconify it.
-
- wm withdraw $w
- update idletasks
- set x [expr {[winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
- - [winfo vrootx [winfo parent $w]]}]
- set y [expr {[winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
- - [winfo vrooty [winfo parent $w]]}]
- wm geom $w +$x+$y
- wm deiconify $w
+ # display (Motif style) and de-iconify it.
+
+ ::tk::PlaceWindow $w
wm title $w $data(-title)
return $w