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