home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tk42r2x.zip / TclTk / lib / tk4.2 / entry.tcl < prev    next >
Text File  |  1999-07-27  |  14KB  |  545 lines
  1. # entry.tcl --
  2. #
  3. # This file defines the default bindings for Tk entry widgets and provides
  4. # procedures that help in implementing those bindings.
  5. #
  6. # SCCS: @(#) entry.tcl 1.43 96/08/23 14:07:15
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1996 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tkPriv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # mouseMoved -        Non-zero means the mouse has moved a significant
  22. #            amount since the button went down (so, for example,
  23. #            start dragging out a selection).
  24. # pressX -        X-coordinate at which the mouse button was pressed.
  25. # selectMode -        The style of selection currently underway:
  26. #            char, word, or line.
  27. # x, y -        Last known mouse coordinates for scanning
  28. #            and auto-scanning.
  29. #-------------------------------------------------------------------------
  30.  
  31. #-------------------------------------------------------------------------
  32. # The code below creates the default class bindings for entries.
  33. #-------------------------------------------------------------------------
  34.  
  35. bind Entry <<Cut>> {
  36.     if {[selection own -displayof %W] == "%W"} {
  37.     clipboard clear -displayof %W
  38.     catch {
  39.         clipboard append -displayof %W [selection get -displayof %W]
  40.         %W delete sel.first sel.last
  41.     }
  42.     }
  43. }
  44. bind Entry <<Copy>> {
  45.     if {[selection own -displayof %W] == "%W"} {
  46.     clipboard clear -displayof %W
  47.     catch {
  48.         clipboard append -displayof %W [selection get -displayof %W]
  49.     }
  50.     }
  51. }
  52. bind Entry <<Paste>> {
  53.     catch {
  54.     %W insert insert [selection get -displayof %W -selection CLIPBOARD]
  55.     tkEntrySeeInsert %W
  56.     }
  57. }
  58. bind Entry <<Clear>> {
  59.     %W delete sel.first sel.last
  60. }
  61.  
  62. # Standard Motif bindings:
  63.  
  64. bind Entry <1> {
  65.     tkEntryButton1 %W %x
  66.     %W selection clear
  67. }
  68. bind Entry <B1-Motion> {
  69.     set tkPriv(x) %x
  70.     tkEntryMouseSelect %W %x
  71. }
  72. bind Entry <Double-1> {
  73.     set tkPriv(selectMode) word
  74.     tkEntryMouseSelect %W %x
  75.     catch {%W icursor sel.first}
  76. }
  77. bind Entry <Triple-1> {
  78.     set tkPriv(selectMode) line
  79.     tkEntryMouseSelect %W %x
  80.     %W icursor 0
  81. }
  82. bind Entry <Shift-1> {
  83.     set tkPriv(selectMode) char
  84.     %W selection adjust @%x
  85. }
  86. bind Entry <Double-Shift-1>    {
  87.     set tkPriv(selectMode) word
  88.     tkEntryMouseSelect %W %x
  89. }
  90. bind Entry <Triple-Shift-1>    {
  91.     set tkPriv(selectMode) line
  92.     tkEntryMouseSelect %W %x
  93. }
  94. bind Entry <B1-Leave> {
  95.     set tkPriv(x) %x
  96.     tkEntryAutoScan %W
  97. }
  98. bind Entry <B1-Enter> {
  99.     tkCancelRepeat
  100. }
  101. bind Entry <ButtonRelease-1> {
  102.     tkCancelRepeat
  103. }
  104. bind Entry <Control-1> {
  105.     %W icursor @%x
  106. }
  107. bind Entry <ButtonRelease-2> {
  108.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  109.     tkEntryPaste %W %x
  110.     }
  111. }
  112.  
  113. bind Entry <Left> {
  114.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  115. }
  116. bind Entry <Right> {
  117.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  118. }
  119. bind Entry <Shift-Left> {
  120.     tkEntryKeySelect %W [expr [%W index insert] - 1]
  121.     tkEntrySeeInsert %W
  122. }
  123. bind Entry <Shift-Right> {
  124.     tkEntryKeySelect %W [expr [%W index insert] + 1]
  125.     tkEntrySeeInsert %W
  126. }
  127. bind Entry <Control-Left> {
  128.     tkEntrySetCursor %W \
  129.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  130. }
  131. bind Entry <Control-Right> {
  132.     tkEntrySetCursor %W [string wordend [%W get] [%W index insert]]
  133. }
  134. bind Entry <Shift-Control-Left> {
  135.     tkEntryKeySelect %W \
  136.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  137.     tkEntrySeeInsert %W
  138. }
  139. bind Entry <Shift-Control-Right> {
  140.     tkEntryKeySelect %W [string wordend [%W get] [%W index insert]]
  141.     tkEntrySeeInsert %W
  142. }
  143. bind Entry <Home> {
  144.     tkEntrySetCursor %W 0
  145. }
  146. bind Entry <Shift-Home> {
  147.     tkEntryKeySelect %W 0
  148.     tkEntrySeeInsert %W
  149. }
  150. bind Entry <End> {
  151.     tkEntrySetCursor %W end
  152. }
  153. bind Entry <Shift-End> {
  154.     tkEntryKeySelect %W end
  155.     tkEntrySeeInsert %W
  156. }
  157.  
  158. bind Entry <Delete> {
  159.     if [%W selection present] {
  160.     %W delete sel.first sel.last
  161.     } else {
  162.     %W delete insert
  163.     }
  164. }
  165. bind Entry <BackSpace> {
  166.     tkEntryBackspace %W
  167. }
  168.  
  169. bind Entry <Control-space> {
  170.     %W selection from insert
  171. }
  172. bind Entry <Select> {
  173.     %W selection from insert
  174. }
  175. bind Entry <Control-Shift-space> {
  176.     %W selection adjust insert
  177. }
  178. bind Entry <Shift-Select> {
  179.     %W selection adjust insert
  180. }
  181. bind Entry <Control-slash> {
  182.     %W selection range 0 end
  183. }
  184. bind Entry <Control-backslash> {
  185.     %W selection clear
  186. }
  187.  
  188. bind Entry <KeyPress> {
  189.     tkEntryInsert %W %A
  190. }
  191.  
  192. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  193. # Otherwise, if a widget binding for one of these is defined, the
  194. # <KeyPress> class binding will also fire and insert the character,
  195. # which is wrong.  Ditto for Escape, Return, and Tab.
  196.  
  197. bind Entry <Alt-KeyPress> {# nothing}
  198. bind Entry <Meta-KeyPress> {# nothing}
  199. bind Entry <Control-KeyPress> {# nothing}
  200. bind Entry <Escape> {# nothing}
  201. bind Entry <Return> {# nothing}
  202. bind Entry <KP_Enter> {# nothing}
  203. bind Entry <Tab> {# nothing}
  204.  
  205. bind Entry <Insert> {
  206.     catch {tkEntryInsert %W [selection get -displayof %W]}
  207. }
  208.  
  209. # Additional emacs-like bindings:
  210.  
  211. bind Entry <Control-a> {
  212.     if !$tk_strictMotif {
  213.     tkEntrySetCursor %W 0
  214.     }
  215. }
  216. bind Entry <Control-b> {
  217.     if !$tk_strictMotif {
  218.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  219.     }
  220. }
  221. bind Entry <Control-d> {
  222.     if !$tk_strictMotif {
  223.     %W delete insert
  224.     }
  225. }
  226. bind Entry <Control-e> {
  227.     if !$tk_strictMotif {
  228.     tkEntrySetCursor %W end
  229.     }
  230. }
  231. bind Entry <Control-f> {
  232.     if !$tk_strictMotif {
  233.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  234.     }
  235. }
  236. bind Entry <Control-h> {
  237.     if !$tk_strictMotif {
  238.     tkEntryBackspace %W
  239.     }
  240. }
  241. bind Entry <Control-k> {
  242.     if !$tk_strictMotif {
  243.     %W delete insert end
  244.     }
  245. }
  246. bind Entry <Control-t> {
  247.     if !$tk_strictMotif {
  248.     tkEntryTranspose %W
  249.     }
  250. }
  251. bind Entry <Meta-b> {
  252.     if !$tk_strictMotif {
  253.     tkEntrySetCursor %W \
  254.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  255.     }
  256. }
  257. bind Entry <Meta-d> {
  258.     if !$tk_strictMotif {
  259.     %W delete insert [string wordend [%W get] [%W index insert]]
  260.     }
  261. }
  262. bind Entry <Meta-f> {
  263.     if !$tk_strictMotif {
  264.     tkEntrySetCursor %W [string wordend [%W get] [%W index insert]]
  265.     }
  266. }
  267. bind Entry <Meta-BackSpace> {
  268.     if !$tk_strictMotif {
  269.     %W delete [string wordstart [%W get] [expr [%W index insert] - 1]] \
  270.         insert
  271.     }
  272. }
  273.  
  274. # A few additional bindings of my own.
  275.  
  276. bind Entry <2> {
  277.     if !$tk_strictMotif {
  278.     %W scan mark %x
  279.     set tkPriv(x) %x
  280.     set tkPriv(y) %y
  281.     set tkPriv(mouseMoved) 0
  282.     }
  283. }
  284. bind Entry <B2-Motion> {
  285.     if !$tk_strictMotif {
  286.     if {abs(%x-$tkPriv(x)) > 2} {
  287.         set tkPriv(mouseMoved) 1
  288.     }
  289.     %W scan dragto %x
  290.     }
  291. }
  292.  
  293. # tkEntryClosestGap --
  294. # Given x and y coordinates, this procedure finds the closest boundary
  295. # between characters to the given coordinates and returns the index
  296. # of the character just after the boundary.
  297. #
  298. # Arguments:
  299. # w -        The entry window.
  300. # x -        X-coordinate within the window.
  301.  
  302. proc tkEntryClosestGap {w x} {
  303.     set pos [$w index @$x]
  304.     set bbox [$w bbox $pos]
  305.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  306.     return $pos
  307.     }
  308.     incr pos
  309. }
  310.  
  311. # tkEntryButton1 --
  312. # This procedure is invoked to handle button-1 presses in entry
  313. # widgets.  It moves the insertion cursor, sets the selection anchor,
  314. # and claims the input focus.
  315. #
  316. # Arguments:
  317. # w -        The entry window in which the button was pressed.
  318. # x -        The x-coordinate of the button press.
  319.  
  320. proc tkEntryButton1 {w x} {
  321.     global tkPriv
  322.  
  323.     set tkPriv(selectMode) char
  324.     set tkPriv(mouseMoved) 0
  325.     set tkPriv(pressX) $x
  326.     $w icursor [tkEntryClosestGap $w $x]
  327.     $w selection from insert
  328.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  329. }
  330.  
  331. # tkEntryMouseSelect --
  332. # This procedure is invoked when dragging out a selection with
  333. # the mouse.  Depending on the selection mode (character, word,
  334. # line) it selects in different-sized units.  This procedure
  335. # ignores mouse motions initially until the mouse has moved from
  336. # one character to another or until there have been multiple clicks.
  337. #
  338. # Arguments:
  339. # w -        The entry window in which the button was pressed.
  340. # x -        The x-coordinate of the mouse.
  341.  
  342. proc tkEntryMouseSelect {w x} {
  343.     global tkPriv
  344.  
  345.     set cur [tkEntryClosestGap $w $x]
  346.     set anchor [$w index anchor]
  347.     if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
  348.     set tkPriv(mouseMoved) 1
  349.     }
  350.     switch $tkPriv(selectMode) {
  351.     char {
  352.         if $tkPriv(mouseMoved) {
  353.         if {$cur < $anchor} {
  354.             $w selection range $cur $anchor
  355.         } elseif {$cur > $anchor} {
  356.             $w selection range $anchor $cur
  357.         } else {
  358.             $w selection clear
  359.         }
  360.         }
  361.     }
  362.     word {
  363.         if {$cur < [$w index anchor]} {
  364.         $w selection range [string wordstart [$w get] $cur] \
  365.             [string wordend [$w get] [expr $anchor-1]]
  366.         } else {
  367.         $w selection range [string wordstart [$w get] $anchor] \
  368.             [string wordend [$w get] [expr $cur - 1]]
  369.         }
  370.     }
  371.     line {
  372.         $w selection range 0 end
  373.     }
  374.     }
  375.     update idletasks
  376. }
  377.  
  378. # tkEntryPaste --
  379. # This procedure sets the insertion cursor to the current mouse position,
  380. # pastes the selection there, and sets the focus to the window.
  381. #
  382. # Arguments:
  383. # w -        The entry window.
  384. # x -        X position of the mouse.
  385.  
  386. proc tkEntryPaste {w x} {
  387.     global tkPriv
  388.  
  389.     $w icursor [tkEntryClosestGap $w $x]
  390.     catch {$w insert insert [selection get -displayof $w]}
  391.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  392. }
  393.  
  394. # tkEntryAutoScan --
  395. # This procedure is invoked when the mouse leaves an entry window
  396. # with button 1 down.  It scrolls the window left or right,
  397. # depending on where the mouse is, and reschedules itself as an
  398. # "after" command so that the window continues to scroll until the
  399. # mouse moves back into the window or the mouse button is released.
  400. #
  401. # Arguments:
  402. # w -        The entry window.
  403.  
  404. proc tkEntryAutoScan {w} {
  405.     global tkPriv
  406.     set x $tkPriv(x)
  407.     if {![winfo exists $w]} return
  408.     if {$x >= [winfo width $w]} {
  409.     $w xview scroll 2 units
  410.     tkEntryMouseSelect $w $x
  411.     } elseif {$x < 0} {
  412.     $w xview scroll -2 units
  413.     tkEntryMouseSelect $w $x
  414.     }
  415.     set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
  416. }
  417.  
  418. # tkEntryKeySelect --
  419. # This procedure is invoked when stroking out selections using the
  420. # keyboard.  It moves the cursor to a new position, then extends
  421. # the selection to that position.
  422. #
  423. # Arguments:
  424. # w -        The entry window.
  425. # new -        A new position for the insertion cursor (the cursor hasn't
  426. #        actually been moved to this position yet).
  427.  
  428. proc tkEntryKeySelect {w new} {
  429.     if ![$w selection present] {
  430.     $w selection from insert
  431.     $w selection to $new
  432.     } else {
  433.     $w selection adjust $new
  434.     }
  435.     $w icursor $new
  436. }
  437.  
  438. # tkEntryInsert --
  439. # Insert a string into an entry at the point of the insertion cursor.
  440. # If there is a selection in the entry, and it covers the point of the
  441. # insertion cursor, then delete the selection before inserting.
  442. #
  443. # Arguments:
  444. # w -        The entry window in which to insert the string
  445. # s -        The string to insert (usually just a single character)
  446.  
  447. proc tkEntryInsert {w s} {
  448.     if {$s == ""} {
  449.     return
  450.     }
  451.     catch {
  452.     set insert [$w index insert]
  453.     if {([$w index sel.first] <= $insert)
  454.         && ([$w index sel.last] >= $insert)} {
  455.         $w delete sel.first sel.last
  456.     }
  457.     }
  458.     $w insert insert $s
  459.     tkEntrySeeInsert $w
  460. }
  461.  
  462. # tkEntryBackspace --
  463. # Backspace over the character just before the insertion cursor.
  464. # If backspacing would move the cursor off the left edge of the
  465. # window, reposition the cursor at about the middle of the window.
  466. #
  467. # Arguments:
  468. # w -        The entry window in which to backspace.
  469.  
  470. proc tkEntryBackspace w {
  471.     if [$w selection present] {
  472.     $w delete sel.first sel.last
  473.     } else {
  474.     set x [expr {[$w index insert] - 1}]
  475.     if {$x >= 0} {$w delete $x}
  476.     if {[$w index @0] >= [$w index insert]} {
  477.         set range [$w xview]
  478.         set left [lindex $range 0]
  479.         set right [lindex $range 1]
  480.         $w xview moveto [expr $left - ($right - $left)/2.0]
  481.     }
  482.     }
  483. }
  484.  
  485. # tkEntrySeeInsert --
  486. # Make sure that the insertion cursor is visible in the entry window.
  487. # If not, adjust the view so that it is.
  488. #
  489. # Arguments:
  490. # w -        The entry window.
  491.  
  492. proc tkEntrySeeInsert w {
  493.     set c [$w index insert]
  494.     set left [$w index @0]
  495.     if {$left > $c} {
  496.     $w xview $c
  497.     return
  498.     }
  499.     set x [winfo width $w]
  500.     while {([$w index @$x] <= $c) && ($left < $c)} {
  501.     incr left
  502.     $w xview $left
  503.     }
  504. }
  505.  
  506. # tkEntrySetCursor -
  507. # Move the insertion cursor to a given position in an entry.  Also
  508. # clears the selection, if there is one in the entry, and makes sure
  509. # that the insertion cursor is visible.
  510. #
  511. # Arguments:
  512. # w -        The entry window.
  513. # pos -        The desired new position for the cursor in the window.
  514.  
  515. proc tkEntrySetCursor {w pos} {
  516.     $w icursor $pos
  517.     $w selection clear
  518.     tkEntrySeeInsert $w
  519. }
  520.  
  521. # tkEntryTranspose -
  522. # This procedure implements the "transpose" function for entry widgets.
  523. # It tranposes the characters on either side of the insertion cursor,
  524. # unless the cursor is at the end of the line.  In this case it
  525. # transposes the two characters to the left of the cursor.  In either
  526. # case, the cursor ends up to the right of the transposed characters.
  527. #
  528. # Arguments:
  529. # w -        The entry window.
  530.  
  531. proc tkEntryTranspose w {
  532.     set i [$w index insert]
  533.     if {$i < [$w index end]} {
  534.     incr i
  535.     }
  536.     set first [expr $i-2]
  537.     if {$first < 0} {
  538.     return
  539.     }
  540.     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
  541.     $w delete $first $i
  542.     $w insert insert $new
  543.     tkEntrySeeInsert $w
  544. }
  545.