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