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