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