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

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