mingw/lib/tk8.5/entry.tcl

   1 # entry.tcl --
   2 #
   3 # This file defines the default bindings for Tk entry widgets and provides
   4 # procedures that help in implementing those bindings.
   5 #
   6 # RCS: @(#) $Id: entry.tcl,v 1.26 2007/12/13 15:26:27 dgp Exp $
   7 #
   8 # Copyright (c) 1992-1994 The Regents of the University of California.
   9 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10 #
  11 # See the file "license.terms" for information on usage and redistribution
  12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13 #
  14
  15 #-------------------------------------------------------------------------
  16 # Elements of tk::Priv that are used in this file:
  17 #
  18 # afterId -             If non-null, it means that auto-scanning is underway
  19 #                       and it gives the "after" id for the next auto-scan
  20 #                       command to be executed.
  21 # mouseMoved -          Non-zero means the mouse has moved a significant
  22 #                       amount since the button went down (so, for example,
  23 #                       start dragging out a selection).
  24 # pressX -              X-coordinate at which the mouse button was pressed.
  25 # selectMode -          The style of selection currently underway:
  26 #                       char, word, or line.
  27 # x, y -                Last known mouse coordinates for scanning
  28 #                       and auto-scanning.
  29 # data -                Used for Cut and Copy
  30 #-------------------------------------------------------------------------
  31
  32 #-------------------------------------------------------------------------
  33 # The code below creates the default class bindings for entries.
  34 #-------------------------------------------------------------------------
  35 bind Entry <<Cut>> {
  36     if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  37         clipboard clear -displayof %W
  38         clipboard append -displayof %W $tk::Priv(data)
  39         %W delete sel.first sel.last
  40         unset tk::Priv(data)
  41     }
  42 }
  43 bind Entry <<Copy>> {
  44     if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  45         clipboard clear -displayof %W
  46         clipboard append -displayof %W $tk::Priv(data)
  47         unset tk::Priv(data)
  48     }
  49 }
  50 bind Entry <<Paste>> {
  51     global tcl_platform
  52     catch {
  53         if {[tk windowingsystem] ne "x11"} {
  54             catch {
  55                 %W delete sel.first sel.last
  56             }
  57         }
  58         %W insert insert [::tk::GetSelection %W CLIPBOARD]
  59         tk::EntrySeeInsert %W
  60     }
  61 }
  62 bind Entry <<Clear>> {
  63     # ignore if there is no selection
  64     catch { %W delete sel.first sel.last }
  65 }
  66 bind Entry <<PasteSelection>> {
  67     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  68         || !$tk::Priv(mouseMoved)} {
  69         tk::EntryPaste %W %x
  70     }
  71 }
  72
  73 bind Entry <<TraverseIn>> {
  74     %W selection range 0 end
  75     %W icursor end
  76 }
  77
  78 # Standard Motif bindings:
  79
  80 bind Entry <1> {
  81     tk::EntryButton1 %W %x
  82     %W selection clear
  83 }
  84 bind Entry <B1-Motion> {
  85     set tk::Priv(x) %x
  86     tk::EntryMouseSelect %W %x
  87 }
  88 bind Entry <Double-1> {
  89     set tk::Priv(selectMode) word
  90     tk::EntryMouseSelect %W %x
  91     catch {%W icursor sel.last}
  92 }
  93 bind Entry <Triple-1> {
  94     set tk::Priv(selectMode) line
  95     tk::EntryMouseSelect %W %x
  96     catch {%W icursor sel.last}
  97 }
  98 bind Entry <Shift-1> {
  99     set tk::Priv(selectMode) char
 100     %W selection adjust @%x
 101 }
 102 bind Entry <Double-Shift-1>     {
 103     set tk::Priv(selectMode) word
 104     tk::EntryMouseSelect %W %x
 105 }
 106 bind Entry <Triple-Shift-1>     {
 107     set tk::Priv(selectMode) line
 108     tk::EntryMouseSelect %W %x
 109 }
 110 bind Entry <B1-Leave> {
 111     set tk::Priv(x) %x
 112     tk::EntryAutoScan %W
 113 }
 114 bind Entry <B1-Enter> {
 115     tk::CancelRepeat
 116 }
 117 bind Entry <ButtonRelease-1> {
 118     tk::CancelRepeat
 119 }
 120 bind Entry <Control-1> {
 121     %W icursor @%x
 122 }
 123
 124 bind Entry <Left> {
 125     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
 126 }
 127 bind Entry <Right> {
 128     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
 129 }
 130 bind Entry <Shift-Left> {
 131     tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
 132     tk::EntrySeeInsert %W
 133 }
 134 bind Entry <Shift-Right> {
 135     tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
 136     tk::EntrySeeInsert %W
 137 }
 138 bind Entry <Control-Left> {
 139     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
 140 }
 141 bind Entry <Control-Right> {
 142     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
 143 }
 144 bind Entry <Shift-Control-Left> {
 145     tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
 146     tk::EntrySeeInsert %W
 147 }
 148 bind Entry <Shift-Control-Right> {
 149     tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
 150     tk::EntrySeeInsert %W
 151 }
 152 bind Entry <Home> {
 153     tk::EntrySetCursor %W 0
 154 }
 155 bind Entry <Shift-Home> {
 156     tk::EntryKeySelect %W 0
 157     tk::EntrySeeInsert %W
 158 }
 159 bind Entry <End> {
 160     tk::EntrySetCursor %W end
 161 }
 162 bind Entry <Shift-End> {
 163     tk::EntryKeySelect %W end
 164     tk::EntrySeeInsert %W
 165 }
 166
 167 bind Entry <Delete> {
 168     if {[%W selection present]} {
 169         %W delete sel.first sel.last
 170     } else {
 171         %W delete insert
 172     }
 173 }
 174 bind Entry <BackSpace> {
 175     tk::EntryBackspace %W
 176 }
 177
 178 bind Entry <Control-space> {
 179     %W selection from insert
 180 }
 181 bind Entry <Select> {
 182     %W selection from insert
 183 }
 184 bind Entry <Control-Shift-space> {
 185     %W selection adjust insert
 186 }
 187 bind Entry <Shift-Select> {
 188     %W selection adjust insert
 189 }
 190 bind Entry <Control-slash> {
 191     %W selection range 0 end
 192 }
 193 bind Entry <Control-backslash> {
 194     %W selection clear
 195 }
 196 bind Entry <KeyPress> {
 197     tk::CancelRepeat
 198     tk::EntryInsert %W %A
 199 }
 200
 201 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 202 # Otherwise, if a widget binding for one of these is defined, the
 203 # <KeyPress> class binding will also fire and insert the character,
 204 # which is wrong.  Ditto for Escape, Return, and Tab.
 205
 206 bind Entry <Alt-KeyPress> {# nothing}
 207 bind Entry <Meta-KeyPress> {# nothing}
 208 bind Entry <Control-KeyPress> {# nothing}
 209 bind Entry <Escape> {# nothing}
 210 bind Entry <Return> {# nothing}
 211 bind Entry <KP_Enter> {# nothing}
 212 bind Entry <Tab> {# nothing}
 213 if {[tk windowingsystem] eq "aqua"} {
 214     bind Entry <Command-KeyPress> {# nothing}
 215 }
 216
 217 # On Windows, paste is done using Shift-Insert.  Shift-Insert already
 218 # generates the <<Paste>> event, so we don't need to do anything here.
 219 if {$tcl_platform(platform) ne "windows"} {
 220     bind Entry <Insert> {
 221         catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
 222     }
 223 }
 224
 225 # Additional emacs-like bindings:
 226
 227 bind Entry <Control-a> {
 228     if {!$tk_strictMotif} {
 229         tk::EntrySetCursor %W 0
 230     }
 231 }
 232 bind Entry <Control-b> {
 233     if {!$tk_strictMotif} {
 234         tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
 235     }
 236 }
 237 bind Entry <Control-d> {
 238     if {!$tk_strictMotif} {
 239         %W delete insert
 240     }
 241 }
 242 bind Entry <Control-e> {
 243     if {!$tk_strictMotif} {
 244         tk::EntrySetCursor %W end
 245     }
 246 }
 247 bind Entry <Control-f> {
 248     if {!$tk_strictMotif} {
 249         tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
 250     }
 251 }
 252 bind Entry <Control-h> {
 253     if {!$tk_strictMotif} {
 254         tk::EntryBackspace %W
 255     }
 256 }
 257 bind Entry <Control-k> {
 258     if {!$tk_strictMotif} {
 259         %W delete insert end
 260     }
 261 }
 262 bind Entry <Control-t> {
 263     if {!$tk_strictMotif} {
 264         tk::EntryTranspose %W
 265     }
 266 }
 267 bind Entry <Meta-b> {
 268     if {!$tk_strictMotif} {
 269         tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
 270     }
 271 }
 272 bind Entry <Meta-d> {
 273     if {!$tk_strictMotif} {
 274         %W delete insert [tk::EntryNextWord %W insert]
 275     }
 276 }
 277 bind Entry <Meta-f> {
 278     if {!$tk_strictMotif} {
 279         tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
 280     }
 281 }
 282 bind Entry <Meta-BackSpace> {
 283     if {!$tk_strictMotif} {
 284         %W delete [tk::EntryPreviousWord %W insert] insert
 285     }
 286 }
 287 bind Entry <Meta-Delete> {
 288     if {!$tk_strictMotif} {
 289         %W delete [tk::EntryPreviousWord %W insert] insert
 290     }
 291 }
 292
 293 # A few additional bindings of my own.
 294
 295 bind Entry <2> {
 296     if {!$tk_strictMotif} {
 297         ::tk::EntryScanMark %W %x
 298     }
 299 }
 300 bind Entry <B2-Motion> {
 301     if {!$tk_strictMotif} {
 302         ::tk::EntryScanDrag %W %x
 303     }
 304 }
 305
 306 # ::tk::EntryClosestGap --
 307 # Given x and y coordinates, this procedure finds the closest boundary
 308 # between characters to the given coordinates and returns the index
 309 # of the character just after the boundary.
 310 #
 311 # Arguments:
 312 # w -           The entry window.
 313 # x -           X-coordinate within the window.
 314
 315 proc ::tk::EntryClosestGap {w x} {
 316     set pos [$w index @$x]
 317     set bbox [$w bbox $pos]
 318     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
 319         return $pos
 320     }
 321     incr pos
 322 }
 323
 324 # ::tk::EntryButton1 --
 325 # This procedure is invoked to handle button-1 presses in entry
 326 # widgets.  It moves the insertion cursor, sets the selection anchor,
 327 # and claims the input focus.
 328 #
 329 # Arguments:
 330 # w -           The entry window in which the button was pressed.
 331 # x -           The x-coordinate of the button press.
 332
 333 proc ::tk::EntryButton1 {w x} {
 334     variable ::tk::Priv
 335
 336     set Priv(selectMode) char
 337     set Priv(mouseMoved) 0
 338     set Priv(pressX) $x
 339     $w icursor [EntryClosestGap $w $x]
 340     $w selection from insert
 341     if {"disabled" ne [$w cget -state]} {
 342         focus $w
 343     }
 344 }
 345
 346 # ::tk::EntryMouseSelect --
 347 # This procedure is invoked when dragging out a selection with
 348 # the mouse.  Depending on the selection mode (character, word,
 349 # line) it selects in different-sized units.  This procedure
 350 # ignores mouse motions initially until the mouse has moved from
 351 # one character to another or until there have been multiple clicks.
 352 #
 353 # Arguments:
 354 # w -           The entry window in which the button was pressed.
 355 # x -           The x-coordinate of the mouse.
 356
 357 proc ::tk::EntryMouseSelect {w x} {
 358     variable ::tk::Priv
 359
 360     set cur [EntryClosestGap $w $x]
 361     set anchor [$w index anchor]
 362     if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
 363         set Priv(mouseMoved) 1
 364     }
 365     switch $Priv(selectMode) {
 366         char {
 367             if {$Priv(mouseMoved)} {
 368                 if {$cur < $anchor} {
 369                     $w selection range $cur $anchor
 370                 } elseif {$cur > $anchor} {
 371                     $w selection range $anchor $cur
 372                 } else {
 373                     $w selection clear
 374                 }
 375             }
 376         }
 377         word {
 378             if {$cur < [$w index anchor]} {
 379                 set before [tcl_wordBreakBefore [$w get] $cur]
 380                 set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
 381             } else {
 382                 set before [tcl_wordBreakBefore [$w get] $anchor]
 383                 set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
 384             }
 385             if {$before < 0} {
 386                 set before 0
 387             }
 388             if {$after < 0} {
 389                 set after end
 390             }
 391             $w selection range $before $after
 392         }
 393         line {
 394             $w selection range 0 end
 395         }
 396     }
 397     if {$Priv(mouseMoved)} {
 398         $w icursor $cur
 399     }
 400     update idletasks
 401 }
 402
 403 # ::tk::EntryPaste --
 404 # This procedure sets the insertion cursor to the current mouse position,
 405 # pastes the selection there, and sets the focus to the window.
 406 #
 407 # Arguments:
 408 # w -           The entry window.
 409 # x -           X position of the mouse.
 410
 411 proc ::tk::EntryPaste {w x} {
 412     $w icursor [EntryClosestGap $w $x]
 413     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
 414     if {"disabled" ne [$w cget -state]} {
 415         focus $w
 416     }
 417 }
 418
 419 # ::tk::EntryAutoScan --
 420 # This procedure is invoked when the mouse leaves an entry window
 421 # with button 1 down.  It scrolls the window left or right,
 422 # depending on where the mouse is, and reschedules itself as an
 423 # "after" command so that the window continues to scroll until the
 424 # mouse moves back into the window or the mouse button is released.
 425 #
 426 # Arguments:
 427 # w -           The entry window.
 428
 429 proc ::tk::EntryAutoScan {w} {
 430     variable ::tk::Priv
 431     set x $Priv(x)
 432     if {![winfo exists $w]} {
 433         return
 434     }
 435     if {$x >= [winfo width $w]} {
 436         $w xview scroll 2 units
 437         EntryMouseSelect $w $x
 438     } elseif {$x < 0} {
 439         $w xview scroll -2 units
 440         EntryMouseSelect $w $x
 441     }
 442     set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
 443 }
 444
 445 # ::tk::EntryKeySelect --
 446 # This procedure is invoked when stroking out selections using the
 447 # keyboard.  It moves the cursor to a new position, then extends
 448 # the selection to that position.
 449 #
 450 # Arguments:
 451 # w -           The entry window.
 452 # new -         A new position for the insertion cursor (the cursor hasn't
 453 #               actually been moved to this position yet).
 454
 455 proc ::tk::EntryKeySelect {w new} {
 456     if {![$w selection present]} {
 457         $w selection from insert
 458         $w selection to $new
 459     } else {
 460         $w selection adjust $new
 461     }
 462     $w icursor $new
 463 }
 464
 465 # ::tk::EntryInsert --
 466 # Insert a string into an entry at the point of the insertion cursor.
 467 # If there is a selection in the entry, and it covers the point of the
 468 # insertion cursor, then delete the selection before inserting.
 469 #
 470 # Arguments:
 471 # w -           The entry window in which to insert the string
 472 # s -           The string to insert (usually just a single character)
 473
 474 proc ::tk::EntryInsert {w s} {
 475     if {$s eq ""} {
 476         return
 477     }
 478     catch {
 479         set insert [$w index insert]
 480         if {([$w index sel.first] <= $insert)
 481                 && ([$w index sel.last] >= $insert)} {
 482             $w delete sel.first sel.last
 483         }
 484     }
 485     $w insert insert $s
 486     EntrySeeInsert $w
 487 }
 488
 489 # ::tk::EntryBackspace --
 490 # Backspace over the character just before the insertion cursor.
 491 # If backspacing would move the cursor off the left edge of the
 492 # window, reposition the cursor at about the middle of the window.
 493 #
 494 # Arguments:
 495 # w -           The entry window in which to backspace.
 496
 497 proc ::tk::EntryBackspace w {
 498     if {[$w selection present]} {
 499         $w delete sel.first sel.last
 500     } else {
 501         set x [expr {[$w index insert] - 1}]
 502         if {$x >= 0} {
 503             $w delete $x
 504         }
 505         if {[$w index @0] >= [$w index insert]} {
 506             set range [$w xview]
 507             set left [lindex $range 0]
 508             set right [lindex $range 1]
 509             $w xview moveto [expr {$left - ($right - $left)/2.0}]
 510         }
 511     }
 512 }
 513
 514 # ::tk::EntrySeeInsert --
 515 # Make sure that the insertion cursor is visible in the entry window.
 516 # If not, adjust the view so that it is.
 517 #
 518 # Arguments:
 519 # w -           The entry window.
 520
 521 proc ::tk::EntrySeeInsert w {
 522     set c [$w index insert]
 523     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
 524         $w xview $c
 525     }
 526 }
 527
 528 # ::tk::EntrySetCursor -
 529 # Move the insertion cursor to a given position in an entry.  Also
 530 # clears the selection, if there is one in the entry, and makes sure
 531 # that the insertion cursor is visible.
 532 #
 533 # Arguments:
 534 # w -           The entry window.
 535 # pos -         The desired new position for the cursor in the window.
 536
 537 proc ::tk::EntrySetCursor {w pos} {
 538     $w icursor $pos
 539     $w selection clear
 540     EntrySeeInsert $w
 541 }
 542
 543 # ::tk::EntryTranspose -
 544 # This procedure implements the "transpose" function for entry widgets.
 545 # It tranposes the characters on either side of the insertion cursor,
 546 # unless the cursor is at the end of the line.  In this case it
 547 # transposes the two characters to the left of the cursor.  In either
 548 # case, the cursor ends up to the right of the transposed characters.
 549 #
 550 # Arguments:
 551 # w -           The entry window.
 552
 553 proc ::tk::EntryTranspose w {
 554     set i [$w index insert]
 555     if {$i < [$w index end]} {
 556         incr i
 557     }
 558     set first [expr {$i-2}]
 559     if {$first < 0} {
 560         return
 561     }
 562     set data [$w get]
 563     set new [string index $data [expr {$i-1}]][string index $data $first]
 564     $w delete $first $i
 565     $w insert insert $new
 566     EntrySeeInsert $w
 567 }
 568
 569 # ::tk::EntryNextWord --
 570 # Returns the index of the next word position after a given position in the
 571 # entry.  The next word is platform dependent and may be either the next
 572 # end-of-word position or the next start-of-word position after the next
 573 # end-of-word position.
 574 #
 575 # Arguments:
 576 # w -           The entry window in which the cursor is to move.
 577 # start -       Position at which to start search.
 578
 579 if {$tcl_platform(platform) eq "windows"}  {
 580     proc ::tk::EntryNextWord {w start} {
 581         set pos [tcl_endOfWord [$w get] [$w index $start]]
 582         if {$pos >= 0} {
 583             set pos [tcl_startOfNextWord [$w get] $pos]
 584         }
 585         if {$pos < 0} {
 586             return end
 587         }
 588         return $pos
 589     }
 590 } else {
 591     proc ::tk::EntryNextWord {w start} {
 592         set pos [tcl_endOfWord [$w get] [$w index $start]]
 593         if {$pos < 0} {
 594             return end
 595         }
 596         return $pos
 597     }
 598 }
 599
 600 # ::tk::EntryPreviousWord --
 601 #
 602 # Returns the index of the previous word position before a given
 603 # position in the entry.
 604 #
 605 # Arguments:
 606 # w -           The entry window in which the cursor is to move.
 607 # start -       Position at which to start search.
 608
 609 proc ::tk::EntryPreviousWord {w start} {
 610     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
 611     if {$pos < 0} {
 612         return 0
 613     }
 614     return $pos
 615 }
 616
 617 # ::tk::EntryScanMark --
 618 #
 619 # Marks the start of a possible scan drag operation
 620 #
 621 # Arguments:
 622 # w -   The entry window from which the text to get
 623 # x -   x location on screen
 624
 625 proc ::tk::EntryScanMark {w x} {
 626     $w scan mark $x
 627     set ::tk::Priv(x) $x
 628     set ::tk::Priv(y) 0 ; # not used
 629     set ::tk::Priv(mouseMoved) 0
 630 }
 631
 632 # ::tk::EntryScanDrag --
 633 #
 634 # Marks the start of a possible scan drag operation
 635 #
 636 # Arguments:
 637 # w -   The entry window from which the text to get
 638 # x -   x location on screen
 639
 640 proc ::tk::EntryScanDrag {w x} {
 641     # Make sure these exist, as some weird situations can trigger the
 642     # motion binding without the initial press.  [Bug #220269]
 643     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
 644     # allow for a delta
 645     if {abs($x-$::tk::Priv(x)) > 2} {
 646         set ::tk::Priv(mouseMoved) 1
 647     }
 648     $w scan dragto $x
 649 }
 650
 651 # ::tk::EntryGetSelection --
 652 #
 653 # Returns the selected text of the entry with respect to the -show option.
 654 #
 655 # Arguments:
 656 # w -         The entry window from which the text to get
 657
 658 proc ::tk::EntryGetSelection {w} {
 659     set entryString [string range [$w get] [$w index sel.first] \
 660             [expr {[$w index sel.last] - 1}]]
 661     if {[$w cget -show] ne ""} {
 662         return [string repeat [string index [$w cget -show] 0] \
 663                 [string length $entryString]]
 664     }
 665     return $entryString
 666 }