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

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.
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-2012  HUBzero Foundation, LLC
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.