diff options
Diffstat (limited to 'library/msgbox.tcl')
| -rw-r--r-- | library/msgbox.tcl | 61 |
1 files changed, 30 insertions, 31 deletions
diff --git a/library/msgbox.tcl b/library/msgbox.tcl index 093afdf..ea04e86 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.4 1998/11/12 06:22:05 welch Exp $ +# RCS: @(#) $Id: msgbox.tcl,v 1.5 1999/04/16 01:51:26 stanton Exp $ # # Copyright (c) 1994-1997 Sun Microsystems, Inc. # @@ -49,15 +49,13 @@ proc tkMessageBox {args} { tclParseConfigSpec $w $specs "" $args if {[lsearch {info warning error question} $data(-icon)] == -1} { - error "invalid icon \"$data(-icon)\", must be error, info, question or warning" + error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning" } - if {$tcl_platform(platform) == "macintosh"} { - if {$data(-icon) == "error"} { - set data(-icon) "stop" - } elseif {$data(-icon) == "warning"} { - set data(-icon) "caution" - } elseif {$data(-icon) == "info"} { - set data(-icon) "note" + if {![string compare $tcl_platform(platform) "macintosh"]} { + switch -- $data(-icon) { + "error" {set data(-icon) "stop"} + "warning" {set data(-icon) "caution"} + "info" {set data(-icon) "note"} } } @@ -77,7 +75,7 @@ proc tkMessageBox {args} { set buttons { {ok -width 6 -text OK -under 0} } - if {$data(-default) == ""} { + if {![string compare $data(-default) ""]} { set data(-default) "ok" } } @@ -107,7 +105,7 @@ proc tkMessageBox {args} { } } default { - error "invalid message box type \"$data(-type)\", must be abortretryignore, ok, okcancel, retrycancel, yesno or yesnocancel" + error "bad -type value \"$data(-type)\": must be abortretryignore, ok, okcancel, retrycancel, yesno, or yesnocancel" } } @@ -142,7 +140,7 @@ proc tkMessageBox {args} { wm iconname $w Dialog wm protocol $w WM_DELETE_WINDOW { } wm transient $w $data(-parent) - if {$tcl_platform(platform) == "macintosh"} { + if {![string compare $tcl_platform(platform) "macintosh"]} { unsupported1 style $w dBoxProc } @@ -150,22 +148,25 @@ proc tkMessageBox {args} { pack $w.bot -side bottom -fill both frame $w.top pack $w.top -side top -fill both -expand 1 - if {$tcl_platform(platform) != "macintosh"} { + if {[string compare $tcl_platform(platform) "macintosh"]} { $w.bot configure -relief raised -bd 1 $w.top configure -relief raised -bd 1 } # 4. Fill the top part with bitmap and message (use the option - # database for -wraplength so that it can be overridden by - # the caller). + # database for -wraplength and -font so that they can be + # overridden by the caller). option add *Dialog.msg.wrapLength 3i widgetDefault - label $w.msg -justify left -text $data(-message) - catch {$w.msg configure -font \ - -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-* + if {![string compare $tcl_platform(platform) "macintosh"]} { + option add *Dialog.msg.font system widgetDefault + } else { + option add *Dialog.msg.font {Times 18} widgetDefault } + + label $w.msg -justify left -text $data(-message) pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m - if {$data(-icon) != ""} { + if {[string compare $data(-icon) ""]} { label $w.bitmap -bitmap $data(-icon) pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m } @@ -176,29 +177,27 @@ proc tkMessageBox {args} { foreach but $buttons { set name [lindex $but 0] set opts [lrange $but 1 end] - if {![string compare $opts {}]} { + if {![llength $opts]} { # Capitalize the first letter of $name - set capName \ - [string toupper \ + set capName [string toupper \ [string index $name 0]][string range $name 1 end] set opts [list -text $capName] } - eval button $w.$name $opts -command [list "set tkPriv(button) $name"] + eval button [list $w.$name] $opts [list -command [list set tkPriv(button) $name]] if {![string compare $name $data(-default)]} { $w.$name configure -default active } - pack $w.$name -in $w.bot -side left -expand 1 \ - -padx 3m -pady 2m + pack $w.$name -in $w.bot -side left -expand 1 -padx 3m -pady 2m # create the binding for the key accelerator, based on the underline # set underIdx [$w.$name cget -under] if {$underIdx >= 0} { set key [string index [$w.$name cget -text] $underIdx] - bind $w <Alt-[string tolower $key]> "$w.$name invoke" - bind $w <Alt-[string toupper $key]> "$w.$name invoke" + bind $w <Alt-[string tolower $key]> [list $w.$name invoke] + bind $w <Alt-[string toupper $key]> [list $w.$name invoke] } incr i } @@ -207,7 +206,7 @@ proc tkMessageBox {args} { # default button. if {[string compare $data(-default) ""]} { - bind $w <Return> "tkButtonInvoke $w.$data(-default)" + bind $w <Return> [list tkButtonInvoke $w.$data(-default)] } # 7. Withdraw the window, then update all the geometry information @@ -227,7 +226,7 @@ proc tkMessageBox {args} { set oldFocus [focus] set oldGrab [grab current $w] - if {$oldGrab != ""} { + if {[string compare $oldGrab ""]} { set grabStatus [grab status $oldGrab] } grab $w @@ -246,8 +245,8 @@ proc tkMessageBox {args} { tkwait variable tkPriv(button) catch {focus $oldFocus} destroy $w - if {$oldGrab != ""} { - if {$grabStatus == "global"} { + if {[string compare $oldGrab ""]} { + if {![string compare $grabStatus "global"]} { grab -global $oldGrab } else { grab $oldGrab |