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