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

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