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