source: trunk/gui/scripts/textentry.tcl @ 681

Last change on this file since 681 was 681, checked in by mmc, 17 years ago

Fixed the Rappture::filexfer code to use the new filexfer mechanism
in the middleware. Instead of running its own file server, Rappture
now execs exportfile/importfile commands to handle file transport.
File size: 22.4 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: textentry - general-purpose text entry widget
3#
4#  This widget is a cross between the Tk entry and text widgets.  For
5#  one-line messages, it acts like an entry widget.  For larger
6#  messages, it morphs into a text widget.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005  Purdue Research Foundation
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
15
16option add *TextEntry.size auto widgetDefault
17option add *TextEntry.width 0 widgetDefault
18option add *TextEntry.height 0 widgetDefault
19option add *TextEntry.editable yes widgetDefault
20option add *TextEntry.textBackground white widgetDefault
21option add *TextEntry*disabledForeground #a3a3a3 widgetDefault
22option add *TextEntry*disabledBackground white widgetDefault
23
24option add *TextEntry.hintForeground gray50 widgetDefault
25option add *TextEntry.hintFont \
26    -*-helvetica-medium-r-normal-*-10-* widgetDefault
27option add *TextEntry.codeFont \
28    -*-courier-medium-r-normal-*-12-* widgetDefault
29
30
31itcl::class Rappture::TextEntry {
32    inherit itk::Widget
33
34    itk_option define -editable editable Editable ""
35    itk_option define -state state State "normal"
36    itk_option define -width width Width 0
37    itk_option define -height height Height 0
38
39    constructor {owner path args} { # defined below }
40
41    public method value {args}
42
43    public method label {}
44    public method tooltip {}
45    public method size {} { return $_size }
46
47    protected method _layout {}
48    protected method _setValue {value}
49    protected method _newValue {}
50    protected method _edit {option args}
51    protected method _fixState {}
52    protected method _uploadValue {args}
53    protected method _downloadValue {}
54
55    private variable _dispatcher "" ;# dispatcher for !events
56    private variable _owner ""      ;# thing managing this control
57    private variable _path ""       ;# path in XML to this number
58
59    private variable _layout ""     ;# entry or full text size
60    private variable _mode "ascii"  ;# ascii text or binary data
61    private variable _value ""      ;# value inside the widget
62    private variable _size ""       ;# size hint from XML
63}
64                                                                               
65itk::usual TextEntry {
66}
67
68# ----------------------------------------------------------------------
69# CONSTRUCTOR
70# ----------------------------------------------------------------------
71itcl::body Rappture::TextEntry::constructor {owner path args} {
72    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
73        error "bad object \"$owner\": should be Rappture::ControlOwner"
74    }
75    set _owner $owner
76    set _path $path
77
78    Rappture::dispatcher _dispatcher
79    $_dispatcher register !layout
80    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
81
82    set _size [$_owner xml get $path.size]
83
84    set hints [$_owner xml get $path.about.hints]
85    if {[string length $hints] > 0} {
86        itk_component add hints {
87            ::label $itk_interior.hints -anchor w -text $hints
88        } {
89            usual
90            rename -foreground -hintforeground hintForeground Foreground
91            rename -font -hintfont hintFont Font
92        }
93        pack $itk_component(hints) -side bottom -fill x
94    }
95
96    eval itk_initialize $args
97
98    set str [$_owner xml get $path.default]
99    if {"" != $str} {
100        _layout  ;# must fix layout or value won't take
101        value $str
102    }
103}
104
105# ----------------------------------------------------------------------
106# USAGE: value ?-check? ?<newval>?
107#
108# Clients use this to query/set the value for this widget.  With
109# no args, it returns the current value for the widget.  If the
110# <newval> is specified, it sets the value of the widget and
111# sends a <<Value>> event.  If the -check flag is included, the
112# new value is not actually applied, but just checked for correctness.
113# ----------------------------------------------------------------------
114itcl::body Rappture::TextEntry::value {args} {
115    set onlycheck 0
116    set i [lsearch -exact $args -check]
117    if {$i >= 0} {
118        set onlycheck 1
119        set args [lreplace $args $i $i]
120    }
121
122    if {[llength $args] == 1} {
123        if {$onlycheck} {
124            # someday we may add validation...
125            return
126        }
127        set newval [lindex $args 0]
128        _setValue $newval
129
130        $_dispatcher event -idle !layout
131        event generate $itk_component(hull) <<Value>>
132        return $newval
133
134    } elseif {[llength $args] != 0} {
135        error "wrong # args: should be \"value ?-check? ?newval?\""
136    }
137
138    #
139    # Query the value and return.
140    #
141    if {$_mode == "ascii"} {
142        if {$_layout == "entry"} {
143            return [$itk_component(entry) get]
144        } elseif {$_layout == "text"} {
145            return [$itk_component(text) get 1.0 end-1char]
146        }
147    } else {
148        return $_value
149    }
150    return ""
151}
152
153# ----------------------------------------------------------------------
154# USAGE: label
155#
156# Clients use this to query the label associated with this widget.
157# Reaches into the XML and pulls out the appropriate label string.
158# ----------------------------------------------------------------------
159itcl::body Rappture::TextEntry::label {} {
160    set label [$_owner xml get $_path.about.label]
161    if {"" == $label} {
162        set label "String"
163    }
164    return $label
165}
166
167# ----------------------------------------------------------------------
168# USAGE: tooltip
169#
170# Clients use this to query the tooltip associated with this widget.
171# Reaches into the XML and pulls out the appropriate description
172# string.  Returns the string that should be used with the
173# Rappture::Tooltip facility.
174# ----------------------------------------------------------------------
175itcl::body Rappture::TextEntry::tooltip {} {
176    set str [$_owner xml get $_path.about.description]
177    return [string trim $str]
178}
179
180# ----------------------------------------------------------------------
181# USAGE: _layout
182#
183# Used internally to change the layout of this widget depending
184# on the .size hint and its contents.  Switches between an entry
185# and a text widget.
186# ----------------------------------------------------------------------
187itcl::body Rappture::TextEntry::_layout {} {
188    set size $_size
189    if {$size == "" || $size == "auto"} {
190        #
191        # If the size is "auto", then look at the current value
192        # and count its lines/characters.
193        #
194        set val ""
195        if {$_layout == "entry"} {
196            set val [$itk_component(entry) get]
197        } elseif {$_layout == "text"} {
198            set val [$itk_component(text) get 1.0 end-1char]
199        }
200
201        set chars 0
202        set lines 0
203        foreach line [split $val \n] {
204            incr lines
205            if {[string length $line] > $chars} {
206                set chars [string length $line]
207            }
208        }
209        incr chars
210
211        if {$lines > 1} {
212            set size "${chars}x${lines}"
213        } else {
214            set size $chars
215        }
216    }
217
218    if {[regexp {^[0-9]+$} $size]} {
219        #
220        # If the size is WW, then flip to entry mode, with
221        # a requested size of WW characters.
222        #
223        if {$_layout != "entry"} {
224            set val ""
225            if {$_layout == "text"} {
226                set val [$itk_component(text) get 1.0 end-1char]
227                destroy $itk_component(text)
228                destroy $itk_component(scrollbars)
229            }
230
231            itk_component add entry {
232                entry $itk_interior.entry
233            } {
234                usual
235                rename -background -textbackground textBackground Background
236                rename -foreground -textforeground textForeground Foreground
237            }
238            pack $itk_component(entry) -expand yes -fill both
239            $itk_component(entry) configure \
240                -background $itk_option(-textbackground) \
241                -foreground $itk_option(-textforeground)
242
243            bind $itk_component(entry) <KeyPress> [itcl::code $this _newValue]
244            bind $itk_component(entry) <Control-KeyPress-a> \
245                "[list $itk_component(entry) selection range 0 end]; break"
246
247            itk_component add emenu {
248                menu $itk_component(entry).menu -tearoff 0
249            }
250            $itk_component(emenu) add command -label "Cut" -accelerator "^X" \
251                -command [list event generate $itk_component(entry) <<Cut>>]
252            $itk_component(emenu) add command -label "Copy" -accelerator "^C" \
253                -command [list event generate $itk_component(entry) <<Copy>>]
254            $itk_component(emenu) add command -label "Paste" -accelerator "^V" \
255                -command [list event generate $itk_component(entry) <<Paste>>]
256            $itk_component(emenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(entry) selection range 0 end]
257            bind $itk_component(entry) <<PopupMenu>> \
258                [itcl::code $this _edit menu emenu %X %Y]
259
260            set _layout "entry"
261            _setValue $val
262        }
263        $itk_component(entry) configure -width $size
264
265    } elseif {[regexp {^([0-9]+)x([0-9]+)$} $size match w h]} {
266        #
267        # If the size is WWxHH, then flip to text mode, with
268        # a requested size of HH lines by WW characters.
269        #
270        if {$_layout != "text"} {
271            set val ""
272            if {$_layout == "entry"} {
273                set val [$itk_component(entry) get]
274                destroy $itk_component(entry)
275            }
276
277            itk_component add scrollbars {
278                Rappture::Scroller $itk_interior.scrl \
279                     -xscrollmode auto -yscrollmode auto
280            }
281            pack $itk_component(scrollbars) -expand yes -fill both
282
283            itk_component add text {
284                text $itk_component(scrollbars).text \
285                    -width 1 -height 1 -wrap char
286            } {
287                usual
288                rename -background -textbackground textBackground Background
289                rename -foreground -textforeground textForeground Foreground
290                rename -font -codefont codeFont CodeFont
291            }
292            $itk_component(text) configure \
293                -background $itk_option(-textbackground) \
294                -foreground $itk_option(-textforeground) \
295                -font $itk_option(-codefont)
296            $itk_component(scrollbars) contents $itk_component(text)
297
298            bind $itk_component(text) <KeyPress> [itcl::code $this _newValue]
299            bind $itk_component(text) <Control-KeyPress-a> \
300                "[list $itk_component(text) tag add sel 1.0 end]; break"
301
302            itk_component add tmenu {
303                menu $itk_component(text).menu -tearoff 0
304            }
305            $itk_component(tmenu) add command -label "Cut" -accelerator "^X" \
306                -command [list event generate $itk_component(text) <<Cut>>]
307            $itk_component(tmenu) add command -label "Copy" -accelerator "^C" \
308                -command [list event generate $itk_component(text) <<Copy>>]
309            $itk_component(tmenu) add command -label "Paste" -accelerator "^V" \
310                -command [list event generate $itk_component(text) <<Paste>>]
311            $itk_component(tmenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(text) tag add sel 1.0 end]
312            $itk_component(tmenu) add separator
313            $itk_component(tmenu) add command -label "Upload..." \
314                -command [itcl::code $this _uploadValue -start]
315            $itk_component(tmenu) add command -label "Download" \
316                -command [itcl::code $this _downloadValue]
317            bind $itk_component(text) <<PopupMenu>> \
318                [itcl::code $this _edit menu tmenu %X %Y]
319
320            set _layout "text"
321            _setValue $val
322        }
323        $itk_component(text) configure -width $w -height $h
324    }
325
326    #
327    # Fix the overall widget size according to -width / -height
328    #
329    if {$itk_option(-width) == 0 && $itk_option(-height) == 0} {
330        pack propagate $itk_component(hull) yes
331    } else {
332        pack propagate $itk_component(hull) no
333        component hull configure \
334            -width $itk_option(-width) -height $itk_option(-width)
335    }
336}
337
338# ----------------------------------------------------------------------
339# USAGE: _setValue <newValue>
340#
341# Used internally to set the value for this widget.  If the <newValue>
342# string is ASCII, then it is stored directly and the widget is enabled
343# for editing.  Otherwise, the value is cached and a representation of
344# the data is displayed.
345# ----------------------------------------------------------------------
346itcl::body Rappture::TextEntry::_setValue {newval} {
347    if {[Rappture::encoding::is binary $newval]} {
348        # looks like a binary file
349        set _mode "binary"
350        set _value $newval
351
352        set size [string length $newval]
353        foreach {factor units} {
354            1073741824 GB
355            1048576 MB
356            1024 kB
357            1 bytes
358        } {
359            if {$size/$factor > 0} {
360                if {$factor > 1} {
361                    set size [format "%.2f" [expr {double($size)/$factor}]]
362                }
363                break
364            }
365        }
366
367        if {$_layout == "entry" || [string match {*x[01]} $_size]} {
368            set newval "<binary> $size $units"
369        } else {
370            set newval "<binary> $size $units\n\n"
371            set tail ""
372            set len [string length $_value]
373            if {$len > 1600} {
374                set len 1600
375                set tail "...more..."
376            }
377
378            for {set i 0} {$i < $len} {incr i 8} {
379                append newval [format "%#06x: " $i]
380                set ascii ""
381                for {set j 0} {$j < 8} {incr j} {
382                    if {$i+$j < $len} {
383                        set char [string index $_value [expr {$i+$j}]]
384                        binary scan $char c ichar
385                        set hexchar [format "%02x" [expr {0xff & $ichar}]]
386                    } else {
387                        set char " "
388                        set hexchar "  "
389                    }
390                    append newval "$hexchar "
391                    if {[regexp {[\000-\037\177-\377]} $char]} {
392                        append ascii "."
393                    } else {
394                        append ascii $char
395                    }
396                }
397                append newval " | $ascii\n"
398            }
399            append newval $tail
400        }
401
402        set _value [Rappture::encoding::encode -as z $_value]
403
404    } else {
405        # ascii file -- map carriage returns to line feeds
406        set _mode "ascii"
407        set _value ""
408        regsub -all "\r" $newval "\n" newval
409    }
410
411    if {$_layout == "entry"} {
412        $itk_component(entry) configure -state normal
413        $itk_component(emenu) entryconfigure "Cut" -state normal
414        $itk_component(emenu) entryconfigure "Paste" -state normal
415        $itk_component(entry) delete 0 end
416        $itk_component(entry) insert 0 $newval
417        if {!$itk_option(-editable) || $_mode == "binary"} {
418            $itk_component(entry) configure -state disabled
419            $itk_component(emenu) entryconfigure "Cut" -state disabled
420            $itk_component(emenu) entryconfigure "Paste" -state disabled
421        }
422    } elseif {$_layout == "text"} {
423        $itk_component(text) configure -state normal
424        $itk_component(tmenu) entryconfigure "Cut" -state normal
425        $itk_component(tmenu) entryconfigure "Paste" -state normal
426        $itk_component(text) delete 1.0 end
427        $itk_component(text) insert end $newval
428        if {!$itk_option(-editable) || $_mode == "binary"} {
429            set hull $itk_component(hull)
430            set dfg [option get $hull disabledForeground Foreground]
431            set dbg [option get $hull disabledBackground Background]
432            $itk_component(text) configure -state disabled \
433                -background $dbg -foreground $dfg
434            $itk_component(tmenu) entryconfigure "Cut" -state disabled
435            $itk_component(tmenu) entryconfigure "Paste" -state disabled
436        } else {
437            $itk_component(text) configure \
438                -background $itk_option(-textbackground) \
439                -foreground $itk_option(-textforeground)
440        }
441    }
442}
443
444# ----------------------------------------------------------------------
445# USAGE: _newValue
446#
447# Invoked automatically whenever the value in the entry changes.
448# Sends a <<Value>> event to notify clients of the change.
449# ----------------------------------------------------------------------
450itcl::body Rappture::TextEntry::_newValue {} {
451    event generate $itk_component(hull) <<Value>>
452}
453
454# ----------------------------------------------------------------------
455# USAGE: _edit menu <which> <X> <Y>
456#
457# Used internally to manage edit operations.
458# ----------------------------------------------------------------------
459itcl::body Rappture::TextEntry::_edit {option args} {
460    if {$itk_option(-state) == "disabled"} {
461        return  ;# disabled? then bail out here!
462    }
463    switch -- $option {
464        menu {
465            if {[llength $args] != 3} {
466                error "wrong # args: should be \"_edit $option which x y\""
467            }
468            set mname [lindex $args 0]
469            set x [lindex $args 1]
470            set y [lindex $args 2]
471            tk_popup $itk_component($mname) $x $y
472        }
473        default {
474            error "bad option \"$option\": should be menu"
475        }
476    }
477}
478
479# ----------------------------------------------------------------------
480# USAGE: _fixState
481#
482# Used internally to update the internal widgets whenever the
483# -state/-editable options change.  Enables or disables various
484# widgets.
485# ----------------------------------------------------------------------
486itcl::body Rappture::TextEntry::_fixState {} {
487    if {$itk_option(-editable) && $itk_option(-state) == "normal"} {
488        set state normal
489    } else {
490        set state disabled
491    }
492    if {$_layout == "entry"} {
493        $itk_component(entry) configure -state $state
494        $itk_component(emenu) entryconfigure "Cut" -state $state
495        $itk_component(emenu) entryconfigure "Copy" -state $state
496        $itk_component(emenu) entryconfigure "Paste" -state $state
497    } elseif {$_layout == "text"} {
498        $itk_component(text) configure -state $state
499        $itk_component(tmenu) entryconfigure "Cut" -state $state
500        $itk_component(tmenu) entryconfigure "Copy" -state $state
501        $itk_component(tmenu) entryconfigure "Paste" -state $state
502    }
503}
504
505# ----------------------------------------------------------------------
506# USAGE: _uploadValue -start
507# USAGE: _uploadValue -assign <key> <value> <key> <value> ...
508#
509# Used internally to initiate an upload operation.  Prompts the
510# user to upload into the text area of this widget.
511# ----------------------------------------------------------------------
512itcl::body Rappture::TextEntry::_uploadValue {args} {
513    switch -- $_layout {
514        entry   { set widget $itk_component(entry) }
515        text    { set widget $itk_component(text) }
516        default { set widget $itk_component(hull) }
517    }
518
519    set opt [lindex $args 0]
520    switch -- $opt {
521        -start {
522            set tool [[$_owner tool] get -name]
523            set cntls [list $_path [label] [tooltip]]
524            Rappture::filexfer::upload \
525                $tool $cntls [itcl::code $this _uploadValue -assign]
526        }
527        -assign {
528            array set data [lrange $args 1 end] ;# skip option
529            if {[info exists data(error)]} {
530                Rappture::Tooltip::cue $widget $data(error)
531            }
532            if {[info exists data(data)]} {
533                Rappture::Tooltip::cue hide  ;# take down note about the popup
534                _setValue $data(data)
535            }
536        }
537        default {
538            error "bad option \"$opt\": should be -start or -assign"
539        }
540    }
541}
542
543# ----------------------------------------------------------------------
544# USAGE: _downloadValue
545#
546# Used internally to initiate a download operation.  Takes the current
547# value and downloads it to the user in a new browser window.
548# ----------------------------------------------------------------------
549itcl::body Rappture::TextEntry::_downloadValue {} {
550    set mesg [Rappture::filexfer::download [value] input.txt]
551
552    if {"" != $mesg} {
553        switch -- $_layout {
554            entry   { set widget $itk_component(entry) }
555            text    { set widget $itk_component(text) }
556            default { set widget $itk_component(hull) }
557        }
558        Rappture::Tooltip::cue $widget $mesg
559    }
560}
561
562# ----------------------------------------------------------------------
563# CONFIGURATION OPTION: -editable
564# ----------------------------------------------------------------------
565itcl::configbody Rappture::TextEntry::editable {
566    if {![string is boolean -strict $itk_option(-editable)]} {
567        error "bad value \"$itk_option(-editable)\": should be boolean"
568    }
569    _fixState
570}
571
572# ----------------------------------------------------------------------
573# CONFIGURATION OPTION: -state
574# ----------------------------------------------------------------------
575itcl::configbody Rappture::TextEntry::state {
576    set valid {normal disabled}
577    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
578        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
579    }
580    if {$_layout == "text"} {
581        if {$itk_option(-state) == "disabled"} {
582            set fg [option get $itk_component(text) disabledForeground Foreground]
583        } else {
584            set fg $itk_option(-foreground)
585        }
586        $itk_component(text) configure -foreground $fg
587    }
588    _fixState
589}
590
591# ----------------------------------------------------------------------
592# CONFIGURATION OPTION: -width
593# ----------------------------------------------------------------------
594itcl::configbody Rappture::TextEntry::width {
595    # check size to see if it has the proper form
596    winfo pixels $itk_component(hull) $itk_option(-width)
597    $_dispatcher event -idle !layout
598}
599
600# ----------------------------------------------------------------------
601# CONFIGURATION OPTION: -height
602# ----------------------------------------------------------------------
603itcl::configbody Rappture::TextEntry::height {
604    # check size to see if it has the proper form
605    winfo pixels $itk_component(hull) $itk_option(-height)
606    $_dispatcher event -idle !layout
607}
Note: See TracBrowser for help on using the repository browser.