Initial revision

1 files changed, 607 insertions, 0 deletions

diff --git a/library/entry.tcl b/library/entry.tcl
new file mode 100644
index 0000000..4a0b764
--- /dev/null
+++ b/library/entry.tcl
@@ -0,0 +1,607 @@
+# entry.tcl --
+#
+# This file defines the default bindings for Tk entry widgets and provides
+# procedures that help in implementing those bindings.
+#
+# SCCS: @(#) entry.tcl 1.49 97/09/17 19:08:48
+#
+# Copyright (c) 1992-1994 The Regents of the University of California.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tkPriv that are used in this file:
+#
+# afterId -		If non-null, it means that auto-scanning is underway
+#			and it gives the "after" id for the next auto-scan
+#			command to be executed.
+# mouseMoved -		Non-zero means the mouse has moved a significant
+#			amount since the button went down (so, for example,
+#			start dragging out a selection).
+# pressX -		X-coordinate at which the mouse button was pressed.
+# selectMode -		The style of selection currently underway:
+#			char, word, or line.
+# x, y -		Last known mouse coordinates for scanning
+#			and auto-scanning.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+
+bind Entry <<Cut>> {
+    if {![catch {set data [string range [%W get] [%W index sel.first]\
+		 [expr [%W index sel.last] - 1]]}]} {
+	clipboard clear -displayof %W
+	clipboard append -displayof %W $data
+	%W delete sel.first sel.last
+    }
+}
+bind Entry <<Copy>> {
+    if {![catch {set data [string range [%W get] [%W index sel.first]\
+		 [expr [%W index sel.last] - 1]]}]} {
+	clipboard clear -displayof %W
+	clipboard append -displayof %W $data
+    }
+}
+bind Entry <<Paste>> {
+    global tcl_platform
+    catch {
+	if {"$tcl_platform(platform)" != "unix"} {
+	    catch {
+		%W delete sel.first sel.last
+	    }
+	}
+	%W insert insert [selection get -displayof %W -selection CLIPBOARD]
+	tkEntrySeeInsert %W
+    }
+}
+bind Entry <<Clear>> {
+    %W delete sel.first sel.last
+}
+
+# Standard Motif bindings:
+
+bind Entry <1> {
+    tkEntryButton1 %W %x
+    %W selection clear
+}
+bind Entry <B1-Motion> {
+    set tkPriv(x) %x
+    tkEntryMouseSelect %W %x
+}
+bind Entry <Double-1> {
+    set tkPriv(selectMode) word
+    tkEntryMouseSelect %W %x
+    catch {%W icursor sel.first}
+}
+bind Entry <Triple-1> {
+    set tkPriv(selectMode) line
+    tkEntryMouseSelect %W %x
+    %W icursor 0
+}
+bind Entry <Shift-1> {
+    set tkPriv(selectMode) char
+    %W selection adjust @%x
+}
+bind Entry <Double-Shift-1>	{
+    set tkPriv(selectMode) word
+    tkEntryMouseSelect %W %x
+}
+bind Entry <Triple-Shift-1>	{
+    set tkPriv(selectMode) line
+    tkEntryMouseSelect %W %x
+}
+bind Entry <B1-Leave> {
+    set tkPriv(x) %x
+    tkEntryAutoScan %W
+}
+bind Entry <B1-Enter> {
+    tkCancelRepeat
+}
+bind Entry <ButtonRelease-1> {
+    tkCancelRepeat
+}
+bind Entry <Control-1> {
+    %W icursor @%x
+}
+bind Entry <ButtonRelease-2> {
+    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
+	tkEntryPaste %W %x
+    }
+}
+
+bind Entry <Left> {
+    tkEntrySetCursor %W [expr [%W index insert] - 1]
+}
+bind Entry <Right> {
+    tkEntrySetCursor %W [expr [%W index insert] + 1]
+}
+bind Entry <Shift-Left> {
+    tkEntryKeySelect %W [expr [%W index insert] - 1]
+    tkEntrySeeInsert %W
+}
+bind Entry <Shift-Right> {
+    tkEntryKeySelect %W [expr [%W index insert] + 1]
+    tkEntrySeeInsert %W
+}
+bind Entry <Control-Left> {
+    tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
+}
+bind Entry <Control-Right> {
+    tkEntrySetCursor %W [tkEntryNextWord %W insert]
+}
+bind Entry <Shift-Control-Left> {
+    tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
+    tkEntrySeeInsert %W
+}
+bind Entry <Shift-Control-Right> {
+    tkEntryKeySelect %W [tkEntryNextWord %W insert]
+    tkEntrySeeInsert %W
+}
+bind Entry <Home> {
+    tkEntrySetCursor %W 0
+}
+bind Entry <Shift-Home> {
+    tkEntryKeySelect %W 0
+    tkEntrySeeInsert %W
+}
+bind Entry <End> {
+    tkEntrySetCursor %W end
+}
+bind Entry <Shift-End> {
+    tkEntryKeySelect %W end
+    tkEntrySeeInsert %W
+}
+
+bind Entry <Delete> {
+    if [%W selection present] {
+	%W delete sel.first sel.last
+    } else {
+	%W delete insert
+    }
+}
+bind Entry <BackSpace> {
+    tkEntryBackspace %W
+}
+
+bind Entry <Control-space> {
+    %W selection from insert
+}
+bind Entry <Select> {
+    %W selection from insert
+}
+bind Entry <Control-Shift-space> {
+    %W selection adjust insert
+}
+bind Entry <Shift-Select> {
+    %W selection adjust insert
+}
+bind Entry <Control-slash> {
+    %W selection range 0 end
+}
+bind Entry <Control-backslash> {
+    %W selection clear
+}
+bind Entry <KeyPress> {
+    tkEntryInsert %W %A
+}
+
+# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
+# Otherwise, if a widget binding for one of these is defined, the
+# <KeyPress> class binding will also fire and insert the character,
+# which is wrong.  Ditto for Escape, Return, and Tab.
+
+bind Entry <Alt-KeyPress> {# nothing}
+bind Entry <Meta-KeyPress> {# nothing}
+bind Entry <Control-KeyPress> {# nothing}
+bind Entry <Escape> {# nothing}
+bind Entry <Return> {# nothing}
+bind Entry <KP_Enter> {# nothing}
+bind Entry <Tab> {# nothing}
+if {$tcl_platform(platform) == "macintosh"} {
+	bind Entry <Command-KeyPress> {# nothing}
+}
+
+bind Entry <Insert> {
+    catch {tkEntryInsert %W [selection get -displayof %W]}
+}
+
+# Additional emacs-like bindings:
+
+bind Entry <Control-a> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W 0
+    }
+}
+bind Entry <Control-b> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W [expr [%W index insert] - 1]
+    }
+}
+bind Entry <Control-d> {
+    if !$tk_strictMotif {
+	%W delete insert
+    }
+}
+bind Entry <Control-e> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W end
+    }
+}
+bind Entry <Control-f> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W [expr [%W index insert] + 1]
+    }
+}
+bind Entry <Control-h> {
+    if !$tk_strictMotif {
+	tkEntryBackspace %W
+    }
+}
+bind Entry <Control-k> {
+    if !$tk_strictMotif {
+	%W delete insert end
+    }
+}
+bind Entry <Control-t> {
+    if !$tk_strictMotif {
+	tkEntryTranspose %W
+    }
+}
+bind Entry <Meta-b> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W [tkEntryPreviousWord %W insert]
+    }
+}
+bind Entry <Meta-d> {
+    if !$tk_strictMotif {
+	%W delete insert [tkEntryNextWord %W insert]
+    }
+}
+bind Entry <Meta-f> {
+    if !$tk_strictMotif {
+	tkEntrySetCursor %W [tkEntryNextWord %W insert]
+    }
+}
+bind Entry <Meta-BackSpace> {
+    if !$tk_strictMotif {
+	%W delete [tkEntryPreviousWord %W insert] insert
+    }
+}
+bind Entry <Meta-Delete> {
+    if !$tk_strictMotif {
+	%W delete [tkEntryPreviousWord %W insert] insert
+    }
+}
+
+# A few additional bindings of my own.
+
+bind Entry <2> {
+    if !$tk_strictMotif {
+	%W scan mark %x
+	set tkPriv(x) %x
+	set tkPriv(y) %y
+	set tkPriv(mouseMoved) 0
+    }
+}
+bind Entry <B2-Motion> {
+    if !$tk_strictMotif {
+	if {abs(%x-$tkPriv(x)) > 2} {
+	    set tkPriv(mouseMoved) 1
+	}
+	%W scan dragto %x
+    }
+}
+
+# tkEntryClosestGap --
+# Given x and y coordinates, this procedure finds the closest boundary
+# between characters to the given coordinates and returns the index
+# of the character just after the boundary.
+#
+# Arguments:
+# w -		The entry window.
+# x -		X-coordinate within the window.
+
+proc tkEntryClosestGap {w x} {
+    set pos [$w index @$x]
+    set bbox [$w bbox $pos]
+    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
+	return $pos
+    }
+    incr pos
+}
+
+# tkEntryButton1 --
+# This procedure is invoked to handle button-1 presses in entry
+# widgets.  It moves the insertion cursor, sets the selection anchor,
+# and claims the input focus.
+#
+# Arguments:
+# w -		The entry window in which the button was pressed.
+# x -		The x-coordinate of the button press.
+
+proc tkEntryButton1 {w x} {
+    global tkPriv
+
+    set tkPriv(selectMode) char
+    set tkPriv(mouseMoved) 0
+    set tkPriv(pressX) $x
+    $w icursor [tkEntryClosestGap $w $x]
+    $w selection from insert
+    if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
+}
+
+# tkEntryMouseSelect --
+# This procedure is invoked when dragging out a selection with
+# the mouse.  Depending on the selection mode (character, word,
+# line) it selects in different-sized units.  This procedure
+# ignores mouse motions initially until the mouse has moved from
+# one character to another or until there have been multiple clicks.
+#
+# Arguments:
+# w -		The entry window in which the button was pressed.
+# x -		The x-coordinate of the mouse.
+
+proc tkEntryMouseSelect {w x} {
+    global tkPriv
+
+    set cur [tkEntryClosestGap $w $x]
+    set anchor [$w index anchor]
+    if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
+	set tkPriv(mouseMoved) 1
+    }
+    switch $tkPriv(selectMode) {
+	char {
+	    if $tkPriv(mouseMoved) {
+		if {$cur < $anchor} {
+		    $w selection range $cur $anchor
+		} elseif {$cur > $anchor} {
+		    $w selection range $anchor $cur
+		} else {
+		    $w selection clear
+		}
+	    }
+	}
+	word {
+	    if {$cur < [$w index anchor]} {
+		set before [tcl_wordBreakBefore [$w get] $cur]
+		set after [tcl_wordBreakAfter [$w get] [expr $anchor-1]]
+	    } else {
+		set before [tcl_wordBreakBefore [$w get] $anchor]
+		set after [tcl_wordBreakAfter [$w get] [expr $cur - 1]]
+	    }
+	    if {$before < 0} {
+		set before 0
+	    }
+	    if {$after < 0} {
+		set after end
+	    }
+	    $w selection range $before $after
+	}
+	line {
+	    $w selection range 0 end
+	}
+    }
+    update idletasks
+}
+
+# tkEntryPaste --
+# This procedure sets the insertion cursor to the current mouse position,
+# pastes the selection there, and sets the focus to the window.
+#
+# Arguments:
+# w -		The entry window.
+# x -		X position of the mouse.
+
+proc tkEntryPaste {w x} {
+    global tkPriv
+
+    $w icursor [tkEntryClosestGap $w $x]
+    catch {$w insert insert [selection get -displayof $w]}
+    if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
+}
+
+# tkEntryAutoScan --
+# This procedure is invoked when the mouse leaves an entry window
+# with button 1 down.  It scrolls the window left or right,
+# depending on where the mouse is, and reschedules itself as an
+# "after" command so that the window continues to scroll until the
+# mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w -		The entry window.
+
+proc tkEntryAutoScan {w} {
+    global tkPriv
+    set x $tkPriv(x)
+    if {![winfo exists $w]} return
+    if {$x >= [winfo width $w]} {
+	$w xview scroll 2 units
+	tkEntryMouseSelect $w $x
+    } elseif {$x < 0} {
+	$w xview scroll -2 units
+	tkEntryMouseSelect $w $x
+    }
+    set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
+}
+
+# tkEntryKeySelect --
+# This procedure is invoked when stroking out selections using the
+# keyboard.  It moves the cursor to a new position, then extends
+# the selection to that position.
+#
+# Arguments:
+# w -		The entry window.
+# new -		A new position for the insertion cursor (the cursor hasn't
+#		actually been moved to this position yet).
+
+proc tkEntryKeySelect {w new} {
+    if ![$w selection present] {
+	$w selection from insert
+	$w selection to $new
+    } else {
+	$w selection adjust $new
+    }
+    $w icursor $new
+}
+
+# tkEntryInsert --
+# Insert a string into an entry at the point of the insertion cursor.
+# If there is a selection in the entry, and it covers the point of the
+# insertion cursor, then delete the selection before inserting.
+#
+# Arguments:
+# w -		The entry window in which to insert the string
+# s -		The string to insert (usually just a single character)
+
+proc tkEntryInsert {w s} {
+    if {$s == ""} {
+	return
+    }
+    catch {
+	set insert [$w index insert]
+	if {([$w index sel.first] <= $insert)
+		&& ([$w index sel.last] >= $insert)} {
+	    $w delete sel.first sel.last
+	}
+    }
+    $w insert insert $s
+    tkEntrySeeInsert $w
+}
+
+# tkEntryBackspace --
+# Backspace over the character just before the insertion cursor.
+# If backspacing would move the cursor off the left edge of the
+# window, reposition the cursor at about the middle of the window.
+#
+# Arguments:
+# w -		The entry window in which to backspace.
+
+proc tkEntryBackspace w {
+    if [$w selection present] {
+	$w delete sel.first sel.last
+    } else {
+	set x [expr {[$w index insert] - 1}]
+	if {$x >= 0} {$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]
+	}
+    }
+}
+
+# tkEntrySeeInsert --
+# Make sure that the insertion cursor is visible in the entry window.
+# If not, adjust the view so that it is.
+#
+# Arguments:
+# w -		The entry window.
+
+proc tkEntrySeeInsert w {
+    set c [$w index insert]
+    set left [$w index @0]
+    if {$left > $c} {
+	$w xview $c
+	return
+    }
+    set x [winfo width $w]
+    while {([$w index @$x] <= $c) && ($left < $c)} {
+	incr left
+	$w xview $left
+    }
+}
+
+# tkEntrySetCursor -
+# Move the insertion cursor to a given position in an entry.  Also
+# clears the selection, if there is one in the entry, and makes sure
+# that the insertion cursor is visible.
+#
+# Arguments:
+# w -		The entry window.
+# pos -		The desired new position for the cursor in the window.
+
+proc tkEntrySetCursor {w pos} {
+    $w icursor $pos
+    $w selection clear
+    tkEntrySeeInsert $w
+}
+
+# tkEntryTranspose -
+# This procedure implements the "transpose" function for entry widgets.
+# It tranposes the characters on either side of the insertion cursor,
+# unless the cursor is at the end of the line.  In this case it
+# transposes the two characters to the left of the cursor.  In either
+# case, the cursor ends up to the right of the transposed characters.
+#
+# Arguments:
+# w -		The entry window.
+
+proc tkEntryTranspose w {
+    set i [$w index insert]
+    if {$i < [$w index end]} {
+	incr i
+    }
+    set first [expr $i-2]
+    if {$first < 0} {
+	return
+    }
+    set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
+    $w delete $first $i
+    $w insert insert $new
+    tkEntrySeeInsert $w
+}
+
+# tkEntryNextWord --
+# Returns the index of the next word position after a given position in the
+# entry.  The next word is platform dependent and may be either the next
+# end-of-word position or the next start-of-word position after the next
+# end-of-word position.
+#
+# Arguments:
+# w -		The entry window in which the cursor is to move.
+# start -	Position at which to start search.
+
+if {$tcl_platform(platform) == "windows"}  {
+    proc tkEntryNextWord {w start} {
+	set pos [tcl_endOfWord [$w get] [$w index $start]]
+	if {$pos >= 0} {
+	    set pos [tcl_startOfNextWord [$w get] $pos]
+	}
+	if {$pos < 0} {
+	    return end
+	}
+	return $pos
+    }
+} else {
+    proc tkEntryNextWord {w start} {
+	set pos [tcl_endOfWord [$w get] [$w index $start]]
+	if {$pos < 0} {
+	    return end
+	}
+	return $pos
+    }
+}
+
+# tkEntryPreviousWord --
+#
+# Returns the index of the previous word position before a given
+# position in the entry.
+#
+# Arguments:
+# w -		The entry window in which the cursor is to move.
+# start -	Position at which to start search.
+
+proc tkEntryPreviousWord {w start} {
+    set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+    if {$pos < 0} {
+	return 0
+    }
+    return $pos
+}
+