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

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