home *** CD-ROM | disk | FTP | other *** search
/ PC World 2001 April / PCWorld_2001-04_cd.bin / Software / TemaCD / webclean / !!!python!!! / BeOpen-Python-2.0.exe / ENTRY.TCL < prev    next >
Encoding:
Text File  |  2000-01-05  |  15.5 KB  |  619 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 2000/01/06 02:22:24 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 equal [$w cget -state] "normal"]} {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.     update idletasks
  394. }
  395.  
  396. # tkEntryPaste --
  397. # This procedure sets the insertion cursor to the current mouse position,
  398. # pastes the selection there, and sets the focus to the window.
  399. #
  400. # Arguments:
  401. # w -        The entry window.
  402. # x -        X position of the mouse.
  403.  
  404. proc tkEntryPaste {w x} {
  405.     global tkPriv
  406.  
  407.     $w icursor [tkEntryClosestGap $w $x]
  408.     catch {$w insert insert [selection get -displayof $w]}
  409.     if {[string equal [$w cget -state] "normal"]} {focus $w}
  410. }
  411.  
  412. # tkEntryAutoScan --
  413. # This procedure is invoked when the mouse leaves an entry window
  414. # with button 1 down.  It scrolls the window left or right,
  415. # depending on where the mouse is, and reschedules itself as an
  416. # "after" command so that the window continues to scroll until the
  417. # mouse moves back into the window or the mouse button is released.
  418. #
  419. # Arguments:
  420. # w -        The entry window.
  421.  
  422. proc tkEntryAutoScan {w} {
  423.     global tkPriv
  424.     set x $tkPriv(x)
  425.     if {![winfo exists $w]} return
  426.     if {$x >= [winfo width $w]} {
  427.     $w xview scroll 2 units
  428.     tkEntryMouseSelect $w $x
  429.     } elseif {$x < 0} {
  430.     $w xview scroll -2 units
  431.     tkEntryMouseSelect $w $x
  432.     }
  433.     set tkPriv(afterId) [after 50 [list tkEntryAutoScan $w]]
  434. }
  435.  
  436. # tkEntryKeySelect --
  437. # This procedure is invoked when stroking out selections using the
  438. # keyboard.  It moves the cursor to a new position, then extends
  439. # the selection to that position.
  440. #
  441. # Arguments:
  442. # w -        The entry window.
  443. # new -        A new position for the insertion cursor (the cursor hasn't
  444. #        actually been moved to this position yet).
  445.  
  446. proc tkEntryKeySelect {w new} {
  447.     if {![$w selection present]} {
  448.     $w selection from insert
  449.     $w selection to $new
  450.     } else {
  451.     $w selection adjust $new
  452.     }
  453.     $w icursor $new
  454. }
  455.  
  456. # tkEntryInsert --
  457. # Insert a string into an entry at the point of the insertion cursor.
  458. # If there is a selection in the entry, and it covers the point of the
  459. # insertion cursor, then delete the selection before inserting.
  460. #
  461. # Arguments:
  462. # w -        The entry window in which to insert the string
  463. # s -        The string to insert (usually just a single character)
  464.  
  465. proc tkEntryInsert {w s} {
  466.     if {[string equal $s ""]} {
  467.     return
  468.     }
  469.     catch {
  470.     set insert [$w index insert]
  471.     if {([$w index sel.first] <= $insert)
  472.         && ([$w index sel.last] >= $insert)} {
  473.         $w delete sel.first sel.last
  474.     }
  475.     }
  476.     $w insert insert $s
  477.     tkEntrySeeInsert $w
  478. }
  479.  
  480. # tkEntryBackspace --
  481. # Backspace over the character just before the insertion cursor.
  482. # If backspacing would move the cursor off the left edge of the
  483. # window, reposition the cursor at about the middle of the window.
  484. #
  485. # Arguments:
  486. # w -        The entry window in which to backspace.
  487.  
  488. proc tkEntryBackspace w {
  489.     if {[$w selection present]} {
  490.     $w delete sel.first sel.last
  491.     } else {
  492.     set x [expr {[$w index insert] - 1}]
  493.     if {$x >= 0} {$w delete $x}
  494.     if {[$w index @0] >= [$w index insert]} {
  495.         set range [$w xview]
  496.         set left [lindex $range 0]
  497.         set right [lindex $range 1]
  498.         $w xview moveto [expr {$left - ($right - $left)/2.0}]
  499.     }
  500.     }
  501. }
  502.  
  503. # tkEntrySeeInsert --
  504. # Make sure that the insertion cursor is visible in the entry window.
  505. # If not, adjust the view so that it is.
  506. #
  507. # Arguments:
  508. # w -        The entry window.
  509.  
  510. proc tkEntrySeeInsert w {
  511.     set c [$w index insert]
  512.     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
  513.     $w xview $c
  514.     }
  515. }
  516.  
  517. # tkEntrySetCursor -
  518. # Move the insertion cursor to a given position in an entry.  Also
  519. # clears the selection, if there is one in the entry, and makes sure
  520. # that the insertion cursor is visible.
  521. #
  522. # Arguments:
  523. # w -        The entry window.
  524. # pos -        The desired new position for the cursor in the window.
  525.  
  526. proc tkEntrySetCursor {w pos} {
  527.     $w icursor $pos
  528.     $w selection clear
  529.     tkEntrySeeInsert $w
  530. }
  531.  
  532. # tkEntryTranspose -
  533. # This procedure implements the "transpose" function for entry widgets.
  534. # It tranposes the characters on either side of the insertion cursor,
  535. # unless the cursor is at the end of the line.  In this case it
  536. # transposes the two characters to the left of the cursor.  In either
  537. # case, the cursor ends up to the right of the transposed characters.
  538. #
  539. # Arguments:
  540. # w -        The entry window.
  541.  
  542. proc tkEntryTranspose w {
  543.     set i [$w index insert]
  544.     if {$i < [$w index end]} {
  545.     incr i
  546.     }
  547.     set first [expr {$i-2}]
  548.     if {$first < 0} {
  549.     return
  550.     }
  551.     set new [string index [$w get] [expr {$i-1}]][string index [$w get] $first]
  552.     $w delete $first $i
  553.     $w insert insert $new
  554.     tkEntrySeeInsert $w
  555. }
  556.  
  557. # tkEntryNextWord --
  558. # Returns the index of the next word position after a given position in the
  559. # entry.  The next word is platform dependent and may be either the next
  560. # end-of-word position or the next start-of-word position after the next
  561. # end-of-word position.
  562. #
  563. # Arguments:
  564. # w -        The entry window in which the cursor is to move.
  565. # start -    Position at which to start search.
  566.  
  567. if {[string equal $tcl_platform(platform) "windows"]}  {
  568.     proc tkEntryNextWord {w start} {
  569.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  570.     if {$pos >= 0} {
  571.         set pos [tcl_startOfNextWord [$w get] $pos]
  572.     }
  573.     if {$pos < 0} {
  574.         return end
  575.     }
  576.     return $pos
  577.     }
  578. } else {
  579.     proc tkEntryNextWord {w start} {
  580.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  581.     if {$pos < 0} {
  582.         return end
  583.     }
  584.     return $pos
  585.     }
  586. }
  587.  
  588. # tkEntryPreviousWord --
  589. #
  590. # Returns the index of the previous word position before a given
  591. # position in the entry.
  592. #
  593. # Arguments:
  594. # w -        The entry window in which the cursor is to move.
  595. # start -    Position at which to start search.
  596.  
  597. proc tkEntryPreviousWord {w start} {
  598.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  599.     if {$pos < 0} {
  600.     return 0
  601.     }
  602.     return $pos
  603. }
  604. # tkEntryGetSelection --
  605. #
  606. # Returns the selected text of the entry with respect to the -show option.
  607. #
  608. # Arguments:
  609. # w -         The entry window from which the text to get
  610.  
  611. proc tkEntryGetSelection {w} {
  612.     set entryString [string range [$w get] [$w index sel.first] \
  613.         [expr {[$w index sel.last] - 1}]]
  614.     if {[string compare [$w cget -show] ""]} {
  615.     regsub -all . $entryString [string index [$w cget -show] 0] entryString
  616.     }
  617.     return $entryString
  618. }
  619.