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

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