Context Navigation

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

Last change on this file since 1710 was 1710, checked in by gah, 14 years ago

File size: 19.1 KB

Rev	Line
[11]	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
[115]	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.
[11]	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.editable yes widgetDefault
	20	option add *TextEntry.textBackground white widgetDefault
[437]	21	option add TextEntrydisabledForeground #a3a3a3 widgetDefault
	22	option add TextEntrydisabledBackground white widgetDefault
[11]	23
	24	option add *TextEntry.hintForeground gray50 widgetDefault
	25	option add *TextEntry.hintFont \
[676]	26	--helvetica-medium-r-normal--10-* widgetDefault
[674]	27	option add *TextEntry.codeFont \
[640]	28	--courier-medium-r-normal--12-* widgetDefault
[11]	29
[1710]	30	itk::usual Scrollset {
	31	}
[22]	32
[11]	33	itcl::class Rappture::TextEntry {
	34	inherit itk::Widget
	35
	36	itk_option define -editable editable Editable ""
[437]	37	itk_option define -state state State "normal"
[11]	38	itk_option define -width width Width 0
	39	itk_option define -height height Height 0
	40
[22]	41	constructor {owner path args} { # defined below }
[11]	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 {}
[640]	50	protected method _setValue {value}
[43]	51	protected method _newValue {}
[437]	52	protected method _edit {option args}
	53	protected method _fixState {}
[640]	54	protected method _uploadValue {args}
	55	protected method _downloadValue {}
[11]	56
	57	private variable _dispatcher "" ;# dispatcher for !events
[640]	58	private variable _owner "" ;# thing managing this control
	59	private variable _path "" ;# path in XML to this number
[11]	60
[640]	61	private variable _layout "" ;# entry or full text size
	62	private variable _mode "ascii" ;# ascii text or binary data
	63	private variable _value "" ;# value inside the widget
[11]	64	private variable _size "" ;# size hint from XML
	65	}
[1342]	66
[11]	67	itk::usual TextEntry {
	68	}
	69
	70	# ----------------------------------------------------------------------
	71	# CONSTRUCTOR
	72	# ----------------------------------------------------------------------
[22]	73	itcl::body Rappture::TextEntry::constructor {owner path args} {
	74	if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 \|\| !$valid} {
[1342]	75	error "bad object \"$owner\": should be Rappture::ControlOwner"
[11]	76	}
[22]	77	set _owner $owner
[11]	78	set _path $path
	79
	80	Rappture::dispatcher _dispatcher
	81	$_dispatcher register !layout
	82	$_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
	83
[22]	84	set _size [$_owner xml get $path.size]
[11]	85
[22]	86	set hints [$_owner xml get $path.about.hints]
[11]	87	if {[string length $hints] > 0} {
[1342]	88	itk_component add hints {
	89	::label $itk_interior.hints -anchor w -text $hints
	90	} {
	91	usual
	92	rename -foreground -hintforeground hintForeground Foreground
	93	rename -font -hintfont hintFont Font
	94	}
	95	pack $itk_component(hints) -side bottom -fill x
[11]	96	}
	97
	98	eval itk_initialize $args
	99
[22]	100	set str [$_owner xml get $path.default]
[69]	101	if {"" != $str} {
[1342]	102	_layout ;# must fix layout or value won't take
	103	value $str
[69]	104	}
[11]	105	}
	106
	107	# ----------------------------------------------------------------------
	108	# USAGE: value ?-check? ?<newval>?
	109	#
	110	# Clients use this to query/set the value for this widget. With
	111	# no args, it returns the current value for the widget. If the
	112	# <newval> is specified, it sets the value of the widget and
	113	# sends a <<Value>> event. If the -check flag is included, the
	114	# new value is not actually applied, but just checked for correctness.
	115	# ----------------------------------------------------------------------
	116	itcl::body Rappture::TextEntry::value {args} {
	117	set onlycheck 0
	118	set i [lsearch -exact $args -check]
	119	if {$i >= 0} {
[1342]	120	set onlycheck 1
	121	set args [lreplace $args $i $i]
[11]	122	}
	123
	124	if {[llength $args] == 1} {
[1342]	125	if {$onlycheck} {
	126	# someday we may add validation...
	127	return
	128	}
	129	set newval [lindex $args 0]
	130	_setValue $newval
[640]	131
[1342]	132	$_dispatcher event -idle !layout
	133	event generate $itk_component(hull) <<Value>>
	134	return $newval
[11]	135
	136	} elseif {[llength $args] != 0} {
[1342]	137	error "wrong # args: should be \"value ?-check? ?newval?\""
[11]	138	}
	139
	140	#
	141	# Query the value and return.
	142	#
[640]	143	if {$_mode == "ascii"} {
[1342]	144	if {$_layout == "entry"} {
	145	return [$itk_component(entry) get]
	146	} elseif {$_layout == "text"} {
	147	return [$itk_component(text) get 1.0 end-1char]
	148	}
[640]	149	} else {
[1342]	150	return $_value
[11]	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	# ----------------------------------------------------------------------
	161	itcl::body Rappture::TextEntry::label {} {
[22]	162	set label [$_owner xml get $_path.about.label]
[11]	163	if {"" == $label} {
[1342]	164	set label "String"
[11]	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	# ----------------------------------------------------------------------
	177	itcl::body Rappture::TextEntry::tooltip {} {
[22]	178	set str [$_owner xml get $_path.about.description]
[11]	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	# ----------------------------------------------------------------------
	189	itcl::body Rappture::TextEntry::_layout {} {
	190	set size $_size
	191	if {$size == "" \|\| $size == "auto"} {
[1342]	192	#
	193	# If the size is "auto", then look at the current value
	194	# and count its lines/characters.
	195	#
	196	set val ""
	197	if {$_layout == "entry"} {
	198	set val [$itk_component(entry) get]
	199	} elseif {$_layout == "text"} {
	200	set val [$itk_component(text) get 1.0 end-1char]
	201	}
[11]	202
[1342]	203	set chars 0
	204	set lines 0
	205	foreach line [split $val \n] {
	206	incr lines
	207	if {[string length $line] > $chars} {
	208	set chars [string length $line]
	209	}
	210	}
	211	incr chars
[11]	212
[1342]	213	if {$lines > 1} {
	214	set size "${chars}x${lines}"
	215	} else {
	216	set size $chars
	217	}
[11]	218	}
	219
	220	if {[regexp {^[0-9]+$} $size]} {
[1342]	221	#
	222	# If the size is WW, then flip to entry mode, with
	223	# a requested size of WW characters.
	224	#
	225	if {$_layout != "entry"} {
	226	set val ""
	227	if {$_layout == "text"} {
	228	set val [$itk_component(text) get 1.0 end-1char]
	229	destroy $itk_component(text)
	230	destroy $itk_component(scrollbars)
	231	}
[11]	232
[1342]	233	itk_component add entry {
	234	entry $itk_interior.entry
	235	} {
	236	usual
	237	rename -background -textbackground textBackground Background
	238	rename -foreground -textforeground textForeground Foreground
	239	}
	240	pack $itk_component(entry) -expand yes -fill both
	241	$itk_component(entry) configure \
	242	-background $itk_option(-textbackground) \
	243	-foreground $itk_option(-textforeground)
[11]	244
[1342]	245	bind $itk_component(entry) <KeyPress> [itcl::code $this _newValue]
	246	bind $itk_component(entry) <Control-KeyPress-a> \
	247	"[list $itk_component(entry) selection range 0 end]; break"
[43]	248
[1342]	249	itk_component add emenu {
	250	menu $itk_component(entry).menu -tearoff 0
	251	}
	252	$itk_component(emenu) add command -label "Cut" -accelerator "^X" \
	253	-command [list event generate $itk_component(entry) <<Cut>>]
	254	$itk_component(emenu) add command -label "Copy" -accelerator "^C" \
	255	-command [list event generate $itk_component(entry) <<Copy>>]
	256	$itk_component(emenu) add command -label "Paste" -accelerator "^V" \
	257	-command [list event generate $itk_component(entry) <<Paste>>]
	258	$itk_component(emenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(entry) selection range 0 end]
	259	bind $itk_component(entry) <<PopupMenu>> \
	260	[itcl::code $this _edit menu emenu %X %Y]
[17]	261
[1342]	262	set _layout "entry"
	263	_setValue $val
	264	}
	265	$itk_component(entry) configure -width $size
[11]	266
	267	} elseif {[regexp {^([0-9]+)x([0-9]+)$} $size match w h]} {
[1342]	268	#
	269	# If the size is WWxHH, then flip to text mode, with
	270	# a requested size of HH lines by WW characters.
	271	#
	272	if {$_layout != "text"} {
	273	set val ""
	274	if {$_layout == "entry"} {
	275	set val [$itk_component(entry) get]
	276	destroy $itk_component(entry)
	277	}
[11]	278
[1342]	279	itk_component add scrollbars {
[1651]	280	blt::scrollset $itk_interior.scrl \
	281	-xscrollbar $itk_interior.scrl.xs \
	282	-yscrollbar $itk_interior.scrl.ys \
	283	-window $itk_interior.scrl.text
[1342]	284	}
[1651]	285	blt::tk::scrollbar $itk_interior.scrl.xs
	286	blt::tk::scrollbar $itk_interior.scrl.ys
[1342]	287	pack $itk_component(scrollbars) -expand yes -fill both
[11]	288
[1342]	289	itk_component add text {
	290	text $itk_component(scrollbars).text \
	291	-width 1 -height 1 -wrap char
	292	} {
	293	usual
	294	rename -background -textbackground textBackground Background
	295	rename -foreground -textforeground textForeground Foreground
	296	rename -font -codefont codeFont CodeFont
	297	}
	298	$itk_component(text) configure \
	299	-background $itk_option(-textbackground) \
	300	-foreground $itk_option(-textforeground) \
	301	-font $itk_option(-codefont)
[11]	302
[1342]	303	bind $itk_component(text) <KeyPress> [itcl::code $this _newValue]
	304	bind $itk_component(text) <Control-KeyPress-a> \
	305	"[list $itk_component(text) tag add sel 1.0 end]; break"
[43]	306
[1342]	307	itk_component add tmenu {
	308	menu $itk_component(text).menu -tearoff 0
	309	}
	310	$itk_component(tmenu) add command -label "Cut" -accelerator "^X" \
	311	-command [list event generate $itk_component(text) <<Cut>>]
	312	$itk_component(tmenu) add command -label "Copy" -accelerator "^C" \
	313	-command [list event generate $itk_component(text) <<Copy>>]
	314	$itk_component(tmenu) add command -label "Paste" -accelerator "^V" \
	315	-command [list event generate $itk_component(text) <<Paste>>]
	316	$itk_component(tmenu) add command -label "Select All" -accelerator "^A" -command [list $itk_component(text) tag add sel 1.0 end]
	317	$itk_component(tmenu) add separator
[1077]	318
[1342]	319	$itk_component(tmenu) add command \
	320	-label [Rappture::filexfer::label upload] \
	321	-command [itcl::code $this _uploadValue -start]
	322	$itk_component(tmenu) add command \
	323	-label [Rappture::filexfer::label download] \
	324	-command [itcl::code $this _downloadValue]
[1077]	325
[1342]	326	bind $itk_component(text) <<PopupMenu>> \
	327	[itcl::code $this _edit menu tmenu %X %Y]
[17]	328
[1342]	329	set _layout "text"
	330	_setValue $val
	331	}
	332	$itk_component(text) configure -width $w -height $h
[11]	333	}
	334
	335	#
	336	# Fix the overall widget size according to -width / -height
	337	#
	338	if {$itk_option(-width) == 0 && $itk_option(-height) == 0} {
[1342]	339	pack propagate $itk_component(hull) yes
[11]	340	} else {
[1342]	341	pack propagate $itk_component(hull) no
	342	component hull configure \
	343	-width $itk_option(-width) -height $itk_option(-width)
[11]	344	}
	345	}
	346
	347	# ----------------------------------------------------------------------
[640]	348	# USAGE: _setValue <newValue>
	349	#
	350	# Used internally to set the value for this widget. If the <newValue>
	351	# string is ASCII, then it is stored directly and the widget is enabled
	352	# for editing. Otherwise, the value is cached and a representation of
	353	# the data is displayed.
	354	# ----------------------------------------------------------------------
	355	itcl::body Rappture::TextEntry::_setValue {newval} {
[649]	356	if {[Rappture::encoding::is binary $newval]} {
[1342]	357	# looks like a binary file
	358	set _mode "binary"
	359	set _value $newval
[640]	360
[1342]	361	if {$_layout == "entry" \|\| [string match {*x[01]} $_size]} {
	362	set newval [Rappture::utils::hexdump -lines 0 $_value]
	363	} else {
	364	set newval [Rappture::utils::hexdump -lines 1000 $_value]
	365	}
[640]	366	} else {
[1342]	367	# ascii file -- map carriage returns to line feeds
	368	set _mode "ascii"
	369	set _value ""
	370	regsub -all "\r\n" $newval "\n" newval
	371	regsub -all "\r" $newval "\n" newval
[640]	372	}
	373
	374	if {$_layout == "entry"} {
[1342]	375	$itk_component(entry) configure -state normal
	376	$itk_component(emenu) entryconfigure "Cut" -state normal
	377	$itk_component(emenu) entryconfigure "Paste" -state normal
	378	$itk_component(entry) delete 0 end
	379	$itk_component(entry) insert 0 $newval
	380	if {!$itk_option(-editable) \|\| $_mode == "binary"} {
	381	$itk_component(entry) configure -state disabled
	382	$itk_component(emenu) entryconfigure "Cut" -state disabled
	383	$itk_component(emenu) entryconfigure "Paste" -state disabled
	384	}
[640]	385	} elseif {$_layout == "text"} {
[1342]	386	$itk_component(text) configure -state normal
	387	$itk_component(tmenu) entryconfigure "Cut" -state normal
	388	$itk_component(tmenu) entryconfigure "Paste" -state normal
	389	$itk_component(text) delete 1.0 end
	390	$itk_component(text) insert end $newval
	391	if {!$itk_option(-editable) \|\| $_mode == "binary"} {
	392	set hull $itk_component(hull)
	393	set dfg [option get $hull disabledForeground Foreground]
	394	set dbg [option get $hull disabledBackground Background]
	395	$itk_component(text) configure -state disabled \
	396	-background $dbg -foreground $dfg
	397	$itk_component(tmenu) entryconfigure "Cut" -state disabled
	398	$itk_component(tmenu) entryconfigure "Paste" -state disabled
	399	} else {
	400	$itk_component(text) configure \
	401	-background $itk_option(-textbackground) \
	402	-foreground $itk_option(-textforeground)
	403	}
[640]	404	}
	405	}
	406
	407	# ----------------------------------------------------------------------
[43]	408	# USAGE: _newValue
	409	#
	410	# Invoked automatically whenever the value in the entry changes.
	411	# Sends a <<Value>> event to notify clients of the change.
	412	# ----------------------------------------------------------------------
	413	itcl::body Rappture::TextEntry::_newValue {} {
	414	event generate $itk_component(hull) <<Value>>
	415	}
	416
	417	# ----------------------------------------------------------------------
[437]	418	# USAGE: _edit menu <which> <X> <Y>
	419	#
	420	# Used internally to manage edit operations.
[11]	421	# ----------------------------------------------------------------------
[437]	422	itcl::body Rappture::TextEntry::_edit {option args} {
	423	if {$itk_option(-state) == "disabled"} {
[1342]	424	return ;# disabled? then bail out here!
[11]	425	}
[437]	426	switch -- $option {
[1342]	427	menu {
	428	if {[llength $args] != 3} {
	429	error "wrong # args: should be \"_edit $option which x y\""
	430	}
	431	set mname [lindex $args 0]
	432	set x [lindex $args 1]
	433	set y [lindex $args 2]
	434	tk_popup $itk_component($mname) $x $y
	435	}
	436	default {
	437	error "bad option \"$option\": should be menu"
	438	}
[437]	439	}
	440	}
[11]	441
[437]	442	# ----------------------------------------------------------------------
	443	# USAGE: _fixState
	444	#
	445	# Used internally to update the internal widgets whenever the
	446	# -state/-editable options change. Enables or disables various
	447	# widgets.
	448	# ----------------------------------------------------------------------
	449	itcl::body Rappture::TextEntry::_fixState {} {
	450	if {$itk_option(-editable) && $itk_option(-state) == "normal"} {
[1342]	451	set state normal
[11]	452	} else {
[1342]	453	set state disabled
[11]	454	}
[640]	455	if {$_layout == "entry"} {
[1342]	456	$itk_component(entry) configure -state $state
	457	$itk_component(emenu) entryconfigure "Cut" -state $state
	458	$itk_component(emenu) entryconfigure "Copy" -state $state
	459	$itk_component(emenu) entryconfigure "Paste" -state $state
[640]	460	} elseif {$_layout == "text"} {
[1342]	461	$itk_component(text) configure -state $state
	462	$itk_component(tmenu) entryconfigure "Cut" -state $state
	463	$itk_component(tmenu) entryconfigure "Copy" -state $state
	464	$itk_component(tmenu) entryconfigure "Paste" -state $state
[11]	465	}
	466	}
	467
	468	# ----------------------------------------------------------------------
[640]	469	# USAGE: _uploadValue -start
	470	# USAGE: _uploadValue -assign <key> <value> <key> <value> ...
	471	#
	472	# Used internally to initiate an upload operation. Prompts the
	473	# user to upload into the text area of this widget.
	474	# ----------------------------------------------------------------------
	475	itcl::body Rappture::TextEntry::_uploadValue {args} {
	476	switch -- $_layout {
[1342]	477	entry { set widget $itk_component(entry) }
	478	text { set widget $itk_component(text) }
	479	default { set widget $itk_component(hull) }
[640]	480	}
	481
	482	set opt [lindex $args 0]
	483	switch -- $opt {
[1342]	484	-start {
	485	set tool [Rappture::Tool::resources -appname]
	486	set cntls [list $_path [label] [tooltip]]
	487	Rappture::filexfer::upload \
	488	$tool $cntls [itcl::code $this _uploadValue -assign]
	489	}
	490	-assign {
	491	array set data [lrange $args 1 end] ;# skip option
	492	if {[info exists data(error)]} {
	493	Rappture::Tooltip::cue $widget $data(error)
	494	}
	495	if {[info exists data(data)]} {
	496	Rappture::Tooltip::cue hide ;# take down note about the popup
	497	_setValue $data(data)
	498	_newValue
	499	}
	500	}
	501	default {
	502	error "bad option \"$opt\": should be -start or -assign"
	503	}
[640]	504	}
	505	}
	506
	507	# ----------------------------------------------------------------------
	508	# USAGE: _downloadValue
	509	#
	510	# Used internally to initiate a download operation. Takes the current
	511	# value and downloads it to the user in a new browser window.
	512	# ----------------------------------------------------------------------
	513	itcl::body Rappture::TextEntry::_downloadValue {} {
	514	set mesg [Rappture::filexfer::download [value] input.txt]
	515
	516	if {"" != $mesg} {
[1342]	517	switch -- $_layout {
	518	entry { set widget $itk_component(entry) }
	519	text { set widget $itk_component(text) }
	520	default { set widget $itk_component(hull) }
	521	}
	522	Rappture::Tooltip::cue $widget $mesg
[640]	523	}
	524	}
	525
	526	# ----------------------------------------------------------------------
[437]	527	# CONFIGURATION OPTION: -editable
	528	# ----------------------------------------------------------------------
	529	itcl::configbody Rappture::TextEntry::editable {
	530	if {![string is boolean -strict $itk_option(-editable)]} {
[1342]	531	error "bad value \"$itk_option(-editable)\": should be boolean"
[437]	532	}
	533	_fixState
	534	}
	535
	536	# ----------------------------------------------------------------------
	537	# CONFIGURATION OPTION: -state
	538	# ----------------------------------------------------------------------
	539	itcl::configbody Rappture::TextEntry::state {
	540	set valid {normal disabled}
	541	if {[lsearch -exact $valid $itk_option(-state)] < 0} {
[1342]	542	error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
[437]	543	}
[640]	544	if {$_layout == "text"} {
[1342]	545	if {$itk_option(-state) == "disabled"} {
	546	set fg [option get $itk_component(text) disabledForeground Foreground]
	547	} else {
	548	set fg $itk_option(-foreground)
	549	}
	550	$itk_component(text) configure -foreground $fg
[437]	551	}
	552	_fixState
	553	}
	554
	555	# ----------------------------------------------------------------------
[11]	556	# CONFIGURATION OPTION: -width
	557	# ----------------------------------------------------------------------
	558	itcl::configbody Rappture::TextEntry::width {
	559	# check size to see if it has the proper form
	560	winfo pixels $itk_component(hull) $itk_option(-width)
	561	$_dispatcher event -idle !layout
	562	}
	563
	564	# ----------------------------------------------------------------------
	565	# CONFIGURATION OPTION: -height
	566	# ----------------------------------------------------------------------
	567	itcl::configbody Rappture::TextEntry::height {
	568	# check size to see if it has the proper form
	569	winfo pixels $itk_component(hull) $itk_option(-height)
	570	$_dispatcher event -idle !layout
	571	}

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

Download in other formats: