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

Last change on this file since 4642 was 3799, checked in by gah, 11 years ago

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