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