通讯编程

开发平台：
Visual C++

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 Daniel A. Steffen <das@users.sourceforge.net>
# 
# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.9 2007/11/09 06:26:54 das Exp $
# $Id: bgerror.tcl,v 1.23.2.9 2007/11/09 06:26:54 das Exp $
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]
    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 {} {
    variable button
    .bgerrorDialog.ok configure -state active -relief sunken
    update idletasks
    after 100
    set button 0
}
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 [.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 {
    global errorInfo tcl_platform
    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 {($tcl_platform(platform) eq "macintosh")
             || ($windowingsystem eq "aqua")} {
	set ok		[mc Ok]
	set messageFont	system
	set textRelief	flat
	set textHilight	0
    } else {
	set ok		[mc OK]
	set messageFont	{Times -18}
	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} $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.
    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")
            || ($windowingsystem eq "aqua")} {
	::tk::unsupported::MacWindowStyle style .bgerrorDialog moveableAlert {}
    }
    frame .bgerrorDialog.bot
    frame .bgerrorDialog.top
    if {$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				
	    -yscrollcommand [list $W.scroll set]
	    -setgrid true			
	    -width 40				
	    -height 10				
	    -state normal			
	    -relief $textRelief			
	    -highlightthickness $textHilight	
	    -wrap char
    if {$windowingsystem eq "aqua"} {
	$W.text configure -width 80 -background white
    }
    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 "$errn$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")
            || ($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
	.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")
	    || ($windowingsystem eq "aqua")} {
	    if {($name eq "ok") || ($name eq "dismiss")} {
		grid columnconfigure .bgerrorDialog.bot $i -minsize 90
	    }
	    grid configure .bgerrorDialog.$name -pady 7
	}
	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
    }
}
namespace eval :: {
    # Fool the indexer
    proc bgerror err {}
    rename bgerror {}
    namespace import ::tk::dialog::error::bgerror
}

						