source: branches/blt4/gui/scripts/textresult.tcl @ 1923

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