source: branches/blt4/gui/scripts/textresult.tcl @ 1683

Last change on this file since 1683 was 1651, checked in by gah, 15 years ago
File size: 12.1 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        blt::scrollset $itk_interior.scroller \
121            -xscrollbar $itk_interior.scroller.xs \
122            -yscrollbar $itk_interior.scroller.ys \
123            -window $itk_interior.scroller.text
124    }
125    blt::tk::scrollbar $itk_interior.scroller.xs
126    blt::tk::scrollbar $itk_interior.scroller.ys
127    pack $itk_component(scroller) -expand yes -fill both
128
129    itk_component add text {
130        text $itk_component(scroller).text -width 1 -height 1 -wrap none
131    } {
132        usual
133        rename -background -textbackground textBackground Background
134        rename -font -textfont textFont Font
135    }
136    $itk_component(text) configure -state disabled
137
138    $itk_component(text) tag configure ERROR -foreground red
139
140    eval itk_initialize $args
141}
142
143# ----------------------------------------------------------------------
144# USAGE: add <dataobj> ?<settings>?
145#
146# Clients use this to add a data object to the plot.  If the optional
147# <settings> are specified, then the are applied to the data.  Allowed
148# settings are -color and -brightness, -width, -linestyle and -raise.
149# (Many of these are ignored.)
150# ----------------------------------------------------------------------
151itcl::body Rappture::TextResult::add {dataobj {settings ""}} {
152    array set params {
153        -color ""
154        -brightness ""
155        -width ""
156        -linestyle ""
157        -raise 0
158        -description ""
159        -param ""
160    }
161    foreach {opt val} $settings {
162        if {![info exists params($opt)]} {
163            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
164        }
165        set params($opt) $val
166    }
167
168    set replace 0
169    if {"" != $dataobj} {
170        set _raised($dataobj) $params(-raise)
171        if {"" == $_dataobj} {
172            set replace 1
173        } elseif {$_raised($_dataobj) == 0 && $params(-raise)} {
174            set replace 1
175        }
176    }
177
178    if {$replace} {
179        $itk_component(text) configure -state normal
180        $itk_component(text) delete 1.0 end
181
182        if {[$dataobj element -as type] == "log"} {
183            # log output -- remove special =RAPPTURE-???=> messages
184            set message [$dataobj get]
185            while {[regexp -indices \
186                       {=RAPPTURE-([a-zA-Z]+)=>([^\n]*)(\n|$)} $message \
187                        match type mesg]} {
188
189                foreach {i0 i1} $match break
190                set first [string range $message 0 [expr {$i0-1}]]
191                if {[string length $first] > 0} {
192                    $itk_component(text) insert end $first
193                }
194
195                foreach {t0 t1} $type break
196                set type [string range $message $t0 $t1]
197                foreach {m0 m1} $mesg break
198                set mesg [string range $message $m0 $m1]
199                if {[string length $mesg] > 0
200                       && $type != "RUN" && $type != "PROGRESS"} {
201                    $itk_component(text) insert end $mesg $type
202                    $itk_component(text) insert end \n $type
203                }
204                set message [string range $message [expr {$i1+1}] end]
205            }
206
207            if {[string length $message] > 0} {
208                $itk_component(text) insert end $message
209                if {[$itk_component(text) get end-2char] != "\n"} {
210                    $itk_component(text) insert end "\n"
211                }
212            }
213        } elseif {[$dataobj element -as type] == "string"} {
214            # add string values
215            set data [$dataobj get current]
216            if {[Rappture::encoding::is binary $data]} {
217                set data [Rappture::utils::hexdump -lines 1000 $data]
218            }
219            $itk_component(text) insert end $data
220        } else {
221            # any other string output -- add it directly
222            $itk_component(text) insert end [$dataobj get]
223        }
224        $itk_component(text) configure -state disabled
225
226        set _dataobj $dataobj
227    }
228}
229
230# ----------------------------------------------------------------------
231# USAGE: get
232#
233# Clients use this to query the list of objects being plotted, in
234# order from bottom to top of this result.
235# ----------------------------------------------------------------------
236itcl::body Rappture::TextResult::get {} {
237    return $_dataobj
238}
239
240# ----------------------------------------------------------------------
241# USAGE: delete ?<curve1> <curve2> ...?
242#
243# Clients use this to delete a curve from the plot.  If no curves
244# are specified, then all curves are deleted.
245# ----------------------------------------------------------------------
246itcl::body Rappture::TextResult::delete {args} {
247    if {[llength $args] == 0} {
248        # delete everything
249        catch {unset _raised}
250        set _dataobj ""
251        $itk_component(text) configure -state normal
252        $itk_component(text) delete 1.0 end
253        $itk_component(text) configure -state disabled
254    } else {
255        # delete these specific objects
256        foreach obj $args {
257            catch {unset _raised($obj)}
258            if {$obj == $_dataobj} {
259                set _dataobj ""
260                $itk_component(text) configure -state normal
261                $itk_component(text) delete 1.0 end
262                $itk_component(text) configure -state disabled
263            }
264        }
265    }
266}
267
268# ----------------------------------------------------------------------
269# USAGE: scale ?<curve1> <curve2> ...?
270#
271# Sets the default limits for the overall plot according to the
272# limits of the data for all of the given <curve> objects.  This
273# accounts for all curves--even those not showing on the screen.
274# Because of this, the limits are appropriate for all curves as
275# the user scans through data in the ResultSet viewer.
276# ----------------------------------------------------------------------
277itcl::body Rappture::TextResult::scale {args} {
278    # nothing to do for text
279}
280
281# ----------------------------------------------------------------------
282# USAGE: download coming
283# USAGE: download controls <downloadCommand>
284# USAGE: download now
285#
286# Clients use this method to create a downloadable representation
287# of the plot.  Returns a list of the form {ext string}, where
288# "ext" is the file extension (indicating the type of data) and
289# "string" is the data itself.
290# ----------------------------------------------------------------------
291itcl::body Rappture::TextResult::download {option args} {
292    switch $option {
293        coming {
294            # nothing to do
295        }
296        controls {
297            # no controls for this download yet
298            return ""
299        }
300        now {
301            if {"" == $_dataobj} {
302                return ""
303            }
304            if {[$_dataobj element -as type] == "log"} {
305                set val [$itk_component(text) get 1.0 end]
306            } elseif {[$_dataobj element -as type] == "string"} {
307                set val [$_dataobj get current]
308            } else {
309                set val [$_dataobj get]
310            }
311
312            set ext [$_dataobj get filetype]
313            if {"" == $ext} {
314                if {[Rappture::encoding::is binary $val]} {
315                    set ext ".dat"
316                } else {
317                    set ext ".txt"
318                }
319            }
320            return [list $ext $val]
321        }
322        default {
323            error "bad option \"$option\": should be coming, controls, now"
324        }
325    }
326}
327
328# ----------------------------------------------------------------------
329# USAGE: select all
330#
331# Handles various selection operations within the text.
332# ----------------------------------------------------------------------
333itcl::body Rappture::TextResult::select {option args} {
334    switch -- $option {
335        all {
336            $itk_component(text) tag add sel 1.0 end
337        }
338        default {
339            error "bad option \"$option\": should be all"
340        }
341    }
342}
343
344# ----------------------------------------------------------------------
345# USAGE: find up
346# USAGE: find down
347# USAGE: find reset
348#
349# Handles various find operations within the text.  These find a
350# bit of text and highlight it within the widget.  The find operation
351# starts from the end of the currently highlighted text, or from the
352# beginning if there is no highlight.
353# ----------------------------------------------------------------------
354itcl::body Rappture::TextResult::find {option} {
355    # handle the reset case...
356    $itk_component(find) configure \
357        -background $itk_option(-background) \
358        -foreground $itk_option(-foreground)
359    $itk_component(findstatus) configure -text ""
360
361    if {$option == "reset"} {
362        return
363    }
364
365    # handle the up/down cases...
366    set t $itk_component(text)
367    set pattern [string trim [$itk_component(find) get]]
368
369    if {"" == $pattern} {
370        $itk_component(find) configure -background red -foreground white
371        $itk_component(findstatus) configure -text "<< Enter a search string"
372        return
373    }
374
375    # find the starting point for the search
376    set seln [$t tag nextrange sel 1.0]
377    if {$seln == ""} {
378        set t0 1.0
379        set t1 end
380    } else {
381        foreach {t0 t1} $seln break
382    }
383    $t tag remove sel 1.0 end
384
385    # search up or down
386    switch -- $option {
387        up {
388            set start [$t index $t0-1char]
389            set next [$t search -backwards -nocase -- $pattern $start]
390        }
391        down {
392            set start [$t index $t1+1char]
393            set next [$t search -forwards -nocase -- $pattern $start]
394        }
395    }
396
397    if {"" != $next} {
398        set len [string length $pattern]
399        $t tag add sel $next $next+${len}chars
400        $t see $next
401        set lnum [lindex [split $next .] 0]
402        set lines [lindex [split [$t index end] .] 0]
403        set percent [expr {round(100.0*$lnum/$lines)}]
404        set status "line $lnum   --$percent%--"
405    } else {
406        set status "Not found"
407        $itk_component(find) configure -background red -foreground white
408    }
409    $itk_component(findstatus) configure -text $status
410}
Note: See TracBrowser for help on using the repository browser.