source: trunk/gui/scripts/textresult.tcl @ 766

Last change on this file since 766 was 766, checked in by mmc, 17 years ago

Fixed the output viewer for numbers/integers to show a plot of
the value versus input parameters. As you change the ResultSet?
control, the x-axis updates to show the number versus values
in the result set.

Fixed the Rappture::result command to include the user's login
in the metadata, so we know who performed the computation.
File size: 13.4 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: TextResult - Log output for ResultSet
3#
4#  This widget is used to show text output in a ResultSet.  The log
5#  output from a tool, for example, is rendered as a TextResult.
6# ======================================================================
7#  AUTHOR:  Michael McLennan, Purdue University
8#  Copyright (c) 2004-2005  Purdue Research Foundation
9#
10#  See the file "license.terms" for information on usage and
11#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12# ======================================================================
13package require Itk
14package require BLT
15
16option add *TextResult.width 4i widgetDefault
17option add *TextResult.height 4i widgetDefault
18option add *TextResult.textBackground white widgetDefault
19option add *TextResult.font \
20    -*-helvetica-medium-r-normal-*-12-* widgetDefault
21option add *TextResult.textFont \
22    -*-courier-medium-r-normal-*-12-* widgetDefault
23
24itcl::class Rappture::TextResult {
25    inherit itk::Widget
26
27    constructor {args} { # defined below }
28
29    public method add {dataobj {settings ""}}
30    public method get {}
31    public method delete {args}
32    public method scale {args}
33    public method parameters {title args} { # do nothing }
34    public method download {option args}
35
36    public method select {option args}
37    public method find {option}
38
39    private variable _dataobj ""  ;# data object currently being displayed
40    private variable _raised      ;# maps all data objects => -raise param
41}
42                                                                               
43itk::usual TextResult {
44    keep -background -foreground -cursor -font
45}
46
47# ----------------------------------------------------------------------
48# CONSTRUCTOR
49# ----------------------------------------------------------------------
50itcl::body Rappture::TextResult::constructor {args} {
51    option add hull.width hull.height
52    pack propagate $itk_component(hull) no
53
54    #
55    # CONTROL BAR with find/select functions
56    #
57    itk_component add controls {
58        frame $itk_interior.cntls
59    }
60    pack $itk_component(controls) -side bottom -fill x -pady {4 0}
61
62    itk_component add selectall {
63        button $itk_component(controls).selall -text "Select All" \
64            -command [itcl::code $this select all]
65    }
66    pack $itk_component(selectall) -side right -fill y
67
68    itk_component add findl {
69        label $itk_component(controls).findl -text "Find:"
70    }
71    pack $itk_component(findl) -side left
72
73    itk_component add find {
74        entry $itk_component(controls).find -width 20
75    }
76    pack $itk_component(find) -side left
77
78    itk_component add finddown {
79        button $itk_component(controls).finddown \
80            -image [Rappture::icon finddn] \
81            -relief flat -overrelief raised \
82            -command [itcl::code $this find down]
83    } {
84        usual
85        ignore -relief
86    }
87    pack $itk_component(finddown) -side left
88
89    itk_component add findup {
90        button $itk_component(controls).findup \
91            -image [Rappture::icon findup] \
92            -relief flat -overrelief raised \
93            -command [itcl::code $this find up]
94    } {
95        usual
96        ignore -relief
97    }
98    pack $itk_component(findup) -side left
99
100    itk_component add findstatus {
101        label $itk_component(controls).finds -width 10 -anchor w
102    }
103    pack $itk_component(findstatus) -side left -expand yes -fill x
104
105    # shortcut for Return in search field
106    bind $itk_component(find) <KeyPress-Return> "
107        $itk_component(finddown) configure -relief sunken
108        update idletasks
109        after 200
110        $itk_component(finddown) configure -relief flat
111        $itk_component(finddown) invoke
112    "
113    bind $itk_component(find) <KeyPress> \
114        [itcl::code $this find reset]
115
116    #
117    # TEXT AREA
118    #
119    itk_component add scroller {
120        Rappture::Scroller $itk_interior.scroller \
121            -xscrollmode auto -yscrollmode auto
122    }
123    pack $itk_component(scroller) -expand yes -fill both
124
125    itk_component add text {
126        text $itk_component(scroller).text -width 1 -height 1 -wrap none
127    } {
128        usual
129        rename -background -textbackground textBackground Background
130        rename -font -textfont textFont Font
131    }
132    $itk_component(scroller) contents $itk_component(text)
133    $itk_component(text) configure -state disabled
134
135    $itk_component(text) tag configure ERROR -foreground red
136
137    eval itk_initialize $args
138}
139
140# ----------------------------------------------------------------------
141# USAGE: add <dataobj> ?<settings>?
142#
143# Clients use this to add a data object to the plot.  If the optional
144# <settings> are specified, then the are applied to the data.  Allowed
145# settings are -color and -brightness, -width, -linestyle and -raise.
146# (Many of these are ignored.)
147# ----------------------------------------------------------------------
148itcl::body Rappture::TextResult::add {dataobj {settings ""}} {
149    array set params {
150        -color ""
151        -brightness ""
152        -width ""
153        -linestyle ""
154        -raise 0
155        -description ""
156    }
157    foreach {opt val} $settings {
158        if {![info exists params($opt)]} {
159            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
160        }
161        set params($opt) $val
162    }
163
164    set replace 0
165    if {"" != $dataobj} {
166        set _raised($dataobj) $params(-raise)
167        if {"" == $_dataobj} {
168            set replace 1
169        } elseif {$_raised($_dataobj) == 0 && $params(-raise)} {
170            set replace 1
171        }
172    }
173
174    if {$replace} {
175        $itk_component(text) configure -state normal
176        $itk_component(text) delete 1.0 end
177
178        if {[$dataobj element -as type] == "log"} {
179            # log output -- remove special =RAPPTURE-???=> messages
180            set message [$dataobj get]
181            while {[regexp -indices \
182                       {=RAPPTURE-([a-zA-Z]+)=>([^\n]*)(\n|$)} $message \
183                        match type mesg]} {
184
185                foreach {i0 i1} $match break
186                set first [string range $message 0 [expr {$i0-1}]]
187                if {[string length $first] > 0} {
188                    $itk_component(text) insert end $first
189                }
190
191                foreach {t0 t1} $type break
192                set type [string range $message $t0 $t1]
193                foreach {m0 m1} $mesg break
194                set mesg [string range $message $m0 $m1]
195                if {[string length $mesg] > 0
196                       && $type != "RUN" && $type != "PROGRESS"} {
197                    $itk_component(text) insert end $mesg $type
198                    $itk_component(text) insert end \n $type
199                }
200                set message [string range $message [expr {$i1+1}] end]
201            }
202
203            if {[string length $message] > 0} {
204                $itk_component(text) insert end $message
205                if {[$itk_component(text) get end-2char] != "\n"} {
206                    $itk_component(text) insert end "\n"
207                }
208            }
209        } elseif {[$dataobj element -as type] == "string"} {
210            # add string values
211            set data [$dataobj get current]
212            if {[Rappture::encoding::is binary $data]} {
213                set data [Rappture::utils::hexdump -lines 1000 $data]
214            }
215            $itk_component(text) insert end $data
216        } else {
217            # any other string output -- add it directly
218            $itk_component(text) insert end [$dataobj get]
219        }
220        $itk_component(text) configure -state disabled
221
222        set _dataobj $dataobj
223    }
224}
225
226# ----------------------------------------------------------------------
227# USAGE: get
228#
229# Clients use this to query the list of objects being plotted, in
230# order from bottom to top of this result.
231# ----------------------------------------------------------------------
232itcl::body Rappture::TextResult::get {} {
233    return $_dataobj
234}
235
236# ----------------------------------------------------------------------
237# USAGE: delete ?<curve1> <curve2> ...?
238#
239# Clients use this to delete a curve from the plot.  If no curves
240# are specified, then all curves are deleted.
241# ----------------------------------------------------------------------
242itcl::body Rappture::TextResult::delete {args} {
243    if {[llength $args] == 0} {
244        # delete everything
245        catch {unset _raised}
246        set _dataobj ""
247        $itk_component(text) configure -state normal
248        $itk_component(text) delete 1.0 end
249        $itk_component(text) configure -state disabled
250    } else {
251        # delete these specific objects
252        foreach obj $args {
253            catch {unset _raised($obj)}
254            if {$obj == $_dataobj} {
255                set _dataobj ""
256                $itk_component(text) configure -state normal
257                $itk_component(text) delete 1.0 end
258                $itk_component(text) configure -state disabled
259            }
260        }
261    }
262}
263
264# ----------------------------------------------------------------------
265# USAGE: scale ?<curve1> <curve2> ...?
266#
267# Sets the default limits for the overall plot according to the
268# limits of the data for all of the given <curve> objects.  This
269# accounts for all curves--even those not showing on the screen.
270# Because of this, the limits are appropriate for all curves as
271# the user scans through data in the ResultSet viewer.
272# ----------------------------------------------------------------------
273itcl::body Rappture::TextResult::scale {args} {
274    # nothing to do for text
275}
276
277# ----------------------------------------------------------------------
278# USAGE: download coming
279# USAGE: download controls <downloadCommand>
280# USAGE: download now
281#
282# Clients use this method to create a downloadable representation
283# of the plot.  Returns a list of the form {ext string}, where
284# "ext" is the file extension (indicating the type of data) and
285# "string" is the data itself.
286# ----------------------------------------------------------------------
287itcl::body Rappture::TextResult::download {option args} {
288    switch $option {
289        coming {
290            # nothing to do
291        }
292        controls {
293            # no controls for this download yet
294            return ""
295        }
296        now {
297            if {"" == $_dataobj} {
298                return ""
299            }
300            if {[$_dataobj element -as type] == "log"} {
301                set val [$itk_component(text) get 1.0 end]
302            } elseif {[$_dataobj element -as type] == "string"} {
303                set val [$_dataobj get current]
304            } else {
305                set val [$_dataobj get]
306            }
307
308            set ext [$_dataobj get filetype]
309            if {"" == $ext && ![Rappture::encoding::is binary $val]} {
310                set ext ".txt"
311            }
312            return [list $ext $val]
313        }
314        default {
315            error "bad option \"$option\": should be coming, controls, now"
316        }
317    }
318}
319
320# ----------------------------------------------------------------------
321# USAGE: select all
322#
323# Handles various selection operations within the text.
324# ----------------------------------------------------------------------
325itcl::body Rappture::TextResult::select {option args} {
326    switch -- $option {
327        all {
328            $itk_component(text) tag add sel 1.0 end
329        }
330        default {
331            error "bad option \"$option\": should be all"
332        }
333    }
334}
335
336# ----------------------------------------------------------------------
337# USAGE: find up
338# USAGE: find down
339# USAGE: find reset
340#
341# Handles various find operations within the text.  These find a
342# bit of text and highlight it within the widget.  The find operation
343# starts from the end of the currently highlighted text, or from the
344# beginning if there is no highlight.
345# ----------------------------------------------------------------------
346itcl::body Rappture::TextResult::find {option} {
347    # handle the reset case...
348    $itk_component(find) configure \
349        -background $itk_option(-background) \
350        -foreground $itk_option(-foreground)
351    $itk_component(findstatus) configure -text ""
352
353    if {$option == "reset"} {
354        return
355    }
356
357    # handle the up/down cases...
358    set t $itk_component(text)
359    set pattern [string trim [$itk_component(find) get]]
360
361    if {"" == $pattern} {
362        $itk_component(find) configure -background red -foreground white
363        $itk_component(findstatus) configure -text "<< Enter a search string"
364        return
365    }
366
367    # find the starting point for the search
368    set seln [$t tag nextrange sel 1.0]
369    if {$seln == ""} {
370        set t0 1.0
371        set t1 end
372    } else {
373        foreach {t0 t1} $seln break
374    }
375    $t tag remove sel 1.0 end
376
377    # search up or down
378    switch -- $option {
379        up {
380            set start [$t index $t0-1char]
381            set next [$t search -backwards -nocase -- $pattern $start]
382        }
383        down {
384            set start [$t index $t1+1char]
385            set next [$t search -forwards -nocase -- $pattern $start]
386        }
387    }
388
389    if {"" != $next} {
390        set len [string length $pattern]
391        $t tag add sel $next $next+${len}chars
392        $t see $next
393        set lnum [lindex [split $next .] 0]
394        set lines [lindex [split [$t index end] .] 0]
395        set percent [expr {round(100.0*$lnum/$lines)}]
396        set status "line $lnum   --$percent%--"
397    } else {
398        set status "Not found"
399        $itk_component(find) configure -background red -foreground white
400    }
401    $itk_component(findstatus) configure -text $status
402}
Note: See TracBrowser for help on using the repository browser.