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