home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 September / WIN95_09962.iso / vrml / cp2b2x.exe / DATA.Z / entry.tcl < prev    next >
Text File  |  1996-04-23  |  13KB  |  495 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. # @(#) entry.tcl 1.36 95/06/17 17:47:29
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 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.  
  117. bind Entry <Left> {
  118.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  119. }
  120. bind Entry <Right> {
  121.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  122. }
  123. bind Entry <Shift-Left> {
  124.     tkEntryKeySelect %W [expr [%W index insert] - 1]
  125.     tkEntrySeeInsert %W
  126. }
  127. bind Entry <Shift-Right> {
  128.     tkEntryKeySelect %W [expr [%W index insert] + 1]
  129.     tkEntrySeeInsert %W
  130. }
  131. bind Entry <Control-Left> {
  132.     tkEntrySetCursor %W \
  133.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  134. }
  135. bind Entry <Control-Right> {
  136.     tkEntrySetCursor %W [string wordend [%W get] [%W index insert]]
  137. }
  138. bind Entry <Shift-Control-Left> {
  139.     tkEntryKeySelect %W \
  140.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  141.     tkEntrySeeInsert %W
  142. }
  143. bind Entry <Shift-Control-Right> {
  144.     tkEntryKeySelect %W [string wordend [%W get] [%W index insert]]
  145.     tkEntrySeeInsert %W
  146. }
  147. bind Entry <Home> {
  148.     tkEntrySetCursor %W 0
  149. }
  150. bind Entry <Shift-Home> {
  151.     tkEntryKeySelect %W 0
  152.     tkEntrySeeInsert %W
  153. }
  154. bind Entry <End> {
  155.     tkEntrySetCursor %W end
  156. }
  157. bind Entry <Shift-End> {
  158.     tkEntryKeySelect %W end
  159.     tkEntrySeeInsert %W
  160. }
  161.  
  162. bind Entry <Delete> {
  163.     if [%W selection present] {
  164.     %W delete sel.first sel.last
  165.     } else {
  166.     %W delete insert
  167.     }
  168. }
  169. bind Entry <BackSpace> {
  170.     tkEntryBackspace %W
  171. }
  172.  
  173. bind Entry <Control-space> {
  174.     %W selection from insert
  175. }
  176. bind Entry <Select> {
  177.     %W selection from insert
  178. }
  179. bind Entry <Control-Shift-space> {
  180.     %W selection adjust insert
  181. }
  182. bind Entry <Shift-Select> {
  183.     %W selection adjust insert
  184. }
  185. bind Entry <Control-slash> {
  186.     %W selection range 0 end
  187. }
  188. bind Entry <Control-backslash> {
  189.     %W selection clear
  190. }
  191. tkEntryClipboardKeysyms F16 F20 F18
  192.  
  193. bind Entry <KeyPress> {
  194.     tkEntryInsert %W %A
  195. }
  196.  
  197. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  198. # Otherwise, if a widget binding for one of these is defined, the
  199. # <KeyPress> class binding will also fire and insert the character,
  200. # which is wrong.  Ditto for Escape, Return, and Tab.
  201.  
  202. bind Entry <Alt-KeyPress> {# nothing}
  203. bind Entry <Meta-KeyPress> {# nothing}
  204. bind Entry <Control-KeyPress> {# nothing}
  205. bind Entry <Escape> {# nothing}
  206. bind Entry <Return> {# nothing}
  207. bind Entry <KP_Enter> {# nothing}
  208. bind Entry <Tab> {# nothing}
  209.  
  210. bind Entry <Insert> {
  211.     catch {tkEntryInsert %W [selection get -displayof %W]}
  212. }
  213.  
  214. # Additional emacs-like bindings:
  215.  
  216. if !$tk_strictMotif {
  217.     bind Entry <Control-a> {
  218.     tkEntrySetCursor %W 0
  219.     }
  220.     bind Entry <Control-b> {
  221.     tkEntrySetCursor %W [expr [%W index insert] - 1]
  222.     }
  223.     bind Entry <Control-d> {
  224.     %W delete insert
  225.     }
  226.     bind Entry <Control-e> {
  227.     tkEntrySetCursor %W end
  228.     }
  229.     bind Entry <Control-f> {
  230.     tkEntrySetCursor %W [expr [%W index insert] + 1]
  231.     }
  232.     bind Entry <Control-h> {
  233.     tkEntryBackspace %W
  234.     }
  235.     bind Entry <Control-k> {
  236.     %W delete insert end
  237.     }
  238.     bind Entry <Control-t> {
  239.     tkEntryTranspose %W
  240.     }
  241.     bind Entry <Meta-b> {
  242.     tkEntrySetCursor %W \
  243.         [string wordstart [%W get] [expr [%W index insert] - 1]]
  244.     }
  245.     bind Entry <Meta-d> {
  246.     %W delete insert [string wordend [%W get] [%W index insert]]
  247.     }
  248.     bind Entry <Meta-f> {
  249.     tkEntrySetCursor %W [string wordend [%W get] [%W index insert]]
  250.     }
  251.     bind Entry <Meta-BackSpace> {
  252.     %W delete [string wordstart [%W get] [expr [%W index insert] - 1]] \
  253.         insert
  254.     }
  255.     tkEntryClipboardKeysyms Meta-w Control-w Control-y
  256.  
  257.     # A few additional bindings of my own.
  258.  
  259.     bind Entry <2> {
  260.     %W scan mark %x
  261.     set tkPriv(x) %x
  262.     set tkPriv(y) %y
  263.     set tkPriv(mouseMoved) 0
  264.     }
  265.     bind Entry <B2-Motion> {
  266.     if {abs(%x-$tkPriv(x)) > 2} {
  267.         set tkPriv(mouseMoved) 1
  268.     }
  269.     %W scan dragto %x
  270.     }
  271.     bind Entry <ButtonRelease-2> {
  272.     if !$tkPriv(mouseMoved) {
  273.         catch {
  274.         %W insert @%x [selection get -displayof %W]
  275.         }
  276.     }
  277.     }
  278. }
  279.  
  280. # tkEntryButton1 --
  281. # This procedure is invoked to handle button-1 presses in entry
  282. # widgets.  It moves the insertion cursor, sets the selection anchor,
  283. # and claims the input focus.
  284. #
  285. # Arguments:
  286. # w -        The entry window in which the button was pressed.
  287. # x -        The x-coordinate of the button press.
  288.  
  289. proc tkEntryButton1 {w x} {
  290.     global tkPriv
  291.  
  292.     set tkPriv(selectMode) char
  293.     set tkPriv(mouseMoved) 0
  294.     set tkPriv(pressX) $x
  295.     $w icursor @$x
  296.     $w selection from @$x
  297.     if {[lindex [$w configure -state] 4] == "normal"} {focus $w}
  298. }
  299.  
  300. # tkEntryMouseSelect --
  301. # This procedure is invoked when dragging out a selection with
  302. # the mouse.  Depending on the selection mode (character, word,
  303. # line) it selects in different-sized units.  This procedure
  304. # ignores mouse motions initially until the mouse has moved from
  305. # one character to another or until there have been multiple clicks.
  306. #
  307. # Arguments:
  308. # w -        The entry window in which the button was pressed.
  309. # x -        The x-coordinate of the mouse.
  310.  
  311. proc tkEntryMouseSelect {w x} {
  312.     global tkPriv
  313.  
  314.     set cur [$w index @$x]
  315.     set anchor [$w index anchor]
  316.     if {($cur != $anchor) || (abs($tkPriv(pressX) - $x) >= 3)} {
  317.     set tkPriv(mouseMoved) 1
  318.     }
  319.     switch $tkPriv(selectMode) {
  320.     char {
  321.         if $tkPriv(mouseMoved) {
  322.         if {$cur < [$w index anchor]} {
  323.             $w selection to $cur
  324.         } else {
  325.             $w selection to [expr $cur+1]
  326.         }
  327.         }
  328.     }
  329.     word {
  330.         if {$cur < [$w index anchor]} {
  331.         $w selection range [string wordstart [$w get] $cur] \
  332.             [string wordend [$w get] [expr $anchor-1]]
  333.         } else {
  334.         $w selection range [string wordstart [$w get] $anchor] \
  335.             [string wordend [$w get] $cur]
  336.         }
  337.     }
  338.     line {
  339.         $w selection range 0 end
  340.     }
  341.     }
  342.     update idletasks
  343. }
  344.  
  345. # tkEntryAutoScan --
  346. # This procedure is invoked when the mouse leaves an entry window
  347. # with button 1 down.  It scrolls the window left or right,
  348. # depending on where the mouse is, and reschedules itself as an
  349. # "after" command so that the window continues to scroll until the
  350. # mouse moves back into the window or the mouse button is released.
  351. #
  352. # Arguments:
  353. # w -        The entry window.
  354.  
  355. proc tkEntryAutoScan {w} {
  356.     global tkPriv
  357.     set x $tkPriv(x)
  358.     if {$x >= [winfo width $w]} {
  359.     $w xview scroll 2 units
  360.     tkEntryMouseSelect $w $x
  361.     } elseif {$x < 0} {
  362.     $w xview scroll -2 units
  363.     tkEntryMouseSelect $w $x
  364.     }
  365.     set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
  366. }
  367.  
  368. # tkEntryKeySelect --
  369. # This procedure is invoked when stroking out selections using the
  370. # keyboard.  It moves the cursor to a new position, then extends
  371. # the selection to that position.
  372. #
  373. # Arguments:
  374. # w -        The entry window.
  375. # new -        A new position for the insertion cursor (the cursor hasn't
  376. #        actually been moved to this position yet).
  377.  
  378. proc tkEntryKeySelect {w new} {
  379.     if ![$w selection present] {
  380.     $w selection from insert
  381.     $w selection to $new
  382.     } else {
  383.     $w selection adjust $new
  384.     }
  385.     $w icursor $new
  386. }
  387.  
  388. # tkEntryInsert --
  389. # Insert a string into an entry at the point of the insertion cursor.
  390. # If there is a selection in the entry, and it covers the point of the
  391. # insertion cursor, then delete the selection before inserting.
  392. #
  393. # Arguments:
  394. # w -        The entry window in which to insert the string
  395. # s -        The string to insert (usually just a single character)
  396.  
  397. proc tkEntryInsert {w s} {
  398.     if {$s == ""} {
  399.     return
  400.     }
  401.     catch {
  402.     set insert [$w index insert]
  403.     if {([$w index sel.first] <= $insert)
  404.         && ([$w index sel.last] >= $insert)} {
  405.         $w delete sel.first sel.last
  406.     }
  407.     }
  408.     $w insert insert $s
  409.     tkEntrySeeInsert $w
  410. }
  411.  
  412. # tkEntryBackspace --
  413. # Backspace over the character just before the insertion cursor.
  414. # If backspacing would move the cursor off the left edge of the
  415. # window, reposition the cursor at about the middle of the window.
  416. #
  417. # Arguments:
  418. # w -        The entry window in which to backspace.
  419.  
  420. proc tkEntryBackspace w {
  421.     if [$w selection present] {
  422.     $w delete sel.first sel.last
  423.     } else {
  424.     set x [expr {[$w index insert] - 1}]
  425.     if {$x >= 0} {$w delete $x}
  426.     if {[$w index @0] >= [$w index insert]} {
  427.         set range [$w xview]
  428.         set left [lindex $range 0]
  429.         set right [lindex $range 1]
  430.         $w xview moveto [expr $left - ($right - $left)/2.0]
  431.     }
  432.     }
  433. }
  434.  
  435. # tkEntrySeeInsert --
  436. # Make sure that the insertion cursor is visible in the entry window.
  437. # If not, adjust the view so that it is.
  438. #
  439. # Arguments:
  440. # w -        The entry window.
  441.  
  442. proc tkEntrySeeInsert w {
  443.     set c [$w index insert]
  444.     set left [$w index @0]
  445.     if {$left > $c} {
  446.     $w xview $c
  447.     return
  448.     }
  449.     set x [winfo width $w]
  450.     while {([$w index @$x] <= $c) && ($left < $c)} {
  451.     incr left
  452.     $w xview $left
  453.     }
  454. }
  455.  
  456. # tkEntrySetCursor -
  457. # Move the insertion cursor to a given position in an entry.  Also
  458. # clears the selection, if there is one in the entry, and makes sure
  459. # that the insertion cursor is visible.
  460. #
  461. # Arguments:
  462. # w -        The entry window.
  463. # pos -        The desired new position for the cursor in the window.
  464.  
  465. proc tkEntrySetCursor {w pos} {
  466.     $w icursor $pos
  467.     $w selection clear
  468.     tkEntrySeeInsert $w
  469. }
  470.  
  471. # tkEntryTranspose -
  472. # This procedure implements the "transpose" function for entry widgets.
  473. # It tranposes the characters on either side of the insertion cursor,
  474. # unless the cursor is at the end of the line.  In this case it
  475. # transposes the two characters to the left of the cursor.  In either
  476. # case, the cursor ends up to the right of the transposed characters.
  477. #
  478. # Arguments:
  479. # w -        The entry window.
  480.  
  481. proc tkEntryTranspose w {
  482.     set i [$w index insert]
  483.     if {$i < [$w index end]} {
  484.     incr i
  485.     }
  486.     set first [expr $i-2]
  487.     if {$first < 0} {
  488.     return
  489.     }
  490.     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
  491.     $w delete $first $i
  492.     $w insert insert $new
  493.     tkEntrySeeInsert $w
  494. }
  495.