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