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

Last change on this file since 1555 was 1342, checked in by gah, 15 years ago

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