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

Last change on this file since 116 was 115, checked in by mmc, 19 years ago

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