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