util/X86LINUX64/lib/tk8.6/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 <<PrevChar>> {
 123     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
 124 }
 125 bind Entry <<NextChar>> {
 126     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
 127 }
 128 bind Entry <<SelectPrevChar>> {
 129     tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
 130     tk::EntrySeeInsert %W
 131 }
 132 bind Entry <<SelectNextChar>> {
 133     tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
 134     tk::EntrySeeInsert %W
 135 }
 136 bind Entry <<PrevWord>> {
 137     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
 138 }
 139 bind Entry <<NextWord>> {
 140     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
 141 }
 142 bind Entry <<SelectPrevWord>> {
 143     tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
 144     tk::EntrySeeInsert %W
 145 }
 146 bind Entry <<SelectNextWord>> {
 147     tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
 148     tk::EntrySeeInsert %W
 149 }
 150 bind Entry <<LineStart>> {
 151     tk::EntrySetCursor %W 0
 152 }
 153 bind Entry <<SelectLineStart>> {
 154     tk::EntryKeySelect %W 0
 155     tk::EntrySeeInsert %W
 156 }
 157 bind Entry <<LineEnd>> {
 158     tk::EntrySetCursor %W end
 159 }
 160 bind Entry <<SelectLineEnd>> {
 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 <<SelectAll>> {
 189     %W selection range 0 end
 190 }
 191 bind Entry <<SelectNone>> {
 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 bind Entry <Prior> {# nothing}
 212 bind Entry <Next> {# nothing}
 213 if {[tk windowingsystem] eq "aqua"} {
 214     bind Entry <Command-KeyPress> {# nothing}
 215 }
 216 # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
 217 bind Entry <<NextLine>> {# nothing}
 218 bind Entry <<PrevLine>> {# nothing}
 219
 220 # On Windows, paste is done using Shift-Insert.  Shift-Insert already
 221 # generates the <<Paste>> event, so we don't need to do anything here.
 222 if {[tk windowingsystem] ne "win32"} {
 223     bind Entry <Insert> {
 224         catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
 225     }
 226 }
 227
 228 # Additional emacs-like bindings:
 229
 230 bind Entry <Control-d> {
 231     if {!$tk_strictMotif} {
 232         %W delete insert
 233     }
 234 }
 235 bind Entry <Control-h> {
 236     if {!$tk_strictMotif} {
 237         tk::EntryBackspace %W
 238     }
 239 }
 240 bind Entry <Control-k> {
 241     if {!$tk_strictMotif} {
 242         %W delete insert end
 243     }
 244 }
 245 bind Entry <Control-t> {
 246     if {!$tk_strictMotif} {
 247         tk::EntryTranspose %W
 248     }
 249 }
 250 bind Entry <Meta-b> {
 251     if {!$tk_strictMotif} {
 252         tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
 253     }
 254 }
 255 bind Entry <Meta-d> {
 256     if {!$tk_strictMotif} {
 257         %W delete insert [tk::EntryNextWord %W insert]
 258     }
 259 }
 260 bind Entry <Meta-f> {
 261     if {!$tk_strictMotif} {
 262         tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
 263     }
 264 }
 265 bind Entry <Meta-BackSpace> {
 266     if {!$tk_strictMotif} {
 267         %W delete [tk::EntryPreviousWord %W insert] insert
 268     }
 269 }
 270 bind Entry <Meta-Delete> {
 271     if {!$tk_strictMotif} {
 272         %W delete [tk::EntryPreviousWord %W insert] insert
 273     }
 274 }
 275
 276 # A few additional bindings of my own.
 277
 278 bind Entry <2> {
 279     if {!$tk_strictMotif} {
 280         ::tk::EntryScanMark %W %x
 281     }
 282 }
 283 bind Entry <B2-Motion> {
 284     if {!$tk_strictMotif} {
 285         ::tk::EntryScanDrag %W %x
 286     }
 287 }
 288
 289 # ::tk::EntryClosestGap --
 290 # Given x and y coordinates, this procedure finds the closest boundary
 291 # between characters to the given coordinates and returns the index
 292 # of the character just after the boundary.
 293 #
 294 # Arguments:
 295 # w -           The entry window.
 296 # x -           X-coordinate within the window.
 297
 298 proc ::tk::EntryClosestGap {w x} {
 299     set pos [$w index @$x]
 300     set bbox [$w bbox $pos]
 301     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
 302         return $pos
 303     }
 304     incr pos
 305 }
 306
 307 # ::tk::EntryButton1 --
 308 # This procedure is invoked to handle button-1 presses in entry
 309 # widgets.  It moves the insertion cursor, sets the selection anchor,
 310 # and claims the input focus.
 311 #
 312 # Arguments:
 313 # w -           The entry window in which the button was pressed.
 314 # x -           The x-coordinate of the button press.
 315
 316 proc ::tk::EntryButton1 {w x} {
 317     variable ::tk::Priv
 318
 319     set Priv(selectMode) char
 320     set Priv(mouseMoved) 0
 321     set Priv(pressX) $x
 322     $w icursor [EntryClosestGap $w $x]
 323     $w selection from insert
 324     if {"disabled" ne [$w cget -state]} {
 325         focus $w
 326     }
 327 }
 328
 329 # ::tk::EntryMouseSelect --
 330 # This procedure is invoked when dragging out a selection with
 331 # the mouse.  Depending on the selection mode (character, word,
 332 # line) it selects in different-sized units.  This procedure
 333 # ignores mouse motions initially until the mouse has moved from
 334 # one character to another or until there have been multiple clicks.
 335 #
 336 # Arguments:
 337 # w -           The entry window in which the button was pressed.
 338 # x -           The x-coordinate of the mouse.
 339
 340 proc ::tk::EntryMouseSelect {w x} {
 341     variable ::tk::Priv
 342
 343     set cur [EntryClosestGap $w $x]
 344     set anchor [$w index anchor]
 345     if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
 346         set Priv(mouseMoved) 1
 347     }
 348     switch $Priv(selectMode) {
 349         char {
 350             if {$Priv(mouseMoved)} {
 351                 if {$cur < $anchor} {
 352                     $w selection range $cur $anchor
 353                 } elseif {$cur > $anchor} {
 354                     $w selection range $anchor $cur
 355                 } else {
 356                     $w selection clear
 357                 }
 358             }
 359         }
 360         word {
 361             if {$cur < [$w index anchor]} {
 362                 set before [tcl_wordBreakBefore [$w get] $cur]
 363                 set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
 364             } else {
 365                 set before [tcl_wordBreakBefore [$w get] $anchor]
 366                 set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
 367             }
 368             if {$before < 0} {
 369                 set before 0
 370             }
 371             if {$after < 0} {
 372                 set after end
 373             }
 374             $w selection range $before $after
 375         }
 376         line {
 377             $w selection range 0 end
 378         }
 379     }
 380     if {$Priv(mouseMoved)} {
 381         $w icursor $cur
 382     }
 383     update idletasks
 384 }
 385
 386 # ::tk::EntryPaste --
 387 # This procedure sets the insertion cursor to the current mouse position,
 388 # pastes the selection there, and sets the focus to the window.
 389 #
 390 # Arguments:
 391 # w -           The entry window.
 392 # x -           X position of the mouse.
 393
 394 proc ::tk::EntryPaste {w x} {
 395     $w icursor [EntryClosestGap $w $x]
 396     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
 397     if {"disabled" ne [$w cget -state]} {
 398         focus $w
 399     }
 400 }
 401
 402 # ::tk::EntryAutoScan --
 403 # This procedure is invoked when the mouse leaves an entry window
 404 # with button 1 down.  It scrolls the window left or right,
 405 # depending on where the mouse is, and reschedules itself as an
 406 # "after" command so that the window continues to scroll until the
 407 # mouse moves back into the window or the mouse button is released.
 408 #
 409 # Arguments:
 410 # w -           The entry window.
 411
 412 proc ::tk::EntryAutoScan {w} {
 413     variable ::tk::Priv
 414     set x $Priv(x)
 415     if {![winfo exists $w]} {
 416         return
 417     }
 418     if {$x >= [winfo width $w]} {
 419         $w xview scroll 2 units
 420         EntryMouseSelect $w $x
 421     } elseif {$x < 0} {
 422         $w xview scroll -2 units
 423         EntryMouseSelect $w $x
 424     }
 425     set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
 426 }
 427
 428 # ::tk::EntryKeySelect --
 429 # This procedure is invoked when stroking out selections using the
 430 # keyboard.  It moves the cursor to a new position, then extends
 431 # the selection to that position.
 432 #
 433 # Arguments:
 434 # w -           The entry window.
 435 # new -         A new position for the insertion cursor (the cursor hasn't
 436 #               actually been moved to this position yet).
 437
 438 proc ::tk::EntryKeySelect {w new} {
 439     if {![$w selection present]} {
 440         $w selection from insert
 441         $w selection to $new
 442     } else {
 443         $w selection adjust $new
 444     }
 445     $w icursor $new
 446 }
 447
 448 # ::tk::EntryInsert --
 449 # Insert a string into an entry at the point of the insertion cursor.
 450 # If there is a selection in the entry, and it covers the point of the
 451 # insertion cursor, then delete the selection before inserting.
 452 #
 453 # Arguments:
 454 # w -           The entry window in which to insert the string
 455 # s -           The string to insert (usually just a single character)
 456
 457 proc ::tk::EntryInsert {w s} {
 458     if {$s eq ""} {
 459         return
 460     }
 461     catch {
 462         set insert [$w index insert]
 463         if {([$w index sel.first] <= $insert)
 464                 && ([$w index sel.last] >= $insert)} {
 465             $w delete sel.first sel.last
 466         }
 467     }
 468     $w insert insert $s
 469     EntrySeeInsert $w
 470 }
 471
 472 # ::tk::EntryBackspace --
 473 # Backspace over the character just before the insertion cursor.
 474 # If backspacing would move the cursor off the left edge of the
 475 # window, reposition the cursor at about the middle of the window.
 476 #
 477 # Arguments:
 478 # w -           The entry window in which to backspace.
 479
 480 proc ::tk::EntryBackspace w {
 481     if {[$w selection present]} {
 482         $w delete sel.first sel.last
 483     } else {
 484         set x [expr {[$w index insert] - 1}]
 485         if {$x >= 0} {
 486             $w delete $x
 487         }
 488         if {[$w index @0] >= [$w index insert]} {
 489             set range [$w xview]
 490             set left [lindex $range 0]
 491             set right [lindex $range 1]
 492             $w xview moveto [expr {$left - ($right - $left)/2.0}]
 493         }
 494     }
 495 }
 496
 497 # ::tk::EntrySeeInsert --
 498 # Make sure that the insertion cursor is visible in the entry window.
 499 # If not, adjust the view so that it is.
 500 #
 501 # Arguments:
 502 # w -           The entry window.
 503
 504 proc ::tk::EntrySeeInsert w {
 505     set c [$w index insert]
 506     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
 507         $w xview $c
 508     }
 509 }
 510
 511 # ::tk::EntrySetCursor -
 512 # Move the insertion cursor to a given position in an entry.  Also
 513 # clears the selection, if there is one in the entry, and makes sure
 514 # that the insertion cursor is visible.
 515 #
 516 # Arguments:
 517 # w -           The entry window.
 518 # pos -         The desired new position for the cursor in the window.
 519
 520 proc ::tk::EntrySetCursor {w pos} {
 521     $w icursor $pos
 522     $w selection clear
 523     EntrySeeInsert $w
 524 }
 525
 526 # ::tk::EntryTranspose -
 527 # This procedure implements the "transpose" function for entry widgets.
 528 # It tranposes the characters on either side of the insertion cursor,
 529 # unless the cursor is at the end of the line.  In this case it
 530 # transposes the two characters to the left of the cursor.  In either
 531 # case, the cursor ends up to the right of the transposed characters.
 532 #
 533 # Arguments:
 534 # w -           The entry window.
 535
 536 proc ::tk::EntryTranspose w {
 537     set i [$w index insert]
 538     if {$i < [$w index end]} {
 539         incr i
 540     }
 541     set first [expr {$i-2}]
 542     if {$first < 0} {
 543         return
 544     }
 545     set data [$w get]
 546     set new [string index $data [expr {$i-1}]][string index $data $first]
 547     $w delete $first $i
 548     $w insert insert $new
 549     EntrySeeInsert $w
 550 }
 551
 552 # ::tk::EntryNextWord --
 553 # Returns the index of the next word position after a given position in the
 554 # entry.  The next word is platform dependent and may be either the next
 555 # end-of-word position or the next start-of-word position after the next
 556 # end-of-word position.
 557 #
 558 # Arguments:
 559 # w -           The entry window in which the cursor is to move.
 560 # start -       Position at which to start search.
 561
 562 if {[tk windowingsystem] eq "win32"}  {
 563     proc ::tk::EntryNextWord {w start} {
 564         set pos [tcl_endOfWord [$w get] [$w index $start]]
 565         if {$pos >= 0} {
 566             set pos [tcl_startOfNextWord [$w get] $pos]
 567         }
 568         if {$pos < 0} {
 569             return end
 570         }
 571         return $pos
 572     }
 573 } else {
 574     proc ::tk::EntryNextWord {w start} {
 575         set pos [tcl_endOfWord [$w get] [$w index $start]]
 576         if {$pos < 0} {
 577             return end
 578         }
 579         return $pos
 580     }
 581 }
 582
 583 # ::tk::EntryPreviousWord --
 584 #
 585 # Returns the index of the previous word position before a given
 586 # position in the entry.
 587 #
 588 # Arguments:
 589 # w -           The entry window in which the cursor is to move.
 590 # start -       Position at which to start search.
 591
 592 proc ::tk::EntryPreviousWord {w start} {
 593     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
 594     if {$pos < 0} {
 595         return 0
 596     }
 597     return $pos
 598 }
 599
 600 # ::tk::EntryScanMark --
 601 #
 602 # Marks the start of a possible scan drag operation
 603 #
 604 # Arguments:
 605 # w -   The entry window from which the text to get
 606 # x -   x location on screen
 607
 608 proc ::tk::EntryScanMark {w x} {
 609     $w scan mark $x
 610     set ::tk::Priv(x) $x
 611     set ::tk::Priv(y) 0 ; # not used
 612     set ::tk::Priv(mouseMoved) 0
 613 }
 614
 615 # ::tk::EntryScanDrag --
 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::EntryScanDrag {w x} {
 624     # Make sure these exist, as some weird situations can trigger the
 625     # motion binding without the initial press.  [Bug #220269]
 626     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
 627     # allow for a delta
 628     if {abs($x-$::tk::Priv(x)) > 2} {
 629         set ::tk::Priv(mouseMoved) 1
 630     }
 631     $w scan dragto $x
 632 }
 633
 634 # ::tk::EntryGetSelection --
 635 #
 636 # Returns the selected text of the entry with respect to the -show option.
 637 #
 638 # Arguments:
 639 # w -         The entry window from which the text to get
 640
 641 proc ::tk::EntryGetSelection {w} {
 642     set entryString [string range [$w get] [$w index sel.first] \
 643             [expr {[$w index sel.last] - 1}]]
 644     if {[$w cget -show] ne ""} {
 645         return [string repeat [string index [$w cget -show] 0] \
 646                 [string length $entryString]]
 647     }
 648     return $entryString
 649 }