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

Last change on this file since 3394 was 3330, checked in by gah, 11 years ago

merge (by hand) with Rappture1.2 branch
File size: 15.6 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    foreach {opt val} $settings {
189        if {![info exists params($opt)]} {
190            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
191        }
192        set params($opt) $val
193    }
194
195    set replace 0
196    if {"" != $dataobj} {
197        set _raised($dataobj) $params(-raise)
198        if {"" == $_dataobj} {
199            set replace 1
200        } elseif {$_raised($_dataobj) == 0 && $params(-raise)} {
201            set replace 1
202        }
203    }
204
205    if {$replace} {
206        $itk_component(text) configure -state normal
207        $itk_component(text) delete 1.0 end
208
209        if {[$dataobj element -as type] == "log"} {
210            # log output -- remove special =RAPPTURE-???=> messages
211            set message [$dataobj get]
212            while {[regexp -indices \
213                       {=RAPPTURE-([a-zA-Z]+)=>([^\n]*)(\n|$)} $message \
214                        match type mesg]} {
215
216                foreach {i0 i1} $match break
217                set first [string range $message 0 [expr {$i0-1}]]
218                if {[string length $first] > 0} {
219                    $itk_component(text) insert end $first
220                }
221
222                foreach {t0 t1} $type break
223                set type [string range $message $t0 $t1]
224                foreach {m0 m1} $mesg break
225                set mesg [string range $message $m0 $m1]
226                if {[string length $mesg] > 0
227                       && $type != "RUN" && $type != "PROGRESS"} {
228                    $itk_component(text) insert end $mesg $type
229                    $itk_component(text) insert end \n $type
230                }
231                set message [string range $message [expr {$i1+1}] end]
232            }
233
234            if {[string length $message] > 0} {
235                $itk_component(text) insert end $message
236                if {[$itk_component(text) get end-2char] != "\n"} {
237                    $itk_component(text) insert end "\n"
238                }
239            }
240        } elseif {[$dataobj element -as type] == "string"} {
241            # add string values
242            set data [$dataobj get current]
243            if {[Rappture::encoding::is binary $data]} {
244                set data [Rappture::utils::hexdump -lines 1000 $data]
245            }
246            $itk_component(text) insert end $data
247        } else {
248            # any other string output -- add it directly
249            $itk_component(text) insert end [$dataobj get]
250        }
251        $itk_component(text) configure -state disabled
252
253        set _dataobj $dataobj
254    }
255}
256
257# ----------------------------------------------------------------------
258# USAGE: get
259#
260# Clients use this to query the list of objects being plotted, in
261# order from bottom to top of this result.
262# ----------------------------------------------------------------------
263itcl::body Rappture::TextResult::get {} {
264    return $_dataobj
265}
266
267# ----------------------------------------------------------------------
268# USAGE: delete ?<curve1> <curve2> ...?
269#
270# Clients use this to delete a curve from the plot.  If no curves
271# are specified, then all curves are deleted.
272# ----------------------------------------------------------------------
273itcl::body Rappture::TextResult::delete {args} {
274    if {[llength $args] == 0} {
275        # delete everything
276        catch {unset _raised}
277        set _dataobj ""
278        $itk_component(text) configure -state normal
279        $itk_component(text) delete 1.0 end
280        $itk_component(text) configure -state disabled
281    } else {
282        # delete these specific objects
283        foreach obj $args {
284            catch {unset _raised($obj)}
285            if {$obj == $_dataobj} {
286                set _dataobj ""
287                $itk_component(text) configure -state normal
288                $itk_component(text) delete 1.0 end
289                $itk_component(text) configure -state disabled
290            }
291        }
292    }
293}
294
295# ----------------------------------------------------------------------
296# USAGE: scale ?<curve1> <curve2> ...?
297#
298# Sets the default limits for the overall plot according to the
299# limits of the data for all of the given <curve> objects.  This
300# accounts for all curves--even those not showing on the screen.
301# Because of this, the limits are appropriate for all curves as
302# the user scans through data in the ResultSet viewer.
303# ----------------------------------------------------------------------
304itcl::body Rappture::TextResult::scale {args} {
305    # nothing to do for text
306}
307
308# ----------------------------------------------------------------------
309# USAGE: download coming
310# USAGE: download controls <downloadCommand>
311# USAGE: download now
312#
313# Clients use this method to create a downloadable representation
314# of the plot.  Returns a list of the form {ext string}, where
315# "ext" is the file extension (indicating the type of data) and
316# "string" is the data itself.
317# ----------------------------------------------------------------------
318itcl::body Rappture::TextResult::download {option args} {
319    switch $option {
320        coming {
321            # nothing to do
322        }
323        controls {
324            # no controls for this download yet
325            return ""
326        }
327        now {
328            if {"" == $_dataobj} {
329                return ""
330            }
331            if {[$_dataobj element -as type] == "log"} {
332                set val [$itk_component(text) get 1.0 end]
333            } elseif {[$_dataobj element -as type] == "string"} {
334                set val [$_dataobj get current]
335            } else {
336                set val [$_dataobj get]
337            }
338
339            set ext [$_dataobj get filetype]
340            if {"" == $ext} {
341                if {[Rappture::encoding::is binary $val]} {
342                    set ext ".dat"
343                } else {
344                    set ext ".txt"
345                }
346            }
347            return [list $ext $val]
348        }
349        default {
350            error "bad option \"$option\": should be coming, controls, now"
351        }
352    }
353}
354
355# ----------------------------------------------------------------------
356# USAGE: select all
357#
358# Handles various selection operations within the text.
359# ----------------------------------------------------------------------
360itcl::body Rappture::TextResult::select {option args} {
361    switch -- $option {
362        all {
363            $itk_component(text) tag add sel 1.0 end
364        }
365        none {
366            if { [$itk_component(text) tag ranges "sel"] != "" } {
367                selection clear
368            }
369        }
370        default {
371            error "bad option \"$option\": should be all or none"
372        }
373    }
374}
375
376# ----------------------------------------------------------------------
377# USAGE: find up
378# USAGE: find down
379# USAGE: find reset
380#
381# Handles various find operations within the text.  These find a
382# bit of text and highlight it within the widget.  The find operation
383# starts from the end of the currently highlighted text, or from the
384# beginning if there is no highlight.
385# ----------------------------------------------------------------------
386itcl::body Rappture::TextResult::find {option} {
387    # handle the reset case...
388    $itk_component(find) configure \
389        -background $itk_option(-background) \
390        -foreground $itk_option(-foreground)
391    $itk_component(findstatus) configure -text ""
392
393    if {$option == "reset"} {
394        return
395    }
396
397    # handle the up/down cases...
398    set t $itk_component(text)
399    set pattern [string trim [$itk_component(find) get]]
400
401    if {"" == $pattern} {
402        $itk_component(find) configure -background red -foreground white
403        $itk_component(findstatus) configure -text "<< Enter a search string"
404        return
405    }
406
407    # find the starting point for the search
408    set seln [$t tag nextrange sel 1.0]
409    if {$seln == ""} {
410        set t0 1.0
411        set t1 end
412    } else {
413        foreach {t0 t1} $seln break
414    }
415    $t tag remove sel 1.0 end
416
417    # search up or down
418    switch -- $option {
419        up {
420            set start [$t index $t0-1char]
421            set next [$t search -backwards -nocase -- $pattern $start]
422            Rappture::Logger::log text find -up $pattern
423        }
424        down {
425            set start [$t index $t1+1char]
426            set next [$t search -forwards -nocase -- $pattern $start]
427            Rappture::Logger::log text find -down $pattern
428        }
429    }
430
431    if {"" != $next} {
432        set len [string length $pattern]
433        $t tag add sel $next $next+${len}chars
434        $t see $next
435        set lnum [lindex [split $next .] 0]
436        set lines [lindex [split [$t index end] .] 0]
437        set percent [expr {round(100.0*$lnum/$lines)}]
438        set status "line $lnum   --$percent%--"
439    } else {
440        set status "Not found"
441        $itk_component(find) configure -background red -foreground white
442    }
443    $itk_component(findstatus) configure -text $status
444}
445
446# ----------------------------------------------------------------------
447# USAGE: _popup menu <which> <X> <Y>
448#
449# Used internally to manage edit operations.
450# ----------------------------------------------------------------------
451itcl::body Rappture::TextResult::popup {option args} {
452    switch -- $option {
453        menu {
454            if {[llength $args] != 3} {
455                error "wrong # args: should be \"_popup $option which x y\""
456            }
457            set mname [lindex $args 0]
458            set x [lindex $args 1]
459            set y [lindex $args 2]
460            tk_popup $itk_component($mname) $x $y
461        }
462        default {
463            error "bad option \"$option\": should be menu"
464        }
465    }
466}
Note: See TracBrowser for help on using the repository browser.