Context Navigation

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

Last change on this file since 3157 was 3157, checked in by gah, 12 years ago

File size: 22.8 KB

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

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

Download in other formats: