Customizable text fields samle

# $Id$

proc btags {what args} {
	switch -glob -- $what {
		add { eval btags::add $args }
		remove { eval btags::remove $args }
		default {
			error "Bad option: "$what": must be add, remove"
		}
	}
}

namespace eval btags {}

proc btags::add {where what args} {
	set which ""
	set off 0
	foreach {opt val} $args {
		switch -glob -- $opt {
			-before {
				set which $val
				set off 1
			}
			-after {
				set which $val
				set off 0
			}
			default {
				error "bad option \"$opt\": must be -before, -after"
			}
		}
	}

	set btags [bindtags $where]

	if {[string equal $which ""]} {
		set ix 0
	} else {
		set ix [lsearch -exact $btags $which]
		if {$ix < 0} {
			error "bindtag \"$which\" is not defined for \"$where\""
		}
		incr ix $off
	}

	bindtags $where [linsert $btags $ix $what]
}

proc btags::remove {where what} {
	set btags [bindtags $where]
	set ix [lsearch -exact $btags $what]
	if {$ix < 0} {
		error "bindtag \"$what\" is not defined for \"$where\""
	}

	bindtags $where [lreplace $btags $ix $ix]
}

### JUNK ###
if 1 {
	namespace eval hook {
		proc run args {}
	}
}

bind TkabberTextActions <Button-3> \
	[list tk_messageBox -message {Menu placeholder}]

# The trickery (see http://wiki.tcl.tk/16343):
rename entry orig.entry
rename text  orig.text

proc entry {w args} {
	eval [linsert $args 0 orig.entry $w]
	btags add $w TkabberTextActions -before Entry
	hook::run entry_created_hook $w $args
	return $w
}

proc text {w args} {
	eval [linsert $args 0 orig.text $w]
	btags add $w TkabberTextActions -before Text
	hook::run text_created_hook $w $args
	return $w
}

### TEST ###
if 1 {
	pack [entry .e] -fill x -expand true
	pack [text .t] -fill x -expand true
	pack [button .b -text REMOVE -command \
		[list btags remove .e TkabberTextActions]]
}