SWAMPy

✎ CARVE FLESH

EDITING: bgerror.tcl

# bgerror.tcl --
#
#	Implementation of the bgerror procedure.  It posts a dialog box with
#	the error message and gives the user a chance to see a more detailed
#	stack trace, and possible do something more interesting with that
#	trace (like save it to a log).  This is adapted from work done by
#	Donal K. Fellows.
#
# 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::*
    namespace export bgerror
    option add *ErrorDialog.function.text [mc "Save To Log"] \
	widgetDefault
    option add *ErrorDialog.function.command [namespace code SaveToLog]
    option add *ErrorDialog*Label.font TkCaptionFont widgetDefault
    if {[tk windowingsystem] eq "aqua"} {
	option add *ErrorDialog*background systemAlertBackgroundActive \
		widgetDefault
	option add *ErrorDialog*info.text.background white widgetDefault
	option add *ErrorDialog*Button.highlightBackground \
		systemAlertBackgroundActive widgetDefault
    }
}

proc ::tk::dialog::error::Return {which code} {
    variable button

.bgerrorDialog.$which state {active selected focus}
    update idletasks
    after 100
    set button $code
}

proc ::tk::dialog::error::Details {} {
    set w .bgerrorDialog
    set caption [option get $w.function text {}]
    set command [option get $w.function command {}]
    if { ($caption eq "") || ($command eq "") } {
	grid forget $w.function
    }
    lappend command [$w.top.info.text get 1.0 end-1c]
    $w.function configure -text $caption -command $command
    grid $w.top.info - -sticky nsew -padx 3m -pady 3m
}

proc ::tk::dialog::error::SaveToLog {text} {
    if { $::tcl_platform(platform) eq "windows" } {
	set allFiles *.*
    } else {
	set allFiles *
    }
    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 {$filename ne {}} {
        set f [open $filename w]
        puts -nonewline $f $text
        close $f
    }
    return
}

proc ::tk::dialog::error::Destroy {w} {
    if {$w eq ".bgerrorDialog"} {
	variable button
	set button -1
    }
}

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.
#
# Arguments:
#	err - The error message.
#
proc ::tk::dialog::error::bgerror err {
    global errorInfo
    variable button

set info $errorInfo

set ret [catch {::tkerror $err} msg];
    if {$ret != 1} {return -code $ret $msg}

# Ok the application's tkerror either failed or was not found
    # we use the default dialog then :
    set windowingsystem [tk windowingsystem]
    if {$windowingsystem eq "aqua"} {
	set ok [mc Ok]
    } else {
	set ok [mc OK]
    }

# Truncate the message if it is too wide (>maxLine characters) or
    # too tall (>4 lines).  Truncation occurs at the first point at
    # which one of those conditions is met.
    set displayedErr ""
    set lines 0
    set maxLine 45
    foreach line [split $err \n] {
	if { [string length $line] > $maxLine } {
	    append displayedErr "[string range $line 0 [expr {$maxLine-3}]]..."
	    break
	}
	if { $lines > 4 } {
	    append displayedErr "..."
	    break
	} else {
	    append displayedErr "${line}\n"
	}
	incr lines
    }

set title [mc "Application Error"]
    set text [mc "Error: %1\$s" $displayedErr]
    set buttons [list ok $ok dismiss [mc "Skip Messages"] \
		     function [mc "Details >>"]]

# 1. Create the top-level window and divide it into top
    # and bottom parts.

set dlg .bgerrorDialog
    set bg [ttk::style lookup . -background]
    destroy $dlg
    toplevel $dlg -class ErrorDialog -background $bg
    wm withdraw $dlg
    wm title $dlg $title
    wm iconname $dlg ErrorDialog
    wm protocol $dlg WM_DELETE_WINDOW [namespace code DeleteByProtocol]

if {$windowingsystem eq "aqua"} {
	::tk::unsupported::MacWindowStyle style $dlg moveableAlert {}
    } elseif {$windowingsystem eq "x11"} {
	wm attributes $dlg -type dialog
    }

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 [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
    }

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"
    $W.text mark set insert 0.0
    bind $W.text <ButtonPress-1> { focus %W }
    $W.text configure -state disabled

# 2. Fill the top part with bitmap and message

# Max-width of message is the width of the screen...
    set wrapwidth [winfo screenwidth $dlg]
    # ...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]}]
    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

# 3. Create a row of buttons at the bottom of the dialog.

set i 0
    foreach {name caption} $buttons {
	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
	# We boost the size of some Mac buttons for l&f
	if {$windowingsystem eq "aqua"} {
	    if {($name eq "ok") || ($name eq "dismiss")} {
		grid columnconfigure $dlg.bot $i -minsize 90
	    }
	    grid configure $dlg.$name -pady 7
	}
	incr i
    }
    # The "OK" button is the default for this dialog.
    $dlg.ok configure -default active

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
    # so we know how big it wants to be, then center the window in the
    # display (Motif style) and de-iconify it.

::tk::PlaceWindow $dlg

# 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"} {
	# Place it topmost if we aren't at the top of the stacking
	# order to ensure that it's seen
	if {[lindex [wm stackorder .] end] ne "$dlg"} {
	    wm attributes $dlg -topmost 1
        }
    }

# 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
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

vwait [namespace which -variable button]
    set copy $button; # Save a copy...

::tk::RestoreFocusGrab $dlg $dlg.ok destroy

if {$copy == 1} {
	return -code break
    }
}

namespace eval :: {
    # Fool the indexer
    proc bgerror err {}
    rename bgerror {}
    namespace import ::tk::dialog::error::bgerror
}

CANCEL

Name	Type	Size	Modified	Actions
↩ ..	DIR	—	—
📁 demos/	DIR	—	2024-07-31 12:10
📁 images/	DIR	—	2024-07-31 12:10
📁 msgs/	DIR	—	2024-07-31 12:10
📁 ttk/	DIR	—	2024-07-31 12:10
📄 bgerror.tcl	TCL	8.1 KB	2019-10-16 17:25	EDIT
📄 button.tcl	TCL	20.2 KB	2019-10-16 17:25	EDIT
📄 choosedir.tcl	TCL	9.4 KB	2019-10-16 17:25	EDIT
📄 clrpick.tcl	TCL	20.9 KB	2019-10-16 17:25	EDIT
📄 comdlg.tcl	TCL	8 KB	2019-10-16 17:25	EDIT
📄 console.tcl	TCL	32 KB	2019-10-16 17:25	EDIT
📄 dialog.tcl	TCL	5.9 KB	2019-10-16 17:25	EDIT
📄 entry.tcl	TCL	16.6 KB	2019-10-16 17:25	EDIT
📄 focus.tcl	TCL	4.7 KB	2019-10-16 17:25	EDIT
📄 fontchooser.tcl	TCL	15.5 KB	2019-10-16 17:25	EDIT
📄 iconlist.tcl	TCL	15.6 KB	2019-10-16 17:25	EDIT
📄 icons.tcl	TCL	10.6 KB	2019-10-16 17:25	EDIT
📄 listbox.tcl	TCL	14.3 KB	2019-10-16 17:25	EDIT
📄 megawidget.tcl	TCL	9.3 KB	2019-10-16 17:25	EDIT
📄 menu.tcl	TCL	37.1 KB	2019-10-16 17:25	EDIT
📄 mkpsenc.tcl	TCL	28.7 KB	2019-10-16 17:25	EDIT
📄 msgbox.tcl	TCL	16.1 KB	2019-10-16 17:25	EDIT
📄 obsolete.tcl	TCL	5.5 KB	2019-10-16 17:25	EDIT
📄 optMenu.tcl	TCL	1.5 KB	2019-10-16 17:25	EDIT
📄 palette.tcl	TCL	7.7 KB	2019-10-16 17:25	EDIT
📄 panedwindow.tcl	TCL	5.1 KB	2019-10-16 17:25	EDIT
📄 safetk.tcl	TCL	7.2 KB	2019-10-16 17:25	EDIT
📄 scale.tcl	TCL	7.6 KB	2019-10-16 17:25	EDIT
📄 scrlbar.tcl	TCL	12.4 KB	2019-10-16 17:25	EDIT
📄 spinbox.tcl	TCL	15.3 KB	2019-10-16 17:25	EDIT
📄 tclIndex	?	19.8 KB	2019-10-16 17:25	EDIT
📄 tearoff.tcl	TCL	5 KB	2019-10-16 17:25	EDIT
📄 text.tcl	TCL	32.3 KB	2019-10-16 17:25	EDIT
📄 tk.tcl	TCL	22.6 KB	2019-10-16 17:25	EDIT
📄 tkfbox.tcl	TCL	37.5 KB	2019-10-16 17:25	EDIT
📄 unsupported.tcl	TCL	10 KB	2019-10-16 17:25	EDIT
📄 xmfbox.tcl	TCL	25.5 KB	2019-10-16 17:25	EDIT