reorganized

svn path=/trunk/; revision=9400

1 files changed, 254 insertions, 0 deletions

diff --git a/desiredata/src/bgerror.tcl b/desiredata/src/bgerror.tcl
new file mode 100644
index 00000000..bff0dd2c
--- /dev/null
+++ b/desiredata/src/bgerror.tcl
@@ -0,0 +1,254 @@
+# 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.
+# All rights reserved.
+# 
+# RCS: @(#) $Id: bgerror.tcl,v 1.1.2.2.2.2 2007-08-12 02:38:45 matju Exp $
+# $Id: bgerror.tcl,v 1.1.2.2.2.2 2007-08-12 02:38:45 matju Exp $
+
+package provide bgerror 8.4
+
+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]
+}
+
+proc ::tk::dialog::error::Return {} {
+    variable button
+    .bgerrorDialog.ok configure -state active -relief sunken
+    update idletasks
+    after 100
+    set button 0
+}
+
+proc ::tk::dialog::error::Details {} {if {[catch {Details2}]} {::error_dump}}
+proc ::tk::dialog::error::Details2 {} {
+    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 [.bgerrorDialog.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 {![string length $filename]} {
+	return
+    }
+    set f [open $filename w]
+    puts -nonewline $f $text
+    close $f
+}
+
+proc ::tk::dialog::error::Destroy {w} {
+    if {$w eq ".bgerrorDialog"} {
+	variable button
+	set button -1
+    }
+}
+
+# ::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} {if {[catch {
+    global errorInfo tcl_platform
+    variable button
+
+# matju: use objective.tcl's
+#    set info $errorInfo
+    set info [::error_text]
+
+    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 :
+    if {($tcl_platform(platform) eq "macintosh")
+             || ([tk windowingsystem] eq "aqua")} {
+	set ok		[mc Ok]
+	set messageFont	system
+	set textRelief	flat
+	set textHilight	0
+    } else {
+	set ok		[mc OK]
+	set messageFont	{Helvetica -14 bold}
+	set textRelief	sunken
+	set textHilight	1
+    }
+
+    # Truncate the message if it is too wide (longer than 30 characacters) or
+    # too tall (more than 4 newlines).  Truncation occurs at the first point at
+    # which one of those conditions is met.
+    set displayedErr ""
+    set lines 0
+    foreach line [split $err \n] {
+	if {[string length $line]>30} {
+	    append displayedErr "[string range $line 0 29]..."
+	    break
+	}
+	if {$lines>4} {
+	    append displayedErr "..."
+	    break
+	} else {
+	    append displayedErr "${line}\n"
+	}
+	incr lines
+    }
+
+    set w .bgerrorDialog
+    set title [mc "Application Error"]
+    set text [mc {Error: %1$s} $err]
+    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.
+
+    catch {destroy .bgerrorDialog}
+    toplevel .bgerrorDialog -class ErrorDialog
+    wm withdraw .bgerrorDialog
+    wm title .bgerrorDialog $title
+    wm iconname .bgerrorDialog ErrorDialog
+    wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
+
+    if {($tcl_platform(platform) eq "macintosh")
+            || ([tk windowingsystem] eq "aqua")} {
+	::tk::unsupported::MacWindowStyle style .bgerrorDialog zoomDocProc
+    }
+
+    frame .bgerrorDialog.bot
+    frame .bgerrorDialog.top
+    if {[tk windowingsystem] eq "x11"} {
+	.bgerrorDialog.bot configure -relief raised -bd 1
+	.bgerrorDialog.top configure -relief raised -bd 1
+    }
+    pack .bgerrorDialog.bot -side bottom -fill both
+    pack .bgerrorDialog.top -side top -fill both -expand 1
+
+    set W [frame $w.top.info]
+    text $W.text -bd 2 -yscrollcommand [list $W.scroll set] -setgrid true \
+	    -width 80 -height 10 -state normal -relief $textRelief -highlightthickness $textHilight -wrap char
+
+    scrollbar $W.scroll -relief sunken -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 insert 0.0 $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 .bgerrorDialog]
+    # ...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 .bgerrorDialog 9m]}]
+    label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
+	    -wraplength $wrapwidth
+    if {($tcl_platform(platform) eq "macintosh")
+            || ([tk windowingsystem] eq "aqua")} {
+	# On the Macintosh, use the stop bitmap
+	label .bgerrorDialog.bitmap -bitmap stop
+    } else {
+	# On other platforms, make the error icon
+	canvas .bgerrorDialog.bitmap -width 32 -height 32 -highlightthickness 0 -bd 0
+	.bgerrorDialog.bitmap create oval 0 0 31 31 -fill red -outline black
+	.bgerrorDialog.bitmap create line 9 9 23 23 -fill white -width 4
+	.bgerrorDialog.bitmap create line 9 23 23 9 -fill white -width 4
+    }
+    grid .bgerrorDialog.bitmap .bgerrorDialog.msg \
+	    -in .bgerrorDialog.top	\
+	    -row 0			\
+	    -padx 3m			\
+	    -pady 3m
+    grid configure	 .bgerrorDialog.msg -sticky nsw -padx {0 3m}
+    grid rowconfigure	 .bgerrorDialog.top 1 -weight 1
+    grid columnconfigure .bgerrorDialog.top 1 -weight 1
+
+    # 3. Create a row of buttons at the bottom of the dialog.
+    set i 0
+    foreach {name caption} $buttons {
+	button .bgerrorDialog.$name -text $caption -default normal -command [namespace code [list set button $i]]
+	grid .bgerrorDialog.$name -in .bgerrorDialog.bot -column $i -row 0 -sticky ew -padx 10
+	grid columnconfigure .bgerrorDialog.bot $i -weight 1
+	# We boost the size of some Mac buttons for l&f
+	if {($tcl_platform(platform) eq "macintosh")
+	    || ([tk windowingsystem] eq "aqua")} {
+	    if {($name eq "ok") || ($name eq "dismiss")} {
+		grid columnconfigure .bgerrorDialog.bot $i -minsize 79
+	    }
+	}
+	incr i
+    }
+    # The "OK" button is the default for this dialog.
+    .bgerrorDialog.ok configure -default active
+
+    bind .bgerrorDialog <Return>  [namespace code Return]
+    bind .bgerrorDialog <Destroy> [namespace code [list Destroy %W]]
+    .bgerrorDialog.function configure -command [namespace code Details]
+
+    # 6. Update all the geometry information so we know how big it wants
+    # to be, then center the window in the display and deiconify it.
+    ::tk::PlaceWindow .bgerrorDialog
+
+    # 7. Ensure that we are topmost.
+    raise .bgerrorDialog
+    if {$tcl_platform(platform) eq "windows"} {
+	# 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 ".bgerrorDialog"} {
+	    wm attributes .bgerrorDialog -topmost 1
+	}
+    }
+
+    # 8. Set a grab and claim the focus too.
+    ::tk::SetFocusGrab .bgerrorDialog .bgerrorDialog.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
+    # 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 .bgerrorDialog .bgerrorDialog.ok destroy
+    if {$copy == 1} {return -code break}
+}]} {
+    ::error_dump
+}}
+
+namespace eval :: {
+    # Fool the indexer
+    proc bgerror err {}
+    rename bgerror {}
+    namespace import ::tk::dialog::error::bgerror
+}