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

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