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 44bind Text <1> { 45 tk::TextButton1 %W %x %y 46 %W tag remove sel 0.0 end 47} 48bind Text <B1-Motion> { 49 set tk::Priv(x) %x 50 set tk::Priv(y) %y 51 tk::TextSelectTo %W %x %y 52} 53bind Text <Double-1> { 54 set tk::Priv(selectMode) word 55 tk::TextSelectTo %W %x %y 56 catch {%W mark set insert sel.last} 57} 58bind Text <Triple-1> { 59 set tk::Priv(selectMode) line 60 tk::TextSelectTo %W %x %y 61 catch {%W mark set insert sel.last} 62} 63bind Text <Shift-1> { 64 tk::TextResetAnchor %W @%x,%y 65 set tk::Priv(selectMode) char 66 tk::TextSelectTo %W %x %y 67} 68bind Text <Double-Shift-1> { 69 set tk::Priv(selectMode) word 70 tk::TextSelectTo %W %x %y 1 71} 72bind Text <Triple-Shift-1> { 73 set tk::Priv(selectMode) line 74 tk::TextSelectTo %W %x %y 75} 76bind Text <B1-Leave> { 77 set tk::Priv(x) %x 78 set tk::Priv(y) %y 79 tk::TextAutoScan %W 80} 81bind Text <B1-Enter> { 82 tk::CancelRepeat 83} 84bind Text <ButtonRelease-1> { 85 tk::CancelRepeat 86} 87bind Text <Control-1> { 88 %W mark set insert @%x,%y 89} 90bind Text <Left> { 91 tk::TextSetCursor %W insert-1c 92} 93bind Text <Right> { 94 tk::TextSetCursor %W insert+1c 95} 96bind Text <Up> { 97 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 98} 99bind Text <Down> { 100 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 101} 102bind Text <Shift-Left> { 103 tk::TextKeySelect %W [%W index {insert - 1c}] 104} 105bind Text <Shift-Right> { 106 tk::TextKeySelect %W [%W index {insert + 1c}] 107} 108bind Text <Shift-Up> { 109 tk::TextKeySelect %W [tk::TextUpDownLine %W -1] 110} 111bind Text <Shift-Down> { 112 tk::TextKeySelect %W [tk::TextUpDownLine %W 1] 113} 114bind Text <Control-Left> { 115 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 116} 117bind Text <Control-Right> { 118 tk::TextSetCursor %W [tk::TextNextWord %W insert] 119} 120bind Text <Control-Up> { 121 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 122} 123bind Text <Control-Down> { 124 tk::TextSetCursor %W [tk::TextNextPara %W insert] 125} 126bind Text <Shift-Control-Left> { 127 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 128} 129bind Text <Shift-Control-Right> { 130 tk::TextKeySelect %W [tk::TextNextWord %W insert] 131} 132bind Text <Shift-Control-Up> { 133 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 134} 135bind Text <Shift-Control-Down> { 136 tk::TextKeySelect %W [tk::TextNextPara %W insert] 137} 138bind Text <Prior> { 139 tk::TextSetCursor %W [tk::TextScrollPages %W -1] 140} 141bind Text <Shift-Prior> { 142 tk::TextKeySelect %W [tk::TextScrollPages %W -1] 143} 144bind Text <Next> { 145 tk::TextSetCursor %W [tk::TextScrollPages %W 1] 146} 147bind Text <Shift-Next> { 148 tk::TextKeySelect %W [tk::TextScrollPages %W 1] 149} 150bind Text <Control-Prior> { 151 %W xview scroll -1 page 152} 153bind Text <Control-Next> { 154 %W xview scroll 1 page 155} 156 157bind Text <Home> { 158 tk::TextSetCursor %W {insert linestart} 159} 160bind Text <Shift-Home> { 161 tk::TextKeySelect %W {insert linestart} 162} 163bind Text <End> { 164 tk::TextSetCursor %W {insert lineend} 165} 166bind Text <Shift-End> { 167 tk::TextKeySelect %W {insert lineend} 168} 169bind Text <Control-Home> { 170 tk::TextSetCursor %W 1.0 171} 172bind Text <Control-Shift-Home> { 173 tk::TextKeySelect %W 1.0 174} 175bind Text <Control-End> { 176 tk::TextSetCursor %W {end - 1 char} 177} 178bind Text <Control-Shift-End> { 179 tk::TextKeySelect %W {end - 1 char} 180} 181 182bind Text <Tab> { 183 if { [%W cget -state] eq "normal" } { 184 tk::TextInsert %W \t 185 focus %W 186 break 187 } 188} 189bind Text <Shift-Tab> { 190 # Needed only to keep <Tab> binding from triggering; doesn't 191 # have to actually do anything. 192 break 193} 194bind Text <Control-Tab> { 195 focus [tk_focusNext %W] 196} 197bind Text <Control-Shift-Tab> { 198 focus [tk_focusPrev %W] 199} 200bind Text <Control-i> { 201 tk::TextInsert %W \t 202} 203bind Text <Return> { 204 tk::TextInsert %W \n 205 if {[%W cget -autoseparators]} {%W edit separator} 206} 207bind 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} 215bind 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 224bind Text <Control-space> { 225 %W mark set anchor insert 226} 227bind Text <Select> { 228 %W mark set anchor insert 229} 230bind Text <Control-Shift-space> { 231 set tk::Priv(selectMode) char 232 tk::TextKeyExtend %W insert 233} 234bind Text <Shift-Select> { 235 set tk::Priv(selectMode) char 236 tk::TextKeyExtend %W insert 237} 238bind Text <Control-slash> { 239 %W tag add sel 1.0 end 240} 241bind Text <Control-backslash> { 242 %W tag remove sel 1.0 end 243} 244bind Text <<Cut>> { 245 tk_textCut %W 246} 247bind Text <<Copy>> { 248 tk_textCopy %W 249} 250bind Text <<Paste>> { 251 tk_textPaste %W 252} 253bind Text <<Clear>> { 254 catch {%W delete sel.first sel.last} 255} 256bind Text <<PasteSelection>> { 257 if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)] 258 || !$tk::Priv(mouseMoved)} { 259 tk::TextPasteSelection %W %x %y 260 } 261} 262bind Text <Insert> { 263 catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]} 264} 265bind 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 274bind Text <Alt-KeyPress> {# nothing } 275bind Text <Meta-KeyPress> {# nothing} 276bind Text <Control-KeyPress> {# nothing} 277bind Text <Escape> {# nothing} 278bind Text <KP_Enter> {# nothing} 279 280if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { 281 bind Text <Command-KeyPress> {# nothing} 282} 283 284# Additional emacs-like bindings: 285 286bind Text <Control-a> { 287 if {!$tk_strictMotif} { 288 tk::TextSetCursor %W {insert linestart} 289 } 290} 291bind Text <Control-b> { 292 if {!$tk_strictMotif} { 293 tk::TextSetCursor %W insert-1c 294 } 295} 296bind Text <Control-d> { 297 if {!$tk_strictMotif} { 298 %W delete insert 299 } 300} 301bind Text <Control-e> { 302 if {!$tk_strictMotif} { 303 tk::TextSetCursor %W {insert lineend} 304 } 305} 306bind Text <Control-f> { 307 if {!$tk_strictMotif} { 308 tk::TextSetCursor %W insert+1c 309 } 310} 311bind 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} 320bind Text <Control-n> { 321 if {!$tk_strictMotif} { 322 tk::TextSetCursor %W [tk::TextUpDownLine %W 1] 323 } 324} 325bind Text <Control-o> { 326 if {!$tk_strictMotif} { 327 %W insert insert \n 328 %W mark set insert insert-1c 329 } 330} 331bind Text <Control-p> { 332 if {!$tk_strictMotif} { 333 tk::TextSetCursor %W [tk::TextUpDownLine %W -1] 334 } 335} 336bind Text <Control-t> { 337 if {!$tk_strictMotif} { 338 tk::TextTranspose %W 339 } 340} 341 342bind Text <<Undo>> { 343 catch { %W edit undo } 344} 345 346bind Text <<Redo>> { 347 catch { %W edit redo } 348} 349 350if {$tcl_platform(platform) ne "windows"} { 351bind Text <Control-v> { 352 if {!$tk_strictMotif} { 353 tk::TextScrollPages %W 1 354 } 355} 356} 357 358bind Text <Meta-b> { 359 if {!$tk_strictMotif} { 360 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 361 } 362} 363bind Text <Meta-d> { 364 if {!$tk_strictMotif} { 365 %W delete insert [tk::TextNextWord %W insert] 366 } 367} 368bind Text <Meta-f> { 369 if {!$tk_strictMotif} { 370 tk::TextSetCursor %W [tk::TextNextWord %W insert] 371 } 372} 373bind Text <Meta-less> { 374 if {!$tk_strictMotif} { 375 tk::TextSetCursor %W 1.0 376 } 377} 378bind Text <Meta-greater> { 379 if {!$tk_strictMotif} { 380 tk::TextSetCursor %W end-1c 381 } 382} 383bind Text <Meta-BackSpace> { 384 if {!$tk_strictMotif} { 385 %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert 386 } 387} 388bind 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 396if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} { 397bind Text <FocusIn> { 398 %W configure -selectbackground systemHighlight -selectforeground systemHighlightText 399} 400bind Text <FocusOut> { 401 %W configure -selectbackground systemHighlightSecondary -selectforeground systemHighlightText 402} 403bind Text <Option-Left> { 404 tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 405} 406bind Text <Option-Right> { 407 tk::TextSetCursor %W [tk::TextNextWord %W insert] 408} 409bind Text <Option-Up> { 410 tk::TextSetCursor %W [tk::TextPrevPara %W insert] 411} 412bind Text <Option-Down> { 413 tk::TextSetCursor %W [tk::TextNextPara %W insert] 414} 415bind Text <Shift-Option-Left> { 416 tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] 417} 418bind Text <Shift-Option-Right> { 419 tk::TextKeySelect %W [tk::TextNextWord %W insert] 420} 421bind Text <Shift-Option-Up> { 422 tk::TextKeySelect %W [tk::TextPrevPara %W insert] 423} 424bind 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 433bind 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} 441bind Text <2> { 442 if {!$tk_strictMotif} { 443 tk::TextScanMark %W %x %y 444 } 445} 446bind Text <B2-Motion> { 447 if {!$tk_strictMotif} { 448 tk::TextScanDrag %W %x %y 449 } 450} 451set ::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 457if {[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 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 -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 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 $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 551proc ::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 618proc ::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 645proc ::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 673proc ::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 701proc ::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 722proc ::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 762proc ::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 813proc ::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 851proc ::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 876proc ::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 902proc ::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 935proc ::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 954proc ::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 985proc ::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 1000proc ::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 1015proc ::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 1045if {$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 1065proc ::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 1094proc ::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 1129proc ::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 1145proc ::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} 1157