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