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