Context Navigation

source: branches/uiuc_vtk_viewers/gui/scripts/textentry.tcl @ 5033

Last change on this file since 5033 was 4992, checked in by dkearney, 10 years ago
merging trunk changes to uiuc_vtk_viewers
File size: 26.1 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: