source: trunk/tester/resultspage.tcl @ 2026

Last change on this file since 2026 was 2026, checked in by braffert, 14 years ago

Regression tester: Created a new widget implementing only the analyze page of the analyzer widget, rather than inheriting the entire class.
File size: 18.5 KB
Line 
1package require Itk
2
3option add *ResultsPage.width 3.5i widgetDefault
4option add *ResultsPage.height 4i widgetDefault
5option add *ResultsPage.font \
6    -*-helvetica-medium-r-normal-*-12-* widgetDefault
7option add *ResultsPage.codeFont \
8    -*-courier-medium-r-normal-*-12-* widgetDefault
9option add *ResultsPage.textFont \
10    -*-helvetica-medium-r-normal-*-12-* widgetDefault
11option add *ResultsPage.boldTextFont \
12    -*-helvetica-bold-r-normal-*-12-* widgetDefault
13
14itcl::class Rappture::ResultsPage {
15    inherit itk::Widget
16
17    itk_option define -codefont codeFont Font ""
18    itk_option define -textfont textFont Font ""
19    itk_option define -boldtextfont boldTextFont Font ""
20
21    constructor {args} { # defined below }
22    destructor { # defined below }
23
24    public method load {xmlobj}
25    public method clear {}
26    public method download {option args}
27
28    protected method _plot {args}
29    protected method _fixResult {}
30    protected method _fixSize {}
31    protected method _resultTooltip {}
32    protected method _autoLabel {xmlobj path title cntVar}
33    protected method _reorder {comps}
34
35    private variable _pages 0
36    private variable _label2page
37    private variable _label2desc
38    private variable _runs ""
39    private variable _lastlabel ""
40    private variable _plotlist ""
41
42    # TODO: ???
43    public variable promptcommand ""
44}
45
46itk::usual ResultsPage {
47    keep -background -cursor -font
48    #TODO: keep -background -cursor foreground -font
49}
50
51itcl::body Rappture::ResultsPage::constructor {args} {
52
53    itk_component add top {
54        frame $itk_interior.top
55    }
56    pack $itk_component(top) -side top -fill x -pady 8
57
58    itk_component add toplabel {
59        label $itk_component(top).l -text "Result:"
60        #TODO: -font $itk_option(font)
61    }
62    pack $itk_component(toplabel) -side left
63
64    itk_component add resultselector {
65        Rappture::Combobox $itk_component(top).sel -width 10 -editable no
66    } {
67        usual
68        rename -font -textfont textFont Font
69    }
70    pack $itk_component(resultselector) -side left -expand yes -fill x
71    bind $itk_component(resultselector) <<Value>> [itcl::code $this _fixResult]
72    bind $itk_component(resultselector) <Enter> \
73        [itcl::code $this download coming]
74
75    Rappture::Tooltip::for $itk_component(resultselector) \
76        "@[itcl::code $this _resultTooltip]"
77
78    $itk_component(resultselector) choices insert end --- "---"
79
80    itk_component add download {
81        button $itk_component(top).dl -image [Rappture::icon download] \
82            -anchor e -borderwidth 1 -relief flat -overrelief raised \
83            -command [itcl::code $this download start $itk_component(top).dl]
84    }
85    pack $itk_component(download) -side right -padx {4 0}
86    bind $itk_component(download) <Enter> [itcl::code $this download coming]
87
88    $itk_component(resultselector) choices insert end \
89        @download [Rappture::filexfer::label download]
90
91    if {[Rappture::filexfer::enabled]} {
92        Rappture::Tooltop::for $itk_component(download) "Downloads the current result to a new web browser window on your desktop.  From there, you can easily print or save results.
93
94NOTE:  Your web browser must allow pop-ups from this site.  If your output does not appear, look for a 'pop-up blocked' message and enable pop-ups."
95    } else {
96        Rappture::Tooltip::for $itk_component(download) "Saves the current result to a file on your desktop."
97    }
98
99    itk_component add results {
100        Rappture::Panes $itk_interior.pane -sashwidth 1 \
101            -sashrelief solid -sashpadding {4 0}
102    }
103    pack $itk_component(results) -expand yes -fill both
104    set f [$itk_component(results) pane 0]
105
106    itk_component add resultpages {
107        Rappture::Notebook $f.nb
108    }
109    pack $itk_component(resultpages) -expand yes -fill both
110
111    set f [$itk_component(results) insert end -fraction 0.1]
112    itk_component add resultset {
113        Rappture::ResultSet $f.rset \
114            -clearcommand [itcl::code $this clear] \
115            -settingscommand [itcl::code $this _plot]
116    } {
117        usual
118        keep -promptcommand
119    }
120    pack $itk_component(resultset) -expand yes -fill both
121    bind $itk_component(resultset) <<Control>> [itcl::code $this _fixSize]
122    bind $itk_component(results) <Configure> [itcl::code $this _fixSize]
123
124    eval itk_initialize $args
125}
126
127itcl::body Rappture::ResultsPage::destructor {} {
128    foreach obj $_runs {
129        itcl::delete object $obj
130    }
131    # TODO: after cancel [itcl::code $this simulate] ???
132}
133 
134itcl::body Rappture::ResultsPage::_fixResult {} {
135    set name [$itk_component(resultselector) value]
136    set page ""
137    if {"" != $name} {
138        set page [$itk_component(resultselector) translate $name]
139    }
140    if {$page == "@download"} {
141        # put the combobox back to its last value
142        $itk_component(resultselector) component entry configure -state normal
143        $itk_component(resultselector) component entry delete 0 end
144        $itk_component(resultselector) component entry insert end $_lastlabel
145        $itk_component(resultselector) component entry configure -state disabled
146        # perform the actual download
147        download start $itk_component(download)
148    } elseif {$page == "---"} {
149        # put the combobox back to its last value
150        $itk_component(resultselector) component entry configure -state normal
151        $itk_component(resultselector) component entry delete 0 end
152        $itk_component(resultselector) component entry insert end $_lastlabel
153        $itk_component(resultselector) component entry configure -state disabled
154    } elseif {$page != ""} {
155        set _lastlabel $name
156        set win [winfo toplevel $itk_component(hull)]
157        blt::busy hold $win
158        $itk_component(resultpages) current $page
159
160        set f [$itk_component(resultpages) page $page]
161        $f.rviewer plot clear
162        eval $f.rviewer plot add $_plotlist
163        blt::busy release [winfo toplevel $itk_component(hull)]
164    }
165}
166
167itcl::body Rappture::ResultsPage::download {option args} {
168    set title [$itk_component(resultselector) value]
169    set page [$itk_component(resultselector) translate $title]
170
171    switch -- $option {
172        coming {
173            #
174            # Warn result that a download is coming, in case
175            # it needs to take a screen snap.
176            #
177            if {![regexp {^(|@download|---)$} $page]} {
178                set f [$itk_component(resultpages) page $page]
179                $f.rviewer download coming
180            }
181        }
182        controls {
183            # no controls for this download yet
184            return ""
185        }
186        start {
187            set widget $itk_component(download)
188            if {[llength $args] > 0} {
189                set widget [lindex $args 0]
190                if {[catch {winfo class $widget}]} {
191                    set widget $itk_component(download)
192                }
193            }
194            #
195            # See if this download has any controls.  If so, then
196            # post them now and let the user continue the download
197            # after selecting a file format.
198            #
199            if {$page != ""} {
200                set ext ""
201                set f [$itk_component(resultpages) page $page]
202                set arg [itcl::code $this download now $widget]
203                set popup [$f.rviewer download controls $arg]
204                if {"" != $popup} {
205                    $popup activate $widget below
206                } else {
207                    download now $widget
208                }
209            } else {
210                # this shouldn't happen
211                set file error.html
212                set data "<h1>Not Found</h1>There is no result selected."
213            }
214        }
215        now {
216            set widget $itk_component(download)
217            if {[llength $args] > 0} {
218                set widget [lindex $args 0]
219                if {[catch {winfo class $widget}]} {
220                    set widget $itk_component(download)
221                }
222            }
223            #
224            # Perform the actual download.
225            #
226            if {$page != ""} {
227                set ext ""
228                set f [$itk_component(resultpages) page $page]
229                set item [$itk_component(resultselector) value]
230                set result [$f.rviewer download now $widget $_appName $item]
231                if { $result == "" } {
232                    return;                # User cancelled the download.
233                }
234                foreach {ext data} $result break
235                if {"" == $ext} {
236                    if {"" != $widget} {
237                        Rappture::Tooltip::cue $widget \
238                            "Can't download this result."
239                    }
240                    return
241                }
242                regsub -all {[\ -\/\:-\@\{-\~]} $title {} title
243                set file "$title$ext"
244            } else {
245                # this shouldn't happen
246                set file error.html
247                set data "<h1>Not Found</h1>There is no result selected."
248            }
249
250            set mesg [Rappture::filexfer::download $data $file]
251            if {[string length $mesg] > 0} {
252                Rappture::Tooltip::cue $widget $mesg
253            }
254        }
255        default {
256            error "bad option \"$option\": should be coming, controls, now, start"
257        }
258    }
259}
260
261itcl::body Rappture::ResultsPage::load {xmlobj} {
262    # TODO: only show the last result? then clear first
263
264    # look for all output.load children and load them first
265    # each run.xml is loaded as a previous simulation.
266    foreach item [$xmlobj children -type run output.load] {
267        set loadfile [$xmlobj get output.load.$item]
268        set loadobj [Rappture::library $loadfile]
269        load $loadobj
270    }
271
272    foreach item [$xmlobj children -type run output.include] {
273        set id [$xmlobj element -as id output.include.$item]
274        set inclfile [$xmlobj get output.include.$item]
275        set inclobj [Rappture::library $inclfil]
276        foreach c [$inclobj children output] {
277            switch -glob -- $c {
278                # We don't want to include these tags.
279                include* - time* - status* - user* {
280                    continue
281                }
282                default {
283                    set oldid [$inclobj element -as id output.$c]
284                    set oldtype [$inclobj element -as type output.$c]
285                    set newcomp "$oldtype\($id-$oldid\)"
286                    $xmlobj copy output.$newcomp from $inclobj output.$c
287                }
288            }
289        }
290    }
291
292    lappend _runs $xmlobj
293
294    # Detect molecule elements that contain trajectory data and convert
295    # to sequences.
296    # TODO: _trajToSequence $xmlobj output
297
298    # Go through the analysis and find all result sets.
299    set haveresults 0
300    foreach item [_reorder [$xmlobj children output]] {
301        switch -glob -- $item {
302            log* {
303                _autoLabel $xmlobj output.$item "Output Log" counters
304            }
305            number* {
306                _autoLabel $xmlobj output.$item "Number" counters
307            }
308            integer* {
309                _autoLabel $xmlobj output.$item "Integer" counters
310            }
311            string* {
312                _autoLabel $xmlobj output.$item "String" counters
313            }
314            histogram* - curve* - field* - drawing3d* {
315                _autoLabel $xmlobj output.$item "Plot" counters
316            }
317            structure* {
318                _autoLabel $xmlobj output.$item "Structure" counters
319            }
320            table* {
321                _autoLabel $xmlobj output.$item "Energy Levels" counters
322            }
323            sequence* {
324                _autoLabel $xmlobj output.$item "Sequence" counters
325            }
326        }
327        set label [$xmlobj get output.$item.about.group]
328        if {"" == $label} {
329            set label [$xmlobj get output.$item.about.label]
330        }
331
332        set hidden [$xmlobj get output.$item.hide]
333        set hidden [expr {"" != $hidden && $hidden}]
334
335        if {"" != $label && !$hidden} {
336            set haveresults 1
337        }
338    }
339
340    # if there are any valid results, add them to the resultset
341    if {$haveresults} {
342        set index [$itk_component(resultset) add $xmlobj]
343
344        # add each result to a result viewer
345        foreach item [_reorder [$xmlobj children output]] {
346            set label [$xmlobj get output.$item.about.group]
347            if {"" == $label} {
348                set label [$xmlobj get output.$item.about.label]
349            }
350
351            set hidden [$xmlobj get output.$item.hide]
352            set hidden [expr {"" != $hidden && $hidden}]
353
354            if {"" != $label && !$hidden} {
355                if {![info exists _label2page($label)]} {
356                    set name "page[incr _pages]"
357                    set page [$itk_component(resultpages) insert end $name]
358                    set _label2page($label) $page
359                    set _label2desc($label) \
360                        [$xmlobj get output.$item.about.description]
361                    Rappture::ResultViewer $page.rviewer
362                    pack $page.rviewer -expand yes -fill both -pady 4
363
364                    set end [$itk_component(resultselector) \
365                        choices index -value ---]
366                    if {$end < 0} {
367                        set end "end"
368                    }
369                    $itk_component(resultselector) choices insert $end \
370                        $name $label
371                }
372
373                # add/replace the latest result into this viewer
374                set page $_label2page($label)
375
376                if {![info exists reset($page)]} {
377                    $page.rviewer clear $index
378                    set reset($page) 1
379                }
380                $page.rviewer add $index $xmlobj output.$item
381            }
382        }
383    }
384
385    # show the first page by default
386    set max [$itk_component(resultselector) choices size]
387    for {set i 0} {$i < $max} {incr i} {
388        set first [$itk_component(resultselector) choices get -label $i]
389        if {$first != ""} {
390            set page [$itk_component(resultselector) choices get -value $i]
391            set char [string index $page 0]
392            if {$char != "@" && $char != "-"} {
393                $itk_component(resultpages) current $page
394                $itk_component(resultselector) value $first
395                set _lastlabel $first
396                break
397            }
398        }
399    }
400}
401
402
403itcl::body Rappture::ResultsPage::clear {} {
404    foreach obj $_runs {
405        itcl::delete object $obj
406    }
407    set _runs ""
408
409    $itk_component(resultset) clear
410
411    # reset the size of the controls area
412    set ht [winfo height $itk_component(results)]
413    set cntlht [$itk_component(resultset) size -controlarea]
414    set frac [expr {double($cntlht)/$ht}]
415    $itk_component(results) fraction end $frac
416
417    foreach label [array names _label2page] {
418        set page $_label2page($label)
419        $page.rviewer clear
420    }
421    $itk_component(resultselector) value ""
422    $itk_component(resultselector) choices delete 0 end
423    catch {unset _label2page}
424    catch {unset _label2desc}
425    set _plotlist ""
426
427    $itk_component(resultselector) choices insert end --- "---"
428    $itk_component(resultselector) choices insert end \
429        @download [Rappture::filexfer::label download]
430    set _lastlabel ""
431
432    #
433    # HACK ALERT!!
434    # The following statement should be in place, but it causes
435    # vtk to dump core.  Leave it out until we can fix the core dump.
436    # In the mean time, we leak memory...
437    #
438    #$itk_component(resultpages) delete -all
439    #set _pages 0
440
441    # TODO: _simState on
442    # TODO: _fixSimControl
443    # TODO: _reset
444}
445
446itcl::body Rappture::ResultsPage::_resultTooltip {} {
447    set tip ""
448    set name [$itk_component(resultselector) value]
449    if {[info exists _label2desc($name)] &&
450         [string length $_label2desc($name)] > 0} {
451        append tip "$_label2desc($name)\n\n"
452    }
453    if {[array size _label2page] > 1} {
454        append tip "Use this control to display other output results."
455    }
456    return $tip
457}
458
459itcl::body Rappture::ResultsPage::_fixSize {} {
460    set ht [winfo height $itk_component(results)]
461    if {$ht <= 1} { set ht [winfo reqheight $itk_component(results)] }
462    set cntlht [$itk_component(resultset) size -controlarea]
463    set frac [expr {double($cntlht)/$ht}]
464
465    if {$frac < 0.4} {
466        $itk_component(results) fraction end $frac
467    }
468    #_fixSimControl
469}
470
471itcl::body Rappture::ResultsPage::_autoLabel {xmlobj path title cntVar} {
472    upvar $cntVar counters
473
474    set group [$xmlobj get $path.about.group]
475    set label [$xmlobj get $path.about.label]
476    if {"" == $label} {
477        # no label -- make one up using the title specified
478        if {![info exists counters($group-$title)]} {
479            set counters($group-$title) 1
480            set label $title
481        } else {
482            set label "$title (#[incr counters($group-$title)])"
483        }
484        $xmlobj put $path.about.label $label
485    } else {
486        # handle the case of two identical labels in <output>
487        if {![info exists counters($group-$label)]} {
488            set counters($group-$label) 1
489        } else {
490            set label "$label (#[incr counters($group-$label)])"
491            $xmlobj put $path.about.label $label
492        }
493    }
494    return $label
495}
496
497# ----------------------------------------------------------------------
498# USAGE: _plot ?<index> <options> <index> <options>...?
499#
500# Used internally to update the plot shown in the current result
501# viewer whenever the resultset settings have changed.  Causes the
502# desired results to show up on screen.
503# ----------------------------------------------------------------------
504itcl::body Rappture::ResultsPage::_plot {args} {
505    set _plotlist $args
506
507    set page [$itk_component(resultselector) value]
508    set page [$itk_component(resultselector) translate $page]
509    if {"" != $page} {
510        set f [$itk_component(resultpages) page $page]
511        $f.rviewer plot clear
512        foreach {index opts} $_plotlist {
513            $f.rviewer plot add $index $opts
514        }
515    }
516}
517
518# ----------------------------------------------------------------------
519# USAGE: _reorder <compList>
520#
521# Used internally to change the order of a series of output components
522# found in the <output> section.  Moves the <log> elements to the end
523# and returns the updated list.
524# ----------------------------------------------------------------------
525itcl::body Rappture::ResultsPage::_reorder {comps} {
526    set i 0
527    set max [llength $comps]
528    while {$i < $max} {
529        set c [lindex $comps $i]
530        if {[string match log* $c]} {
531            set comps [lreplace $comps $i $i]
532            lappend comps $c
533            incr max -1
534        } else {
535            incr i
536        }
537    }
538    return $comps
539}
540
Note: See TracBrowser for help on using the repository browser.