source: trunk/gui/scripts/bugreport.tcl @ 4291

Last change on this file since 4291 was 4003, checked in by gah, 11 years ago

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