Tk Source Code
Artifact Content
Not logged in
Tcl 2015 Conference, Manassas/VA, US, Oct 19-23
Send your abstracts to tclconference@googlegroups.com by Aug 24.

Artifact b02d466ba9f0ef9c353e833b7bc85697ef2fe72e:


     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]
    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  #
    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 <ButtonPress-1> 		{ ttk::entry::Press %W %x }
    72  bind TEntry <Shift-ButtonPress-1>	{ ttk::entry::Shift-Press %W %x }
    73  bind TEntry <Double-ButtonPress-1> 	{ ttk::entry::Select %W %x word }
    74  bind TEntry <Triple-ButtonPress-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 <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  #
    89  bind TEntry <ButtonPress-2> 		{ ttk::entry::ScanMark %W %x }
    90  bind TEntry <B2-Motion> 		{ ttk::entry::ScanDrag %W %x }
    91  bind TEntry <ButtonRelease-2>		{ ttk::entry::ScanRelease %W %x }
    92  bind TEntry <<PasteSelection>>		{ ttk::entry::ScanRelease %W %x }
    93  
    94  ## Keyboard navigation bindings:
    95  #
    96  bind TEntry <Key-Left> 			{ ttk::entry::Move %W prevchar }
    97  bind TEntry <Key-Right> 		{ ttk::entry::Move %W nextchar }
    98  bind TEntry <Control-Key-Left>		{ ttk::entry::Move %W prevword }
    99  bind TEntry <Control-Key-Right>		{ ttk::entry::Move %W nextword }
   100  bind TEntry <Key-Home>			{ ttk::entry::Move %W home }
   101  bind TEntry <Key-End>			{ ttk::entry::Move %W end }
   102  
   103  bind TEntry <Shift-Key-Left> 		{ ttk::entry::Extend %W prevchar }
   104  bind TEntry <Shift-Key-Right>		{ ttk::entry::Extend %W nextchar }
   105  bind TEntry <Shift-Control-Key-Left>	{ ttk::entry::Extend %W prevword }
   106  bind TEntry <Shift-Control-Key-Right>	{ ttk::entry::Extend %W nextword }
   107  bind TEntry <Shift-Key-Home>		{ ttk::entry::Extend %W home }
   108  bind TEntry <Shift-Key-End>		{ ttk::entry::Extend %W end }
   109  
   110  bind TEntry <Control-Key-slash> 	{ %W selection range 0 end }
   111  bind TEntry <Control-Key-backslash> 	{ %W selection clear }
   112  
   113  bind TEntry <<TraverseIn>> 	{ %W selection range 0 end; %W icursor end }
   114  
   115  ## Edit bindings:
   116  #
   117  bind TEntry <KeyPress> 			{ ttk::entry::Insert %W %A }
   118  bind TEntry <Key-Delete>		{ ttk::entry::Delete %W }
   119  bind 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  #
   125  bind TEntry <Alt-KeyPress>		{# nothing}
   126  bind TEntry <Meta-KeyPress>		{# nothing}
   127  bind TEntry <Control-KeyPress> 		{# nothing}
   128  bind TEntry <Key-Escape> 		{# nothing}
   129  bind TEntry <Key-Return> 		{# nothing}
   130  bind TEntry <Key-KP_Enter> 		{# nothing}
   131  bind TEntry <Key-Tab> 			{# nothing}
   132  
   133  # Argh.  Apparently on Windows, the NumLock modifier is interpreted
   134  # as a Command modifier.
   135  if {[tk windowingsystem] eq "aqua"} {
   136      bind TEntry <Command-KeyPress>	{# nothing}
   137  }
   138  # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
   139  bind TEntry <Down>			{# nothing}
   140  bind TEntry <Up>			{# nothing}
   141  
   142  ## Additional emacs-like bindings:
   143  #
   144  bind TEntry <Control-Key-a>		{ ttk::entry::Move %W home }
   145  bind TEntry <Control-Key-b>		{ ttk::entry::Move %W prevchar }
   146  bind TEntry <Control-Key-d> 		{ ttk::entry::Delete %W }
   147  bind TEntry <Control-Key-e> 		{ ttk::entry::Move %W end }
   148  bind TEntry <Control-Key-f> 		{ ttk::entry::Move %W nextchar }
   149  bind TEntry <Control-Key-h>		{ ttk::entry::Backspace %W }
   150  bind 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  #
   158  proc 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  #
   170  proc 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  #
   181  proc 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  #
   190  proc ttk::entry::Clear {w} {
   191      catch { $w delete sel.first sel.last }
   192  }
   193  
   194  ## Cut -- Copy selection to clipboard then delete it.
   195  #
   196  proc 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  #
   206  proc 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 # 217 proc 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 # 231 set ::ttk::entry::State(startNext) \ 232 [string equal [tk windowingsystem] "win32"] 233 234 proc 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 # 248 proc 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 # 258 proc 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 # 274 proc 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 # 296 proc 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 # 329 proc 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 # 344 proc 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 # 360 proc 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 # 375 proc 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 # 391 proc 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 # 399 proc 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 # 414 proc 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 # 424 proc ttk::entry::DragIn {w} { 425 ttk::CancelRepeat 426 } 427 428 ## <ButtonRelease-1> binding 429 # 430 proc 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 # 445 proc 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 # 460 proc 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 # 471 proc 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 # 486 proc ttk::entry::WordBack {text index} { 487 if {[set pos [tcl_wordBreakBefore $text $index]] < 0} { return 0 } 488 return $pos 489 } 490 proc 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 # 497 proc 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 # 509 proc 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 # 518 proc 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 # 541 proc 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 # 559 proc 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 # 572 proc 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 # 584 proc 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 # 605 proc ttk::entry::Delete {w} { 606 if {![PendingDelete $w]} { 607 $w delete insert 608 } 609 } 610 611 #*EOF*