1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204 |
- # text.tcl --
- #
- # This file defines the default bindings for Tk text widgets and provides
- # procedures that help in implementing the bindings.
- #
- # Copyright (c) 1992-1994 The Regents of the University of California.
- # Copyright (c) 1994-1997 Sun Microsystems, Inc.
- # Copyright (c) 1998 by Scriptics Corporation.
- #
- # 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.
- # char - Character position on the line; kept in order
- # to allow moving up or down past short lines while
- # still remembering the desired position.
- # mouseMoved - Non-zero means the mouse has moved a significant
- # amount since the button went down (so, for example,
- # start dragging out a selection).
- # prevPos - Used when moving up or down lines via the keyboard.
- # Keeps track of the previous insert position, so
- # we can distinguish a series of ups and downs, all
- # in a row, from a new up or down.
- # 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 text widgets.
- #-------------------------------------------------------------------------
- # Standard Motif bindings:
- bind Text <1> {
- tk::TextButton1 %W %x %y
- %W tag remove sel 0.0 end
- }
- bind Text <B1-Motion> {
- set tk::Priv(x) %x
- set tk::Priv(y) %y
- tk::TextSelectTo %W %x %y
- }
- bind Text <Double-1> {
- set tk::Priv(selectMode) word
- tk::TextSelectTo %W %x %y
- catch {%W mark set insert sel.first}
- }
- bind Text <Triple-1> {
- set tk::Priv(selectMode) line
- tk::TextSelectTo %W %x %y
- catch {%W mark set insert sel.first}
- }
- bind Text <Shift-1> {
- tk::TextResetAnchor %W @%x,%y
- set tk::Priv(selectMode) char
- tk::TextSelectTo %W %x %y
- }
- bind Text <Double-Shift-1> {
- set tk::Priv(selectMode) word
- tk::TextSelectTo %W %x %y 1
- }
- bind Text <Triple-Shift-1> {
- set tk::Priv(selectMode) line
- tk::TextSelectTo %W %x %y
- }
- bind Text <B1-Leave> {
- set tk::Priv(x) %x
- set tk::Priv(y) %y
- tk::TextAutoScan %W
- }
- bind Text <B1-Enter> {
- tk::CancelRepeat
- }
- bind Text <ButtonRelease-1> {
- tk::CancelRepeat
- }
- bind Text <Control-1> {
- %W mark set insert @%x,%y
- # An operation that moves the insert mark without making it
- # one end of the selection must insert an autoseparator
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- }
- # stop an accidental double click triggering <Double-Button-1>
- bind Text <Double-Control-1> { # nothing }
- # stop an accidental movement triggering <B1-Motion>
- bind Text <Control-B1-Motion> { # nothing }
- bind Text <<PrevChar>> {
- tk::TextSetCursor %W insert-1displayindices
- }
- bind Text <<NextChar>> {
- tk::TextSetCursor %W insert+1displayindices
- }
- bind Text <<PrevLine>> {
- tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
- }
- bind Text <<NextLine>> {
- tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
- }
- bind Text <<SelectPrevChar>> {
- tk::TextKeySelect %W [%W index {insert - 1displayindices}]
- }
- bind Text <<SelectNextChar>> {
- tk::TextKeySelect %W [%W index {insert + 1displayindices}]
- }
- bind Text <<SelectPrevLine>> {
- tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
- }
- bind Text <<SelectNextLine>> {
- tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
- }
- bind Text <<PrevWord>> {
- tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
- }
- bind Text <<NextWord>> {
- tk::TextSetCursor %W [tk::TextNextWord %W insert]
- }
- bind Text <<PrevPara>> {
- tk::TextSetCursor %W [tk::TextPrevPara %W insert]
- }
- bind Text <<NextPara>> {
- tk::TextSetCursor %W [tk::TextNextPara %W insert]
- }
- bind Text <<SelectPrevWord>> {
- tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
- }
- bind Text <<SelectNextWord>> {
- tk::TextKeySelect %W [tk::TextNextWord %W insert]
- }
- bind Text <<SelectPrevPara>> {
- tk::TextKeySelect %W [tk::TextPrevPara %W insert]
- }
- bind Text <<SelectNextPara>> {
- tk::TextKeySelect %W [tk::TextNextPara %W insert]
- }
- bind Text <Prior> {
- tk::TextSetCursor %W [tk::TextScrollPages %W -1]
- }
- bind Text <Shift-Prior> {
- tk::TextKeySelect %W [tk::TextScrollPages %W -1]
- }
- bind Text <Next> {
- tk::TextSetCursor %W [tk::TextScrollPages %W 1]
- }
- bind Text <Shift-Next> {
- tk::TextKeySelect %W [tk::TextScrollPages %W 1]
- }
- bind Text <Control-Prior> {
- %W xview scroll -1 page
- }
- bind Text <Control-Next> {
- %W xview scroll 1 page
- }
- bind Text <<LineStart>> {
- tk::TextSetCursor %W {insert display linestart}
- }
- bind Text <<SelectLineStart>> {
- tk::TextKeySelect %W {insert display linestart}
- }
- bind Text <<LineEnd>> {
- tk::TextSetCursor %W {insert display lineend}
- }
- bind Text <<SelectLineEnd>> {
- tk::TextKeySelect %W {insert display lineend}
- }
- bind Text <Control-Home> {
- tk::TextSetCursor %W 1.0
- }
- bind Text <Control-Shift-Home> {
- tk::TextKeySelect %W 1.0
- }
- bind Text <Control-End> {
- tk::TextSetCursor %W {end - 1 indices}
- }
- bind Text <Control-Shift-End> {
- tk::TextKeySelect %W {end - 1 indices}
- }
- bind Text <Tab> {
- if {[%W cget -state] eq "normal"} {
- tk::TextInsert %W \t
- focus %W
- break
- }
- }
- bind Text <Shift-Tab> {
- # Needed only to keep <Tab> binding from triggering; doesn't
- # have to actually do anything.
- break
- }
- bind Text <Control-Tab> {
- focus [tk_focusNext %W]
- }
- bind Text <Control-Shift-Tab> {
- focus [tk_focusPrev %W]
- }
- bind Text <Control-i> {
- tk::TextInsert %W \t
- }
- bind Text <Return> {
- tk::TextInsert %W \n
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- }
- bind Text <Delete> {
- if {[tk::TextCursorInSelection %W]} {
- %W delete sel.first sel.last
- } else {
- if {[%W compare end != insert+1c]} {
- %W delete insert
- }
- %W see insert
- }
- }
- bind Text <BackSpace> {
- if {[tk::TextCursorInSelection %W]} {
- %W delete sel.first sel.last
- } else {
- if {[%W compare insert != 1.0]} {
- %W delete insert-1c
- }
- %W see insert
- }
- }
- bind Text <Control-space> {
- %W mark set [tk::TextAnchor %W] insert
- }
- bind Text <Select> {
- %W mark set [tk::TextAnchor %W] insert
- }
- bind Text <Control-Shift-space> {
- set tk::Priv(selectMode) char
- tk::TextKeyExtend %W insert
- }
- bind Text <Shift-Select> {
- set tk::Priv(selectMode) char
- tk::TextKeyExtend %W insert
- }
- bind Text <<SelectAll>> {
- %W tag add sel 1.0 end
- }
- bind Text <<SelectNone>> {
- %W tag remove sel 1.0 end
- # An operation that clears the selection must insert an autoseparator,
- # because the selection operation may have moved the insert mark
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- }
- bind Text <<Cut>> {
- tk_textCut %W
- }
- bind Text <<Copy>> {
- tk_textCopy %W
- }
- bind Text <<Paste>> {
- tk_textPaste %W
- }
- bind Text <<Clear>> {
- # Make <<Clear>> an atomic operation on the Undo stack,
- # i.e. separate it from other delete operations on either side
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- catch {%W delete sel.first sel.last}
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- }
- bind Text <<PasteSelection>> {
- if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
- || !$tk::Priv(mouseMoved)} {
- tk::TextPasteSelection %W %x %y
- }
- }
- bind Text <Insert> {
- catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
- }
- bind Text <KeyPress> {
- tk::TextInsert %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>.
- bind Text <Alt-KeyPress> {# nothing }
- bind Text <Meta-KeyPress> {# nothing}
- bind Text <Control-KeyPress> {# nothing}
- bind Text <Escape> {# nothing}
- bind Text <KP_Enter> {# nothing}
- if {[tk windowingsystem] eq "aqua"} {
- bind Text <Command-KeyPress> {# nothing}
- }
- # Additional emacs-like bindings:
- bind Text <Control-d> {
- if {!$tk_strictMotif && [%W compare end != insert+1c]} {
- %W delete insert
- }
- }
- bind Text <Control-k> {
- if {!$tk_strictMotif && [%W compare end != insert+1c]} {
- if {[%W compare insert == {insert lineend}]} {
- %W delete insert
- } else {
- %W delete insert {insert lineend}
- }
- }
- }
- bind Text <Control-o> {
- if {!$tk_strictMotif} {
- %W insert insert \n
- %W mark set insert insert-1c
- }
- }
- bind Text <Control-t> {
- if {!$tk_strictMotif} {
- tk::TextTranspose %W
- }
- }
- bind Text <<Undo>> {
- # An Undo operation may remove the separator at the top of the Undo stack.
- # Then the item at the top of the stack gets merged with the subsequent changes.
- # Place separators before and after Undo to prevent this.
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- catch { %W edit undo }
- if {[%W cget -autoseparators]} {
- %W edit separator
- }
- }
- bind Text <<Redo>> {
- catch { %W edit redo }
- }
- bind Text <Meta-b> {
- if {!$tk_strictMotif} {
- tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
- }
- }
- bind Text <Meta-d> {
- if {!$tk_strictMotif && [%W compare end != insert+1c]} {
- %W delete insert [tk::TextNextWord %W insert]
- }
- }
- bind Text <Meta-f> {
- if {!$tk_strictMotif} {
- tk::TextSetCursor %W [tk::TextNextWord %W insert]
- }
- }
- bind Text <Meta-less> {
- if {!$tk_strictMotif} {
- tk::TextSetCursor %W 1.0
- }
- }
- bind Text <Meta-greater> {
- if {!$tk_strictMotif} {
- tk::TextSetCursor %W end-1c
- }
- }
- bind Text <Meta-BackSpace> {
- if {!$tk_strictMotif} {
- %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
- }
- }
- bind Text <Meta-Delete> {
- if {!$tk_strictMotif} {
- %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
- }
- }
- # Macintosh only bindings:
- if {[tk windowingsystem] eq "aqua"} {
- bind Text <Control-v> {
- tk::TextScrollPages %W 1
- }
- # End of Mac only bindings
- }
- # A few additional bindings of my own.
- bind Text <Control-h> {
- if {!$tk_strictMotif && [%W compare insert != 1.0]} {
- %W delete insert-1c
- %W see insert
- }
- }
- bind Text <2> {
- if {!$tk_strictMotif} {
- tk::TextScanMark %W %x %y
- }
- }
- bind Text <B2-Motion> {
- if {!$tk_strictMotif} {
- tk::TextScanDrag %W %x %y
- }
- }
- set ::tk::Priv(prevPos) {}
- # The MouseWheel will typically only fire on Windows and MacOS X.
- # However, someone could use the "event generate" command to produce one
- # on other platforms. We must be careful not to round -ve values of %D
- # down to zero.
- if {[tk windowingsystem] eq "aqua"} {
- bind Text <MouseWheel> {
- %W yview scroll [expr {-15 * (%D)}] pixels
- }
- bind Text <Option-MouseWheel> {
- %W yview scroll [expr {-150 * (%D)}] pixels
- }
- bind Text <Shift-MouseWheel> {
- %W xview scroll [expr {-15 * (%D)}] pixels
- }
- bind Text <Shift-Option-MouseWheel> {
- %W xview scroll [expr {-150 * (%D)}] pixels
- }
- } else {
- # We must make sure that positive and negative movements are rounded
- # equally to integers, avoiding the problem that
- # (int)1/3 = 0,
- # but
- # (int)-1/3 = -1
- # The following code ensure equal +/- behaviour.
- bind Text <MouseWheel> {
- if {%D >= 0} {
- %W yview scroll [expr {-%D/3}] pixels
- } else {
- %W yview scroll [expr {(2-%D)/3}] pixels
- }
- }
- bind Text <Shift-MouseWheel> {
- if {%D >= 0} {
- %W xview scroll [expr {-%D/3}] pixels
- } else {
- %W xview scroll [expr {(2-%D)/3}] pixels
- }
- }
- }
- if {"x11" eq [tk windowingsystem]} {
- # Support for mousewheels on Linux/Unix commonly comes through mapping
- # the wheel to the extended buttons. If you have a mousewheel, find
- # Linux configuration info at:
- # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
- bind Text <4> {
- if {!$tk_strictMotif} {
- %W yview scroll -50 pixels
- }
- }
- bind Text <5> {
- if {!$tk_strictMotif} {
- %W yview scroll 50 pixels
- }
- }
- bind Text <Shift-4> {
- if {!$tk_strictMotif} {
- %W xview scroll -50 pixels
- }
- }
- bind Text <Shift-5> {
- if {!$tk_strictMotif} {
- %W xview scroll 50 pixels
- }
- }
- }
- # ::tk::TextClosestGap --
- # 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 text window.
- # x - X-coordinate within the window.
- # y - Y-coordinate within the window.
- proc ::tk::TextClosestGap {w x y} {
- set pos [$w index @$x,$y]
- set bbox [$w bbox $pos]
- if {$bbox eq ""} {
- return $pos
- }
- if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
- return $pos
- }
- $w index "$pos + 1 char"
- }
- # ::tk::TextButton1 --
- # This procedure is invoked to handle button-1 presses in text
- # widgets. It moves the insertion cursor, sets the selection anchor,
- # and claims the input focus.
- #
- # Arguments:
- # w - The text window in which the button was pressed.
- # x - The x-coordinate of the button press.
- # y - The x-coordinate of the button press.
- proc ::tk::TextButton1 {w x y} {
- variable ::tk::Priv
- set Priv(selectMode) char
- set Priv(mouseMoved) 0
- set Priv(pressX) $x
- set anchorname [tk::TextAnchor $w]
- $w mark set insert [TextClosestGap $w $x $y]
- $w mark set $anchorname insert
- # Set the anchor mark's gravity depending on the click position
- # relative to the gap
- set bbox [$w bbox [$w index $anchorname]]
- if {$x > [lindex $bbox 0]} {
- $w mark gravity $anchorname right
- } else {
- $w mark gravity $anchorname left
- }
- # Allow focus in any case on Windows, because that will let the
- # selection be displayed even for state disabled text widgets.
- if {[tk windowingsystem] eq "win32" \
- || [$w cget -state] eq "normal"} {
- focus $w
- }
- if {[$w cget -autoseparators]} {
- $w edit separator
- }
- }
- # ::tk::TextSelectTo --
- # This procedure is invoked to extend the selection, typically when
- # dragging it 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.
- #
- # Note that the 'anchor' is implemented programmatically using
- # a text widget mark, and uses a name that will be unique for each
- # text widget (even when there are multiple peers). Currently the
- # anchor is considered private to Tk, hence the name 'tk::anchor$w'.
- #
- # Arguments:
- # w - The text window in which the button was pressed.
- # x - Mouse x position.
- # y - Mouse y position.
- set ::tk::Priv(textanchoruid) 0
- proc ::tk::TextAnchor {w} {
- variable Priv
- if {![info exists Priv(textanchor,$w)]} {
- set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
- }
- return $Priv(textanchor,$w)
- }
- proc ::tk::TextSelectTo {w x y {extend 0}} {
- variable ::tk::Priv
- set anchorname [tk::TextAnchor $w]
- set cur [TextClosestGap $w $x $y]
- if {[catch {$w index $anchorname}]} {
- $w mark set $anchorname $cur
- }
- set anchor [$w index $anchorname]
- if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
- set Priv(mouseMoved) 1
- }
- switch -- $Priv(selectMode) {
- char {
- if {[$w compare $cur < $anchorname]} {
- set first $cur
- set last $anchorname
- } else {
- set first $anchorname
- set last $cur
- }
- }
- word {
- # Set initial range based only on the anchor (1 char min width)
- if {[$w mark gravity $anchorname] eq "right"} {
- set first $anchorname
- set last "$anchorname + 1c"
- } else {
- set first "$anchorname - 1c"
- set last $anchorname
- }
- # Extend range (if necessary) based on the current point
- if {[$w compare $cur < $first]} {
- set first $cur
- } elseif {[$w compare $cur > $last]} {
- set last $cur
- }
- # Now find word boundaries
- set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
- set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
- }
- line {
- # Set initial range based only on the anchor
- set first "$anchorname linestart"
- set last "$anchorname lineend"
- # Extend range (if necessary) based on the current point
- if {[$w compare $cur < $first]} {
- set first "$cur linestart"
- } elseif {[$w compare $cur > $last]} {
- set last "$cur lineend"
- }
- set first [$w index $first]
- set last [$w index "$last + 1c"]
- }
- }
- if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
- $w tag remove sel 0.0 end
- $w mark set insert $cur
- $w tag add sel $first $last
- $w tag remove sel $last end
- update idletasks
- }
- }
- # ::tk::TextKeyExtend --
- # This procedure handles extending the selection from the keyboard,
- # where the point to extend to is really the boundary between two
- # characters rather than a particular character.
- #
- # Arguments:
- # w - The text window.
- # index - The point to which the selection is to be extended.
- proc ::tk::TextKeyExtend {w index} {
- set anchorname [tk::TextAnchor $w]
- set cur [$w index $index]
- if {[catch {$w index $anchorname}]} {
- $w mark set $anchorname $cur
- }
- set anchor [$w index $anchorname]
- if {[$w compare $cur < $anchorname]} {
- set first $cur
- set last $anchorname
- } else {
- set first $anchorname
- set last $cur
- }
- $w tag remove sel 0.0 $first
- $w tag add sel $first $last
- $w tag remove sel $last end
- }
- # ::tk::TextPasteSelection --
- # This procedure sets the insertion cursor to the mouse position,
- # inserts the selection, and sets the focus to the window.
- #
- # Arguments:
- # w - The text window.
- # x, y - Position of the mouse.
- proc ::tk::TextPasteSelection {w x y} {
- $w mark set insert [TextClosestGap $w $x $y]
- if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
- set oldSeparator [$w cget -autoseparators]
- if {$oldSeparator} {
- $w configure -autoseparators 0
- $w edit separator
- }
- $w insert insert $sel
- if {$oldSeparator} {
- $w edit separator
- $w configure -autoseparators 1
- }
- }
- if {[$w cget -state] eq "normal"} {
- focus $w
- }
- }
- # ::tk::TextAutoScan --
- # This procedure is invoked when the mouse leaves a text window
- # with button 1 down. It scrolls the window up, down, left, or right,
- # depending on where the mouse is (this information was saved in
- # ::tk::Priv(x) and ::tk::Priv(y)), 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 text window.
- proc ::tk::TextAutoScan {w} {
- variable ::tk::Priv
- if {![winfo exists $w]} {
- return
- }
- if {$Priv(y) >= [winfo height $w]} {
- $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
- } elseif {$Priv(y) < 0} {
- $w yview scroll [expr {-1 + $Priv(y)}] pixels
- } elseif {$Priv(x) >= [winfo width $w]} {
- $w xview scroll 2 units
- } elseif {$Priv(x) < 0} {
- $w xview scroll -2 units
- } else {
- return
- }
- TextSelectTo $w $Priv(x) $Priv(y)
- set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
- }
- # ::tk::TextSetCursor
- # Move the insertion cursor to a given position in a text. Also
- # clears the selection, if there is one in the text, and makes sure
- # that the insertion cursor is visible. Also, don't let the insertion
- # cursor appear on the dummy last line of the text.
- #
- # Arguments:
- # w - The text window.
- # pos - The desired new position for the cursor in the window.
- proc ::tk::TextSetCursor {w pos} {
- if {[$w compare $pos == end]} {
- set pos {end - 1 chars}
- }
- $w mark set insert $pos
- $w tag remove sel 1.0 end
- $w see insert
- if {[$w cget -autoseparators]} {
- $w edit separator
- }
- }
- # ::tk::TextKeySelect
- # 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 text window.
- # new - A new position for the insertion cursor (the cursor hasn't
- # actually been moved to this position yet).
- proc ::tk::TextKeySelect {w new} {
- set anchorname [tk::TextAnchor $w]
- if {[$w tag nextrange sel 1.0 end] eq ""} {
- if {[$w compare $new < insert]} {
- $w tag add sel $new insert
- } else {
- $w tag add sel insert $new
- }
- $w mark set $anchorname insert
- } else {
- if {[$w compare $new < $anchorname]} {
- set first $new
- set last $anchorname
- } else {
- set first $anchorname
- set last $new
- }
- $w tag remove sel 1.0 $first
- $w tag add sel $first $last
- $w tag remove sel $last end
- }
- $w mark set insert $new
- $w see insert
- update idletasks
- }
- # ::tk::TextResetAnchor --
- # Set the selection anchor to whichever end is farthest from the
- # index argument. One special trick: if the selection has two or
- # fewer characters, just leave the anchor where it is. In this
- # case it doesn't matter which point gets chosen for the anchor,
- # and for the things like Shift-Left and Shift-Right this produces
- # better behavior when the cursor moves back and forth across the
- # anchor.
- #
- # Arguments:
- # w - The text widget.
- # index - Position at which mouse button was pressed, which determines
- # which end of selection should be used as anchor point.
- proc ::tk::TextResetAnchor {w index} {
- if {[$w tag ranges sel] eq ""} {
- # Don't move the anchor if there is no selection now; this
- # makes the widget behave "correctly" when the user clicks
- # once, then shift-clicks somewhere -- ie, the area between
- # the two clicks will be selected. [Bug: 5929].
- return
- }
- set anchorname [tk::TextAnchor $w]
- set a [$w index $index]
- set b [$w index sel.first]
- set c [$w index sel.last]
- if {[$w compare $a < $b]} {
- $w mark set $anchorname sel.last
- return
- }
- if {[$w compare $a > $c]} {
- $w mark set $anchorname sel.first
- return
- }
- scan $a "%d.%d" lineA chA
- scan $b "%d.%d" lineB chB
- scan $c "%d.%d" lineC chC
- if {$lineB < $lineC+2} {
- set total [string length [$w get $b $c]]
- if {$total <= 2} {
- return
- }
- if {[string length [$w get $b $a]] < ($total/2)} {
- $w mark set $anchorname sel.last
- } else {
- $w mark set $anchorname sel.first
- }
- return
- }
- if {($lineA-$lineB) < ($lineC-$lineA)} {
- $w mark set $anchorname sel.last
- } else {
- $w mark set $anchorname sel.first
- }
- }
- # ::tk::TextCursorInSelection --
- # Check whether the selection exists and contains the insertion cursor. Note
- # that it assumes that the selection is contiguous.
- #
- # Arguments:
- # w - The text widget whose selection is to be checked
- proc ::tk::TextCursorInSelection {w} {
- expr {
- [llength [$w tag ranges sel]]
- && [$w compare sel.first <= insert]
- && [$w compare sel.last >= insert]
- }
- }
- # ::tk::TextInsert --
- # Insert a string into a text at the point of the insertion cursor.
- # If there is a selection in the text, and it covers the point of the
- # insertion cursor, then delete the selection before inserting.
- #
- # Arguments:
- # w - The text window in which to insert the string
- # s - The string to insert (usually just a single character)
- proc ::tk::TextInsert {w s} {
- if {$s eq "" || [$w cget -state] eq "disabled"} {
- return
- }
- set compound 0
- if {[TextCursorInSelection $w]} {
- set oldSeparator [$w cget -autoseparators]
- if {$oldSeparator} {
- $w configure -autoseparators 0
- $w edit separator
- set compound 1
- }
- $w delete sel.first sel.last
- }
- $w insert insert $s
- $w see insert
- if {$compound && $oldSeparator} {
- $w edit separator
- $w configure -autoseparators 1
- }
- }
- # ::tk::TextUpDownLine --
- # Returns the index of the character one display line above or below the
- # insertion cursor. There are two tricky things here. First, we want to
- # maintain the original x position across repeated operations, even though
- # some lines that will get passed through don't have enough characters to
- # cover the original column. Second, don't try to scroll past the
- # beginning or end of the text.
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # n - The number of display lines to move: -1 for up one line,
- # +1 for down one line.
- proc ::tk::TextUpDownLine {w n} {
- variable ::tk::Priv
- set i [$w index insert]
- if {$Priv(prevPos) ne $i} {
- set Priv(textPosOrig) $i
- }
- set lines [$w count -displaylines $Priv(textPosOrig) $i]
- set new [$w index \
- "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"]
- if {[$w compare $new == end] \
- || [$w compare $new == "insert display linestart"]} {
- set new $i
- }
- set Priv(prevPos) $new
- return $new
- }
- # ::tk::TextPrevPara --
- # Returns the index of the beginning of the paragraph just before a given
- # position in the text (the beginning of a paragraph is the first non-blank
- # character after a blank line).
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # pos - Position at which to start search.
- proc ::tk::TextPrevPara {w pos} {
- set pos [$w index "$pos linestart"]
- while {1} {
- if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \
- || $pos eq "1.0"} {
- if {[regexp -indices -- {^[ \t]+(.)} \
- [$w get $pos "$pos lineend"] -> index]} {
- set pos [$w index "$pos + [lindex $index 0] chars"]
- }
- if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} {
- return $pos
- }
- }
- set pos [$w index "$pos - 1 line"]
- }
- }
- # ::tk::TextNextPara --
- # Returns the index of the beginning of the paragraph just after a given
- # position in the text (the beginning of a paragraph is the first non-blank
- # character after a blank line).
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # start - Position at which to start search.
- proc ::tk::TextNextPara {w start} {
- set pos [$w index "$start linestart + 1 line"]
- while {[$w get $pos] ne "\n"} {
- if {[$w compare $pos == end]} {
- return [$w index "end - 1c"]
- }
- set pos [$w index "$pos + 1 line"]
- }
- while {[$w get $pos] eq "\n"} {
- set pos [$w index "$pos + 1 line"]
- if {[$w compare $pos == end]} {
- return [$w index "end - 1c"]
- }
- }
- if {[regexp -indices -- {^[ \t]+(.)} \
- [$w get $pos "$pos lineend"] -> index]} {
- return [$w index "$pos + [lindex $index 0] chars"]
- }
- return $pos
- }
- # ::tk::TextScrollPages --
- # This is a utility procedure used in bindings for moving up and down
- # pages and possibly extending the selection along the way. It scrolls
- # the view in the widget by the number of pages, and it returns the
- # index of the character that is at the same position in the new view
- # as the insertion cursor used to be in the old view.
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # count - Number of pages forward to scroll; may be negative
- # to scroll backwards.
- proc ::tk::TextScrollPages {w count} {
- set bbox [$w bbox insert]
- $w yview scroll $count pages
- if {$bbox eq ""} {
- return [$w index @[expr {[winfo height $w]/2}],0]
- }
- return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
- }
- # ::tk::TextTranspose --
- # This procedure implements the "transpose" function for text 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 - Text window in which to transpose.
- proc ::tk::TextTranspose w {
- set pos insert
- if {[$w compare $pos != "$pos lineend"]} {
- set pos [$w index "$pos + 1 char"]
- }
- set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"]
- if {[$w compare "$pos - 1 char" == 1.0]} {
- return
- }
- # ensure this is seen as an atomic op to undo
- set autosep [$w cget -autoseparators]
- if {$autosep} {
- $w configure -autoseparators 0
- $w edit separator
- }
- $w delete "$pos - 2 char" $pos
- $w insert insert $new
- $w see insert
- if {$autosep} {
- $w edit separator
- $w configure -autoseparators $autosep
- }
- }
- # ::tk_textCopy --
- # This procedure copies the selection from a text widget into the
- # clipboard.
- #
- # Arguments:
- # w - Name of a text widget.
- proc ::tk_textCopy w {
- if {![catch {set data [$w get sel.first sel.last]}]} {
- clipboard clear -displayof $w
- clipboard append -displayof $w $data
- }
- }
- # ::tk_textCut --
- # This procedure copies the selection from a text widget into the
- # clipboard, then deletes the selection (if it exists in the given
- # widget).
- #
- # Arguments:
- # w - Name of a text widget.
- proc ::tk_textCut w {
- if {![catch {set data [$w get sel.first sel.last]}]} {
- # make <<Cut>> an atomic operation on the Undo stack,
- # i.e. separate it from other delete operations on either side
- set oldSeparator [$w cget -autoseparators]
- if {$oldSeparator} {
- $w edit separator
- }
- clipboard clear -displayof $w
- clipboard append -displayof $w $data
- $w delete sel.first sel.last
- if {$oldSeparator} {
- $w edit separator
- }
- }
- }
- # ::tk_textPaste --
- # This procedure pastes the contents of the clipboard to the insertion
- # point in a text widget.
- #
- # Arguments:
- # w - Name of a text widget.
- proc ::tk_textPaste w {
- if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
- set oldSeparator [$w cget -autoseparators]
- if {$oldSeparator} {
- $w configure -autoseparators 0
- $w edit separator
- }
- if {[tk windowingsystem] ne "x11"} {
- catch { $w delete sel.first sel.last }
- }
- $w insert insert $sel
- if {$oldSeparator} {
- $w edit separator
- $w configure -autoseparators 1
- }
- }
- }
- # ::tk::TextNextWord --
- # Returns the index of the next word position after a given position in the
- # text. 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 text window in which the cursor is to move.
- # start - Position at which to start search.
- if {[tk windowingsystem] eq "win32"} {
- proc ::tk::TextNextWord {w start} {
- TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
- tcl_startOfNextWord
- }
- } else {
- proc ::tk::TextNextWord {w start} {
- TextNextPos $w $start tcl_endOfWord
- }
- }
- # ::tk::TextNextPos --
- # Returns the index of the next position after the given starting
- # position in the text as computed by a specified function.
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # start - Position at which to start search.
- # op - Function to use to find next position.
- proc ::tk::TextNextPos {w start op} {
- set text ""
- set cur $start
- while {[$w compare $cur < end]} {
- set text $text[$w get -displaychars $cur "$cur lineend + 1c"]
- set pos [$op $text 0]
- if {$pos >= 0} {
- return [$w index "$start + $pos display chars"]
- }
- set cur [$w index "$cur lineend +1c"]
- }
- return end
- }
- # ::tk::TextPrevPos --
- # Returns the index of the previous position before the given starting
- # position in the text as computed by a specified function.
- #
- # Arguments:
- # w - The text window in which the cursor is to move.
- # start - Position at which to start search.
- # op - Function to use to find next position.
- proc ::tk::TextPrevPos {w start op} {
- set text ""
- set cur $start
- while {[$w compare $cur > 0.0]} {
- set text [$w get -displaychars "$cur linestart - 1c" $cur]$text
- set pos [$op $text end]
- if {$pos >= 0} {
- return [$w index "$cur linestart - 1c + $pos display chars"]
- }
- set cur [$w index "$cur linestart - 1c"]
- }
- return 0.0
- }
- # ::tk::TextScanMark --
- #
- # Marks the start of a possible scan drag operation
- #
- # Arguments:
- # w - The text window from which the text to get
- # x - x location on screen
- # y - y location on screen
- proc ::tk::TextScanMark {w x y} {
- variable ::tk::Priv
- $w scan mark $x $y
- set Priv(x) $x
- set Priv(y) $y
- set Priv(mouseMoved) 0
- }
- # ::tk::TextScanDrag --
- #
- # Marks the start of a possible scan drag operation
- #
- # Arguments:
- # w - The text window from which the text to get
- # x - x location on screen
- # y - y location on screen
- proc ::tk::TextScanDrag {w x y} {
- variable ::tk::Priv
- # Make sure these exist, as some weird situations can trigger the
- # motion binding without the initial press. [Bug #220269]
- if {![info exists Priv(x)]} {
- set Priv(x) $x
- }
- if {![info exists Priv(y)]} {
- set Priv(y) $y
- }
- if {($x != $Priv(x)) || ($y != $Priv(y))} {
- set Priv(mouseMoved) 1
- }
- if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
- $w scan dragto $x $y
- }
- }
|