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