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

Last change on this file since 468 was 437, checked in by mmc, 18 years ago

Added a new <enable> parameter to all inputs. Controls can now be
enabled/disabled based on the status of other controls. If a group
is disabled, it disappears entirely. If a parameter is enabled to
a hard-coded "off" value, then it acts like a hidden (secret)
parameter.
File size: 17.0 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-*-*-100-* widgetDefault
27
28
29itcl::class Rappture::TextEntry {
30    inherit itk::Widget
31
32    itk_option define -editable editable Editable ""
33    itk_option define -state state State "normal"
34    itk_option define -width width Width 0
35    itk_option define -height height Height 0
36
37    constructor {owner path args} { # defined below }
38
39    public method value {args}
40
41    public method label {}
42    public method tooltip {}
43    public method size {} { return $_size }
44
45    protected method _layout {}
46    protected method _newValue {}
47    protected method _edit {option args}
48    protected method _fixState {}
49
50    private variable _dispatcher "" ;# dispatcher for !events
51    private variable _owner ""    ;# thing managing this control
52    private variable _path ""     ;# path in XML to this number
53
54    private variable _mode ""       ;# entry or text mode
55    private variable _size ""       ;# size hint from XML
56}
57                                                                               
58itk::usual TextEntry {
59}
60
61# ----------------------------------------------------------------------
62# CONSTRUCTOR
63# ----------------------------------------------------------------------
64itcl::body Rappture::TextEntry::constructor {owner path args} {
65    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
66        error "bad object \"$owner\": should be Rappture::ControlOwner"
67    }
68    set _owner $owner
69    set _path $path
70
71    Rappture::dispatcher _dispatcher
72    $_dispatcher register !layout
73    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
74
75    set _size [$_owner xml get $path.size]
76
77    set hints [$_owner xml get $path.about.hints]
78    if {[string length $hints] > 0} {
79        itk_component add hints {
80            ::label $itk_interior.hints -anchor w -text $hints
81        } {
82            usual
83            rename -foreground -hintforeground hintForeground Foreground
84            rename -font -hintfont hintFont Font
85        }
86        pack $itk_component(hints) -side bottom -fill x
87    }
88
89    eval itk_initialize $args
90
91    set str [$_owner xml get $path.default]
92    if {"" != $str} {
93        _layout  ;# must fix layout or value won't take
94        value $str
95    }
96}
97
98# ----------------------------------------------------------------------
99# USAGE: value ?-check? ?<newval>?
100#
101# Clients use this to query/set the value for this widget.  With
102# no args, it returns the current value for the widget.  If the
103# <newval> is specified, it sets the value of the widget and
104# sends a <<Value>> event.  If the -check flag is included, the
105# new value is not actually applied, but just checked for correctness.
106# ----------------------------------------------------------------------
107itcl::body Rappture::TextEntry::value {args} {
108    set onlycheck 0
109    set i [lsearch -exact $args -check]
110    if {$i >= 0} {
111        set onlycheck 1
112        set args [lreplace $args $i $i]
113    }
114
115    if {[llength $args] == 1} {
116        if {$onlycheck} {
117            # someday we may add validation...
118            return
119        }
120        set newval [lindex $args 0]
121        if {$_mode == "entry"} {
122            $itk_component(entry) configure -state normal
123            $itk_component(emenu) entryconfigure "Cut" -state normal
124            $itk_component(emenu) entryconfigure "Copy" -state normal
125            $itk_component(emenu) entryconfigure "Paste" -state normal
126            $itk_component(entry) delete 0 end
127            $itk_component(entry) insert 0 $newval
128            if {!$itk_option(-editable)} {
129                $itk_component(entry) configure -state disabled
130                $itk_component(emenu) entryconfigure "Cut" -state disabled
131                $itk_component(emenu) entryconfigure "Copy" -state disabled
132                $itk_component(emenu) entryconfigure "Paste" -state disabled
133            }
134        } elseif {$_mode == "text"} {
135            $itk_component(text) configure -state normal
136            $itk_component(tmenu) entryconfigure "Cut" -state normal
137            $itk_component(tmenu) entryconfigure "Copy" -state normal
138            $itk_component(tmenu) entryconfigure "Paste" -state normal
139            $itk_component(text) delete 1.0 end
140            $itk_component(text) insert end $newval
141            if {!$itk_option(-editable)} {
142                $itk_component(text) configure -state disabled
143                $itk_component(tmenu) entryconfigure "Cut" -state disabled
144                $itk_component(tmenu) entryconfigure "Copy" -state disabled
145                $itk_component(tmenu) entryconfigure "Paste" -state disabled
146            }
147        }
148        $_dispatcher event -idle !layout
149        event generate $itk_component(hull) <<Value>>
150        return $newval
151
152    } elseif {[llength $args] != 0} {
153        error "wrong # args: should be \"value ?-check? ?newval?\""
154    }
155
156    #
157    # Query the value and return.
158    #
159    if {$_mode == "entry"} {
160        return [$itk_component(entry) get]
161    } elseif {$_mode == "text"} {
162        return [$itk_component(text) get 1.0 end-1char]
163    }
164    return ""
165}
166
167# ----------------------------------------------------------------------
168# USAGE: label
169#
170# Clients use this to query the label associated with this widget.
171# Reaches into the XML and pulls out the appropriate label string.
172# ----------------------------------------------------------------------
173itcl::body Rappture::TextEntry::label {} {
174    set label [$_owner xml get $_path.about.label]
175    if {"" == $label} {
176        set label "String"
177    }
178    return $label
179}
180
181# ----------------------------------------------------------------------
182# USAGE: tooltip
183#
184# Clients use this to query the tooltip associated with this widget.
185# Reaches into the XML and pulls out the appropriate description
186# string.  Returns the string that should be used with the
187# Rappture::Tooltip facility.
188# ----------------------------------------------------------------------
189itcl::body Rappture::TextEntry::tooltip {} {
190    set str [$_owner xml get $_path.about.description]
191    return [string trim $str]
192}
193
194# ----------------------------------------------------------------------
195# USAGE: _layout
196#
197# Used internally to change the layout of this widget depending
198# on the .size hint and its contents.  Switches between an entry
199# and a text widget.
200# ----------------------------------------------------------------------
201itcl::body Rappture::TextEntry::_layout {} {
202    set size $_size
203    if {$size == "" || $size == "auto"} {
204        #
205        # If the size is "auto", then look at the current value
206        # and count its lines/characters.
207        #
208        set val ""
209        if {$_mode == "entry"} {
210            set val [$itk_component(entry) get]
211        } elseif {$_mode == "text"} {
212            set val [$itk_component(text) get 1.0 end-1char]
213        }
214
215        set chars 0
216        set lines 0
217        foreach line [split $val \n] {
218            incr lines
219            if {[string length $line] > $chars} {
220                set chars [string length $line]
221            }
222        }
223        incr chars
224
225        if {$lines > 1} {
226            set size "${chars}x${lines}"
227        } else {
228            set size $chars
229        }
230    }
231
232    if {[regexp {^[0-9]+$} $size]} {
233        #
234        # If the size is WW, then flip to entry mode, with
235        # a requested size of WW characters.
236        #
237        if {$_mode != "entry"} {
238            set val ""
239            if {$_mode == "text"} {
240                set val [$itk_component(text) get 1.0 end-1char]
241                destroy $itk_component(text)
242                destroy $itk_component(scrollbars)
243            }
244
245            itk_component add entry {
246                entry $itk_interior.entry
247            } {
248                usual
249                rename -background -textbackground textBackground Background
250                rename -foreground -textforeground textForeground Foreground
251            }
252            pack $itk_component(entry) -expand yes -fill both
253            $itk_component(entry) configure \
254                -background $itk_option(-textbackground) \
255                -foreground $itk_option(-textforeground)
256
257            bind $itk_component(entry) <KeyPress> [itcl::code $this _newValue]
258
259            itk_component add emenu {
260                menu $itk_component(entry).menu -tearoff 0
261            }
262            $itk_component(emenu) add command -label "Cut" -accelerator "^X" \
263                -command [list event generate $itk_component(entry) <<Cut>>]
264            $itk_component(emenu) add command -label "Copy" -accelerator "^C" \
265                -command [list event generate $itk_component(entry) <<Copy>>]
266            $itk_component(emenu) add command -label "Paste" -accelerator "^V" \
267                -command [list event generate $itk_component(entry) <<Paste>>]
268            bind $itk_component(entry) <<PopupMenu>> \
269                [itcl::code $this _edit menu emenu %X %Y]
270
271            $itk_component(entry) insert end $val
272            if {!$itk_option(-editable)} {
273                $itk_component(entry) configure -state disabled
274            }
275            set _mode "entry"
276        }
277        $itk_component(entry) configure -width $size
278
279    } elseif {[regexp {^([0-9]+)x([0-9]+)$} $size match w h]} {
280        #
281        # If the size is WWxHH, then flip to text mode, with
282        # a requested size of HH lines by WW characters.
283        #
284        if {$_mode != "text"} {
285            set val ""
286            if {$_mode == "entry"} {
287                set val [$itk_component(entry) get]
288                destroy $itk_component(entry)
289            }
290
291            itk_component add scrollbars {
292                Rappture::Scroller $itk_interior.scrl \
293                     -xscrollmode auto -yscrollmode auto
294            }
295            pack $itk_component(scrollbars) -expand yes -fill both
296
297            itk_component add text {
298                text $itk_component(scrollbars).text \
299                    -width 1 -height 1 -wrap char
300            } {
301                usual
302                rename -background -textbackground textBackground Background
303                rename -foreground -textforeground textForeground Foreground
304            }
305            $itk_component(text) configure \
306                -background $itk_option(-textbackground) \
307                -foreground $itk_option(-textforeground)
308            $itk_component(scrollbars) contents $itk_component(text)
309
310            bind $itk_component(text) <KeyPress> [itcl::code $this _newValue]
311
312            itk_component add tmenu {
313                menu $itk_component(text).menu -tearoff 0
314            }
315            $itk_component(tmenu) add command -label "Cut" -accelerator "^X" \
316                -command [list event generate $itk_component(text) <<Cut>>]
317            $itk_component(tmenu) add command -label "Copy" -accelerator "^C" \
318                -command [list event generate $itk_component(text) <<Copy>>]
319            $itk_component(tmenu) add command -label "Paste" -accelerator "^V" \
320                -command [list event generate $itk_component(text) <<Paste>>]
321            bind $itk_component(text) <<PopupMenu>> \
322                [itcl::code $this _edit menu tmenu %X %Y]
323
324            $itk_component(text) insert end $val
325            if {!$itk_option(-editable)} {
326                $itk_component(text) configure -state disabled
327                $itk_component(menu) entryconfigure "Cut" -state disabled
328                $itk_component(menu) entryconfigure "Copy" -state disabled
329                $itk_component(menu) entryconfigure "Paste" -state disabled
330            }
331            set _mode "text"
332        }
333        $itk_component(text) configure -width $w -height $h
334    }
335
336    #
337    # Fix the overall widget size according to -width / -height
338    #
339    if {$itk_option(-width) == 0 && $itk_option(-height) == 0} {
340        pack propagate $itk_component(hull) yes
341    } else {
342        pack propagate $itk_component(hull) no
343        component hull configure \
344            -width $itk_option(-width) -height $itk_option(-width)
345    }
346}
347
348# ----------------------------------------------------------------------
349# USAGE: _newValue
350#
351# Invoked automatically whenever the value in the entry changes.
352# Sends a <<Value>> event to notify clients of the change.
353# ----------------------------------------------------------------------
354itcl::body Rappture::TextEntry::_newValue {} {
355    event generate $itk_component(hull) <<Value>>
356}
357
358# ----------------------------------------------------------------------
359# USAGE: _edit menu <which> <X> <Y>
360#
361# Used internally to manage edit operations.
362# ----------------------------------------------------------------------
363itcl::body Rappture::TextEntry::_edit {option args} {
364    if {$itk_option(-state) == "disabled"} {
365        return  ;# disabled? then bail out here!
366    }
367    switch -- $option {
368        menu {
369            if {[llength $args] != 3} {
370                error "wrong # args: should be \"_edit $option which x y\""
371            }
372            set mname [lindex $args 0]
373            set x [lindex $args 1]
374            set y [lindex $args 2]
375            tk_popup $itk_component($mname) $x $y
376        }
377        default {
378            error "bad option \"$option\": should be menu"
379        }
380    }
381}
382
383# ----------------------------------------------------------------------
384# USAGE: _fixState
385#
386# Used internally to update the internal widgets whenever the
387# -state/-editable options change.  Enables or disables various
388# widgets.
389# ----------------------------------------------------------------------
390itcl::body Rappture::TextEntry::_fixState {} {
391    if {$itk_option(-editable) && $itk_option(-state) == "normal"} {
392        set state normal
393    } else {
394        set state disabled
395    }
396    if {$_mode == "entry"} {
397        $itk_component(entry) configure -state $state
398        $itk_component(emenu) entryconfigure "Cut" -state $state
399        $itk_component(emenu) entryconfigure "Copy" -state $state
400        $itk_component(emenu) entryconfigure "Paste" -state $state
401    } elseif {$_mode == "text"} {
402        $itk_component(text) configure -state $state
403        $itk_component(tmenu) entryconfigure "Cut" -state $state
404        $itk_component(tmenu) entryconfigure "Copy" -state $state
405        $itk_component(tmenu) entryconfigure "Paste" -state $state
406    }
407}
408
409# ----------------------------------------------------------------------
410# CONFIGURATION OPTION: -editable
411# ----------------------------------------------------------------------
412itcl::configbody Rappture::TextEntry::editable {
413    if {![string is boolean -strict $itk_option(-editable)]} {
414        error "bad value \"$itk_option(-editable)\": should be boolean"
415    }
416    _fixState
417}
418
419# ----------------------------------------------------------------------
420# CONFIGURATION OPTION: -state
421# ----------------------------------------------------------------------
422itcl::configbody Rappture::TextEntry::state {
423    set valid {normal disabled}
424    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
425        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
426    }
427    if {$_mode == "text"} {
428        if {$itk_option(-state) == "disabled"} {
429            set fg [option get $itk_component(text) disabledForeground Foreground]
430        } else {
431            set fg $itk_option(-foreground)
432        }
433        $itk_component(text) configure -foreground $fg
434    }
435    _fixState
436}
437
438# ----------------------------------------------------------------------
439# CONFIGURATION OPTION: -width
440# ----------------------------------------------------------------------
441itcl::configbody Rappture::TextEntry::width {
442    # check size to see if it has the proper form
443    winfo pixels $itk_component(hull) $itk_option(-width)
444    $_dispatcher event -idle !layout
445}
446
447# ----------------------------------------------------------------------
448# CONFIGURATION OPTION: -height
449# ----------------------------------------------------------------------
450itcl::configbody Rappture::TextEntry::height {
451    # check size to see if it has the proper form
452    winfo pixels $itk_component(hull) $itk_option(-height)
453    $_dispatcher event -idle !layout
454}
Note: See TracBrowser for help on using the repository browser.