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