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