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