source: branches/blt4/gui/scripts/bugreport.tcl @ 4651

Last change on this file since 4651 was 4651, checked in by gah, 10 years ago

update for ssl3 bug
File size: 26.9 KB
Line 
1
2# ----------------------------------------------------------------------
3#  UTILITY: bugreport
4#
5#  This redefines the usual Tcl bgerror command to install a nicer
6#  looking bug handler.  Bug reports can be submitted back to a
7#  HUBzero-based site as support tickets.  Additional information
8#  can be obtained by defining procedures as bugreport::instrumented
9#  proc (captures entrance/exit from proc) and by calling
10#  bugreport::remark with extra info along the way.
11# ======================================================================
12#  AUTHOR:  Michael McLennan, Purdue University
13#  Copyright (c) 2004-2006  Purdue Research Foundation
14#
15#  See the file "license.terms" for information on usage and
16#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17# ======================================================================
18option add *BugReport*Label.font {Helvetica -12} startupFile
19option add *BugReport*banner*foreground white startupFile
20option add *BugReport*banner*background #a9a9a9 startupFile
21option add *BugReport*banner*highlightBackground #a9a9a9 startupFile
22option add *BugReport*banner.title.font {Helvetica -18 bold} startupFile
23option add *BugReport*xmit*wrapLength 3i startupFile
24option add *BugReport*expl.width 50 startupFile
25option add *BugReport*expl.font {Helvetica -12} startupFile
26option add *BugReport*expl.boldFont {Helvetica -12 bold} startupFile
27option add *BugReport*comments.l.font {Helvetica -12 italic} startupFile
28option add *BugReport*comments.info.text.font {Helvetica -12} startupFile
29option add *BugReport*details*font {Courier -12} startupFile
30
31namespace eval Rappture::bugreport {
32    # details from the current trouble report, which user may decide to submit
33    variable details
34
35    # status from bugreport::instrumented/remark in case a bug occurs
36    variable extraStack ""
37    variable extraInfo ""
38
39    # assume that if there's a problem launching a job, we should know it
40    variable reportJobFailures 1
41
42    # submit these kinds of tickets by default
43    variable settings
44    set settings(user) $::tcl_platform(user)
45    set settings(type) "automatic"
46    set settings(group) ""
47    set settings(category) "Rappture"
48}
49
50# ----------------------------------------------------------------------
51# USAGE: install
52#
53# Called once in the main program to install this bug reporting
54# facility.  Any unexpected errors after this call will be handled
55# by this mechanism.
56# ----------------------------------------------------------------------
57proc Rappture::bugreport::install {} {
58    ::proc ::bgerror {err} { ::Rappture::bugreport::activate $err }
59}
60
61# ----------------------------------------------------------------------
62# USAGE: activate <error>
63#
64# Used internally to pop up the bug handler whenver a bug is
65# encountered.  Tells the user that there is a bug and logs the
66# problem, so it can be fixed.
67# ----------------------------------------------------------------------
68proc Rappture::bugreport::activate {err} {
69    global env errorInfo
70    variable details
71    variable settings
72
73puts stderr "err=$err\nerrorInfo=$errorInfo"
74    if {"@SHOWDETAILS" == $err} {
75        pack propagate .bugreport yes
76        pack forget .bugreport.expl
77        pack forget .bugreport.xmit
78        pack forget .bugreport.done
79        pack forget .bugreport.cntls.show
80        pack .bugreport.cntls -after .bugreport.banner -side bottom -fill x
81        pack .bugreport.details -after .bugreport.banner \
82            -expand yes -fill both -padx 8 -pady 8
83        pack .bugreport.comments -after .bugreport.details \
84            -expand yes -fill both -padx 8 -pady {0 8}
85
86        update idletasks
87        set w [winfo reqwidth .bugreport]
88        set h [winfo reqheight .bugreport]
89        #gah@purdue: temporary hack to force view of dismiss button
90        incr h 300
91        set x [expr {([winfo screenwidth .bugreport]-$w)/2}]
92        if {$x < 0} {set x "+0"} else {set x "+$x"}
93        set y [expr {([winfo screenheight .bugreport]-$h)/2}]
94        if {$y < 0} {set y "-0"} else {set y "+$y"}
95
96        wm geometry .bugreport $x$y
97        raise .bugreport
98        return
99    }
100
101    # gather details so we can submit trouble reports later
102    # do this now, before we do anything with "catch" down below
103    # that might mask the errorInfo
104    register $err
105
106    pack propagate .bugreport yes
107    pack forget .bugreport.details
108    pack forget .bugreport.xmit
109    pack forget .bugreport.done
110    pack .bugreport.cntls.show -side right
111    pack .bugreport.cntls -after .bugreport.banner -side bottom -fill x
112    pack .bugreport.expl -after .bugreport.banner \
113        -expand yes -fill both -padx 8 -pady 8
114    pack .bugreport.comments -after .bugreport.expl \
115        -expand yes -fill both -padx 8 -pady {0 8}
116
117    .bugreport.expl configure -state normal
118    .bugreport.expl delete 1.0 end
119
120    set url [Rappture::Tool::resources -huburl]
121    if {"" != $url} {
122        .bugreport.expl insert end "Something went wrong with this tool.  Help us understand what happened by submitting a trouble report, so we can fix the problem.  If you continue having trouble with this tool, please close it and restart."
123        .bugreport.cntls.send configure -state normal
124        focus .bugreport.cntls.send
125    } else {
126        .bugreport.expl insert end "Something went wrong with this tool.  We would ask you to submit a trouble report about the error, but we can't tell what hub it should be submitted to.  If you continue having trouble with this tool, please close it and restart."
127        pack forget .bugreport.comments
128        .bugreport.cntls.send configure -state disabled
129        focus .bugreport.cntls.ok
130    }
131    fixTextHeight .bugreport.expl
132    .bugreport.expl configure -state disabled
133
134    .bugreport.details.info.text configure -state normal
135    .bugreport.details.info.text delete 1.0 end
136    .bugreport.details.info.text insert end "    USER: $settings(user)\n"
137    .bugreport.details.info.text insert end "HOSTNAME: $details(hostname)\n"
138    .bugreport.details.info.text insert end "PLATFORM: $details(platform)\n"
139    .bugreport.details.info.text insert end "CATEGORY: $details(category)\n"
140    .bugreport.details.info.text insert end "    TOOL: $details(referrer)\n"
141    .bugreport.details.info.text insert end " SESSION: $details(session)\n"
142    .bugreport.details.info.text insert end " SUMMARY: $details(summary)\n"
143    .bugreport.details.info.text insert end "---------\n"
144    .bugreport.details.info.text insert end $details(stackTrace)
145    .bugreport.details.info.text configure -state disabled
146
147    set w [winfo reqwidth .bugreport]
148    set h [winfo reqheight .bugreport]
149    set x [expr {([winfo screenwidth .bugreport]-$w)/2}]
150    if {$x < 0} {set x 0}
151    set y [expr {([winfo screenheight .bugreport]-$h)/2}]
152    if {$y < 0} {set y 0}
153
154    wm geometry .bugreport +$x+$y
155    wm deiconify .bugreport
156    raise .bugreport
157
158    catch {grab set .bugreport}
159    update
160}
161
162# ----------------------------------------------------------------------
163# USAGE: deactivate
164#
165# Used internally to take down the bug handler dialog.
166# ----------------------------------------------------------------------
167proc Rappture::bugreport::deactivate {} {
168    grab release .bugreport
169    wm withdraw .bugreport
170
171    # reset the grab in case it's hosed
172    Rappture::grab::reset
173}
174
175# ----------------------------------------------------------------------
176# USAGE: instrumented <what> <name> <arglist> <body>
177#
178# Used instead of the usual Tcl "proc" or itcl::body to define a
179# procedure that will automatically register information about its
180# execution in the bugreport mechanism.  The <what> parameter should
181# be either "proc" or "itcl::body" or something like that.  When the
182# procedure starts, it pushes its call information onto the stack,
183# then invokes the procedure body, then adds information about the
184# return code.
185# ----------------------------------------------------------------------
186proc Rappture::bugreport::instrumented {what name arglist body} {
187    set avals ""
188    foreach term $arglist {
189        set aname [lindex $term 0]
190        append avals "\$$aname "
191    }
192    uplevel [list $what $name $arglist [format {
193        Rappture::bugreport::remark -enter "PROC %s: %s"
194        set __status [catch {%s} __result]
195        Rappture::bugreport::remark -leave "PROC %s: code($__status) => $__result"
196        switch -- $__status {
197            0 - 2 {
198                return $__result
199            }
200            3 {
201                set __result "invoked \"break\" outside of a loop"
202            }
203            4 {
204                set __result "invoked \"continue\" outside of a loop"
205            }
206        }
207        error $__result $::errorInfo
208    } $name $avals $body $name]]
209}
210
211# ----------------------------------------------------------------------
212# USAGE: remark ?-enter|-leave? <message>
213#
214# Adds the <message> to the current "extraInfo" being kept about the
215# program.  This adds useful debugging info to the report that gets
216# sent back when an unexpected error is trapped.  The -enter and -leave
217# options are used when a bugreport::instrumented proc starts/exits to
218# change the indent level for future messages.
219# ----------------------------------------------------------------------
220proc Rappture::bugreport::remark {args} {
221    variable extraStack
222    variable extraInfo
223
224    if {[llength $args] > 1} {
225        set option [lindex $args 0]
226        set args [lrange $args 1 end]
227        switch -- $option {
228            -enter {
229                if {[llength $args] != 1} {
230                    error "wrong # args: should be \"remark -enter message\""
231                }
232                set mesg [lindex $args 0]
233                if {[llength $extraStack] == 0} {
234                    set extraInfo ""
235                }
236                append extraInfo [remark -indent ">> $mesg"]
237                set extraStack [linsert $extraStack 0 $mesg]
238                return
239            }
240            -leave {
241                if {[llength $args] != 1} {
242                    error "wrong # args: should be \"remark -leave message\""
243                }
244                set mesg [lindex $args 0]
245                set extraStack [lrange $extraStack 1 end]
246                append extraInfo [remark -indent "<< $mesg"]
247                return
248            }
249            -indent {
250                if {[llength $args] != 1} {
251                    error "wrong # args: should be \"remark -indent message\""
252                }
253            }
254            default {
255                error "bad option \"$option\": should be -enter, -leave, -indent"
256            }
257        }
258    }
259    set mesg [lindex $args 0]
260    set nlevel [llength $extraStack]
261    set indent [string repeat { } [expr {2*$nlevel}]]
262    foreach line [split $mesg \n] {
263        append extraInfo "$indent$line\n"
264        set prefix "   "
265    }
266}
267
268# ----------------------------------------------------------------------
269# USAGE: sanitize <string> ?<replacement>?
270#
271# Removes any sensitive information in the bug report.  This is useful
272# for things such as passwords that should be scrubbed out before any
273# ticket is filed.  Replaces the <string> with an optional <replacement>
274# string (or ******** by default).  This is usually called in some sort
275# of "catch" before forwarding the error on to the usual bgerror routine.
276# ----------------------------------------------------------------------
277proc Rappture::bugreport::sanitize {str {repl ********}} {
278    global errorInfo
279    variable extraInfo
280
281    set map [list $str $repl]
282    set errorInfo [string map $map $errorInfo]
283    set extraInfo [string map $map $extraInfo]
284}
285
286# ----------------------------------------------------------------------
287# USAGE: attach <name> <string>
288#
289# Removes any sensitive information in the bug report.  This is useful
290# for things such as passwords that should be scrubbed out before any
291# ticket is filed.  Replaces the <string> with an optional <replacement>
292# string (or ******** by default).  This is usually called in some sort
293# of "catch" before forwarding the error on to the usual bgerror routine.
294# ----------------------------------------------------------------------
295proc Rappture::bugreport::attach {str {repl ********}} {
296    global errorInfo
297    variable extraInfo
298
299    set map [list $str $repl]
300    set errorInfo [string map $map $errorInfo]
301    set extraInfo [string map $map $extraInfo]
302}
303
304
305# ----------------------------------------------------------------------
306# USAGE: submit
307#
308# Takes details currently stored in the panel and registers them
309# as a support ticket on the hosting hub site.  Pops up a panel
310# during the process and informs the user of the result.
311# ----------------------------------------------------------------------
312proc Rappture::bugreport::submit {} {
313    set info [.bugreport.details.info.text get 1.0 end]
314
315    pack propagate .bugreport no
316    pack forget .bugreport.details
317    pack forget .bugreport.expl
318    pack forget .bugreport.comments
319    pack forget .bugreport.cntls
320    pack .bugreport.xmit -after .bugreport.banner -padx 8 -pady 8
321    .bugreport.xmit.title configure -text "Sending trouble report to [Rappture::Tool::resources -hubname]..."
322
323    # send off the trouble report...
324    .bugreport.xmit.icon start
325    set status [catch send result]
326    .bugreport.xmit.icon stop
327
328    pack propagate .bugreport yes
329    pack forget .bugreport.xmit
330    pack .bugreport.expl -after .bugreport.banner -padx 8 -pady 8
331    .bugreport.expl configure -state normal
332    .bugreport.expl delete 1.0 end
333
334    # handle the result
335    if {$status != 0} {
336        # add error to the details field, so we can see it with magic clicks
337        .bugreport.details.info.text configure -state normal
338        .bugreport.details.info.text insert 1.0 "Ticket submission failed:\n$result\n-----\n"
339        .bugreport.details.info.text configure -state disabled
340
341        .bugreport.expl insert end "Oops! Ticket submission failed:\n$result\n\nIf you want to report the original problem, you can file your own trouble report by going to the web site and clicking on the \"Help\" or \"Support\" link on the main navigation bar.  If you continue having trouble with this tool, please close it and restart."
342    } elseif {[regexp {Ticket #([0-9]*) +\((.*?)\) +([0-9]+) +times} $result match ticket extra times]} {
343        .bugreport.expl insert end "This problem has been reported as " "" "Ticket #$ticket" bold " in our system." ""
344        if {[string is integer $times] && $times > 1} {
345            .bugreport.expl insert end "  This particular problem has been reported $times times."
346        }
347        .bugreport.expl insert end "\n\nIf you continue having trouble with this tool, please close it and restart.  Thanks for reporting the problem and helping us improve things!"
348    } else {
349        .bugreport.expl insert end "This problem has been reported.  Here is the response from the hub, which may contain information about your ticket:\n" "" $result bold "\n\nIf you continue having trouble with this tool, please close it and restart.  Thanks for reporting the problem and helping us improve things!" ""
350    }
351    fixTextHeight .bugreport.expl
352    .bugreport.expl configure -state disabled
353    pack .bugreport.done -side bottom -padx 8 -pady 8
354    focus .bugreport.done
355}
356
357# ----------------------------------------------------------------------
358# USAGE: register <err>
359#
360# Low-level function used to capture information about a bug report
361# prior to calling "send", which actually sends the ticket.  We usually
362# let the user preview the information and decide whether or not to
363# send the ticket.
364# ----------------------------------------------------------------------
365proc Rappture::bugreport::register {err} {
366    global errorInfo tcl_platform
367    variable details
368    variable settings
369    variable extraInfo
370
371    #
372    # Figure out exactly what we'll send if the bug report is
373    # submitted, so we can show the user.
374    #
375    set stackTrace "$err\n---------\n$errorInfo\n---------\n$extraInfo"
376    if {![regexp {^([^\n]+)\n} $stackTrace match summary]} {
377        if {[string length $stackTrace] == 0} {
378            set summary "Unexpected error from Rappture"
379        } else {
380            set summary $stackTrace
381        }
382    }
383    if {[string length $summary] > 200} {
384        set summary "[string range $summary 0 200]..."
385    }
386    if {[string match {Problem launching job*} $summary]} {
387        append summary " (in tool \"[Rappture::Tool::resources -appname]\")"
388        set category "Tools"
389    } else {
390        set category $settings(category)
391    }
392
393    # make sure that the stack trace isn't too long
394    set toolong 20000
395    if {[string length $stackTrace] > $toolong} {
396        #
397        # If this came from "Problem launching job", then it will have
398        # a "== RAPPTURE INPUT ==" part somewhere in the middle.  Try
399        # to show the first part, this middle part, and the very last
400        # part, cutting out whatever we have to in the middle.
401        #
402        if {[regexp -indices {\n== RAPPTURE INPUT ==\n} $stackTrace match]} {
403            foreach {smid0 smid1} $match break
404            set quarter [expr {$toolong/4}]
405            set s0 $quarter
406            set smid0 [expr {$smid0-$quarter}]
407            set smid1 [expr {$smid1+$quarter}]
408            set s1 [expr {[string length $stackTrace]-$quarter}]
409
410            if {$smid0 < $s0} {
411                # first part is short -- truncate last part
412                set stackTrace "[string range $stackTrace 0 $smid1]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-($toolong-$smid1)}] end]"
413            } elseif {$smid1 > $s1} {
414                # last part is short -- truncate first part
415                set tailsize [expr {[string length $stackTrace]-$smid0}]
416                set stackTrace "[string range $stackTrace 0 [expr {$toolong-$tailsize}]]\n...\n[string range $stackTrace $smid0 end]"
417            } else {
418                # rappture input line is right about in the middle
419                set stackTrace "[string range $stackTrace 0 $s0]\n...\n[string range $stackTrace $smid0 $smid1]\n...\n[string range $stackTrace $s1 end]"
420            }
421        } else {
422            # no Rappture input -- just show first part and last part
423            set half [expr {$toolong/2}]
424            set stackTrace "[string range $stackTrace 0 $half]\n...\n[string range $stackTrace [expr {[string length $stackTrace]-$half}] end]"
425        }
426    }
427
428    set details(summary) $summary
429    set details(category) $category
430    set details(stackTrace) $stackTrace
431    set details(hostname) [info hostname]
432    set details(session) [Rappture::Tool::resources -session]
433    set details(referrer) [Rappture::Tool::resources -appname]
434    set details(platform) [array get tcl_platform]
435}
436
437# ----------------------------------------------------------------------
438# USAGE: attachment <string>
439#
440# Low-level function used to capture information about a bug report
441# prior to calling "send", which actually sends the ticket.  We usually
442# let the user preview the information and decide whether or not to
443# send the ticket.
444# ----------------------------------------------------------------------
445proc Rappture::bugreport::attachment { string } {
446    variable details
447    set details(attachment) $string
448}
449
450# ----------------------------------------------------------------------
451# USAGE: send
452#
453# Low-level function used to send bug reports back to the hub site.
454# Error details gathered by a previous call to "register" are sent
455# along as a support ticket.  Returns a string of the following form,
456# representing details about the new or existing ticket:
457#   Ticket #XX (XXXXXX) XX times
458# ----------------------------------------------------------------------
459proc Rappture::bugreport::send {} {
460    variable details
461    variable settings
462
463    package require http
464    package require tls
465    http::register https 443 [list ::tls::socket -tls1 1]
466
467    set report $details(stackTrace)
468    set cmts [string trim [.bugreport.comments.info.text get 1.0 end]]
469    if {[string length $cmts] > 0} {
470        set report "$cmts\n\n[string repeat = 72]\n$report"
471    }
472    set toolFile ""
473    if { [info exists details(attachment)] } {
474        set toolFile "/tmp/tool[pid].xml"
475        set f [open $toolFile "w"]
476        puts $f $details(attachment)
477        close $f
478        unset details(attachment)
479    }
480    set query [http::formatQuery \
481        option com_support \
482        controller tickets \
483        upload $toolFile \
484        task create \
485        no_html 1 \
486        report $report \
487        sesstoken $details(session) \
488        hostname $details(hostname) \
489        os $details(platform) \
490        category $details(category) \
491        summary $details(summary) \
492        referrer $details(referrer) \
493        login $settings(user) \
494        group $settings(group) \
495        type $settings(type) \
496    ]
497    set url [Rappture::Tool::resources -huburl]
498    if { $url == "" } {
499        set url "http://hubzero.org"
500    }
501    if {[string index $url end] == "/"} {
502        append url "index.php"
503    } else {
504        append url "/index.php"
505    }
506
507    set token [http::geturl $url -query $query -timeout 60000]
508
509    if {[http::ncode $token] != 200} {
510        error [http::code $token]
511    }
512    upvar #0 $token rval
513    set info $rval(body)
514    http::cleanup $token
515
516    if { $toolFile != "" } {
517        file delete $toolFile
518    }
519    if {[regexp {Ticket #[0-9]* +\(.*?\) +[0-9]+ +times} $info match]} {
520        return $match
521    }
522    error "Report received, but ticket may not have been filed.  Here's the result...\n$info"
523}
524
525# ----------------------------------------------------------------------
526# USAGE: fixTextHeight <widget>
527#
528# Used internally to adjust the height of a text widget so it is just
529# tall enough to show the info within it.
530# ----------------------------------------------------------------------
531proc Rappture::bugreport::fixTextHeight {widget} {
532    #
533    # HACK ALERT!  In Tk8.5, we can count display lines directly.
534    #   But for earlier versions, we have to cook up something
535    #   similar.
536    #
537    if {[catch {$widget count -displaylines 1.0 end} h] == 0 && $h > 0} {
538        $widget configure -height $h
539    } else {
540        for {set h 1} {$h < 15} {incr h} {
541            $widget configure -height $h
542            $widget see 1.0
543            update idletasks
544            if {"" != [$widget bbox end-1char]} {
545                break
546            }
547        }
548    }
549}
550
551# ----------------------------------------------------------------------
552# USAGE: shouldReport jobfailures <boolean>
553# USAGE: shouldReport for ?oops|jobs?
554#
555# Used internally to determine whether or not this system should
556# automatically report errors back to the hosting hub.  Returns 1
557# if the tool should, and 0 otherwise.  The decision is made based
558# on whether this is a current tool in production, whether it is
559# being tested in a workspace, and whether the tool commonly generates
560# problems (by pilot error in its input deck).
561# ----------------------------------------------------------------------
562proc Rappture::bugreport::shouldReport {option value} {
563    global env
564
565    switch -- $option {
566        jobfailures {
567            variable reportJobFailures
568            if {![string is boolean $value]} {
569                error "bad value \"$value\": should be boolean"
570            }
571            set reportJobFailures $value
572        }
573        for {
574            # is it being run within a workspace?
575            set appname [Rappture::Tool::resources -appname]
576            if {[string match {[Ww]orkspace*} $appname]} {
577                return 0
578            }
579
580            # if this is a problem launching a job and the tool
581            # expects this, then don't bother with automatic reports.
582            variable reportJobFailures
583            if {"jobs" == $value && !$reportJobFailures} {
584                return 0
585            }
586
587            # this is a real problem -- report it!
588            return 1
589        }
590        default {
591            error "bad option \"$option\": should be jobfailures or for"
592        }
593    }
594}
595
596# ----------------------------------------------------------------------
597# Build the bug reporting dialog
598# ----------------------------------------------------------------------
599toplevel .bugreport -class BugReport -borderwidth 1 -relief solid
600wm overrideredirect .bugreport 1
601wm withdraw .bugreport
602
603frame .bugreport.banner -background #a9a9a9
604pack .bugreport.banner -side top -fill x
605label .bugreport.banner.icon -image [Rappture::icon alert]
606pack .bugreport.banner.icon -side left -padx 2 -pady 2
607label .bugreport.banner.title -text "Oops! Internal Error"
608pack .bugreport.banner.title -side left -padx {0 8} -pady 2
609
610# add these frustration bindings in case the "Dismiss" button is off screen
611bind .bugreport.banner.icon <Double-ButtonPress-1> \
612    Rappture::bugreport::deactivate
613bind .bugreport.banner.title <Double-ButtonPress-1> \
614    Rappture::bugreport::deactivate
615bind .bugreport <KeyPress-Escape> \
616    Rappture::bugreport::deactivate
617
618set bg [.bugreport cget -background]
619text .bugreport.expl -borderwidth 0 -highlightthickness 0 -background $bg \
620    -height 3 -wrap word
621.bugreport.expl tag configure bold \
622    -font [option get .bugreport.expl boldFont Font]
623#
624# HACK ALERT!  We have problems with fixTextHeight working correctly
625#   on Windows for Tk8.4 and earlier.  To make it work properly, we
626#   add the binding below.  At some point, we'll ditch 8.4 and we can
627#   use the new "count -displaylines" option in Tk8.5.
628#
629bind .bugreport.expl <Map> {Rappture::bugreport::fixTextHeight %W}
630
631frame .bugreport.comments
632label .bugreport.comments.l -text "What were you doing just before this error?" -anchor w
633pack .bugreport.comments.l -side top -anchor w
634Rappture::Scroller .bugreport.comments.info -xscrollmode none -yscrollmode auto
635text .bugreport.comments.info.text -width 30 -height 3 -wrap word
636.bugreport.comments.info contents .bugreport.comments.info.text
637bind .bugreport.comments.info.text <ButtonPress> {focus %W}
638pack .bugreport.comments.info -expand yes -fill both
639
640frame .bugreport.cntls
641pack .bugreport.cntls -side bottom -fill x
642button .bugreport.cntls.ok -text "Ignore" -command {
643    Rappture::bugreport::deactivate
644}
645pack .bugreport.cntls.ok -side left -padx {4 20} -pady 8
646button .bugreport.cntls.send -text "Send Trouble Report" -command {
647    Rappture::bugreport::submit
648}
649pack .bugreport.cntls.send -side right -padx 4 -pady 8
650
651button .bugreport.cntls.show -text "Show Details..." \
652    -command {Rappture::bugreport::activate @SHOWDETAILS}
653pack .bugreport.cntls.show -side right
654
655
656frame .bugreport.details
657Rappture::Scroller .bugreport.details.info -xscrollmode auto -yscrollmode auto
658text .bugreport.details.info.text -width 50 -height 15 -wrap none
659.bugreport.details.info contents .bugreport.details.info.text
660pack .bugreport.details.info -expand yes -fill both
661
662frame .bugreport.xmit
663Rappture::Animicon .bugreport.xmit.icon -images {
664    circle-ball1 circle-ball2 circle-ball3 circle-ball4
665    circle-ball5 circle-ball6 circle-ball7 circle-ball8
666}
667pack .bugreport.xmit.icon -side left
668label .bugreport.xmit.title -anchor w
669pack .bugreport.xmit.title -side left -expand yes -fill x
670
671button .bugreport.done -text "Done" \
672    -command Rappture::bugreport::deactivate
673
674# this binding keeps the bugreport window on top
675bind BugReportOnTop <ButtonPress> {
676    wm deiconify %W
677    raise %W
678}
679set btags [bindtags .bugreport]
680bindtags .bugreport [linsert $btags 0 BugReportOnTop]
681
Note: See TracBrowser for help on using the repository browser.