mingw/lib/tk8.5/text.tcl

   1 # text.tcl --
   2 #
   3 # This file defines the default bindings for Tk text widgets and provides
   4 # procedures that help in implementing the bindings.
   5 #
   6 # Copyright (c) 1992-1994 The Regents of the University of California.
   7 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
   8 # Copyright (c) 1998 by Scriptics Corporation.
   9 #
  10 # See the file "license.terms" for information on usage and redistribution
  11 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12 #
  13
  14 #-------------------------------------------------------------------------
  15 # Elements of ::tk::Priv that are used in this file:
  16 #
  17 # afterId -             If non-null, it means that auto-scanning is underway
  18 #                       and it gives the "after" id for the next auto-scan
  19 #                       command to be executed.
  20 # char -                Character position on the line;  kept in order
  21 #                       to allow moving up or down past short lines while
  22 #                       still remembering the desired position.
  23 # mouseMoved -          Non-zero means the mouse has moved a significant
  24 #                       amount since the button went down (so, for example,
  25 #                       start dragging out a selection).
  26 # prevPos -             Used when moving up or down lines via the keyboard.
  27 #                       Keeps track of the previous insert position, so
  28 #                       we can distinguish a series of ups and downs, all
  29 #                       in a row, from a new up or down.
  30 # selectMode -          The style of selection currently underway:
  31 #                       char, word, or line.
  32 # x, y -                Last known mouse coordinates for scanning
  33 #                       and auto-scanning.
  34 #
  35 #-------------------------------------------------------------------------
  36
  37 #-------------------------------------------------------------------------
  38 # The code below creates the default class bindings for text widgets.
  39 #-------------------------------------------------------------------------
  40
  41 # Standard Motif bindings:
  42
  43 bind Text <1> {
  44     tk::TextButton1 %W %x %y
  45     %W tag remove sel 0.0 end
  46 }
  47 bind Text <B1-Motion> {
  48     set tk::Priv(x) %x
  49     set tk::Priv(y) %y
  50     tk::TextSelectTo %W %x %y
  51 }
  52 bind Text <Double-1> {
  53     set tk::Priv(selectMode) word
  54     tk::TextSelectTo %W %x %y
  55     catch {%W mark set insert sel.first}
  56 }
  57 bind Text <Triple-1> {
  58     set tk::Priv(selectMode) line
  59     tk::TextSelectTo %W %x %y
  60     catch {%W mark set insert sel.first}
  61 }
  62 bind Text <Shift-1> {
  63     tk::TextResetAnchor %W @%x,%y
  64     set tk::Priv(selectMode) char
  65     tk::TextSelectTo %W %x %y
  66 }
  67 bind Text <Double-Shift-1>      {
  68     set tk::Priv(selectMode) word
  69     tk::TextSelectTo %W %x %y 1
  70 }
  71 bind Text <Triple-Shift-1>      {
  72     set tk::Priv(selectMode) line
  73     tk::TextSelectTo %W %x %y
  74 }
  75 bind Text <B1-Leave> {
  76     set tk::Priv(x) %x
  77     set tk::Priv(y) %y
  78     tk::TextAutoScan %W
  79 }
  80 bind Text <B1-Enter> {
  81     tk::CancelRepeat
  82 }
  83 bind Text <ButtonRelease-1> {
  84     tk::CancelRepeat
  85 }
  86 bind Text <Control-1> {
  87     %W mark set insert @%x,%y
  88 }
  89 bind Text <Left> {
  90     tk::TextSetCursor %W insert-1displayindices
  91 }
  92 bind Text <Right> {
  93     tk::TextSetCursor %W insert+1displayindices
  94 }
  95 bind Text <Up> {
  96     tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  97 }
  98 bind Text <Down> {
  99     tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
 100 }
 101 bind Text <Shift-Left> {
 102     tk::TextKeySelect %W [%W index {insert - 1displayindices}]
 103 }
 104 bind Text <Shift-Right> {
 105     tk::TextKeySelect %W [%W index {insert + 1displayindices}]
 106 }
 107 bind Text <Shift-Up> {
 108     tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
 109 }
 110 bind Text <Shift-Down> {
 111     tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
 112 }
 113 bind Text <Control-Left> {
 114     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 115 }
 116 bind Text <Control-Right> {
 117     tk::TextSetCursor %W [tk::TextNextWord %W insert]
 118 }
 119 bind Text <Control-Up> {
 120     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
 121 }
 122 bind Text <Control-Down> {
 123     tk::TextSetCursor %W [tk::TextNextPara %W insert]
 124 }
 125 bind Text <Shift-Control-Left> {
 126     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 127 }
 128 bind Text <Shift-Control-Right> {
 129     tk::TextKeySelect %W [tk::TextNextWord %W insert]
 130 }
 131 bind Text <Shift-Control-Up> {
 132     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
 133 }
 134 bind Text <Shift-Control-Down> {
 135     tk::TextKeySelect %W [tk::TextNextPara %W insert]
 136 }
 137 bind Text <Prior> {
 138     tk::TextSetCursor %W [tk::TextScrollPages %W -1]
 139 }
 140 bind Text <Shift-Prior> {
 141     tk::TextKeySelect %W [tk::TextScrollPages %W -1]
 142 }
 143 bind Text <Next> {
 144     tk::TextSetCursor %W [tk::TextScrollPages %W 1]
 145 }
 146 bind Text <Shift-Next> {
 147     tk::TextKeySelect %W [tk::TextScrollPages %W 1]
 148 }
 149 bind Text <Control-Prior> {
 150     %W xview scroll -1 page
 151 }
 152 bind Text <Control-Next> {
 153     %W xview scroll 1 page
 154 }
 155
 156 bind Text <Home> {
 157     tk::TextSetCursor %W {insert display linestart}
 158 }
 159 bind Text <Shift-Home> {
 160     tk::TextKeySelect %W {insert display linestart}
 161 }
 162 bind Text <End> {
 163     tk::TextSetCursor %W {insert display lineend}
 164 }
 165 bind Text <Shift-End> {
 166     tk::TextKeySelect %W {insert display lineend}
 167 }
 168 bind Text <Control-Home> {
 169     tk::TextSetCursor %W 1.0
 170 }
 171 bind Text <Control-Shift-Home> {
 172     tk::TextKeySelect %W 1.0
 173 }
 174 bind Text <Control-End> {
 175     tk::TextSetCursor %W {end - 1 indices}
 176 }
 177 bind Text <Control-Shift-End> {
 178     tk::TextKeySelect %W {end - 1 indices}
 179 }
 180
 181 bind Text <Tab> {
 182     if {[%W cget -state] eq "normal"} {
 183         tk::TextInsert %W \t
 184         focus %W
 185         break
 186     }
 187 }
 188 bind Text <Shift-Tab> {
 189     # Needed only to keep <Tab> binding from triggering;  doesn't
 190     # have to actually do anything.
 191     break
 192 }
 193 bind Text <Control-Tab> {
 194     focus [tk_focusNext %W]
 195 }
 196 bind Text <Control-Shift-Tab> {
 197     focus [tk_focusPrev %W]
 198 }
 199 bind Text <Control-i> {
 200     tk::TextInsert %W \t
 201 }
 202 bind Text <Return> {
 203     tk::TextInsert %W \n
 204     if {[%W cget -autoseparators]} {
 205         %W edit separator
 206     }
 207 }
 208 bind Text <Delete> {
 209     if {[tk::TextCursorInSelection %W]} {
 210         %W delete sel.first sel.last
 211     } elseif {[%W compare end != insert+1c]} {
 212         %W delete insert
 213     }
 214     %W see insert
 215 }
 216 bind Text <BackSpace> {
 217     if {[tk::TextCursorInSelection %W]} {
 218         %W delete sel.first sel.last
 219     } elseif {[%W compare insert != 1.0]} {
 220         %W delete insert-1c
 221     }
 222     %W see insert
 223 }
 224
 225 bind Text <Control-space> {
 226     %W mark set [tk::TextAnchor %W] insert
 227 }
 228 bind Text <Select> {
 229     %W mark set [tk::TextAnchor %W] insert
 230 }
 231 bind Text <Control-Shift-space> {
 232     set tk::Priv(selectMode) char
 233     tk::TextKeyExtend %W insert
 234 }
 235 bind Text <Shift-Select> {
 236     set tk::Priv(selectMode) char
 237     tk::TextKeyExtend %W insert
 238 }
 239 bind Text <Control-slash> {
 240     %W tag add sel 1.0 end
 241 }
 242 bind Text <Control-backslash> {
 243     %W tag remove sel 1.0 end
 244 }
 245 bind Text <<Cut>> {
 246     tk_textCut %W
 247 }
 248 bind Text <<Copy>> {
 249     tk_textCopy %W
 250 }
 251 bind Text <<Paste>> {
 252     tk_textPaste %W
 253 }
 254 bind Text <<Clear>> {
 255     catch {%W delete sel.first sel.last}
 256 }
 257 bind Text <<PasteSelection>> {
 258     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
 259             || !$tk::Priv(mouseMoved)} {
 260         tk::TextPasteSelection %W %x %y
 261     }
 262 }
 263 bind Text <Insert> {
 264     catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
 265 }
 266 bind Text <KeyPress> {
 267     tk::TextInsert %W %A
 268 }
 269
 270 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 271 # Otherwise, if a widget binding for one of these is defined, the
 272 # <KeyPress> class binding will also fire and insert the character,
 273 # which is wrong.  Ditto for <Escape>.
 274
 275 bind Text <Alt-KeyPress> {# nothing }
 276 bind Text <Meta-KeyPress> {# nothing}
 277 bind Text <Control-KeyPress> {# nothing}
 278 bind Text <Escape> {# nothing}
 279 bind Text <KP_Enter> {# nothing}
 280 if {[tk windowingsystem] eq "aqua"} {
 281     bind Text <Command-KeyPress> {# nothing}
 282 }
 283
 284 # Additional emacs-like bindings:
 285
 286 bind Text <Control-a> {
 287     if {!$tk_strictMotif} {
 288         tk::TextSetCursor %W {insert display linestart}
 289     }
 290 }
 291 bind Text <Control-b> {
 292     if {!$tk_strictMotif} {
 293         tk::TextSetCursor %W insert-1displayindices
 294     }
 295 }
 296 bind Text <Control-d> {
 297     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 298         %W delete insert
 299     }
 300 }
 301 bind Text <Control-e> {
 302     if {!$tk_strictMotif} {
 303         tk::TextSetCursor %W {insert display lineend}
 304     }
 305 }
 306 bind Text <Control-f> {
 307     if {!$tk_strictMotif} {
 308         tk::TextSetCursor %W insert+1displayindices
 309     }
 310 }
 311 bind Text <Control-k> {
 312     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 313         if {[%W compare insert == {insert lineend}]} {
 314             %W delete insert
 315         } else {
 316             %W delete insert {insert lineend}
 317         }
 318     }
 319 }
 320 bind Text <Control-n> {
 321     if {!$tk_strictMotif} {
 322         tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
 323     }
 324 }
 325 bind Text <Control-o> {
 326     if {!$tk_strictMotif} {
 327         %W insert insert \n
 328         %W mark set insert insert-1c
 329     }
 330 }
 331 bind Text <Control-p> {
 332     if {!$tk_strictMotif} {
 333         tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
 334     }
 335 }
 336 bind Text <Control-t> {
 337     if {!$tk_strictMotif} {
 338         tk::TextTranspose %W
 339     }
 340 }
 341
 342 bind Text <<Undo>> {
 343     catch { %W edit undo }
 344 }
 345
 346 bind Text <<Redo>> {
 347     catch { %W edit redo }
 348 }
 349
 350 bind Text <Meta-b> {
 351     if {!$tk_strictMotif} {
 352         tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 353     }
 354 }
 355 bind Text <Meta-d> {
 356     if {!$tk_strictMotif && [%W compare end != insert+1c]} {
 357         %W delete insert [tk::TextNextWord %W insert]
 358     }
 359 }
 360 bind Text <Meta-f> {
 361     if {!$tk_strictMotif} {
 362         tk::TextSetCursor %W [tk::TextNextWord %W insert]
 363     }
 364 }
 365 bind Text <Meta-less> {
 366     if {!$tk_strictMotif} {
 367         tk::TextSetCursor %W 1.0
 368     }
 369 }
 370 bind Text <Meta-greater> {
 371     if {!$tk_strictMotif} {
 372         tk::TextSetCursor %W end-1c
 373     }
 374 }
 375 bind Text <Meta-BackSpace> {
 376     if {!$tk_strictMotif} {
 377         %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
 378     }
 379 }
 380 bind Text <Meta-Delete> {
 381     if {!$tk_strictMotif} {
 382         %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
 383     }
 384 }
 385
 386 # Macintosh only bindings:
 387
 388 if {[tk windowingsystem] eq "aqua"} {
 389 bind Text <Option-Left> {
 390     tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 391 }
 392 bind Text <Option-Right> {
 393     tk::TextSetCursor %W [tk::TextNextWord %W insert]
 394 }
 395 bind Text <Option-Up> {
 396     tk::TextSetCursor %W [tk::TextPrevPara %W insert]
 397 }
 398 bind Text <Option-Down> {
 399     tk::TextSetCursor %W [tk::TextNextPara %W insert]
 400 }
 401 bind Text <Shift-Option-Left> {
 402     tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
 403 }
 404 bind Text <Shift-Option-Right> {
 405     tk::TextKeySelect %W [tk::TextNextWord %W insert]
 406 }
 407 bind Text <Shift-Option-Up> {
 408     tk::TextKeySelect %W [tk::TextPrevPara %W insert]
 409 }
 410 bind Text <Shift-Option-Down> {
 411     tk::TextKeySelect %W [tk::TextNextPara %W insert]
 412 }
 413 bind Text <Control-v> {
 414     tk::TextScrollPages %W 1
 415 }
 416
 417 # End of Mac only bindings
 418 }
 419
 420 # A few additional bindings of my own.
 421
 422 bind Text <Control-h> {
 423     if {!$tk_strictMotif && [%W compare insert != 1.0]} {
 424         %W delete insert-1c
 425         %W see insert
 426     }
 427 }
 428 bind Text <2> {
 429     if {!$tk_strictMotif} {
 430         tk::TextScanMark %W %x %y
 431     }
 432 }
 433 bind Text <B2-Motion> {
 434     if {!$tk_strictMotif} {
 435         tk::TextScanDrag %W %x %y
 436     }
 437 }
 438 set ::tk::Priv(prevPos) {}
 439
 440 # The MouseWheel will typically only fire on Windows and MacOS X.
 441 # However, someone could use the "event generate" command to produce one
 442 # on other platforms.  We must be careful not to round -ve values of %D
 443 # down to zero.
 444
 445 if {[tk windowingsystem] eq "aqua"} {
 446     bind Text <MouseWheel> {
 447         %W yview scroll [expr {-15 * (%D)}] pixels
 448     }
 449     bind Text <Option-MouseWheel> {
 450         %W yview scroll [expr {-150 * (%D)}] pixels
 451     }
 452     bind Text <Shift-MouseWheel> {
 453         %W xview scroll [expr {-15 * (%D)}] pixels
 454     }
 455     bind Text <Shift-Option-MouseWheel> {
 456         %W xview scroll [expr {-150 * (%D)}] pixels
 457     }
 458 } else {
 459     # We must make sure that positive and negative movements are rounded
 460     # equally to integers, avoiding the problem that
 461     #     (int)1/3 = 0,
 462     # but
 463     #     (int)-1/3 = -1
 464     # The following code ensure equal +/- behaviour.
 465     bind Text <MouseWheel> {
 466         if {%D >= 0} {
 467             %W yview scroll [expr {-%D/3}] pixels
 468         } else {
 469             %W yview scroll [expr {(2-%D)/3}] pixels
 470         }
 471     }
 472 }
 473
 474 if {"x11" eq [tk windowingsystem]} {
 475     # Support for mousewheels on Linux/Unix commonly comes through mapping
 476     # the wheel to the extended buttons.  If you have a mousewheel, find
 477     # Linux configuration info at:
 478     #   http://www.inria.fr/koala/colas/mouse-wheel-scroll/
 479     bind Text <4> {
 480         if {!$tk_strictMotif} {
 481             %W yview scroll -50 pixels
 482         }
 483     }
 484     bind Text <5> {
 485         if {!$tk_strictMotif} {
 486             %W yview scroll 50 pixels
 487         }
 488     }
 489 }
 490
 491 # ::tk::TextClosestGap --
 492 # Given x and y coordinates, this procedure finds the closest boundary
 493 # between characters to the given coordinates and returns the index
 494 # of the character just after the boundary.
 495 #
 496 # Arguments:
 497 # w -           The text window.
 498 # x -           X-coordinate within the window.
 499 # y -           Y-coordinate within the window.
 500
 501 proc ::tk::TextClosestGap {w x y} {
 502     set pos [$w index @$x,$y]
 503     set bbox [$w bbox $pos]
 504     if {$bbox eq ""} {
 505         return $pos
 506     }
 507     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
 508         return $pos
 509     }
 510     $w index "$pos + 1 char"
 511 }
 512
 513 # ::tk::TextButton1 --
 514 # This procedure is invoked to handle button-1 presses in text
 515 # widgets.  It moves the insertion cursor, sets the selection anchor,
 516 # and claims the input focus.
 517 #
 518 # Arguments:
 519 # w -           The text window in which the button was pressed.
 520 # x -           The x-coordinate of the button press.
 521 # y -           The x-coordinate of the button press.
 522
 523 proc ::tk::TextButton1 {w x y} {
 524     variable ::tk::Priv
 525
 526     set Priv(selectMode) char
 527     set Priv(mouseMoved) 0
 528     set Priv(pressX) $x
 529     set anchorname [tk::TextAnchor $w]
 530     $w mark set insert [TextClosestGap $w $x $y]
 531     $w mark set $anchorname insert
 532     # Set the anchor mark's gravity depending on the click position
 533     # relative to the gap
 534     set bbox [$w bbox [$w index $anchorname]]
 535     if {$x > [lindex $bbox 0]} {
 536         $w mark gravity $anchorname right
 537     } else {
 538         $w mark gravity $anchorname left
 539     }
 540     # Allow focus in any case on Windows, because that will let the
 541     # selection be displayed even for state disabled text widgets.
 542     if {[tk windowingsystem] eq "win32" \
 543             || [$w cget -state] eq "normal"} {
 544         focus $w
 545     }
 546     if {[$w cget -autoseparators]} {
 547         $w edit separator
 548     }
 549 }
 550
 551 # ::tk::TextSelectTo --
 552 # This procedure is invoked to extend the selection, typically when
 553 # dragging it with the mouse.  Depending on the selection mode (character,
 554 # word, line) it selects in different-sized units.  This procedure
 555 # ignores mouse motions initially until the mouse has moved from
 556 # one character to another or until there have been multiple clicks.
 557 #
 558 # Note that the 'anchor' is implemented programmatically using
 559 # a text widget mark, and uses a name that will be unique for each
 560 # text widget (even when there are multiple peers).  Currently the
 561 # anchor is considered private to Tk, hence the name 'tk::anchor$w'.
 562 #
 563 # Arguments:
 564 # w -           The text window in which the button was pressed.
 565 # x -           Mouse x position.
 566 # y -           Mouse y position.
 567
 568 set ::tk::Priv(textanchoruid) 0
 569
 570 proc ::tk::TextAnchor {w} {
 571     variable Priv
 572     if {![info exists Priv(textanchor,$w)]} {
 573         set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
 574     }
 575     return $Priv(textanchor,$w)
 576 }
 577
 578 proc ::tk::TextSelectTo {w x y {extend 0}} {
 579     global tcl_platform
 580     variable ::tk::Priv
 581
 582     set anchorname [tk::TextAnchor $w]
 583     set cur [TextClosestGap $w $x $y]
 584     if {[catch {$w index $anchorname}]} {
 585         $w mark set $anchorname $cur
 586     }
 587     set anchor [$w index $anchorname]
 588     if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
 589         set Priv(mouseMoved) 1
 590     }
 591     switch -- $Priv(selectMode) {
 592         char {
 593             if {[$w compare $cur < $anchorname]} {
 594                 set first $cur
 595                 set last $anchorname
 596             } else {
 597                 set first $anchorname
 598                 set last $cur
 599             }
 600         }
 601         word {
 602             # Set initial range based only on the anchor (1 char min width)
 603             if {[$w mark gravity $anchorname] eq "right"} {
 604                 set first $anchorname
 605                 set last "$anchorname + 1c"
 606             } else {
 607                 set first "$anchorname - 1c"
 608                 set last $anchorname
 609             }
 610             # Extend range (if necessary) based on the current point
 611             if {[$w compare $cur < $first]} {
 612                 set first $cur
 613             } elseif {[$w compare $cur > $last]} {
 614                 set last $cur
 615             }
 616
 617             # Now find word boundaries
 618             set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
 619             set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
 620         }
 621         line {
 622             # Set initial range based only on the anchor
 623             set first "$anchorname linestart"
 624             set last "$anchorname lineend"
 625
 626             # Extend range (if necessary) based on the current point
 627             if {[$w compare $cur < $first]} {
 628                 set first "$cur linestart"
 629             } elseif {[$w compare $cur > $last]} {
 630                 set last "$cur lineend"
 631             }
 632             set first [$w index $first]
 633             set last [$w index "$last + 1c"]
 634         }
 635     }
 636     if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
 637         $w tag remove sel 0.0 end
 638         $w mark set insert $cur
 639         $w tag add sel $first $last
 640         $w tag remove sel $last end
 641         update idletasks
 642     }
 643 }
 644
 645 # ::tk::TextKeyExtend --
 646 # This procedure handles extending the selection from the keyboard,
 647 # where the point to extend to is really the boundary between two
 648 # characters rather than a particular character.
 649 #
 650 # Arguments:
 651 # w -           The text window.
 652 # index -       The point to which the selection is to be extended.
 653
 654 proc ::tk::TextKeyExtend {w index} {
 655
 656     set anchorname [tk::TextAnchor $w]
 657     set cur [$w index $index]
 658     if {[catch {$w index $anchorname}]} {
 659         $w mark set $anchorname $cur
 660     }
 661     set anchor [$w index $anchorname]
 662     if {[$w compare $cur < $anchorname]} {
 663         set first $cur
 664         set last $anchorname
 665     } else {
 666         set first $anchorname
 667         set last $cur
 668     }
 669     $w tag remove sel 0.0 $first
 670     $w tag add sel $first $last
 671     $w tag remove sel $last end
 672 }
 673
 674 # ::tk::TextPasteSelection --
 675 # This procedure sets the insertion cursor to the mouse position,
 676 # inserts the selection, and sets the focus to the window.
 677 #
 678 # Arguments:
 679 # w -           The text window.
 680 # x, y -        Position of the mouse.
 681
 682 proc ::tk::TextPasteSelection {w x y} {
 683     $w mark set insert [TextClosestGap $w $x $y]
 684     if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
 685         set oldSeparator [$w cget -autoseparators]
 686         if {$oldSeparator} {
 687             $w configure -autoseparators 0
 688             $w edit separator
 689         }
 690         $w insert insert $sel
 691         if {$oldSeparator} {
 692             $w edit separator
 693             $w configure -autoseparators 1
 694         }
 695     }
 696     if {[$w cget -state] eq "normal"} {
 697         focus $w
 698     }
 699 }
 700
 701 # ::tk::TextAutoScan --
 702 # This procedure is invoked when the mouse leaves a text window
 703 # with button 1 down.  It scrolls the window up, down, left, or right,
 704 # depending on where the mouse is (this information was saved in
 705 # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
 706 # command so that the window continues to scroll until the mouse
 707 # moves back into the window or the mouse button is released.
 708 #
 709 # Arguments:
 710 # w -           The text window.
 711
 712 proc ::tk::TextAutoScan {w} {
 713     variable ::tk::Priv
 714     if {![winfo exists $w]} {
 715         return
 716     }
 717     if {$Priv(y) >= [winfo height $w]} {
 718         $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
 719     } elseif {$Priv(y) < 0} {
 720         $w yview scroll [expr {-1 + $Priv(y)}] pixels
 721     } elseif {$Priv(x) >= [winfo width $w]} {
 722         $w xview scroll 2 units
 723     } elseif {$Priv(x) < 0} {
 724         $w xview scroll -2 units
 725     } else {
 726         return
 727     }
 728     TextSelectTo $w $Priv(x) $Priv(y)
 729     set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
 730 }
 731
 732 # ::tk::TextSetCursor
 733 # Move the insertion cursor to a given position in a text.  Also
 734 # clears the selection, if there is one in the text, and makes sure
 735 # that the insertion cursor is visible.  Also, don't let the insertion
 736 # cursor appear on the dummy last line of the text.
 737 #
 738 # Arguments:
 739 # w -           The text window.
 740 # pos -         The desired new position for the cursor in the window.
 741
 742 proc ::tk::TextSetCursor {w pos} {
 743     if {[$w compare $pos == end]} {
 744         set pos {end - 1 chars}
 745     }
 746     $w mark set insert $pos
 747     $w tag remove sel 1.0 end
 748     $w see insert
 749     if {[$w cget -autoseparators]} {
 750         $w edit separator
 751     }
 752 }
 753
 754 # ::tk::TextKeySelect
 755 # This procedure is invoked when stroking out selections using the
 756 # keyboard.  It moves the cursor to a new position, then extends
 757 # the selection to that position.
 758 #
 759 # Arguments:
 760 # w -           The text window.
 761 # new -         A new position for the insertion cursor (the cursor hasn't
 762 #               actually been moved to this position yet).
 763
 764 proc ::tk::TextKeySelect {w new} {
 765     set anchorname [tk::TextAnchor $w]
 766     if {[$w tag nextrange sel 1.0 end] eq ""} {
 767         if {[$w compare $new < insert]} {
 768             $w tag add sel $new insert
 769         } else {
 770             $w tag add sel insert $new
 771         }
 772         $w mark set $anchorname insert
 773     } else {
 774         if {[$w compare $new < $anchorname]} {
 775             set first $new
 776             set last $anchorname
 777         } else {
 778             set first $anchorname
 779             set last $new
 780         }
 781         $w tag remove sel 1.0 $first
 782         $w tag add sel $first $last
 783         $w tag remove sel $last end
 784     }
 785     $w mark set insert $new
 786     $w see insert
 787     update idletasks
 788 }
 789
 790 # ::tk::TextResetAnchor --
 791 # Set the selection anchor to whichever end is farthest from the
 792 # index argument.  One special trick: if the selection has two or
 793 # fewer characters, just leave the anchor where it is.  In this
 794 # case it doesn't matter which point gets chosen for the anchor,
 795 # and for the things like Shift-Left and Shift-Right this produces
 796 # better behavior when the cursor moves back and forth across the
 797 # anchor.
 798 #
 799 # Arguments:
 800 # w -           The text widget.
 801 # index -       Position at which mouse button was pressed, which determines
 802 #               which end of selection should be used as anchor point.
 803
 804 proc ::tk::TextResetAnchor {w index} {
 805     if {[$w tag ranges sel] eq ""} {
 806         # Don't move the anchor if there is no selection now; this
 807         # makes the widget behave "correctly" when the user clicks
 808         # once, then shift-clicks somewhere -- ie, the area between
 809         # the two clicks will be selected. [Bug: 5929].
 810         return
 811     }
 812     set anchorname [tk::TextAnchor $w]
 813     set a [$w index $index]
 814     set b [$w index sel.first]
 815     set c [$w index sel.last]
 816     if {[$w compare $a < $b]} {
 817         $w mark set $anchorname sel.last
 818         return
 819     }
 820     if {[$w compare $a > $c]} {
 821         $w mark set $anchorname sel.first
 822         return
 823     }
 824     scan $a "%d.%d" lineA chA
 825     scan $b "%d.%d" lineB chB
 826     scan $c "%d.%d" lineC chC
 827     if {$lineB < $lineC+2} {
 828         set total [string length [$w get $b $c]]
 829         if {$total <= 2} {
 830             return
 831         }
 832         if {[string length [$w get $b $a]] < ($total/2)} {
 833             $w mark set $anchorname sel.last
 834         } else {
 835             $w mark set $anchorname sel.first
 836         }
 837         return
 838     }
 839     if {($lineA-$lineB) < ($lineC-$lineA)} {
 840         $w mark set $anchorname sel.last
 841     } else {
 842         $w mark set $anchorname sel.first
 843     }
 844 }
 845
 846 # ::tk::TextCursorInSelection --
 847 # Check whether the selection exists and contains the insertion cursor. Note
 848 # that it assumes that the selection is contiguous.
 849 #
 850 # Arguments:
 851 # w -           The text widget whose selection is to be checked
 852
 853 proc ::tk::TextCursorInSelection {w} {
 854     expr {
 855         [llength [$w tag ranges sel]]
 856         && [$w compare sel.first <= insert]
 857         && [$w compare sel.last >= insert]
 858     }
 859 }
 860
 861 # ::tk::TextInsert --
 862 # Insert a string into a text at the point of the insertion cursor.
 863 # If there is a selection in the text, and it covers the point of the
 864 # insertion cursor, then delete the selection before inserting.
 865 #
 866 # Arguments:
 867 # w -           The text window in which to insert the string
 868 # s -           The string to insert (usually just a single character)
 869
 870 proc ::tk::TextInsert {w s} {
 871     if {$s eq "" || [$w cget -state] eq "disabled"} {
 872         return
 873     }
 874     set compound 0
 875     if {[TextCursorInSelection $w]} {
 876         set compound [$w cget -autoseparators]
 877         if {$compound} {
 878             $w configure -autoseparators 0
 879             $w edit separator
 880         }
 881         $w delete sel.first sel.last
 882     }
 883     $w insert insert $s
 884     $w see insert
 885     if {$compound} {
 886         $w edit separator
 887         $w configure -autoseparators 1
 888     }
 889 }
 890
 891 # ::tk::TextUpDownLine --
 892 # Returns the index of the character one display line above or below the
 893 # insertion cursor.  There are two tricky things here.  First, we want to
 894 # maintain the original x position across repeated operations, even though
 895 # some lines that will get passed through don't have enough characters to
 896 # cover the original column.  Second, don't try to scroll past the
 897 # beginning or end of the text.
 898 #
 899 # Arguments:
 900 # w -           The text window in which the cursor is to move.
 901 # n -           The number of display lines to move: -1 for up one line,
 902 #               +1 for down one line.
 903
 904 proc ::tk::TextUpDownLine {w n} {
 905     variable ::tk::Priv
 906
 907     set i [$w index insert]
 908     if {$Priv(prevPos) ne $i} {
 909         set Priv(textPosOrig) $i
 910     }
 911     set lines [$w count -displaylines $Priv(textPosOrig) $i]
 912     set new [$w index \
 913             "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"]
 914     if {[$w compare $new == end] \
 915             || [$w compare $new == "insert display linestart"]} {
 916         set new $i
 917     }
 918     set Priv(prevPos) $new
 919     return $new
 920 }
 921
 922 # ::tk::TextPrevPara --
 923 # Returns the index of the beginning of the paragraph just before a given
 924 # position in the text (the beginning of a paragraph is the first non-blank
 925 # character after a blank line).
 926 #
 927 # Arguments:
 928 # w -           The text window in which the cursor is to move.
 929 # pos -         Position at which to start search.
 930
 931 proc ::tk::TextPrevPara {w pos} {
 932     set pos [$w index "$pos linestart"]
 933     while {1} {
 934         if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \
 935                 || $pos eq "1.0"} {
 936             if {[regexp -indices -- {^[ \t]+(.)} \
 937                     [$w get $pos "$pos lineend"] -> index]} {
 938                 set pos [$w index "$pos + [lindex $index 0] chars"]
 939             }
 940             if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} {
 941                 return $pos
 942             }
 943         }
 944         set pos [$w index "$pos - 1 line"]
 945     }
 946 }
 947
 948 # ::tk::TextNextPara --
 949 # Returns the index of the beginning of the paragraph just after a given
 950 # position in the text (the beginning of a paragraph is the first non-blank
 951 # character after a blank line).
 952 #
 953 # Arguments:
 954 # w -           The text window in which the cursor is to move.
 955 # start -       Position at which to start search.
 956
 957 proc ::tk::TextNextPara {w start} {
 958     set pos [$w index "$start linestart + 1 line"]
 959     while {[$w get $pos] ne "\n"} {
 960         if {[$w compare $pos == end]} {
 961             return [$w index "end - 1c"]
 962         }
 963         set pos [$w index "$pos + 1 line"]
 964     }
 965     while {[$w get $pos] eq "\n"} {
 966         set pos [$w index "$pos + 1 line"]
 967         if {[$w compare $pos == end]} {
 968             return [$w index "end - 1c"]
 969         }
 970     }
 971     if {[regexp -indices -- {^[ \t]+(.)} \
 972             [$w get $pos "$pos lineend"] -> index]} {
 973         return [$w index "$pos + [lindex $index 0] chars"]
 974     }
 975     return $pos
 976 }
 977
 978 # ::tk::TextScrollPages --
 979 # This is a utility procedure used in bindings for moving up and down
 980 # pages and possibly extending the selection along the way.  It scrolls
 981 # the view in the widget by the number of pages, and it returns the
 982 # index of the character that is at the same position in the new view
 983 # as the insertion cursor used to be in the old view.
 984 #
 985 # Arguments:
 986 # w -           The text window in which the cursor is to move.
 987 # count -       Number of pages forward to scroll;  may be negative
 988 #               to scroll backwards.
 989
 990 proc ::tk::TextScrollPages {w count} {
 991     set bbox [$w bbox insert]
 992     $w yview scroll $count pages
 993     if {$bbox eq ""} {
 994         return [$w index @[expr {[winfo height $w]/2}],0]
 995     }
 996     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
 997 }
 998
 999 # ::tk::TextTranspose --
1000 # This procedure implements the "transpose" function for text widgets.
1001 # It tranposes the characters on either side of the insertion cursor,
1002 # unless the cursor is at the end of the line.  In this case it
1003 # transposes the two characters to the left of the cursor.  In either
1004 # case, the cursor ends up to the right of the transposed characters.
1005 #
1006 # Arguments:
1007 # w -           Text window in which to transpose.
1008
1009 proc ::tk::TextTranspose w {
1010     set pos insert
1011     if {[$w compare $pos != "$pos lineend"]} {
1012         set pos [$w index "$pos + 1 char"]
1013     }
1014     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
1015     if {[$w compare "$pos - 1 char" == 1.0]} {
1016         return
1017     }
1018     # ensure this is seen as an atomic op to undo
1019     set autosep [$w cget -autoseparators]
1020     if {$autosep} {
1021         $w configure -autoseparators 0
1022         $w edit separator
1023     }
1024     $w delete "$pos - 2 char" $pos
1025     $w insert insert $new
1026     $w see insert
1027     if {$autosep} {
1028         $w edit separator
1029         $w configure -autoseparators $autosep
1030     }
1031 }
1032
1033 # ::tk_textCopy --
1034 # This procedure copies the selection from a text widget into the
1035 # clipboard.
1036 #
1037 # Arguments:
1038 # w -           Name of a text widget.
1039
1040 proc ::tk_textCopy w {
1041     if {![catch {set data [$w get sel.first sel.last]}]} {
1042         clipboard clear -displayof $w
1043         clipboard append -displayof $w $data
1044     }
1045 }
1046
1047 # ::tk_textCut --
1048 # This procedure copies the selection from a text widget into the
1049 # clipboard, then deletes the selection (if it exists in the given
1050 # widget).
1051 #
1052 # Arguments:
1053 # w -           Name of a text widget.
1054
1055 proc ::tk_textCut w {
1056     if {![catch {set data [$w get sel.first sel.last]}]} {
1057         clipboard clear -displayof $w
1058         clipboard append -displayof $w $data
1059         $w delete sel.first sel.last
1060     }
1061 }
1062
1063 # ::tk_textPaste --
1064 # This procedure pastes the contents of the clipboard to the insertion
1065 # point in a text widget.
1066 #
1067 # Arguments:
1068 # w -           Name of a text widget.
1069
1070 proc ::tk_textPaste w {
1071     global tcl_platform
1072     if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
1073         set oldSeparator [$w cget -autoseparators]
1074         if {$oldSeparator} {
1075             $w configure -autoseparators 0
1076             $w edit separator
1077         }
1078         if {[tk windowingsystem] ne "x11"} {
1079             catch { $w delete sel.first sel.last }
1080         }
1081         $w insert insert $sel
1082         if {$oldSeparator} {
1083             $w edit separator
1084             $w configure -autoseparators 1
1085         }
1086     }
1087 }
1088
1089 # ::tk::TextNextWord --
1090 # Returns the index of the next word position after a given position in the
1091 # text.  The next word is platform dependent and may be either the next
1092 # end-of-word position or the next start-of-word position after the next
1093 # end-of-word position.
1094 #
1095 # Arguments:
1096 # w -           The text window in which the cursor is to move.
1097 # start -       Position at which to start search.
1098
1099 if {[tk windowingsystem] eq "win32"}  {
1100     proc ::tk::TextNextWord {w start} {
1101         TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
1102                 tcl_startOfNextWord
1103     }
1104 } else {
1105     proc ::tk::TextNextWord {w start} {
1106         TextNextPos $w $start tcl_endOfWord
1107     }
1108 }
1109
1110 # ::tk::TextNextPos --
1111 # Returns the index of the next position after the given starting
1112 # position in the text as computed by a specified function.
1113 #
1114 # Arguments:
1115 # w -           The text window in which the cursor is to move.
1116 # start -       Position at which to start search.
1117 # op -          Function to use to find next position.
1118
1119 proc ::tk::TextNextPos {w start op} {
1120     set text ""
1121     set cur $start
1122     while {[$w compare $cur < end]} {
1123         set text $text[$w get -displaychars $cur "$cur lineend + 1c"]
1124         set pos [$op $text 0]
1125         if {$pos >= 0} {
1126             return [$w index "$start + $pos display chars"]
1127         }
1128         set cur [$w index "$cur lineend +1c"]
1129     }
1130     return end
1131 }
1132
1133 # ::tk::TextPrevPos --
1134 # Returns the index of the previous position before the given starting
1135 # position in the text as computed by a specified function.
1136 #
1137 # Arguments:
1138 # w -           The text window in which the cursor is to move.
1139 # start -       Position at which to start search.
1140 # op -          Function to use to find next position.
1141
1142 proc ::tk::TextPrevPos {w start op} {
1143     set text ""
1144     set cur $start
1145     while {[$w compare $cur > 0.0]} {
1146         set text [$w get -displaychars "$cur linestart - 1c" $cur]$text
1147         set pos [$op $text end]
1148         if {$pos >= 0} {
1149             return [$w index "$cur linestart - 1c + $pos display chars"]
1150         }
1151         set cur [$w index "$cur linestart - 1c"]
1152     }
1153     return 0.0
1154 }
1155
1156 # ::tk::TextScanMark --
1157 #
1158 # Marks the start of a possible scan drag operation
1159 #
1160 # Arguments:
1161 # w -   The text window from which the text to get
1162 # x -   x location on screen
1163 # y -   y location on screen
1164
1165 proc ::tk::TextScanMark {w x y} {
1166     variable ::tk::Priv
1167     $w scan mark $x $y
1168     set Priv(x) $x
1169     set Priv(y) $y
1170     set Priv(mouseMoved) 0
1171 }
1172
1173 # ::tk::TextScanDrag --
1174 #
1175 # Marks the start of a possible scan drag operation
1176 #
1177 # Arguments:
1178 # w -   The text window from which the text to get
1179 # x -   x location on screen
1180 # y -   y location on screen
1181
1182 proc ::tk::TextScanDrag {w x y} {
1183     variable ::tk::Priv
1184     # Make sure these exist, as some weird situations can trigger the
1185     # motion binding without the initial press.  [Bug #220269]
1186     if {![info exists Priv(x)]} {
1187         set Priv(x) $x
1188     }
1189     if {![info exists Priv(y)]} {
1190         set Priv(y) $y
1191     }
1192     if {($x != $Priv(x)) || ($y != $Priv(y))} {
1193         set Priv(mouseMoved) 1
1194     }
1195     if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
1196         $w scan dragto $x $y
1197     }
1198 }