diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/clrpick.tcl | 32 | ||||
| -rw-r--r-- | library/msgbox.tcl | 34 | ||||
| -rw-r--r-- | library/tk.tcl | 82 | ||||
| -rw-r--r-- | library/tkfbox.tcl | 65 | ||||
| -rw-r--r-- | library/xmfbox.tcl | 38 |
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 |