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

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