summaryrefslogtreecommitdiffstats
path: root/tk8.6/library/entry.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tk8.6/library/entry.tcl')
-rw-r--r--tk8.6/library/entry.tcl668
1 files changed, 668 insertions, 0 deletions
diff --git a/tk8.6/library/entry.tcl b/tk8.6/library/entry.tcl
new file mode 100644
index 0000000..0cc9ffb
--- /dev/null
+++ b/tk8.6/library/entry.tcl
@@ -0,0 +1,668 @@
+# entry.tcl --
+#
+# This file defines the default bindings for Tk entry widgets and provides
+# procedures that help in implementing those bindings.
+#
+# 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 tk::Priv 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.
+# data - Used for Cut and Copy
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+bind Entry <<Cut>> {
+ if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ %W delete sel.first sel.last
+ unset tk::Priv(data)
+ }
+}
+bind Entry <<Copy>> {
+ if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $tk::Priv(data)
+ unset tk::Priv(data)
+ }
+}
+bind Entry <<Paste>> {
+ catch {
+ if {[tk windowingsystem] ne "x11"} {
+ catch {
+ %W delete sel.first sel.last
+ }
+ }
+ %W insert insert [::tk::GetSelection %W CLIPBOARD]
+ tk::EntrySeeInsert %W
+ }
+}
+bind Entry <<Clear>> {
+ # ignore if there is no selection
+ catch { %W delete sel.first sel.last }
+}
+bind Entry <<PasteSelection>> {
+ if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
+ || !$tk::Priv(mouseMoved)} {
+ tk::EntryPaste %W %x
+ }
+}
+
+bind Entry <<TraverseIn>> {
+ %W selection range 0 end
+ %W icursor end
+}
+
+# Standard Motif bindings:
+
+bind Entry <Map> {
+ if {[tk windowingsystem] eq "aqua"} {
+ ::tk::RegisterServiceWidget %W
+ }
+}
+bind Entry <1> {
+ tk::EntryButton1 %W %x
+ %W selection clear
+}
+bind Entry <B1-Motion> {
+ set tk::Priv(x) %x
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <Double-1> {
+ set tk::Priv(selectMode) word
+ tk::EntryMouseSelect %W %x
+ catch {%W icursor sel.last}
+}
+bind Entry <Triple-1> {
+ set tk::Priv(selectMode) line
+ tk::EntryMouseSelect %W %x
+ catch {%W icursor sel.last}
+}
+bind Entry <Shift-1> {
+ set tk::Priv(selectMode) char
+ %W selection adjust @%x
+}
+bind Entry <Double-Shift-1> {
+ set tk::Priv(selectMode) word
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <Triple-Shift-1> {
+ set tk::Priv(selectMode) line
+ tk::EntryMouseSelect %W %x
+}
+bind Entry <B1-Leave> {
+ set tk::Priv(x) %x
+ tk::EntryAutoScan %W
+}
+bind Entry <B1-Enter> {
+ tk::CancelRepeat
+}
+bind Entry <ButtonRelease-1> {
+ tk::CancelRepeat
+}
+bind Entry <Control-1> {
+ %W icursor @%x
+}
+
+bind Entry <<PrevChar>> {
+ tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
+}
+bind Entry <<NextChar>> {
+ tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
+}
+bind Entry <<SelectPrevChar>> {
+ tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
+ tk::EntrySeeInsert %W
+}
+bind Entry <<SelectNextChar>> {
+ tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
+ tk::EntrySeeInsert %W
+}
+bind Entry <<PrevWord>> {
+ tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
+}
+bind Entry <<NextWord>> {
+ tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
+}
+bind Entry <<SelectPrevWord>> {
+ tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
+ tk::EntrySeeInsert %W
+}
+bind Entry <<SelectNextWord>> {
+ tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
+ tk::EntrySeeInsert %W
+}
+bind Entry <<LineStart>> {
+ tk::EntrySetCursor %W 0
+}
+bind Entry <<SelectLineStart>> {
+ tk::EntryKeySelect %W 0
+ tk::EntrySeeInsert %W
+}
+bind Entry <<LineEnd>> {
+ tk::EntrySetCursor %W end
+}
+bind Entry <<SelectLineEnd>> {
+ tk::EntryKeySelect %W end
+ tk::EntrySeeInsert %W
+}
+
+bind Entry <Delete> {
+ if {[%W selection present]} {
+ %W delete sel.first sel.last
+ } else {
+ %W delete insert
+ }
+}
+bind Entry <BackSpace> {
+ tk::EntryBackspace %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 <<SelectAll>> {
+ %W selection range 0 end
+}
+bind Entry <<SelectNone>> {
+ %W selection clear
+}
+bind Entry <KeyPress> {
+ tk::CancelRepeat
+ tk::EntryInsert %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}
+bind Entry <Prior> {# nothing}
+bind Entry <Next> {# nothing}
+if {[tk windowingsystem] eq "aqua"} {
+ bind Entry <Command-KeyPress> {# nothing}
+}
+# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
+bind Entry <<NextLine>> {# nothing}
+bind Entry <<PrevLine>> {# nothing}
+
+# On Windows, paste is done using Shift-Insert. Shift-Insert already
+# generates the <<Paste>> event, so we don't need to do anything here.
+if {[tk windowingsystem] ne "win32"} {
+ bind Entry <Insert> {
+ catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
+ }
+}
+
+# Additional emacs-like bindings:
+
+bind Entry <Control-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert
+ }
+}
+bind Entry <Control-h> {
+ if {!$tk_strictMotif} {
+ tk::EntryBackspace %W
+ }
+}
+bind Entry <Control-k> {
+ if {!$tk_strictMotif} {
+ %W delete insert end
+ }
+}
+bind Entry <Control-t> {
+ if {!$tk_strictMotif} {
+ tk::EntryTranspose %W
+ }
+}
+bind Entry <Meta-b> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
+ }
+}
+bind Entry <Meta-d> {
+ if {!$tk_strictMotif} {
+ %W delete insert [tk::EntryNextWord %W insert]
+ }
+}
+bind Entry <Meta-f> {
+ if {!$tk_strictMotif} {
+ tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
+ }
+}
+bind Entry <Meta-BackSpace> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::EntryPreviousWord %W insert] insert
+ }
+}
+bind Entry <Meta-Delete> {
+ if {!$tk_strictMotif} {
+ %W delete [tk::EntryPreviousWord %W insert] insert
+ }
+}
+
+# A few additional bindings of my own.
+
+bind Entry <2> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanMark %W %x
+ }
+}
+bind Entry <B2-Motion> {
+ if {!$tk_strictMotif} {
+ ::tk::EntryScanDrag %W %x
+ }
+}
+
+# ::tk::EntryClosestGap --
+# 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 ::tk::EntryClosestGap {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
+}
+
+# ::tk::EntryButton1 --
+# 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 ::tk::EntryButton1 {w x} {
+ variable ::tk::Priv
+
+ set Priv(selectMode) char
+ set Priv(mouseMoved) 0
+ set Priv(pressX) $x
+ $w icursor [EntryClosestGap $w $x]
+ $w selection from insert
+ if {"disabled" ne [$w cget -state]} {
+ focus $w
+ }
+}
+
+# ::tk::EntryMouseSelect --
+# 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 ::tk::EntryMouseSelect {w x} {
+ variable ::tk::Priv
+
+ set cur [EntryClosestGap $w $x]
+ set anchor [$w index anchor]
+ if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
+ set Priv(mouseMoved) 1
+ }
+ switch $Priv(selectMode) {
+ char {
+ if {$Priv(mouseMoved)} {
+ if {$cur < $anchor} {
+ $w selection range $cur $anchor
+ } elseif {$cur > $anchor} {
+ $w selection range $anchor $cur
+ } else {
+ $w selection clear
+ }
+ }
+ }
+ word {
+ if {$cur < $anchor} {
+ set before [tcl_wordBreakBefore [$w get] $cur]
+ set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
+ } elseif {$cur > $anchor} {
+ set before [tcl_wordBreakBefore [$w get] $anchor]
+ set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
+ } else {
+ if {[$w index @$Priv(pressX)] < $anchor} {
+ incr anchor -1
+ }
+ set before [tcl_wordBreakBefore [$w get] $anchor]
+ set after [tcl_wordBreakAfter [$w get] $anchor]
+ }
+ if {$before < 0} {
+ set before 0
+ }
+ if {$after < 0} {
+ set after end
+ }
+ $w selection range $before $after
+ }
+ line {
+ $w selection range 0 end
+ }
+ }
+ if {$Priv(mouseMoved)} {
+ $w icursor $cur
+ }
+ update idletasks
+}
+
+# ::tk::EntryPaste --
+# 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 ::tk::EntryPaste {w x} {
+ $w icursor [EntryClosestGap $w $x]
+ catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
+ if {"disabled" ne [$w cget -state]} {
+ focus $w
+ }
+}
+
+# ::tk::EntryAutoScan --
+# 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 ::tk::EntryAutoScan {w} {
+ variable ::tk::Priv
+ set x $Priv(x)
+ if {![winfo exists $w]} {
+ return
+ }
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ EntryMouseSelect $w $x
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ EntryMouseSelect $w $x
+ }
+ set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
+}
+
+# ::tk::EntryKeySelect --
+# 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 ::tk::EntryKeySelect {w new} {
+ if {![$w selection present]} {
+ $w selection from insert
+ $w selection to $new
+ } else {
+ $w selection adjust $new
+ }
+ $w icursor $new
+}
+
+# ::tk::EntryInsert --
+# 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 ::tk::EntryInsert {w s} {
+ if {$s eq ""} {
+ 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
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryBackspace --
+# 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 ::tk::EntryBackspace 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}]
+ }
+ }
+}
+
+# ::tk::EntrySeeInsert --
+# 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 ::tk::EntrySeeInsert w {
+ set c [$w index insert]
+ if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
+ $w xview $c
+ }
+}
+
+# ::tk::EntrySetCursor -
+# 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 ::tk::EntrySetCursor {w pos} {
+ $w icursor $pos
+ $w selection clear
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryTranspose -
+# 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 ::tk::EntryTranspose w {
+ set i [$w index insert]
+ if {$i < [$w index end]} {
+ incr i
+ }
+ set first [expr {$i-2}]
+ if {$first < 0} {
+ return
+ }
+ set data [$w get]
+ set new [string index $data [expr {$i-1}]][string index $data $first]
+ $w delete $first $i
+ $w insert insert $new
+ EntrySeeInsert $w
+}
+
+# ::tk::EntryNextWord --
+# 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 {[tk windowingsystem] eq "win32"} {
+ proc ::tk::EntryNextWord {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 ::tk::EntryNextWord {w start} {
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+ }
+}
+
+# ::tk::EntryPreviousWord --
+#
+# 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 ::tk::EntryPreviousWord {w start} {
+ set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return 0
+ }
+ return $pos
+}
+
+# ::tk::EntryScanMark --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The entry window from which the text to get
+# x - x location on screen
+
+proc ::tk::EntryScanMark {w x} {
+ $w scan mark $x
+ set ::tk::Priv(x) $x
+ set ::tk::Priv(y) 0 ; # not used
+ set ::tk::Priv(mouseMoved) 0
+}
+
+# ::tk::EntryScanDrag --
+#
+# Marks the start of a possible scan drag operation
+#
+# Arguments:
+# w - The entry window from which the text to get
+# x - x location on screen
+
+proc ::tk::EntryScanDrag {w x} {
+ # Make sure these exist, as some weird situations can trigger the
+ # motion binding without the initial press. [Bug #220269]
+ if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
+ # allow for a delta
+ if {abs($x-$::tk::Priv(x)) > 2} {
+ set ::tk::Priv(mouseMoved) 1
+ }
+ $w scan dragto $x
+}
+
+# ::tk::EntryGetSelection --
+#
+# Returns the selected text of the entry with respect to the -show option.
+#
+# Arguments:
+# w - The entry window from which the text to get
+
+proc ::tk::EntryGetSelection {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
+}
+
+
+
+
+
+
+
+
+
generated by cgit v0.12 at 2024-11-05 19:14:46 (GMT)