Context Navigation

textentry.tcl @ 3636

Last change on this file since 3636 was 3636, checked in by mmc, 11 years ago

Fixed the drawing widget to handle notifications from outside widgets, so
that canvas items react to value changes. Also added tooltips for drawing
items.

Nudged the next/back buttons for the pager in a bit, so they're a little
easier to press in the iPad app.

Fixed the Ruby template for the builder to include the overwrite/append flag.

File size: 24.6 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	# Don't trim the text default value. Assume that any leading/trailing
106	# whitespace is wanted.
107	set str [$_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 [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 [$_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 [$_owner xml get $_path.about.description]
184	return [string trim $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	# take down any existing widget
240	foreach win [pack slaves $itk_interior] {
241	if { [winfo name $win] != "hints" } {
242	pack forget $win
243	}
244	}
245
246	switch -- $newlayout {
247	entry {
248	# don't have the entry widget yet? then create it
249	if {![winfo exists $itk_interior.entry]} {
250	itk_component add entry {
251	entry $itk_interior.entry
252	} {
253	usual
254	rename -background -textbackground textBackground Background
255	rename -foreground -textforeground textForeground Foreground
256	}
257	$itk_component(entry) configure \
258	-background $itk_option(-textbackground) \
259	-foreground $itk_option(-textforeground)
260
261	# Make sure these event bindings occur after the class bindings.
262	# Otherwise you'll always get the entry value before the edit.
263	bind textentry-$this <KeyPress> \
264	[itcl::code $this _newValue]
265	bind textentry-$this <Control-KeyPress-a> \
266	"[list $itk_component(entry) selection range 0 end]; break"
267	bind textentry-$this <FocusOut> \
268	[itcl::code $this _edit log]
269	set bindtags [bindtags $itk_component(entry)]
270	lappend bindtags textentry-$this
271	bindtags $itk_component(entry) $bindtags
272
273	itk_component add emenu {
274	menu $itk_component(entry).menu -tearoff 0
275	}
276	$itk_component(emenu) add command \
277	-label "Cut" -accelerator "^X" \
278	-command [itcl::code $this _edit action entry cut]
279	$itk_component(emenu) add command \
280	-label "Copy" -accelerator "^C" \
281	-command [itcl::code $this _edit action entry copy]
282	$itk_component(emenu) add command \
283	-label "Paste" -accelerator "^V" \
284	-command [itcl::code $this _edit action entry paste]
285	$itk_component(emenu) add command \
286	-label "Select All" -accelerator "^A" \
287	-command [itcl::code $this _edit action entry selectall]
288	bind $itk_component(entry) <<PopupMenu>> \
289	[itcl::code $this _edit menu emenu %X %Y]
290	}
291
292	# show the entry widget
293	pack $itk_component(entry) -expand yes -fill both
294
295	# load any previous value
296	regsub -all "\n" $oldval "" oldval
297	$itk_component(entry) delete 0 end
298	$itk_component(entry) insert end $oldval
299	}
300
301	text {
302	if {![winfo exists $itk_interior.scrl]} {
303	itk_component add scrollbars {
304	Rappture::Scroller $itk_interior.scrl \
305	-xscrollmode auto -yscrollmode auto
306	}
307
308	itk_component add text {
309	text $itk_component(scrollbars).text \
310	-width 1 -height 1 -wrap char
311	} {
312	usual
313	rename -background -textbackground textBackground Background
314	rename -foreground -textforeground textForeground Foreground
315	rename -font -codefont codeFont CodeFont
316	}
317	$itk_component(text) configure \
318	-background $itk_option(-textbackground) \
319	-foreground $itk_option(-textforeground) \
320	-font $itk_option(-codefont)
321	$itk_component(scrollbars) contents $itk_component(text)
322
323	# Make sure these event bindings occur after the class bindings.
324	# Otherwise you'll always get the text value before the edit.
325	bind textentry-$this <KeyPress> \
326	[itcl::code $this _newValue]
327	bind textentry-$this <Control-KeyPress-a> \
328	"[list $itk_component(text) tag add sel 1.0 end]; break"
329	bind textentry-$this <FocusOut> \
330	[itcl::code $this _edit log]
331	set bindtags [bindtags $itk_component(text)]
332	lappend bindtags textentry-$this
333	bindtags $itk_component(text) $bindtags
334
335	itk_component add tmenu {
336	menu $itk_component(text).menu -tearoff 0
337	}
338	$itk_component(tmenu) add command \
339	-label "Cut" -accelerator "^X" \
340	-command [itcl::code $this _edit action text cut]
341	$itk_component(tmenu) add command \
342	-label "Copy" -accelerator "^C" \
343	-command [itcl::code $this _edit action text copy]
344	$itk_component(tmenu) add command \
345	-label "Paste" -accelerator "^V" \
346	-command [itcl::code $this _edit action text paste]
347	$itk_component(tmenu) add command \
348	-label "Select All" -accelerator "^A" \
349	-command [itcl::code $this _edit action text selectall]
350	$itk_component(tmenu) add separator
351
352	$itk_component(tmenu) add command \
353	-label [Rappture::filexfer::label upload] \
354	-command [itcl::code $this _uploadValue -start]
355	$itk_component(tmenu) add command \
356	-label [Rappture::filexfer::label download] \
357	-command [itcl::code $this _downloadValue]
358
359	bind $itk_component(text) <<PopupMenu>> \
360	[itcl::code $this _edit menu tmenu %X %Y]
361	}
362
363	# show the text editor widget
364	pack $itk_component(scrollbars) -expand yes -fill both
365	$itk_component(text) configure -width $w -height $h
366
367	# load any previous value
368	$itk_component(text) delete 1.0 end
369	$itk_component(text) insert end $oldval
370	}
371
372	binary {
373	if {![winfo exists $itk_interior.bin]} {
374	itk_component add binary {
375	frame $itk_interior.bin
376	}
377	set icon $_icon
378	if { $icon == "" } {
379	set icon [Rappture::icon binary]
380	}
381	itk_component add binicon {
382	::label $itk_component(binary).binicon \
383	-image $icon -borderwidth 0
384	}
385	pack $itk_component(binicon) -side left
386
387	itk_component add bininfo {
388	::label $itk_component(binary).bininfo \
389	-text "Empty\n0 bytes" \
390	-width 5 -justify left -anchor w -borderwidth 0
391	}
392	pack $itk_component(bininfo) -side left -expand yes -fill x -padx 4
393
394	itk_component add bmenu {
395	menu $itk_component(binary).menu -tearoff 0
396	}
397	$itk_component(bmenu) add command \
398	-label [Rappture::filexfer::label upload] \
399	-command [itcl::code $this _uploadValue -start]
400	$itk_component(bmenu) add command \
401	-label [Rappture::filexfer::label download] \
402	-command [itcl::code $this _downloadValue]
403
404	bind $itk_component(binicon) <<PopupMenu>> \
405	[itcl::code $this _edit menu bmenu %X %Y]
406	bind $itk_component(bininfo) <<PopupMenu>> \
407	[itcl::code $this _edit menu bmenu %X %Y]
408	}
409
410	# show the binary mode rep
411	pack $itk_component(binary) -side top -fill x
412
413	}
414	default {
415	error "don't know how to handle mode \"$newlayout\" for string editor"
416	}
417	}
418	set _layout $newlayout
419	}
420
421	#
422	# Fix the overall widget size according to -width / -height
423	#
424	if {$itk_option(-width) == 0 && $itk_option(-height) == 0} {
425	pack propagate $itk_component(hull) yes
426	} else {
427	pack propagate $itk_component(hull) no
428	component hull configure \
429	-width $itk_option(-width) -height $itk_option(-width)
430	}
431	}
432
433	# ----------------------------------------------------------------------
434	# USAGE: _setValue <newValue>
435	#
436	# Used internally to set the value for this widget. If the <newValue>
437	# string is ASCII, then it is stored directly and the widget is enabled
438	# for editing. Otherwise, the value is cached and a representation of
439	# the data is displayed.
440	# ----------------------------------------------------------------------
441	itcl::body Rappture::TextEntry::_setValue {newval} {
442	if {[Rappture::encoding::is binary $newval]} {
443	# looks like a binary file
444	set _value $newval
445	} else {
446	# ascii file -- map carriage returns to line feeds
447	regsub -all "\r\n" $newval "\n" newval
448	regsub -all "\r" $newval "\n" newval
449	set _value $newval
450	}
451
452	# fix up the layout so the display widgets exist, then load the new value
453	_layout
454
455	switch -- $_layout {
456	entry {
457	$itk_component(entry) configure -state normal
458	$itk_component(entry) delete 0 end
459	$itk_component(entry) insert end $_value
460	$itk_component(entry) configure -state $itk_option(-state)
461	}
462	text {
463	$itk_component(text) configure -state normal
464	$itk_component(text) delete 1.0 end
465	$itk_component(text) insert end $_value
466	$itk_component(text) configure -state $itk_option(-state)
467	}
468	binary {
469	set desc [Rappture::utils::datatype $_value]
470	append desc "\n[Rappture::utils::binsize [string length $_value]]"
471	$itk_component(bininfo) configure -text $desc
472	}
473	}
474	}
475
476	# ----------------------------------------------------------------------
477	# USAGE: _newValue
478	#
479	# Invoked automatically whenever the value in the entry changes.
480	# Sends a <<Value>> event to notify clients of the change.
481	# ----------------------------------------------------------------------
482	itcl::body Rappture::TextEntry::_newValue {} {
483	event generate $itk_component(hull) <<Value>>
484	}
485
486	# ----------------------------------------------------------------------
487	# USAGE: _edit action <which> <action>
488	# USAGE: _edit menu <which> <X> <Y>
489	# USAGE: _edit log
490	#
491	# Used internally to manage edit operations.
492	# ----------------------------------------------------------------------
493	itcl::body Rappture::TextEntry::_edit {option args} {
494	if {$itk_option(-state) == "disabled"} {
495	return ;# disabled? then bail out here!
496	}
497	switch -- $option {
498	action {
499	if {[llength $args] != 2} {
500	error "wrong # args: should be \"_edit $option which action\""
501	}
502	set widget [lindex $args 0]
503	set action [lindex $args 1]
504	switch -- $action {
505	cut - copy - paste {
506	set event "<<[string totitle $action]>>"
507	event generate $itk_component($widget) $event
508	}
509	selectall {
510	switch -- $widget {
511	entry { $itk_component(entry) selection range 0 end }
512	text { $itk_component(text) tag add sel 1.0 end }
513	default { error "don't know how to select for $widget" }
514	}
515	}
516	default {
517	error "don't know how to handle action $action"
518	}
519	}
520	Rappture::Logger::log input $_path -action $action
521	}
522	menu {
523	if {[llength $args] != 3} {
524	error "wrong # args: should be \"_edit $option which x y\""
525	}
526	set mname [lindex $args 0]
527	set x [lindex $args 1]
528	set y [lindex $args 2]
529	tk_popup $itk_component($mname) $x $y
530	}
531	log {
532	set newval [value]
533	if {$newval ne $_value} {
534	Rappture::Logger::log input $_path $newval
535	set _value $newval
536	}
537	}
538	default {
539	error "bad option \"$option\": should be action, menu, log"
540	}
541	}
542	}
543
544	# ----------------------------------------------------------------------
545	# USAGE: _uploadValue -start
546	# USAGE: _uploadValue -assign <key> <value> <key> <value> ...
547	#
548	# Used internally to initiate an upload operation. Prompts the
549	# user to upload into the text area of this widget.
550	# ----------------------------------------------------------------------
551	itcl::body Rappture::TextEntry::_uploadValue {args} {
552	switch -- $_layout {
553	entry { set widget $itk_component(entry) }
554	text { set widget $itk_component(text) }
555	default { set widget $itk_component(hull) }
556	}
557
558	set opt [lindex $args 0]
559	switch -- $opt {
560	-start {
561	set tool [Rappture::Tool::resources -appname]
562	set cntls [list $_path [label] [tooltip]]
563	Rappture::filexfer::upload \
564	$tool $cntls [itcl::code $this _uploadValue -assign]
565	}
566	-assign {
567	array set data [lrange $args 1 end] ;# skip option
568	if {[info exists data(error)]} {
569	Rappture::Tooltip::cue $widget $data(error)
570	Rappture::Logger::log warning $_path $data(error)
571	}
572	if {[info exists data(data)]} {
573	Rappture::Tooltip::cue hide ;# take down note about the popup
574	_setValue $data(data)
575	_newValue
576	Rappture::Logger::log upload $_path $data(data)
577	}
578	}
579	default {
580	error "bad option \"$opt\": should be -start or -assign"
581	}
582	}
583	}
584
585	# ----------------------------------------------------------------------
586	# USAGE: _downloadValue
587	#
588	# Used internally to initiate a download operation. Takes the current
589	# value and downloads it to the user in a new browser window.
590	# ----------------------------------------------------------------------
591	itcl::body Rappture::TextEntry::_downloadValue {} {
592	set mesg [Rappture::filexfer::download [value] input.txt]
593
594	if {$mesg ne ""} {
595	switch -- $_layout {
596	entry { set widget $itk_component(entry) }
597	text { set widget $itk_component(text) }
598	default { set widget $itk_component(hull) }
599	}
600	Rappture::Tooltip::cue $widget $mesg
601	Rappture::Logger::log warning $_path $mesg
602	} else {
603	Rappture::Logger::log download $_path
604	}
605	}
606
607	# ----------------------------------------------------------------------
608	# CONFIGURATION OPTION: -state
609	# ----------------------------------------------------------------------
610	itcl::configbody Rappture::TextEntry::state {
611	set valid {normal disabled}
612	if {[lsearch -exact $valid $itk_option(-state)] < 0} {
613	error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
614	}
615	if {[info exists itk_component(text)]} {
616	$itk_component(text) configure -state $itk_option(-state)
617	$itk_component(tmenu) entryconfigure "Cut" -state $itk_option(-state)
618	$itk_component(tmenu) entryconfigure "Copy" -state $itk_option(-state)
619	$itk_component(tmenu) entryconfigure "Paste" -state $itk_option(-state)
620	if {$itk_option(-state) == "disabled"} {
621	$itk_component(text) configure \
622	-foreground $itk_option(-disabledforeground) \
623	-background $itk_option(-disabledbackground)
624	} else {
625	$itk_component(text) configure \
626	-foreground $itk_option(-foreground) \
627	-background $itk_option(-textbackground)
628	}
629	}
630	if {[info exists itk_component(entry)]} {
631	$itk_component(entry) configure -state $itk_option(-state)
632	$itk_component(emenu) entryconfigure "Cut" -state $itk_option(-state)
633	$itk_component(emenu) entryconfigure "Copy" -state $itk_option(-state)
634	$itk_component(emenu) entryconfigure "Paste" -state $itk_option(-state)
635	}
636	}
637
638	# ----------------------------------------------------------------------
639	# CONFIGURATION OPTION: -width
640	# ----------------------------------------------------------------------
641	itcl::configbody Rappture::TextEntry::width {
642	# check size to see if it has the proper form
643	winfo pixels $itk_component(hull) $itk_option(-width)
644	$_dispatcher event -idle !layout
645	}
646
647	# ----------------------------------------------------------------------
648	# CONFIGURATION OPTION: -height
649	# ----------------------------------------------------------------------
650	itcl::configbody Rappture::TextEntry::height {
651	# check size to see if it has the proper form
652	winfo pixels $itk_component(hull) $itk_option(-height)
653	$_dispatcher event -idle !layout
654	}
655
656

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

Context Navigation

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

Download in other formats: