diff options
Diffstat (limited to 'library/bgerror.tcl')
| -rw-r--r-- | library/bgerror.tcl | 102 |
1 files changed, 54 insertions, 48 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl index f46ab4c..b15387e 100644 --- a/library/bgerror.tcl +++ b/library/bgerror.tcl @@ -9,6 +9,7 @@ # Copyright (c) 1998-2000 by Ajuba Solutions. # Copyright (c) 2007 by ActiveState Software Inc. # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net> +# Copyright (c) 2009 Pat Thoyts <patthoyts@users.sourceforge.net> namespace eval ::tk::dialog::error { namespace import -force ::tk::msgcat::* @@ -26,13 +27,13 @@ namespace eval ::tk::dialog::error { } } -proc ::tk::dialog::error::Return {} { +proc ::tk::dialog::error::Return {which code} { variable button - .bgerrorDialog.ok configure -state active -relief sunken + .bgerrorDialog.$which state {active selected focus} update idletasks after 100 - set button 0 + set button $code } proc ::tk::dialog::error::Details {} { @@ -53,19 +54,19 @@ proc ::tk::dialog::error::SaveToLog {text} { } else { set allFiles * } - set types [list \ - [list [mc "Log Files"] .log] \ - [list [mc "Text Files"] .txt] \ + set types [list \ + [list [mc "Log Files"] .log] \ + [list [mc "Text Files"] .txt] \ [list [mc "All Files"] $allFiles] \ ] set filename [tk_getSaveFile -title [mc "Select Log File"] \ -filetypes $types -defaultextension .log -parent .bgerrorDialog] - if {![string length $filename]} { - return + if {$filename ne {}} { + set f [open $filename w] + puts -nonewline $f $text + close $f } - set f [open $filename w] - puts -nonewline $f $text - close $f + return } proc ::tk::dialog::error::Destroy {w} { @@ -75,16 +76,29 @@ proc ::tk::dialog::error::Destroy {w} { } } +proc ::tk::dialog::error::DeleteByProtocol {} { + variable button + set button 1 +} + +proc ::tk::dialog::error::ReturnInDetails w { + bind $w <Return> {}; # Remove this binding + $w invoke + return -code break +} + # ::tk::dialog::error::bgerror -- -# This is the default version of bgerror. -# It tries to execute tkerror, if that fails it posts a dialog box containing -# the error message and gives the user a chance to ask to see a stack -# trace. +# +# This is the default version of bgerror. +# It tries to execute tkerror, if that fails it posts a dialog box +# containing the error message and gives the user a chance to ask +# to see a stack trace. +# # Arguments: -# err - The error message. - +# err - The error message. +# proc ::tk::dialog::error::bgerror err { - global errorInfo tcl_platform + global errorInfo variable button set info $errorInfo @@ -130,12 +144,13 @@ proc ::tk::dialog::error::bgerror err { # and bottom parts. set dlg .bgerrorDialog + set bg [ttk::style lookup . -background] destroy $dlg - toplevel $dlg -class ErrorDialog + toplevel $dlg -class ErrorDialog -background $bg wm withdraw $dlg wm title $dlg $title wm iconname $dlg ErrorDialog - wm protocol $dlg WM_DELETE_WINDOW { } + wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol] if {$windowingsystem eq "aqua"} { ::tk::unsupported::MacWindowStyle style $dlg moveableAlert {} @@ -143,23 +158,19 @@ proc ::tk::dialog::error::bgerror err { wm attributes $dlg -type dialog } - frame $dlg.bot - frame $dlg.top - if {$windowingsystem eq "x11"} { - $dlg.bot configure -relief raised -bd 1 - $dlg.top configure -relief raised -bd 1 - } + ttk::frame $dlg.bot + ttk::frame $dlg.top pack $dlg.bot -side bottom -fill both pack $dlg.top -side top -fill both -expand 1 - set W [frame $dlg.top.info] + set W [ttk::frame $dlg.top.info] text $W.text -setgrid true -height 10 -wrap char \ -yscrollcommand [list $W.scroll set] if {$windowingsystem ne "aqua"} { $W.text configure -width 40 } - scrollbar $W.scroll -command [list $W.text yview] + ttk::scrollbar $W.scroll -command [list $W.text yview] pack $W.scroll -side right -fill y pack $W.text -side left -expand yes -fill both $W.text insert 0.0 "$err\n$info" @@ -174,18 +185,11 @@ proc ::tk::dialog::error::bgerror err { # ...minus the width of the icon, padding and a fudge factor for # the window manager decorations and aesthetics. set wrapwidth [expr {$wrapwidth-60-[winfo pixels $dlg 9m]}] - label $dlg.msg -justify left -text $text -wraplength $wrapwidth - if {$windowingsystem eq "aqua"} { - # On the Macintosh, use the stop bitmap - label $dlg.bitmap -bitmap stop - } else { - # On other platforms, make the error icon - canvas $dlg.bitmap -width 32 -height 32 -highlightthickness 0 - $dlg.bitmap create oval 0 0 31 31 -fill red -outline black - $dlg.bitmap create line 9 9 23 23 -fill white -width 4 - $dlg.bitmap create line 9 23 23 9 -fill white -width 4 - } + ttk::label $dlg.msg -justify left -text $text -wraplength $wrapwidth + ttk::label $dlg.bitmap -image ::tk::icons::error + grid $dlg.bitmap $dlg.msg -in $dlg.top -row 0 -padx 3m -pady 3m + grid configure $dlg.bitmap -sticky ne grid configure $dlg.msg -sticky nsw -padx {0 3m} grid rowconfigure $dlg.top 1 -weight 1 grid columnconfigure $dlg.top 1 -weight 1 @@ -194,7 +198,7 @@ proc ::tk::dialog::error::bgerror err { set i 0 foreach {name caption} $buttons { - button $dlg.$name -text $caption -default normal \ + ttk::button $dlg.$name -text $caption -default normal \ -command [namespace code [list set button $i]] grid $dlg.$name -in $dlg.bot -column $i -row 0 -sticky ew -padx 10 grid columnconfigure $dlg.bot $i -weight 1 @@ -210,8 +214,10 @@ proc ::tk::dialog::error::bgerror err { # The "OK" button is the default for this dialog. $dlg.ok configure -default active - bind $dlg <Return> [namespace code Return] - bind $dlg <Destroy> [namespace code [list Destroy %W]] + bind $dlg <Return> [namespace code {Return ok 0}] + bind $dlg <Escape> [namespace code {Return dismiss 1}] + bind $dlg <Destroy> [namespace code {Destroy %W}] + bind $dlg.function <Return> [namespace code {ReturnInDetails %W}] $dlg.function configure -command [namespace code Details] # 6. Withdraw the window, then update all the geometry information @@ -220,7 +226,11 @@ proc ::tk::dialog::error::bgerror err { ::tk::PlaceWindow $dlg - # 7. Ensure that we are topmost. + # 7. Set a grab and claim the focus too. + + ::tk::SetFocusGrab $dlg $dlg.ok + + # 8. Ensure that we are topmost. raise $dlg if {[tk windowingsystem] eq "win32"} { @@ -228,13 +238,9 @@ proc ::tk::dialog::error::bgerror err { # order to ensure that it's seen if {[lindex [wm stackorder .] end] ne "$dlg"} { wm attributes $dlg -topmost 1 - } + } } - # 8. Set a grab and claim the focus too. - - ::tk::SetFocusGrab $dlg $dlg.ok - # 9. Wait for the user to respond, then restore the focus and # return the index of the selected button. Restore the focus # before deleting the window, since otherwise the window manager |