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$ 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 45bind Text <1> { 46 tk::TextButton1 %W %x %y 47 %W tag remove sel 0.0 end 48} 49bind Text <B1-Motion> { 50 set tk::Priv(x) %x 51 set tk::Priv(y) %y 52 tk::TextSelectTo %W %x %y 53} 54bind Text <Double-1> { 55 set tk::Priv(selectMode) word 56 tk::TextSelectTo %W %x %y 57 catch {%W mark set insert sel.first} 58} 59bind Text <Triple-1> { 60 set tk::Priv(selectMode) line 61 tk::TextSelectTo %W %x %y 62 catch {%W mark set insert sel.first} 63} 64bind Text <Shift-1> { 65 tk::TextResetAnchor %W @%x,%y 66 set tk::Priv(selectMode) char 67 tk::TextSelectTo %W %x %y 68} 69bind Text <Double-Shift-1> { 70 set tk::Priv(selectMode) word 71 tk::TextSelectTo %W %x %y 1 72} 73bind Text <Triple-Shift-1> { 74 set tk::Priv(selectMode) line 75 tk::TextSelectTo %W %x %y 76} 77bind Text <B1-Leave> { 78 set tk::Priv(x) %x 79 set tk::Priv(y) %y 80 tk::TextAutoScan %W 81} 82bind Text <B1-Enter> { 83 tk::CancelRepeat 84} 85bind Text <ButtonRelease-1> { 86 tk::CancelRepeat 87} 88bind Text <Control-1> { 89 %W mark set insert @%x,%y 90} 91bind Text <Left> { 92 tk::TextSetCursor %W insert-1displayindices 93} 94bind Text <Right> { 95 tk::TextSetCursor %W insert+1displayindices 96} 97bind Text <Up> { 98 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 99} 100bind Text <Down> { 101 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 102} 103bind Text <Shift-Left> { 104 tk::TextKeySelect %W [%W index {insert - 1displayindices}] 105} 106bind Text <Shift-Right> { 107 tk::TextKeySelect %W [%W index {insert + 1displayindices}] 108} 109bind Text <Shift-Up> { 110 tk::TextKeySelect %W [tk::TextUpDownLine %W -1] 111} 112bind Text <Shift-Down> { 113 tk::TextKeySelect %W [tk::TextUpDownLine %W 1] 114} 115bind Text <Control-Left> { 116 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 117} 118bind Text <Control-Right> { 119 tk::TextSetCursor %W [tk::TextNextWord %W insert] 120} 121bind Text <Control-Up> { 122 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 123} 124bind Text <Control-Down> { 125 tk::TextSetCursor %W [tk::TextNextPara %W insert] 126} 127bind Text <Shift-Control-Left> { 128 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 129} 130bind Text <Shift-Control-Right> { 131 tk::TextKeySelect %W [tk::TextNextWord %W insert] 132} 133bind Text <Shift-Control-Up> { 134 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 135} 136bind Text <Shift-Control-Down> { 137 tk::TextKeySelect %W [tk::TextNextPara %W insert] 138} 139bind Text <Prior> { 140 tk::TextSetCursor %W [tk::TextScrollPages %W -1] 141} 142bind Text <Shift-Prior> { 143 tk::TextKeySelect %W [tk::TextScrollPages %W -1] 144} 145bind Text <Next> { 146 tk::TextSetCursor %W [tk::TextScrollPages %W 1] 147} 148bind Text <Shift-Next> { 149 tk::TextKeySelect %W [tk::TextScrollPages %W 1] 150} 151bind Text <Control-Prior> { 152 %W xview scroll -1 page 153} 154bind Text <Control-Next> { 155 %W xview scroll 1 page 156} 157 158bind Text <Home> { 159 tk::TextSetCursor %W {insert display linestart} 160} 161bind Text <Shift-Home> { 162 tk::TextKeySelect %W {insert display linestart} 163} 164bind Text <End> { 165 tk::TextSetCursor %W {insert display lineend} 166} 167bind Text <Shift-End> { 168 tk::TextKeySelect %W {insert display lineend} 169} 170bind Text <Control-Home> { 171 tk::TextSetCursor %W 1.0 172} 173bind Text <Control-Shift-Home> { 174 tk::TextKeySelect %W 1.0 175} 176bind Text <Control-End> { 177 tk::TextSetCursor %W {end - 1 indices} 178} 179bind Text <Control-Shift-End> { 180 tk::TextKeySelect %W {end - 1 indices} 181} 182 183bind Text <Tab> { 184 if {[%W cget -state] eq "normal"} { 185 tk::TextInsert %W \t 186 focus %W 187 break 188 } 189} 190bind Text <Shift-Tab> { 191 # Needed only to keep <Tab> binding from triggering; doesn't 192 # have to actually do anything. 193 break 194} 195bind Text <Control-Tab> { 196 focus [tk_focusNext %W] 197} 198bind Text <Control-Shift-Tab> { 199 focus [tk_focusPrev %W] 200} 201bind Text <Control-i> { 202 tk::TextInsert %W \t 203} 204bind Text <Return> { 205 tk::TextInsert %W \n 206 if {[%W cget -autoseparators]} { 207 %W edit separator 208 } 209} 210bind 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} 218bind 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 227bind Text <Control-space> { 228 %W mark set [tk::TextAnchor %W] insert 229} 230bind Text <Select> { 231 %W mark set [tk::TextAnchor %W] insert 232} 233bind Text <Control-Shift-space> { 234 set tk::Priv(selectMode) char 235 tk::TextKeyExtend %W insert 236} 237bind Text <Shift-Select> { 238 set tk::Priv(selectMode) char 239 tk::TextKeyExtend %W insert 240} 241bind Text <Control-slash> { 242 %W tag add sel 1.0 end 243} 244bind Text <Control-backslash> { 245 %W tag remove sel 1.0 end 246} 247bind Text <<Cut>> { 248 tk_textCut %W 249} 250bind Text <<Copy>> { 251 tk_textCopy %W 252} 253bind Text <<Paste>> { 254 tk_textPaste %W 255} 256bind Text <<Clear>> { 257 catch {%W delete sel.first sel.last} 258} 259bind Text <<PasteSelection>> { 260 if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] 261 || !$tk::Priv(mouseMoved)} { 262 tk::TextPasteSelection %W %x %y 263 } 264} 265bind Text <Insert> { 266 catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} 267} 268bind 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 277bind Text <Alt-KeyPress> {# nothing } 278bind Text <Meta-KeyPress> {# nothing} 279bind Text <Control-KeyPress> {# nothing} 280bind Text <Escape> {# nothing} 281bind Text <KP_Enter> {# nothing} 282if {[tk windowingsystem] eq "aqua"} { 283 bind Text <Command-KeyPress> {# nothing} 284} 285 286# Additional emacs-like bindings: 287 288bind Text <Control-a> { 289 if {!$tk_strictMotif} { 290 tk::TextSetCursor %W {insert display linestart} 291 } 292} 293bind Text <Control-b> { 294 if {!$tk_strictMotif} { 295 tk::TextSetCursor %W insert-1displayindices 296 } 297} 298bind Text <Control-d> { 299 if {!$tk_strictMotif && [%W compare end != insert+1c]} { 300 %W delete insert 301 } 302} 303bind Text <Control-e> { 304 if {!$tk_strictMotif} { 305 tk::TextSetCursor %W {insert display lineend} 306 } 307} 308bind Text <Control-f> { 309 if {!$tk_strictMotif} { 310 tk::TextSetCursor %W insert+1displayindices 311 } 312} 313bind 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} 322bind Text <Control-n> { 323 if {!$tk_strictMotif} { 324 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 325 } 326} 327bind Text <Control-o> { 328 if {!$tk_strictMotif} { 329 %W insert insert \n 330 %W mark set insert insert-1c 331 } 332} 333bind Text <Control-p> { 334 if {!$tk_strictMotif} { 335 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 336 } 337} 338bind Text <Control-t> { 339 if {!$tk_strictMotif} { 340 tk::TextTranspose %W 341 } 342} 343 344bind Text <<Undo>> { 345 catch { %W edit undo } 346} 347 348bind Text <<Redo>> { 349 catch { %W edit redo } 350} 351 352bind Text <Meta-b> { 353 if {!$tk_strictMotif} { 354 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 355 } 356} 357bind Text <Meta-d> { 358 if {!$tk_strictMotif && [%W compare end != insert+1c]} { 359 %W delete insert [tk::TextNextWord %W insert] 360 } 361} 362bind Text <Meta-f> { 363 if {!$tk_strictMotif} { 364 tk::TextSetCursor %W [tk::TextNextWord %W insert] 365 } 366} 367bind Text <Meta-less> { 368 if {!$tk_strictMotif} { 369 tk::TextSetCursor %W 1.0 370 } 371} 372bind Text <Meta-greater> { 373 if {!$tk_strictMotif} { 374 tk::TextSetCursor %W end-1c 375 } 376} 377bind Text <Meta-BackSpace> { 378 if {!$tk_strictMotif} { 379 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert 380 } 381} 382bind 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 390if {[tk windowingsystem] eq "aqua"} { 391bind Text <Option-Left> { 392 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 393} 394bind Text <Option-Right> { 395 tk::TextSetCursor %W [tk::TextNextWord %W insert] 396} 397bind Text <Option-Up> { 398 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 399} 400bind Text <Option-Down> { 401 tk::TextSetCursor %W [tk::TextNextPara %W insert] 402} 403bind Text <Shift-Option-Left> { 404 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 405} 406bind Text <Shift-Option-Right> { 407 tk::TextKeySelect %W [tk::TextNextWord %W insert] 408} 409bind Text <Shift-Option-Up> { 410 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 411} 412bind Text <Shift-Option-Down> { 413 tk::TextKeySelect %W [tk::TextNextPara %W insert] 414} 415bind 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 424bind Text <Control-h> { 425 if {!$tk_strictMotif && [%W compare insert != 1.0]} { 426 %W delete insert-1c 427 %W see insert 428 } 429} 430bind Text <2> { 431 if {!$tk_strictMotif} { 432 tk::TextScanMark %W %x %y 433 } 434} 435bind Text <B2-Motion> { 436 if {!$tk_strictMotif} { 437 tk::TextScanDrag %W %x %y 438 } 439} 440set ::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 447if {[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 476if {"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 503proc ::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 525proc ::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 570set ::tk::Priv(textanchoruid) 0 571 572proc ::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 580proc ::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 656proc ::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 684proc ::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 714proc ::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 744proc ::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 766proc ::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 806proc ::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 855proc ::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 872proc ::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 906proc ::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 933proc ::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 959proc ::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 992proc ::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 1011proc ::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 1042proc ::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 1057proc ::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 1072proc ::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 1101if {$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 1121proc ::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 1144proc ::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 1167proc ::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 1184proc ::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} 1201