mingw/lib/tk8.5/ttk/entry.tcl

   1 #
   2 # DERIVED FROM: tk/library/entry.tcl r1.22
   3 #
   4 # Copyright (c) 1992-1994 The Regents of the University of California.
   5 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
   6 # Copyright (c) 2004, Joe English
   7 #
   8 # See the file "license.terms" for information on usage and redistribution
   9 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10 #
  11
  12 namespace eval ttk {
  13     namespace eval entry {
  14         variable State
  15
  16         set State(x) 0
  17         set State(selectMode) char
  18         set State(anchor) 0
  19         set State(scanX) 0
  20         set State(scanIndex) 0
  21         set State(scanMoved) 0
  22
  23         # Button-2 scan speed is (scanNum/scanDen) characters
  24         # per pixel of mouse movement.
  25         # The standard Tk entry widget uses the equivalent of
  26         # scanNum = 10, scanDen = average character width.
  27         # I don't know why that was chosen.
  28         #
  29         set State(scanNum) 1
  30         set State(scanDen) 1
  31         set State(deadband) 3   ;# #pixels for mouse-moved deadband.
  32     }
  33 }
  34
  35 ### Option database settings.
  36 #
  37 option add *TEntry.cursor [ttk::cursor text]
  38
  39 ### Bindings.
  40 #
  41 # Removed the following standard Tk bindings:
  42 #
  43 # <Control-Key-space>, <Control-Shift-Key-space>,
  44 # <Key-Select>,  <Shift-Key-Select>:
  45 #       ttk::entry widget doesn't use selection anchor.
  46 # <Key-Insert>:
  47 #       Inserts PRIMARY selection (on non-Windows platforms).
  48 #       This is inconsistent with typical platform bindings.
  49 # <Double-Shift-ButtonPress-1>, <Triple-Shift-ButtonPress-1>:
  50 #       These don't do the right thing to start with.
  51 # <Meta-Key-b>, <Meta-Key-d>, <Meta-Key-f>,
  52 # <Meta-Key-BackSpace>, <Meta-Key-Delete>:
  53 #       Judgment call.  If <Meta> happens to be assigned to the Alt key,
  54 #       these could conflict with application accelerators.
  55 #       (Plus, who has a Meta key these days?)
  56 # <Control-Key-t>:
  57 #       Another judgment call.  If anyone misses this, let me know
  58 #       and I'll put it back.
  59 #
  60
  61 ## Clipboard events:
  62 #
  63 bind TEntry <<Cut>>                     { ttk::entry::Cut %W }
  64 bind TEntry <<Copy>>                    { ttk::entry::Copy %W }
  65 bind TEntry <<Paste>>                   { ttk::entry::Paste %W }
  66 bind TEntry <<Clear>>                   { ttk::entry::Clear %W }
  67
  68 ## Button1 bindings:
  69 #       Used for selection and navigation.
  70 #
  71 bind TEntry <ButtonPress-1>             { ttk::entry::Press %W %x }
  72 bind TEntry <Shift-ButtonPress-1>       { ttk::entry::Shift-Press %W %x }
  73 bind TEntry <Double-ButtonPress-1>      { ttk::entry::Select %W %x word }
  74 bind TEntry <Triple-ButtonPress-1>      { ttk::entry::Select %W %x line }
  75 bind TEntry <B1-Motion>                 { ttk::entry::Drag %W %x }
  76
  77 bind TEntry <B1-Leave>          { ttk::Repeatedly ttk::entry::AutoScroll %W }
  78 bind TEntry <B1-Enter>          { ttk::CancelRepeat }
  79 bind TEntry <ButtonRelease-1>   { ttk::CancelRepeat }
  80
  81 bind TEntry <Control-ButtonPress-1> {
  82     %W instate {!readonly !disabled} { %W icursor @%x ; focus %W }
  83 }
  84
  85 ## Button2 bindings:
  86 #       Used for scanning and primary transfer.
  87 #       Note: ButtonRelease-2 is mapped to <<PasteSelection>> in tk.tcl.
  88 #
  89 bind TEntry <ButtonPress-2>             { ttk::entry::ScanMark %W %x }
  90 bind TEntry <B2-Motion>                 { ttk::entry::ScanDrag %W %x }
  91 bind TEntry <ButtonRelease-2>           { ttk::entry::ScanRelease %W %x }
  92 bind TEntry <<PasteSelection>>          { ttk::entry::ScanRelease %W %x }
  93
  94 ## Keyboard navigation bindings:
  95 #
  96 bind TEntry <Key-Left>                  { ttk::entry::Move %W prevchar }
  97 bind TEntry <Key-Right>                 { ttk::entry::Move %W nextchar }
  98 bind TEntry <Control-Key-Left>          { ttk::entry::Move %W prevword }
  99 bind TEntry <Control-Key-Right>         { ttk::entry::Move %W nextword }
 100 bind TEntry <Key-Home>                  { ttk::entry::Move %W home }
 101 bind TEntry <Key-End>                   { ttk::entry::Move %W end }
 102
 103 bind TEntry <Shift-Key-Left>            { ttk::entry::Extend %W prevchar }
 104 bind TEntry <Shift-Key-Right>           { ttk::entry::Extend %W nextchar }
 105 bind TEntry <Shift-Control-Key-Left>    { ttk::entry::Extend %W prevword }
 106 bind TEntry <Shift-Control-Key-Right>   { ttk::entry::Extend %W nextword }
 107 bind TEntry <Shift-Key-Home>            { ttk::entry::Extend %W home }
 108 bind TEntry <Shift-Key-End>             { ttk::entry::Extend %W end }
 109
 110 bind TEntry <Control-Key-slash>         { %W selection range 0 end }
 111 bind TEntry <Control-Key-backslash>     { %W selection clear }
 112
 113 bind TEntry <<TraverseIn>>      { %W selection range 0 end; %W icursor end }
 114
 115 ## Edit bindings:
 116 #
 117 bind TEntry <KeyPress>                  { ttk::entry::Insert %W %A }
 118 bind TEntry <Key-Delete>                { ttk::entry::Delete %W }
 119 bind TEntry <Key-BackSpace>             { ttk::entry::Backspace %W }
 120
 121 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 122 # Otherwise, the <KeyPress> class binding will fire and insert the character.
 123 # Ditto for Escape, Return, and Tab.
 124 #
 125 bind TEntry <Alt-KeyPress>              {# nothing}
 126 bind TEntry <Meta-KeyPress>             {# nothing}
 127 bind TEntry <Control-KeyPress>          {# nothing}
 128 bind TEntry <Key-Escape>                {# nothing}
 129 bind TEntry <Key-Return>                {# nothing}
 130 bind TEntry <Key-KP_Enter>              {# nothing}
 131 bind TEntry <Key-Tab>                   {# nothing}
 132
 133 # Argh.  Apparently on Windows, the NumLock modifier is interpreted
 134 # as a Command modifier.
 135 if {[tk windowingsystem] eq "aqua"} {
 136     bind TEntry <Command-KeyPress>      {# nothing}
 137 }
 138 # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
 139 bind TEntry <Down>                      {# nothing}
 140 bind TEntry <Up>                        {# nothing}
 141
 142 ## Additional emacs-like bindings:
 143 #
 144 bind TEntry <Control-Key-a>             { ttk::entry::Move %W home }
 145 bind TEntry <Control-Key-b>             { ttk::entry::Move %W prevchar }
 146 bind TEntry <Control-Key-d>             { ttk::entry::Delete %W }
 147 bind TEntry <Control-Key-e>             { ttk::entry::Move %W end }
 148 bind TEntry <Control-Key-f>             { ttk::entry::Move %W nextchar }
 149 bind TEntry <Control-Key-h>             { ttk::entry::Backspace %W }
 150 bind TEntry <Control-Key-k>             { %W delete insert end }
 151
 152 ### Clipboard procedures.
 153 #
 154
 155 ## EntrySelection -- Return the selected text of the entry.
 156 #       Raises an error if there is no selection.
 157 #
 158 proc ttk::entry::EntrySelection {w} {
 159     set entryString [string range [$w get] [$w index sel.first] \
 160             [expr {[$w index sel.last] - 1}]]
 161     if {[$w cget -show] ne ""} {
 162         return [string repeat [string index [$w cget -show] 0] \
 163                 [string length $entryString]]
 164     }
 165     return $entryString
 166 }
 167
 168 ## Paste -- Insert clipboard contents at current insert point.
 169 #
 170 proc ttk::entry::Paste {w} {
 171     catch {
 172         set clipboard [::tk::GetSelection $w CLIPBOARD]
 173         PendingDelete $w
 174         $w insert insert $clipboard
 175         See $w insert
 176     }
 177 }
 178
 179 ## Copy -- Copy selection to clipboard.
 180 #
 181 proc ttk::entry::Copy {w} {
 182     if {![catch {EntrySelection $w} selection]} {
 183         clipboard clear -displayof $w
 184         clipboard append -displayof $w $selection
 185     }
 186 }
 187
 188 ## Clear -- Delete the selection.
 189 #
 190 proc ttk::entry::Clear {w} {
 191     catch { $w delete sel.first sel.last }
 192 }
 193
 194 ## Cut -- Copy selection to clipboard then delete it.
 195 #
 196 proc ttk::entry::Cut {w} {
 197     Copy $w; Clear $w
 198 }
 199
 200 ### Navigation procedures.
 201 #
 202
 203 ## ClosestGap -- Find closest boundary between characters.
 204 #       Returns the index of the character just after the boundary.
 205 #
 206 proc ttk::entry::ClosestGap {w x} {
 207     set pos [$w index @$x]
 208     set bbox [$w bbox $pos]
 209     if {$x - [lindex $bbox 0] > [lindex $bbox 2]/2} {
 210         incr pos
 211     }
 212     return $pos
 213 }
 214
 215 ## See $index -- Make sure that the character at $index is visible.
 216 #
 217 proc ttk::entry::See {w {index insert}} {
 218     update idletasks    ;# ensure scroll data up-to-date
 219     set c [$w index $index]
 220     # @@@ OR: check [$w index left] / [$w index right]
 221     if {$c < [$w index @0] || $c >= [$w index @[winfo width $w]]} {
 222         $w xview $c
 223     }
 224 }
 225
 226 ## NextWord -- Find the next word position.
 227 #       Note: The "next word position" follows platform conventions:
 228 #       either the next end-of-word position, or the start-of-word
 229 #       position following the next end-of-word position.
 230 #
 231 set ::ttk::entry::State(startNext) \
 232         [string equal $::tcl_platform(platform) "windows"]
 233
 234 proc ttk::entry::NextWord {w start} {
 235     variable State
 236     set pos [tcl_endOfWord [$w get] [$w index $start]]
 237     if {$pos >= 0 && $State(startNext)} {
 238         set pos [tcl_startOfNextWord [$w get] $pos]
 239     }
 240     if {$pos < 0} {
 241         return end
 242     }
 243     return $pos
 244 }
 245
 246 ## PrevWord -- Find the previous word position.
 247 #
 248 proc ttk::entry::PrevWord {w start} {
 249     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
 250     if {$pos < 0} {
 251         return 0
 252     }
 253     return $pos
 254 }
 255
 256 ## RelIndex -- Compute character/word/line-relative index.
 257 #
 258 proc ttk::entry::RelIndex {w where {index insert}} {
 259     switch -- $where {
 260         prevchar        { expr {[$w index $index] - 1} }
 261         nextchar        { expr {[$w index $index] + 1} }
 262         prevword        { PrevWord $w $index }
 263         nextword        { NextWord $w $index }
 264         home            { return 0 }
 265         end             { $w index end }
 266         default         { error "Bad relative index $index" }
 267     }
 268 }
 269
 270 ## Move -- Move insert cursor to relative location.
 271 #       Also clears the selection, if any, and makes sure
 272 #       that the insert cursor is visible.
 273 #
 274 proc ttk::entry::Move {w where} {
 275     $w icursor [RelIndex $w $where]
 276     $w selection clear
 277     See $w insert
 278 }
 279
 280 ### Selection procedures.
 281 #
 282
 283 ## ExtendTo -- Extend the selection to the specified index.
 284 #
 285 # The other end of the selection (the anchor) is determined as follows:
 286 #
 287 # (1) if there is no selection, the anchor is the insert cursor;
 288 # (2) if the index is outside the selection, grow the selection;
 289 # (3) if the insert cursor is at one end of the selection, anchor the other end
 290 # (4) otherwise anchor the start of the selection
 291 #
 292 # The insert cursor is placed at the new end of the selection.
 293 #
 294 # Returns: selection anchor.
 295 #
 296 proc ttk::entry::ExtendTo {w index} {
 297     set index [$w index $index]
 298     set insert [$w index insert]
 299
 300     # Figure out selection anchor:
 301     if {![$w selection present]} {
 302         set anchor $insert
 303     } else {
 304         set selfirst [$w index sel.first]
 305         set sellast  [$w index sel.last]
 306
 307         if {   ($index < $selfirst)
 308             || ($insert == $selfirst && $index <= $sellast)
 309         } {
 310             set anchor $sellast
 311         } else {
 312             set anchor $selfirst
 313         }
 314     }
 315
 316     # Extend selection:
 317     if {$anchor < $index} {
 318         $w selection range $anchor $index
 319     } else {
 320         $w selection range $index $anchor
 321     }
 322
 323     $w icursor $index
 324     return $anchor
 325 }
 326
 327 ## Extend -- Extend the selection to a relative position, show insert cursor
 328 #
 329 proc ttk::entry::Extend {w where} {
 330     ExtendTo $w [RelIndex $w $where]
 331     See $w
 332 }
 333
 334 ### Button 1 binding procedures.
 335 #
 336 # Double-clicking followed by a drag enters "word-select" mode.
 337 # Triple-clicking enters "line-select" mode.
 338 #
 339
 340 ## Press -- ButtonPress-1 binding.
 341 #       Set the insertion cursor, claim the input focus, set up for
 342 #       future drag operations.
 343 #
 344 proc ttk::entry::Press {w x} {
 345     variable State
 346
 347     $w icursor [ClosestGap $w $x]
 348     $w selection clear
 349     $w instate !disabled { focus $w }
 350
 351     # Set up for future drag, double-click, or triple-click.
 352     set State(x) $x
 353     set State(selectMode) char
 354     set State(anchor) [$w index insert]
 355 }
 356
 357 ## Shift-Press -- Shift-ButtonPress-1 binding.
 358 #       Extends the selection, sets anchor for future drag operations.
 359 #
 360 proc ttk::entry::Shift-Press {w x} {
 361     variable State
 362
 363     focus $w
 364     set anchor [ExtendTo $w @$x]
 365
 366     set State(x) $x
 367     set State(selectMode) char
 368     set State(anchor) $anchor
 369 }
 370
 371 ## Select $w $x $mode -- Binding for double- and triple- clicks.
 372 #       Selects a word or line (according to mode),
 373 #       and sets the selection mode for subsequent drag operations.
 374 #
 375 proc ttk::entry::Select {w x mode} {
 376     variable State
 377     set cur [ClosestGap $w $x]
 378
 379     switch -- $mode {
 380         word    { WordSelect $w $cur $cur }
 381         line    { LineSelect $w $cur $cur }
 382         char    { # no-op }
 383     }
 384
 385     set State(anchor) $cur
 386     set State(selectMode) $mode
 387 }
 388
 389 ## Drag -- Button1 motion binding.
 390 #
 391 proc ttk::entry::Drag {w x} {
 392     variable State
 393     set State(x) $x
 394     DragTo $w $x
 395 }
 396
 397 ## DragTo $w $x -- Extend selection to $x based on current selection mode.
 398 #
 399 proc ttk::entry::DragTo {w x} {
 400     variable State
 401
 402     set cur [ClosestGap $w $x]
 403     switch $State(selectMode) {
 404         char { CharSelect $w $State(anchor) $cur }
 405         word { WordSelect $w $State(anchor) $cur }
 406         line { LineSelect $w $State(anchor) $cur }
 407     }
 408 }
 409
 410 ## AutoScroll
 411 #       Called repeatedly when the mouse is outside an entry window
 412 #       with Button 1 down.  Scroll the window left or right,
 413 #       depending on where the mouse is, and extend the selection
 414 #       according to the current selection mode.
 415 #
 416 # TODO: AutoScroll should repeat faster (50ms) than normal autorepeat.
 417 # TODO: Need a way for Repeat scripts to cancel themselves.
 418 #
 419 proc ttk::entry::AutoScroll {w} {
 420     variable State
 421     if {![winfo exists $w]} return
 422     set x $State(x)
 423     if {$x > [winfo width $w]} {
 424         $w xview scroll 2 units
 425         DragTo $w $x
 426     } elseif {$x < 0} {
 427         $w xview scroll -2 units
 428         DragTo $w $x
 429     }
 430 }
 431
 432 ## CharSelect -- select characters between index $from and $to
 433 #
 434 proc ttk::entry::CharSelect {w from to} {
 435     if {$to <= $from} {
 436         $w selection range $to $from
 437     } else {
 438         $w selection range $from $to
 439     }
 440     $w icursor $to
 441 }
 442
 443 ## WordSelect -- Select whole words between index $from and $to
 444 #
 445 proc ttk::entry::WordSelect {w from to} {
 446     if {$to < $from} {
 447         set first [WordBack [$w get] $to]
 448         set last [WordForward [$w get] $from]
 449         $w icursor $first
 450     } else {
 451         set first [WordBack [$w get] $from]
 452         set last [WordForward [$w get] $to]
 453         $w icursor $last
 454     }
 455     $w selection range $first $last
 456 }
 457
 458 ## WordBack, WordForward -- helper routines for WordSelect.
 459 #
 460 proc ttk::entry::WordBack {text index} {
 461     if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 }
 462     return $pos
 463 }
 464 proc ttk::entry::WordForward {text index} {
 465     if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end }
 466     return $pos
 467 }
 468
 469 ## LineSelect -- Select the entire line.
 470 #
 471 proc ttk::entry::LineSelect {w _ _} {
 472     variable State
 473     $w selection range 0 end
 474     $w icursor end
 475 }
 476
 477 ### Button 2 binding procedures.
 478 #
 479
 480 ## ScanMark -- ButtonPress-2 binding.
 481 #       Marks the start of a scan or primary transfer operation.
 482 #
 483 proc ttk::entry::ScanMark {w x} {
 484     variable State
 485     set State(scanX) $x
 486     set State(scanIndex) [$w index @0]
 487     set State(scanMoved) 0
 488 }
 489
 490 ## ScanDrag -- Button2 motion binding.
 491 #
 492 proc ttk::entry::ScanDrag {w x} {
 493     variable State
 494
 495     set dx [expr {$State(scanX) - $x}]
 496     if {abs($dx) > $State(deadband)} {
 497         set State(scanMoved) 1
 498     }
 499     set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}]
 500     $w xview $left
 501
 502     if {$left != [set newLeft [$w index @0]]} {
 503         # We've scanned past one end of the entry;
 504         # reset the mark so that the text will start dragging again
 505         # as soon as the mouse reverses direction.
 506         #
 507         set State(scanX) $x
 508         set State(scanIndex) $newLeft
 509     }
 510 }
 511
 512 ## ScanRelease -- Button2 release binding.
 513 #       Do a primary transfer if the mouse has not moved since the button press.
 514 #
 515 proc ttk::entry::ScanRelease {w x} {
 516     variable State
 517     if {!$State(scanMoved)} {
 518         $w instate {!disabled !readonly} {
 519             $w icursor [ClosestGap $w $x]
 520             catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
 521         }
 522     }
 523 }
 524
 525 ### Insertion and deletion procedures.
 526 #
 527
 528 ## PendingDelete -- Delete selection prior to insert.
 529 #       If the entry currently has a selection, delete it and
 530 #       set the insert position to where the selection was.
 531 #       Returns: 1 if pending delete occurred, 0 if nothing was selected.
 532 #
 533 proc ttk::entry::PendingDelete {w} {
 534     if {[$w selection present]} {
 535         $w icursor sel.first
 536         $w delete sel.first sel.last
 537         return 1
 538     }
 539     return 0
 540 }
 541
 542 ## Insert -- Insert text into the entry widget.
 543 #       If a selection is present, the new text replaces it.
 544 #       Otherwise, the new text is inserted at the insert cursor.
 545 #
 546 proc ttk::entry::Insert {w s} {
 547     if {$s eq ""} { return }
 548     PendingDelete $w
 549     $w insert insert $s
 550     See $w insert
 551 }
 552
 553 ## Backspace -- Backspace over the character just before the insert cursor.
 554 #       If there is a selection, delete that instead.
 555 #       If the new insert position is offscreen to the left,
 556 #       scroll to place the cursor at about the middle of the window.
 557 #
 558 proc ttk::entry::Backspace {w} {
 559     if {[PendingDelete $w]} {
 560         See $w
 561         return
 562     }
 563     set x [expr {[$w index insert] - 1}]
 564     if {$x < 0} { return }
 565
 566     $w delete $x
 567
 568     if {[$w index @0] >= [$w index insert]} {
 569         set range [$w xview]
 570         set left [lindex $range 0]
 571         set right [lindex $range 1]
 572         $w xview moveto [expr {$left - ($right - $left)/2.0}]
 573     }
 574 }
 575
 576 ## Delete -- Delete the character after the insert cursor.
 577 #       If there is a selection, delete that instead.
 578 #
 579 proc ttk::entry::Delete {w} {
 580     if {![PendingDelete $w]} {
 581         $w delete insert
 582     }
 583 }
 584
 585 #*EOF*