source: branches/blt4/gui/scripts/textentry.tcl @ 1710

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