source: branches/1.3/gui/scripts/bugreport.tcl @ 4706

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

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