1 | # ---------------------------------------------------------------------- |
---|
2 | # UTILITY: bugreport |
---|
3 | # |
---|
4 | # This redefines the usual Tcl bgerror command to install a nicer |
---|
5 | # looking bug handler. |
---|
6 | # ====================================================================== |
---|
7 | # AUTHOR: Michael McLennan, Purdue University |
---|
8 | # Copyright (c) 2004-2006 Purdue Research Foundation |
---|
9 | # |
---|
10 | # See the file "license.terms" for information on usage and |
---|
11 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
12 | # ====================================================================== |
---|
13 | |
---|
14 | option add *BugReport*banner*foreground white startupFile |
---|
15 | option add *BugReport*banner*background #a9a9a9 startupFile |
---|
16 | option add *BugReport*banner*highlightBackground #a9a9a9 startupFile |
---|
17 | option add *BugReport*banner*font \ |
---|
18 | -*-helvetica-bold-r-normal-*-*-180-* startupFile |
---|
19 | option add *BugReport*expl.font \ |
---|
20 | -*-helvetica-medium-r-normal-*-*-120-* startupFile |
---|
21 | option add *BugReport*expl.wrapLength 3i startupFile |
---|
22 | |
---|
23 | namespace eval Rappture::bugreport { # forward declaration } |
---|
24 | |
---|
25 | # ---------------------------------------------------------------------- |
---|
26 | # USAGE: install |
---|
27 | # |
---|
28 | # Called once in the main program to install this bug reporting |
---|
29 | # facility. Any unexpected errors after this call will be handled |
---|
30 | # by this mechanism. |
---|
31 | # ---------------------------------------------------------------------- |
---|
32 | proc Rappture::bugreport::install {} { |
---|
33 | proc ::bgerror {err} { ::Rappture::bugreport::activate $err } |
---|
34 | } |
---|
35 | |
---|
36 | # ---------------------------------------------------------------------- |
---|
37 | # USAGE: activate <error> |
---|
38 | # |
---|
39 | # Used internally to pop up the bug handler whenver a bug is |
---|
40 | # encountered. Tells the user that there is a bug and logs the |
---|
41 | # problem, so it can be fixed. |
---|
42 | # ---------------------------------------------------------------------- |
---|
43 | proc Rappture::bugreport::activate {err} { |
---|
44 | global errorInfo |
---|
45 | |
---|
46 | set w [winfo reqwidth .bugreport] |
---|
47 | set h [winfo reqheight .bugreport] |
---|
48 | set x [expr {([winfo screenwidth .bugreport]-$w)/2}] |
---|
49 | set y [expr {([winfo screenheight .bugreport]-$w)/2}] |
---|
50 | |
---|
51 | wm geometry .bugreport +$x+$y |
---|
52 | wm deiconify .bugreport |
---|
53 | raise .bugreport |
---|
54 | |
---|
55 | # should log the error someday too... |
---|
56 | |
---|
57 | catch {grab set .bugreport} |
---|
58 | } |
---|
59 | |
---|
60 | # ---------------------------------------------------------------------- |
---|
61 | # USAGE: deactivate |
---|
62 | # |
---|
63 | # Used internally to take down the bug handler dialog. |
---|
64 | # ---------------------------------------------------------------------- |
---|
65 | proc Rappture::bugreport::deactivate {} { |
---|
66 | grab release .bugreport |
---|
67 | wm withdraw .bugreport |
---|
68 | |
---|
69 | # reset the grab in case it's hosed |
---|
70 | Rappture::grab::reset |
---|
71 | } |
---|
72 | |
---|
73 | # ---------------------------------------------------------------------- |
---|
74 | # Build the bug reporting dialog |
---|
75 | # ---------------------------------------------------------------------- |
---|
76 | toplevel .bugreport -class BugReport -borderwidth 1 -relief solid |
---|
77 | wm overrideredirect .bugreport 1 |
---|
78 | wm withdraw .bugreport |
---|
79 | |
---|
80 | frame .bugreport.banner -background #a9a9a9 |
---|
81 | pack .bugreport.banner -side top -fill x |
---|
82 | label .bugreport.banner.icon -image [Rappture::icon alert] |
---|
83 | pack .bugreport.banner.icon -side left -padx 2 -pady 2 |
---|
84 | label .bugreport.banner.title -text "Oops! Unexpected Error" |
---|
85 | pack .bugreport.banner.title -side left -padx {0 8} -pady 2 |
---|
86 | |
---|
87 | button .bugreport.ok -text "OK" -command Rappture::bugreport::deactivate |
---|
88 | pack .bugreport.ok -side bottom -pady {0 8} |
---|
89 | |
---|
90 | label .bugreport.expl -text "You've found a bug in this application.\n\nIf it's not a serious bug, you may be able to continue using the tool. But if the tool doesn't seem to behave properly after this, please close this session and start the tool again.\n\nYou can help us improve nanoHUB by reporting this error. Click on the \"Report Problems\" link in the web page containing this tool session, and tell us what you were doing when the error occurred." -justify left |
---|
91 | pack .bugreport.expl -padx 8 -pady 8 |
---|
92 | |
---|
93 | # this binding keeps the bugreport window on top |
---|
94 | bind BugReportOnTop <ButtonPress> { |
---|
95 | wm deiconify %W |
---|
96 | raise %W |
---|
97 | } |
---|
98 | set btags [bindtags .bugreport] |
---|
99 | bindtags .bugreport [linsert $btags 0 BugReportOnTop] |
---|