Pratt 1.5.6

data/pkgs/tile-0.8.2/library/cursors.tcl

@@ -0,0 +1,36 @@
+#
+# cursors.tcl,v 1.3 2006/11/05 18:40:48 jenglish Exp
+#
+# Tile package: Symbolic cursor names.
+#
+# @@@ TODO: Figure out appropriate platform-specific cursors
+#	for the various functions.
+#
+
+namespace eval ttk {
+
+    variable Cursors
+
+    switch -glob $::tcl_platform(platform) {
+
+	"windows" {
+	    array set Cursors {
+		hresize 	sb_h_double_arrow
+		vresize 	sb_v_double_arrow
+		seresize	size_nw_se
+	    }
+	}
+
+	"unix" - 
+	* {
+	    array set Cursors {
+		hresize 	sb_h_double_arrow
+		vresize 	sb_v_double_arrow
+		seresize	bottom_right_corner
+	    }
+	}
+
+    }
+}
+
+#*EOF*

data/pkgs/tile-0.8.2/library/defaults.tcl

@@ -0,0 +1,118 @@
+#
+# defaults.tcl,v 1.38 2007/11/18 18:09:26 jenglish Exp
+#
+# Settings for default theme.
+#
+
+namespace eval ttk::theme::default {
+    variable colors
+    array set colors {
+	-frame		"#d9d9d9"
+	-window		"#ffffff"
+	-activebg	"#ececec"
+	-selectbg	"#4a6984"
+	-selectfg	"#ffffff"
+	-darker 	"#c3c3c3"
+	-disabledfg	"#a3a3a3"
+	-indicator	"#4a6984"
+    }
+
+    ttk::style theme settings default {
+
+	ttk::style configure "." \
+	    -borderwidth 	1 \
+	    -background 	$colors(-frame) \
+	    -foreground 	black \
+	    -troughcolor 	$colors(-darker) \
+	    -font 		TkDefaultFont \
+	    -selectborderwidth	1 \
+	    -selectbackground	$colors(-selectbg) \
+	    -selectforeground	$colors(-selectfg) \
+	    -insertwidth 	1 \
+	    -indicatordiameter	10 \
+	    ;
+
+	ttk::style map "." -background \
+	    [list disabled $colors(-frame)  active $colors(-activebg)]
+	ttk::style map "." -foreground \
+	    [list disabled $colors(-disabledfg)]
+
+	ttk::style configure TButton \
+	    -anchor center -padding "3 3" -width -9 \
+	    -relief raised -shiftrelief 1
+	ttk::style map TButton -relief [list {!disabled pressed} sunken] 
+
+	ttk::style configure TCheckbutton \
+	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+	ttk::style map TCheckbutton -indicatorcolor \
+	    [list pressed $colors(-activebg)  selected $colors(-indicator)]
+
+	ttk::style configure TRadiobutton \
+	    -indicatorcolor "#ffffff" -indicatorrelief sunken -padding 1
+	ttk::style map TRadiobutton -indicatorcolor \
+	    [list pressed $colors(-activebg)  selected $colors(-indicator)]
+
+	ttk::style configure TMenubutton \
+	    -relief raised -padding "10 3"
+
+	ttk::style configure TEntry \
+	    -relief sunken -fieldbackground white -padding 1
+	ttk::style map TEntry -fieldbackground \
+	    [list readonly $colors(-frame) disabled $colors(-frame)]
+
+	ttk::style configure TCombobox -arrowsize 12 -padding 1
+	ttk::style map TCombobox -fieldbackground \
+	    [list readonly $colors(-frame) disabled $colors(-frame)]
+
+	ttk::style configure TLabelframe \
+	    -relief groove -borderwidth 2
+
+	ttk::style configure TScrollbar \
+	    -width 12 -arrowsize 12
+	ttk::style map TScrollbar \
+	    -arrowcolor [list disabled $colors(-disabledfg)]
+
+	ttk::style configure TScale \
+	    -sliderrelief raised
+	ttk::style configure TProgressbar \
+	    -background $colors(-selectbg)
+
+	ttk::style configure TNotebook.Tab \
+	    -padding {4 2} -background $colors(-darker)
+	ttk::style map TNotebook.Tab \
+	    -background [list selected $colors(-frame)]
+
+	# Treeview.
+	#
+	ttk::style configure Heading -font TkHeadingFont -relief raised
+	ttk::style configure Row -background $colors(-window)
+	ttk::style configure Cell -background $colors(-window)
+	ttk::style map Row \
+	    -background [list selected $colors(-selectbg)] \
+	    -foreground [list selected $colors(-selectfg)] ;
+	ttk::style map Cell \
+	    -background [list selected $colors(-selectbg)] \
+	    -foreground [list selected $colors(-selectfg)] ;
+	ttk::style map Item \
+	    -background [list selected $colors(-selectbg)] \
+	    -foreground [list selected $colors(-selectfg)] ;
+
+	#
+	# Toolbar buttons:
+	#
+	ttk::style layout Toolbutton {
+	    Toolbutton.border -children {
+		Toolbutton.padding -children {
+		    Toolbutton.label
+		}
+	    }
+	}
+
+	ttk::style configure Toolbutton \
+	    -padding 2 -relief flat
+	ttk::style map Toolbutton -relief \
+	    [list disabled flat selected sunken pressed sunken active raised]
+	ttk::style map Toolbutton -background \
+	    [list pressed $colors(-darker)  active $colors(-activebg)]
+    }
+}

data/pkgs/tile-0.8.2/library/dialog.tcl

@@ -0,0 +1,274 @@
+#
+# dialog.tcl,v 1.6 2007/07/10 21:53:26 jenglish Exp
+#
+# Copyright (c) 2005, Joe English.  Freely redistributable.
+#
+# Tile widget set: dialog boxes.
+#
+# TODO: option to keep dialog onscreen ("persistent" / "transient")
+# TODO: accelerator keys.
+# TODO: use message catalogs for button labels
+# TODO: routines to selectively enable/disable individual command buttons
+# TODO: use megawidgetoid API [$dlg dismiss] vs. [ttk::dialog::dismiss $dlg]
+# TODO: MAYBE: option for app-modal dialogs
+# TODO: MAYBE: [wm withdraw] dialog on dismiss instead of self-destructing 
+#
+
+package provide ttk::dialog 0.8
+
+namespace eval ttk::dialog {
+
+    variable Config
+    #
+    # Spacing parameters:
+    # (taken from GNOME HIG 2.0, may need adjustment for other platforms)
+    # (textwidth just a guess)
+    #
+    set Config(margin)		12	;# space between icon and text
+    set Config(interspace)	6	;# horizontal space between buttons
+    set Config(sepspace) 	24	;# vertical space above buttons
+    set Config(textwidth) 	400	;# width of dialog box text (pixels)
+
+    variable DialogTypes	;# map -type => list of dialog options
+    variable ButtonOptions	;# map button name => list of button options
+
+    # stockButton -- define new built-in button
+    #
+    proc stockButton {button args} {
+	variable ButtonOptions
+	set ButtonOptions($button) $args
+    }
+
+    # Built-in button types:
+    #
+    stockButton ok 	-text OK
+    stockButton cancel	-text Cancel
+    stockButton yes	-text Yes
+    stockButton no	-text No
+    stockButton retry 	-text Retry
+
+    # stockDialog -- define new dialog type.
+    #
+    proc stockDialog {type args} {
+	variable DialogTypes
+	set DialogTypes($type) $args
+    }
+
+    # Built-in dialog types:
+    #
+    stockDialog ok \
+	-icon info -buttons {ok} -default ok
+    stockDialog okcancel \
+	-icon info -buttons {ok cancel} -default ok -cancel cancel
+    stockDialog retrycancel \
+	-icon question -buttons {retry cancel} -cancel cancel
+    stockDialog yesno \
+	-icon question -buttons {yes no}
+    stockDialog yesnocancel \
+	-icon question -buttons {yes no cancel} -cancel cancel
+}
+
+## ttk::dialog::nop --
+#	Do nothing (used as a default callback command). 
+#
+proc ttk::dialog::nop {args} { }
+
+## ttk::dialog -- dialog box constructor.
+#
+interp alias {} ttk::dialog {} ttk::dialog::Constructor
+
+proc ttk::dialog::Constructor {dlg args} {
+    upvar #0 $dlg D
+    variable Config
+    variable ButtonOptions
+    variable DialogTypes
+
+    # 
+    # Option processing:
+    #
+    array set defaults {
+	-title 		""
+    	-message	""
+	-detail		""
+	-command	ttk::dialog::nop
+	-icon 		""
+	-buttons 	{}
+	-labels 	{}
+	-default 	{}
+	-cancel		{}
+	-parent		#AUTO
+    }
+
+    array set options [array get defaults]
+
+    foreach {option value} $args {
+	if {$option eq "-type"} {
+	    array set options $DialogTypes($value)
+	} elseif {![info exists options($option)]} {
+	    set validOptions [join [lsort [array names options]] ", "]
+	    return -code error \
+	    	"Illegal option $option: must be one of $validOptions"
+	}
+    }
+    array set options $args
+
+    # ...
+    #
+    array set buttonOptions [array get ::ttk::dialog::ButtonOptions]
+    foreach {button label} $options(-labels) {
+	lappend buttonOptions($button) -text $label
+    }
+
+    #
+    # Initialize dialog private data:
+    #
+    foreach option {-command -message -detail} {
+	set D($option) $options($option)
+    }
+
+    toplevel $dlg -class Dialog; wm withdraw $dlg
+
+    #
+    # Determine default transient parent.
+    #
+    # NB: menus (including menubars) are considered toplevels,
+    # so skip over those. 
+    #
+    if {$options(-parent) eq "#AUTO"} {
+	set parent [winfo toplevel [winfo parent $dlg]]
+	while {[winfo class $parent] eq "Menu" && $parent ne "."} {
+	    set parent [winfo toplevel [winfo parent $parent]]
+	}
+	set options(-parent) $parent
+    }
+
+    #
+    # Build dialog:
+    #
+    if {$options(-parent) ne ""} {
+    	wm transient $dlg $options(-parent)
+    }
+    wm title $dlg $options(-title)
+    wm protocol $dlg WM_DELETE_WINDOW { }
+
+    set f [ttk::frame $dlg.f] 
+
+    ttk::label $f.icon 
+    if {$options(-icon) ne ""} {
+	$f.icon configure -image [ttk::stockIcon dialog/$options(-icon)]
+    }
+    ttk::label $f.message -textvariable ${dlg}(-message) \
+    	-font TkCaptionFont -wraplength $Config(textwidth)\
+	-anchor w -justify left
+    ttk::label $f.detail -textvariable ${dlg}(-detail) \
+    	-font TkTextFont -wraplength $Config(textwidth) \
+	-anchor w -justify left
+
+    #
+    # Command buttons:
+    #
+    set cmd [ttk::frame $f.cmd]
+    set column 0
+    grid columnconfigure $f.cmd 0 -weight 1
+
+    foreach button $options(-buttons) {
+	incr column
+	eval [linsert $buttonOptions($button) 0 ttk::button $cmd.$button]
+        $cmd.$button configure -command [list ttk::dialog::Done $dlg $button]
+    	grid $cmd.$button -row 0 -column $column \
+	    -padx [list $Config(interspace) 0] -sticky ew
+	grid columnconfigure $cmd $column -uniform buttons
+    }
+
+    if {$options(-default) ne ""} {
+    	keynav::defaultButton $cmd.$options(-default)
+	focus $cmd.$options(-default)
+    }
+    if {$options(-cancel) ne ""} {
+	bind $dlg <KeyPress-Escape> \
+	    [list event generate $cmd.$options(-cancel) <<Invoke>>]
+	wm protocol $dlg WM_DELETE_WINDOW \
+	    [list event generate $cmd.$options(-cancel) <<Invoke>>]
+    }
+
+    #
+    # Assemble dialog.
+    #
+    pack $f.cmd -side bottom -expand false -fill x \
+    	-pady [list $Config(sepspace) $Config(margin)] -padx $Config(margin)
+
+    if {0} {
+	# GNOME and Apple HIGs say not to use separators.
+	# But in case we want them anyway:
+	#
+	pack [ttk::separator $f.sep -orient horizontal] \
+	    -side bottom -expand false -fill x \
+	    -pady [list $Config(sepspace) 0] \
+	    -padx $Config(margin)
+    }
+
+    if {$options(-icon) ne ""} {
+	pack $f.icon -side left -anchor n -expand false \
+	    -pady $Config(margin) -padx $Config(margin)
+    }
+
+    pack $f.message -side top -expand false -fill x \
+    	-padx $Config(margin) -pady $Config(margin)
+    if {$options(-detail) != ""} {
+	pack $f.detail -side top -expand false -fill x \
+	    -padx $Config(margin)
+    }
+
+    # Client area goes here.
+
+    pack $f -expand true -fill both
+    keynav::enableMnemonics $dlg
+    wm deiconify $dlg
+}
+
+## ttk::dialog::clientframe --
+#	Returns the widget path of the dialog client frame,
+#	creating and managing it if necessary.
+#
+proc ttk::dialog::clientframe {dlg} { 
+    variable Config
+    set client $dlg.f.client
+    if {![winfo exists $client]} {
+	pack [ttk::frame $client] -side top -expand true -fill both \
+		-pady $Config(margin) -padx $Config(margin)
+	lower $client	;# so it's first in keyboard traversal order
+    }
+    return $client 
+}
+
+## ttk::dialog::Done --
+#	-command callback for dialog command buttons (internal)
+#
+proc ttk::dialog::Done {dlg button} {
+    upvar #0 $dlg D
+    set rc [catch [linsert $D(-command) end $button] result]
+    if {$rc == 1} {
+    	return -code $rc -errorinfo $::errorInfo -errorcode $::errorCode $result
+    } elseif {$rc == 3 || $rc == 4} {
+	# break or continue -- don't dismiss dialog
+	return
+    }
+    dismiss $dlg
+}
+
+## ttk::dialog::activate $dlg $button --
+#	Simulate a button press.
+#
+proc ttk::dialog::activate {dlg button} {
+    event generate $dlg.f.cmd.$button <<Invoke>>
+}
+
+## dismiss --
+#	Dismiss the dialog (without invoking any actions).
+#
+proc ttk::dialog::dismiss {dlg} {
+    uplevel #0 [list unset $dlg]
+    destroy $dlg
+}
+
+#*EOF*

data/pkgs/tile-0.8.2/library/entry.tcl

@@ -0,0 +1,580 @@
+#
+# entry.tcl,v 1.15 2007/09/30 16:56:11 jenglish Exp
+#
+# DERIVED FROM: tk/library/entry.tcl r1.22
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 2004, Joe English
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+namespace eval ttk {
+    namespace eval entry {
+	variable State
+
+	set State(x) 0
+	set State(selectMode) char
+	set State(anchor) 0
+	set State(scanX) 0
+	set State(scanIndex) 0
+	set State(scanMoved) 0
+
+	# Button-2 scan speed is (scanNum/scanDen) characters
+	# per pixel of mouse movement.
+	# The standard Tk entry widget uses the equivalent of
+	# scanNum = 10, scanDen = average character width.
+	# I don't know why that was chosen.
+	#
+	set State(scanNum) 1
+	set State(scanDen) 1
+	set State(deadband) 3	;# #pixels for mouse-moved deadband.
+    }
+}
+
+### Bindings.
+#
+# Removed the following standard Tk bindings:
+#
+# <Control-Key-space>, <Control-Shift-Key-space>,
+# <Key-Select>,  <Shift-Key-Select>:
+#	Tile entry widget doesn't use selection anchor.
+# <Key-Insert>:
+#	Inserts PRIMARY selection (on non-Windows platforms).
+#	This is inconsistent with typical platform bindings.
+# <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>:
+#	These don't do the right thing to start with.
+# <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>,
+# <Meta-Key-BackSpace>, <Meta-Key-Delete>:
+#	Judgment call.  If <Meta> happens to be assigned to the Alt key,
+#	these could conflict with application accelerators.
+#	(Plus, who has a Meta key these days?)
+# <Control-Key-t>:
+#	Another judgment call.  If anyone misses this, let me know
+#	and I'll put it back.
+#
+
+## Clipboard events:
+#
+bind TEntry <<Cut>> 			{ ttk::entry::Cut %W }
+bind TEntry <<Copy>> 			{ ttk::entry::Copy %W }
+bind TEntry <<Paste>> 			{ ttk::entry::Paste %W }
+bind TEntry <<Clear>> 			{ ttk::entry::Clear %W }
+
+## Button1 bindings:
+#	Used for selection and navigation.
+#
+bind TEntry <ButtonPress-1> 		{ ttk::entry::Press %W %x }
+bind TEntry <Shift-ButtonPress-1>	{ ttk::entry::Shift-Press %W %x }
+bind TEntry <Double-ButtonPress-1> 	{ ttk::entry::Select %W %x word }
+bind TEntry <Triple-ButtonPress-1> 	{ ttk::entry::Select %W %x line }
+bind TEntry <B1-Motion>			{ ttk::entry::Drag %W %x }
+
+bind TEntry <B1-Leave> 		{ ttk::Repeatedly ttk::entry::AutoScroll %W }
+bind TEntry <B1-Enter>		{ ttk::CancelRepeat }
+bind TEntry <ButtonRelease-1>	{ ttk::CancelRepeat }
+
+bind TEntry <Control-ButtonPress-1> {
+    %W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
+}
+
+## Button2 bindings:
+#	Used for scanning and primary transfer.
+#	Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
+#
+bind TEntry <ButtonPress-2> 		{ ttk::entry::ScanMark %W %x }
+bind TEntry <B2-Motion> 		{ ttk::entry::ScanDrag %W %x }
+bind TEntry <ButtonRelease-2>		{ ttk::entry::ScanRelease %W %x }
+bind TEntry <<PasteSelection>>		{ ttk::entry::ScanRelease %W %x }
+
+## Keyboard navigation bindings:
+#
+bind TEntry <Key-Left> 			{ ttk::entry::Move %W prevchar }
+bind TEntry <Key-Right> 		{ ttk::entry::Move %W nextchar }
+bind TEntry <Control-Key-Left>		{ ttk::entry::Move %W prevword }
+bind TEntry <Control-Key-Right>		{ ttk::entry::Move %W nextword }
+bind TEntry <Key-Home>			{ ttk::entry::Move %W home }
+bind TEntry <Key-End>			{ ttk::entry::Move %W end }
+
+bind TEntry <Shift-Key-Left> 		{ ttk::entry::Extend %W prevchar }
+bind TEntry <Shift-Key-Right>		{ ttk::entry::Extend %W nextchar }
+bind TEntry <Shift-Control-Key-Left>	{ ttk::entry::Extend %W prevword }
+bind TEntry <Shift-Control-Key-Right>	{ ttk::entry::Extend %W nextword }
+bind TEntry <Shift-Key-Home>		{ ttk::entry::Extend %W home }
+bind TEntry <Shift-Key-End>		{ ttk::entry::Extend %W end }
+
+bind TEntry <Control-Key-slash> 	{ %W selection range 0 end }
+bind TEntry <Control-Key-backslash> 	{ %W selection clear }
+
+bind TEntry <<TraverseIn>> 	{ %W selection range 0 end; %W icursor end }
+
+## Edit bindings:
+#
+bind TEntry <KeyPress> 			{ ttk::entry::Insert %W %A }
+bind TEntry <Key-Delete>		{ ttk::entry::Delete %W }
+bind TEntry <Key-BackSpace> 		{ ttk::entry::Backspace %W }
+
+# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+# Otherwise, the <KeyPress> class binding will fire and insert the character.
+# Ditto for Escape, Return, and Tab.
+#
+bind TEntry <Alt-KeyPress>		{# nothing}
+bind TEntry <Meta-KeyPress>		{# nothing}
+bind TEntry <Control-KeyPress> 		{# nothing}
+bind TEntry <Key-Escape> 		{# nothing}
+bind TEntry <Key-Return> 		{# nothing}
+bind TEntry <Key-KP_Enter> 		{# nothing}
+bind TEntry <Key-Tab> 			{# nothing}
+
+# Argh.  Apparently on Windows, the NumLock modifier is interpreted
+# as a Command modifier.
+if {[tk windowingsystem] eq "aqua"} {
+    bind TEntry <Command-KeyPress>	{# nothing}
+}
+
+## Additional emacs-like bindings:
+#
+bind TEntry <Control-Key-a>		{ ttk::entry::Move %W home }
+bind TEntry <Control-Key-b>		{ ttk::entry::Move %W prevchar }
+bind TEntry <Control-Key-d> 		{ ttk::entry::Delete %W }
+bind TEntry <Control-Key-e> 		{ ttk::entry::Move %W end }
+bind TEntry <Control-Key-f> 		{ ttk::entry::Move %W nextchar }
+bind TEntry <Control-Key-h>		{ ttk::entry::Backspace %W }
+bind TEntry <Control-Key-k>		{ %W delete insert end }
+
+### Clipboard procedures.
+#
+
+## EntrySelection -- Return the selected text of the entry.
+#	Raises an error if there is no selection.
+#
+proc ttk::entry::EntrySelection {w} {
+    set entryString [string range [$w get] [$w index sel.first] \
+	    [expr {[$w index sel.last] - 1}]]
+    if {[$w cget -show] ne ""} {
+	return [string repeat [string index [$w cget -show] 0] \
+		[string length $entryString]]
+    }
+    return $entryString
+}
+
+## Paste -- Insert clipboard contents at current insert point.
+#
+proc ttk::entry::Paste {w} {
+    catch {
+	set clipboard [::tk::GetSelection $w CLIPBOARD]
+	PendingDelete $w
+	$w insert insert $clipboard
+	See $w insert
+    }
+}
+
+## Copy -- Copy selection to clipboard.
+#
+proc ttk::entry::Copy {w} {
+    if {![catch {EntrySelection $w} selection]} {
+	clipboard clear -displayof $w
+	clipboard append -displayof $w $selection
+    }
+}
+
+## Clear -- Delete the selection.
+#
+proc ttk::entry::Clear {w} {
+    catch { $w delete sel.first sel.last }
+}
+
+## Cut -- Copy selection to clipboard then delete it.
+#
+proc ttk::entry::Cut {w} {
+    Copy $w; Clear $w
+}
+
+### Navigation procedures.
+#
+
+## ClosestGap -- Find closest boundary between characters.
+# 	Returns the index of the character just after the boundary.
+#
+proc ttk::entry::ClosestGap {w x} {
+    set pos [$w index @$x]
+    set bbox [$w bbox $pos]
+    if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
+	incr pos
+    }
+    return $pos
+}
+
+## See $index -- Make sure that the character at $index is visible.
+#
+proc ttk::entry::See {w {index insert}} {
+    update idletasks	;# ensure scroll data up-to-date
+    set c [$w index $index]
+    # @@@ OR: check [$w index left] / [$w index right]
+    if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
+	$w xview $c
+    }
+}
+
+## NextWord -- Find the next word position.
+#	Note: The "next word position" follows platform conventions:
+#	either the next end-of-word position, or the start-of-word
+#	position following the next end-of-word position.
+#
+set ::ttk::entry::State(startNext) \
+	[string equal $tcl_platform(platform) "windows"]
+
+proc ttk::entry::NextWord {w start} {
+    variable State
+    set pos [tcl_endOfWord [$w get] [$w index $start]]
+    if {$pos >= 0 && $State(startNext)} {
+	set pos [tcl_startOfNextWord [$w get] $pos]
+    }
+    if {$pos < 0} {
+	return end
+    }
+    return $pos
+}
+
+## PrevWord -- Find the previous word position.
+#
+proc ttk::entry::PrevWord {w start} {
+    set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+    if {$pos < 0} {
+	return 0
+    }
+    return $pos
+}
+
+## RelIndex -- Compute character/word/line-relative index.
+#
+proc ttk::entry::RelIndex {w where {index insert}} {
+    switch -- $where {
+	prevchar	{ expr {[$w index $index] - 1} }
+    	nextchar	{ expr {[$w index $index] + 1} }
+	prevword	{ PrevWord $w $index }
+	nextword	{ NextWord $w $index }
+	home		{ return 0 }
+	end		{ $w index end }
+	default		{ error "Bad relative index $index" }
+    }
+}
+
+## Move -- Move insert cursor to relative location.
+#	Also clears the selection, if any, and makes sure
+#	that the insert cursor is visible.
+#
+proc ttk::entry::Move {w where} {
+    $w icursor [RelIndex $w $where]
+    $w selection clear
+    See $w insert
+}
+
+### Selection procedures.
+#
+
+## ExtendTo -- Extend the selection to the specified index.
+#
+# The other end of the selection (the anchor) is determined as follows:
+#
+# (1) if there is no selection, the anchor is the insert cursor;
+# (2) if the index is outside the selection, grow the selection;
+# (3) if the insert cursor is at one end of the selection, anchor the other end
+# (4) otherwise anchor the start of the selection
+#
+# The insert cursor is placed at the new end of the selection.
+#
+# Returns: selection anchor.
+#
+proc ttk::entry::ExtendTo {w index} {
+    set index [$w index $index]
+    set insert [$w index insert]
+
+    # Figure out selection anchor:
+    if {![$w selection present]} {
+    	set anchor $insert
+    } else {
+    	set selfirst [$w index sel.first]
+	set sellast  [$w index sel.last]
+
+	if {   ($index < $selfirst)
+	    || ($insert == $selfirst && $index <= $sellast)
+	} {
+	    set anchor $sellast
+	} else {
+	    set anchor $selfirst
+	}
+    }
+
+    # Extend selection:
+    if {$anchor < $index} {
+	$w selection range $anchor $index
+    } else {
+    	$w selection range $index $anchor
+    }
+
+    $w icursor $index
+    return $anchor
+}
+
+## Extend -- Extend the selection to a relative position, show insert cursor
+#
+proc ttk::entry::Extend {w where} {
+    ExtendTo $w [RelIndex $w $where]
+    See $w
+}
+
+### Button 1 binding procedures.
+#
+# Double-clicking followed by a drag enters "word-select" mode.
+# Triple-clicking enters "line-select" mode.
+#
+
+## Press -- ButtonPress-1 binding.
+#	Set the insertion cursor, claim the input focus, set up for
+#	future drag operations.
+#
+proc ttk::entry::Press {w x} {
+    variable State
+
+    $w icursor [ClosestGap $w $x]
+    $w selection clear
+    $w instate !disabled { focus $w }
+
+    # Set up for future drag, double-click, or triple-click.
+    set State(x) $x
+    set State(selectMode) char
+    set State(anchor) [$w index insert]
+}
+
+## Shift-Press -- Shift-ButtonPress-1 binding.
+#	Extends the selection, sets anchor for future drag operations.
+#
+proc ttk::entry::Shift-Press {w x} {
+    variable State
+
+    focus $w
+    set anchor [ExtendTo $w @$x]
+
+    set State(x) $x
+    set State(selectMode) char
+    set State(anchor) $anchor
+}
+
+## Select $w $x $mode -- Binding for double- and triple- clicks.
+#	Selects a word or line (according to mode),
+#	and sets the selection mode for subsequent drag operations.
+#
+proc ttk::entry::Select {w x mode} {
+    variable State
+    set cur [ClosestGap $w $x]
+
+    switch -- $mode {
+    	word	{ WordSelect $w $cur $cur }
+    	line	{ LineSelect $w $cur $cur }
+	char	{ # no-op }
+    }
+
+    set State(anchor) $cur
+    set State(selectMode) $mode
+}
+
+## Drag -- Button1 motion binding.
+#
+proc ttk::entry::Drag {w x} {
+    variable State
+    set State(x) $x
+    DragTo $w $x
+}
+
+## DragTo $w $x -- Extend selection to $x based on current selection mode.
+#
+proc ttk::entry::DragTo {w x} {
+    variable State
+
+    set cur [ClosestGap $w $x]
+    switch $State(selectMode) {
+	char { CharSelect $w $State(anchor) $cur }
+	word { WordSelect $w $State(anchor) $cur }
+	line { LineSelect $w $State(anchor) $cur }
+    }
+}
+
+## AutoScroll
+#	Called repeatedly when the mouse is outside an entry window
+#	with Button 1 down.  Scroll the window left or right,
+#	depending on where the mouse is, and extend the selection
+#	according to the current selection mode.
+#
+# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
+# TODO: Need a way for Repeat scripts to cancel themselves.
+#
+proc ttk::entry::AutoScroll {w} {
+    variable State
+    if {![winfo exists $w]} return
+    set x $State(x)
+    if {$x > [winfo width $w]} {
+	$w xview scroll 2 units
+	DragTo $w $x
+    } elseif {$x < 0} {
+	$w xview scroll -2 units
+	DragTo $w $x
+    }
+}
+
+## CharSelect -- select characters between index $from and $to
+#
+proc ttk::entry::CharSelect {w from to} {
+    if {$to <= $from} {
+	$w selection range $to $from
+    } else {
+	$w selection range $from $to
+    }
+    $w icursor $to
+}
+
+## WordSelect -- Select whole words between index $from and $to
+#
+proc ttk::entry::WordSelect {w from to} {
+    if {$to < $from} {
+	set first [WordBack [$w get] $to]
+	set last [WordForward [$w get] $from]
+	$w icursor $first
+    } else {
+	set first [WordBack [$w get] $from]
+	set last [WordForward [$w get] $to]
+	$w icursor $last
+    }
+    $w selection range $first $last
+}
+
+## WordBack, WordForward -- helper routines for WordSelect.
+#
+proc ttk::entry::WordBack {text index} {
+    if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
+    return $pos
+}
+proc ttk::entry::WordForward {text index} {
+    if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
+    return $pos
+}
+
+## LineSelect -- Select the entire line.
+#
+proc ttk::entry::LineSelect {w _ _} {
+    variable State
+    $w selection range 0 end
+    $w icursor end
+}
+
+### Button 2 binding procedures.
+#
+
+## ScanMark -- ButtonPress-2 binding.
+#	Marks the start of a scan or primary transfer operation.
+#
+proc ttk::entry::ScanMark {w x} {
+    variable State
+    set State(scanX) $x
+    set State(scanIndex) [$w index @0]
+    set State(scanMoved) 0
+}
+
+## ScanDrag -- Button2 motion binding.
+#
+proc ttk::entry::ScanDrag {w x} {
+    variable State
+
+    set dx [expr {$State(scanX) - $x}]
+    if {abs($dx) > $State(deadband)} {
+	set State(scanMoved) 1
+    }
+    set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
+    $w xview $left
+
+    if {$left != [set newLeft [$w index @0]]} {
+    	# We've scanned past one end of the entry;
+	# reset the mark so that the text will start dragging again
+	# as soon as the mouse reverses direction.
+	#
+	set State(scanX) $x
+	set State(scanIndex) $newLeft
+    }
+}
+
+## ScanRelease -- Button2 release binding.
+#	Do a primary transfer if the mouse has not moved since the button press.
+#
+proc ttk::entry::ScanRelease {w x} {
+    variable State
+    if {!$State(scanMoved)} {
+	$w instate {!disabled !readonly} {
+	    $w icursor [ClosestGap $w $x]
+	    catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
+	}
+    }
+}
+
+### Insertion and deletion procedures.
+#
+
+## PendingDelete -- Delete selection prior to insert.
+#	If the entry currently has a selection, delete it and
+#	set the insert position to where the selection was.
+#	Returns: 1 if pending delete occurred, 0 if nothing was selected.
+#
+proc ttk::entry::PendingDelete {w} {
+    if {[$w selection present]} {
+	$w icursor sel.first
+	$w delete sel.first sel.last
+	return 1
+    }
+    return 0
+}
+
+## Insert -- Insert text into the entry widget.
+#	If a selection is present, the new text replaces it.
+#	Otherwise, the new text is inserted at the insert cursor.
+#
+proc ttk::entry::Insert {w s} {
+    if {$s eq ""} { return }
+    PendingDelete $w
+    $w insert insert $s
+    See $w insert
+}
+
+## Backspace -- Backspace over the character just before the insert cursor.
+#	If there is a selection, delete that instead.
+#	If the new insert position is offscreen to the left,
+#	scroll to place the cursor at about the middle of the window.
+#
+proc ttk::entry::Backspace {w} {
+    if {[PendingDelete $w]} {
+    	See $w
+	return
+    }
+    set x [expr {[$w index insert] - 1}]
+    if {$x < 0} { return }
+
+    $w delete $x
+
+    if {[$w index @0] >= [$w index insert]} {
+	set range [$w xview]
+	set left [lindex $range 0]
+	set right [lindex $range 1]
+	$w xview moveto [expr {$left - ($right - $left)/2.0}]
+    }
+}
+
+## Delete -- Delete the character after the insert cursor.
+#	If there is a selection, delete that instead.
+#
+proc ttk::entry::Delete {w} {
+    if {![PendingDelete $w]} {
+	$w delete insert
+    }
+}
+
+#*EOF*