123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654 |
- # 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 <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
- }
|