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 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] 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# 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 <ButtonPress-1> { ttk::entry::Press %W %x } 72bind TEntry <Shift-ButtonPress-1> { ttk::entry::Shift-Press %W %x } 73bind TEntry <Double-ButtonPress-1> { ttk::entry::Select %W %x word } 74bind TEntry <Triple-ButtonPress-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 <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# 89bind TEntry <ButtonPress-2> { ttk::entry::ScanMark %W %x } 90bind TEntry <B2-Motion> { ttk::entry::ScanDrag %W %x } 91bind TEntry <ButtonRelease-2> { ttk::entry::ScanRelease %W %x } 92bind TEntry <<PasteSelection>> { ttk::entry::ScanRelease %W %x } 93 94## Keyboard navigation bindings: 95# 96bind TEntry <Key-Left> { ttk::entry::Move %W prevchar } 97bind TEntry <Key-Right> { ttk::entry::Move %W nextchar } 98bind TEntry <Control-Key-Left> { ttk::entry::Move %W prevword } 99bind TEntry <Control-Key-Right> { ttk::entry::Move %W nextword } 100bind TEntry <Key-Home> { ttk::entry::Move %W home } 101bind TEntry <Key-End> { ttk::entry::Move %W end } 102 103bind TEntry <Shift-Key-Left> { ttk::entry::Extend %W prevchar } 104bind TEntry <Shift-Key-Right> { ttk::entry::Extend %W nextchar } 105bind TEntry <Shift-Control-Key-Left> { ttk::entry::Extend %W prevword } 106bind TEntry <Shift-Control-Key-Right> { ttk::entry::Extend %W nextword } 107bind TEntry <Shift-Key-Home> { ttk::entry::Extend %W home } 108bind TEntry <Shift-Key-End> { ttk::entry::Extend %W end } 109 110bind TEntry <Control-Key-slash> { %W selection range 0 end } 111bind TEntry <Control-Key-backslash> { %W selection clear } 112 113bind TEntry <<TraverseIn>> { %W selection range 0 end; %W icursor end } 114 115## Edit bindings: 116# 117bind TEntry <KeyPress> { ttk::entry::Insert %W %A } 118bind TEntry <Key-Delete> { ttk::entry::Delete %W } 119bind 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# 125bind TEntry <Alt-KeyPress> {# nothing} 126bind TEntry <Meta-KeyPress> {# nothing} 127bind TEntry <Control-KeyPress> {# nothing} 128bind TEntry <Key-Escape> {# nothing} 129bind TEntry <Key-Return> {# nothing} 130bind TEntry <Key-KP_Enter> {# nothing} 131bind TEntry <Key-Tab> {# nothing} 132 133# Argh. Apparently on Windows, the NumLock modifier is interpreted 134# as a Command modifier. 135if {[tk windowingsystem] eq "aqua"} { 136 bind TEntry <Command-KeyPress> {# nothing} 137} 138# Tk-on-Cocoa generates characters for these two keys. [Bug 2971663] 139bind TEntry <Down> {# nothing} 140bind TEntry <Up> {# nothing} 141 142## Additional emacs-like bindings: 143# 144bind TEntry <Control-Key-a> { ttk::entry::Move %W home } 145bind TEntry <Control-Key-b> { ttk::entry::Move %W prevchar } 146bind TEntry <Control-Key-d> { ttk::entry::Delete %W } 147bind TEntry <Control-Key-e> { ttk::entry::Move %W end } 148bind TEntry <Control-Key-f> { ttk::entry::Move %W nextchar } 149bind TEntry <Control-Key-h> { ttk::entry::Backspace %W } 150bind 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# 158proc 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# 170proc 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# 181proc 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# 190proc ttk::entry::Clear {w} { 191 catch { $w delete sel.first sel.last } 192} 193 194## Cut -- Copy selection to clipboard then delete it. 195# 196proc 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# 206proc 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# 217proc 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# 231set ::ttk::entry::State(startNext) \ 232 [string equal [tk windowingsystem] "win32"] 233 234proc 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# 248proc 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# 258proc 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# 274proc 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# 296proc 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# 329proc 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# 344proc 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# 360proc 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# 375proc 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# 391proc 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# 399proc 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 none { # no-op } 408 } 409} 410 411## <B1-Leave> binding: 412# Begin autoscroll. 413# 414proc ttk::entry::DragOut {w mode} { 415 variable State 416 if {$State(selectMode) ne "none" && $mode eq "NotifyNormal"} { 417 ttk::Repeatedly ttk::entry::AutoScroll $w 418 } 419} 420 421## <B1-Enter> binding 422# Suspend autoscroll. 423# 424proc ttk::entry::DragIn {w} { 425 ttk::CancelRepeat 426} 427 428## <ButtonRelease-1> binding 429# 430proc ttk::entry::Release {w} { 431 variable State 432 set State(selectMode) none 433 ttk::CancelRepeat ;# suspend autoscroll 434} 435 436## AutoScroll 437# Called repeatedly when the mouse is outside an entry window 438# with Button 1 down. Scroll the window left or right, 439# depending on where the mouse left the window, and extend 440# the selection according to the current selection mode. 441# 442# TODO: AutoScroll should repeat faster (50ms) than normal autorepeat. 443# TODO: Need a way for Repeat scripts to cancel themselves. 444# 445proc ttk::entry::AutoScroll {w} { 446 variable State 447 if {![winfo exists $w]} return 448 set x $State(x) 449 if {$x > [winfo width $w]} { 450 $w xview scroll 2 units 451 DragTo $w $x 452 } elseif {$x < 0} { 453 $w xview scroll -2 units 454 DragTo $w $x 455 } 456} 457 458## CharSelect -- select characters between index $from and $to 459# 460proc ttk::entry::CharSelect {w from to} { 461 if {$to <= $from} { 462 $w selection range $to $from 463 } else { 464 $w selection range $from $to 465 } 466 $w icursor $to 467} 468 469## WordSelect -- Select whole words between index $from and $to 470# 471proc ttk::entry::WordSelect {w from to} { 472 if {$to < $from} { 473 set first [WordBack [$w get] $to] 474 set last [WordForward [$w get] $from] 475 $w icursor $first 476 } else { 477 set first [WordBack [$w get] $from] 478 set last [WordForward [$w get] $to] 479 $w icursor $last 480 } 481 $w selection range $first $last 482} 483 484## WordBack, WordForward -- helper routines for WordSelect. 485# 486proc ttk::entry::WordBack {text index} { 487 if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 } 488 return $pos 489} 490proc ttk::entry::WordForward {text index} { 491 if {[set pos [tcl_wordBreakAfter $text $index]] < 0} { return end } 492 return $pos 493} 494 495## LineSelect -- Select the entire line. 496# 497proc ttk::entry::LineSelect {w _ _} { 498 variable State 499 $w selection range 0 end 500 $w icursor end 501} 502 503### Button 2 binding procedures. 504# 505 506## ScanMark -- ButtonPress-2 binding. 507# Marks the start of a scan or primary transfer operation. 508# 509proc ttk::entry::ScanMark {w x} { 510 variable State 511 set State(scanX) $x 512 set State(scanIndex) [$w index @0] 513 set State(scanMoved) 0 514} 515 516## ScanDrag -- Button2 motion binding. 517# 518proc ttk::entry::ScanDrag {w x} { 519 variable State 520 521 set dx [expr {$State(scanX) - $x}] 522 if {abs($dx) > $State(deadband)} { 523 set State(scanMoved) 1 524 } 525 set left [expr {$State(scanIndex) + ($dx*$State(scanNum))/$State(scanDen)}] 526 $w xview $left 527 528 if {$left != [set newLeft [$w index @0]]} { 529 # We've scanned past one end of the entry; 530 # reset the mark so that the text will start dragging again 531 # as soon as the mouse reverses direction. 532 # 533 set State(scanX) $x 534 set State(scanIndex) $newLeft 535 } 536} 537 538## ScanRelease -- Button2 release binding. 539# Do a primary transfer if the mouse has not moved since the button press. 540# 541proc ttk::entry::ScanRelease {w x} { 542 variable State 543 if {!$State(scanMoved)} { 544 $w instate {!disabled !readonly} { 545 $w icursor [ClosestGap $w $x] 546 catch {$w insert insert [::tk::GetSelection $w PRIMARY]} 547 } 548 } 549} 550 551### Insertion and deletion procedures. 552# 553 554## PendingDelete -- Delete selection prior to insert. 555# If the entry currently has a selection, delete it and 556# set the insert position to where the selection was. 557# Returns: 1 if pending delete occurred, 0 if nothing was selected. 558# 559proc ttk::entry::PendingDelete {w} { 560 if {[$w selection present]} { 561 $w icursor sel.first 562 $w delete sel.first sel.last 563 return 1 564 } 565 return 0 566} 567 568## Insert -- Insert text into the entry widget. 569# If a selection is present, the new text replaces it. 570# Otherwise, the new text is inserted at the insert cursor. 571# 572proc ttk::entry::Insert {w s} { 573 if {$s eq ""} { return } 574 PendingDelete $w 575 $w insert insert $s 576 See $w insert 577} 578 579## Backspace -- Backspace over the character just before the insert cursor. 580# If there is a selection, delete that instead. 581# If the new insert position is offscreen to the left, 582# scroll to place the cursor at about the middle of the window. 583# 584proc ttk::entry::Backspace {w} { 585 if {[PendingDelete $w]} { 586 See $w 587 return 588 } 589 set x [expr {[$w index insert] - 1}] 590 if {$x < 0} { return } 591 592 $w delete $x 593 594 if {[$w index @0] >= [$w index insert]} { 595 set range [$w xview] 596 set left [lindex $range 0] 597 set right [lindex $range 1] 598 $w xview moveto [expr {$left - ($right - $left)/2.0}] 599 } 600} 601 602## Delete -- Delete the character after the insert cursor. 603# If there is a selection, delete that instead. 604# 605proc ttk::entry::Delete {w} { 606 if {![PendingDelete $w]} { 607 $w delete insert 608 } 609} 610 611#*EOF* 612