home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / entry.tcl < prev    next >
Text File  |  2003-09-01  |  17KB  |  653 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.20 2002/08/31 06:12:28 das 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 tk::Priv 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 {tk::EntryGetSelection %W} tk::Priv(data)]} {
  37.     clipboard clear -displayof %W
  38.     clipboard append -displayof %W $tk::Priv(data)
  39.     %W delete sel.first sel.last
  40.     unset tk::Priv(data)
  41.     }
  42. }
  43. bind Entry <<Copy>> {
  44.     if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  45.     clipboard clear -displayof %W
  46.     clipboard append -displayof %W $tk::Priv(data)
  47.     unset tk::Priv(data)
  48.     }
  49. }
  50. bind Entry <<Paste>> {
  51.     global tcl_platform
  52.     catch {
  53.     if {[string compare [tk windowingsystem] "x11"]} {
  54.         catch {
  55.         %W delete sel.first sel.last
  56.         }
  57.     }
  58.     %W insert insert [::tk::GetSelection %W CLIPBOARD]
  59.     tk::EntrySeeInsert %W
  60.     }
  61. }
  62. bind Entry <<Clear>> {
  63.     %W delete sel.first sel.last
  64. }
  65. bind Entry <<PasteSelection>> {
  66.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  67.     || !$tk::Priv(mouseMoved)} {
  68.     tk::EntryPaste %W %x
  69.     }
  70. }
  71.  
  72. # Standard Motif bindings:
  73.  
  74. bind Entry <1> {
  75.     tk::EntryButton1 %W %x
  76.     %W selection clear
  77. }
  78. bind Entry <B1-Motion> {
  79.     set tk::Priv(x) %x
  80.     tk::EntryMouseSelect %W %x
  81. }
  82. bind Entry <Double-1> {
  83.     set tk::Priv(selectMode) word
  84.     tk::EntryMouseSelect %W %x
  85.     catch {%W icursor sel.last}
  86. }
  87. bind Entry <Triple-1> {
  88.     set tk::Priv(selectMode) line
  89.     tk::EntryMouseSelect %W %x
  90.     catch {%W icursor sel.last}
  91. }
  92. bind Entry <Shift-1> {
  93.     set tk::Priv(selectMode) char
  94.     %W selection adjust @%x
  95. }
  96. bind Entry <Double-Shift-1>    {
  97.     set tk::Priv(selectMode) word
  98.     tk::EntryMouseSelect %W %x
  99. }
  100. bind Entry <Triple-Shift-1>    {
  101.     set tk::Priv(selectMode) line
  102.     tk::EntryMouseSelect %W %x
  103. }
  104. bind Entry <B1-Leave> {
  105.     set tk::Priv(x) %x
  106.     tk::EntryAutoScan %W
  107. }
  108. bind Entry <B1-Enter> {
  109.     tk::CancelRepeat
  110. }
  111. bind Entry <ButtonRelease-1> {
  112.     tk::CancelRepeat
  113. }
  114. bind Entry <Control-1> {
  115.     %W icursor @%x
  116. }
  117.  
  118. bind Entry <Left> {
  119.     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  120. }
  121. bind Entry <Right> {
  122.     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  123. }
  124. bind Entry <Shift-Left> {
  125.     tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
  126.     tk::EntrySeeInsert %W
  127. }
  128. bind Entry <Shift-Right> {
  129.     tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
  130.     tk::EntrySeeInsert %W
  131. }
  132. bind Entry <Control-Left> {
  133.     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  134. }
  135. bind Entry <Control-Right> {
  136.     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  137. }
  138. bind Entry <Shift-Control-Left> {
  139.     tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
  140.     tk::EntrySeeInsert %W
  141. }
  142. bind Entry <Shift-Control-Right> {
  143.     tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
  144.     tk::EntrySeeInsert %W
  145. }
  146. bind Entry <Home> {
  147.     tk::EntrySetCursor %W 0
  148. }
  149. bind Entry <Shift-Home> {
  150.     tk::EntryKeySelect %W 0
  151.     tk::EntrySeeInsert %W
  152. }
  153. bind Entry <End> {
  154.     tk::EntrySetCursor %W end
  155. }
  156. bind Entry <Shift-End> {
  157.     tk::EntryKeySelect %W end
  158.     tk::EntrySeeInsert %W
  159. }
  160.  
  161. bind Entry <Delete> {
  162.     if {[%W selection present]} {
  163.     %W delete sel.first sel.last
  164.     } else {
  165.     %W delete insert
  166.     }
  167. }
  168. bind Entry <BackSpace> {
  169.     tk::EntryBackspace %W
  170. }
  171.  
  172. bind Entry <Control-space> {
  173.     %W selection from insert
  174. }
  175. bind Entry <Select> {
  176.     %W selection from insert
  177. }
  178. bind Entry <Control-Shift-space> {
  179.     %W selection adjust insert
  180. }
  181. bind Entry <Shift-Select> {
  182.     %W selection adjust insert
  183. }
  184. bind Entry <Control-slash> {
  185.     %W selection range 0 end
  186. }
  187. bind Entry <Control-backslash> {
  188.     %W selection clear
  189. }
  190. bind Entry <KeyPress> {
  191.     tk::EntryInsert %W %A
  192. }
  193.  
  194. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  195. # Otherwise, if a widget binding for one of these is defined, the
  196. # <KeyPress> class binding will also fire and insert the character,
  197. # which is wrong.  Ditto for Escape, Return, and Tab.
  198.  
  199. bind Entry <Alt-KeyPress> {# nothing}
  200. bind Entry <Meta-KeyPress> {# nothing}
  201. bind Entry <Control-KeyPress> {# nothing}
  202. bind Entry <Escape> {# nothing}
  203. bind Entry <Return> {# nothing}
  204. bind Entry <KP_Enter> {# nothing}
  205. bind Entry <Tab> {# nothing}
  206. if {[string equal [tk windowingsystem] "classic"]
  207.     || [string equal [tk windowingsystem] "aqua"]} {
  208.     bind Entry <Command-KeyPress> {# nothing}
  209. }
  210.  
  211. # On Windows, paste is done using Shift-Insert.  Shift-Insert already
  212. # generates the <<Paste>> event, so we don't need to do anything here.
  213. if {[string compare $tcl_platform(platform) "windows"]} {
  214.     bind Entry <Insert> {
  215.     catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  216.     }
  217. }
  218.  
  219. # Additional emacs-like bindings:
  220.  
  221. bind Entry <Control-a> {
  222.     if {!$tk_strictMotif} {
  223.     tk::EntrySetCursor %W 0
  224.     }
  225. }
  226. bind Entry <Control-b> {
  227.     if {!$tk_strictMotif} {
  228.     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  229.     }
  230. }
  231. bind Entry <Control-d> {
  232.     if {!$tk_strictMotif} {
  233.     %W delete insert
  234.     }
  235. }
  236. bind Entry <Control-e> {
  237.     if {!$tk_strictMotif} {
  238.     tk::EntrySetCursor %W end
  239.     }
  240. }
  241. bind Entry <Control-f> {
  242.     if {!$tk_strictMotif} {
  243.     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  244.     }
  245. }
  246. bind Entry <Control-h> {
  247.     if {!$tk_strictMotif} {
  248.     tk::EntryBackspace %W
  249.     }
  250. }
  251. bind Entry <Control-k> {
  252.     if {!$tk_strictMotif} {
  253.     %W delete insert end
  254.     }
  255. }
  256. bind Entry <Control-t> {
  257.     if {!$tk_strictMotif} {
  258.     tk::EntryTranspose %W
  259.     }
  260. }
  261. bind Entry <Meta-b> {
  262.     if {!$tk_strictMotif} {
  263.     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  264.     }
  265. }
  266. bind Entry <Meta-d> {
  267.     if {!$tk_strictMotif} {
  268.     %W delete insert [tk::EntryNextWord %W insert]
  269.     }
  270. }
  271. bind Entry <Meta-f> {
  272.     if {!$tk_strictMotif} {
  273.     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  274.     }
  275. }
  276. bind Entry <Meta-BackSpace> {
  277.     if {!$tk_strictMotif} {
  278.     %W delete [tk::EntryPreviousWord %W insert] insert
  279.     }
  280. }
  281. bind Entry <Meta-Delete> {
  282.     if {!$tk_strictMotif} {
  283.     %W delete [tk::EntryPreviousWord %W insert] insert
  284.     }
  285. }
  286.  
  287. # A few additional bindings of my own.
  288.  
  289. bind Entry <2> {
  290.     if {!$tk_strictMotif} {
  291.     ::tk::EntryScanMark %W %x
  292.     }
  293. }
  294. bind Entry <B2-Motion> {
  295.     if {!$tk_strictMotif} {
  296.     ::tk::EntryScanDrag %W %x
  297.     }
  298. }
  299.  
  300. # ::tk::EntryClosestGap --
  301. # Given x and y coordinates, this procedure finds the closest boundary
  302. # between characters to the given coordinates and returns the index
  303. # of the character just after the boundary.
  304. #
  305. # Arguments:
  306. # w -        The entry window.
  307. # x -        X-coordinate within the window.
  308.  
  309. proc ::tk::EntryClosestGap {w x} {
  310.     set pos [$w index @$x]
  311.     set bbox [$w bbox $pos]
  312.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  313.     return $pos
  314.     }
  315.     incr pos
  316. }
  317.  
  318. # ::tk::EntryButton1 --
  319. # This procedure is invoked to handle button-1 presses in entry
  320. # widgets.  It moves the insertion cursor, sets the selection anchor,
  321. # and claims the input focus.
  322. #
  323. # Arguments:
  324. # w -        The entry window in which the button was pressed.
  325. # x -        The x-coordinate of the button press.
  326.  
  327. proc ::tk::EntryButton1 {w x} {
  328.     variable ::tk::Priv
  329.  
  330.     set Priv(selectMode) char
  331.     set Priv(mouseMoved) 0
  332.     set Priv(pressX) $x
  333.     $w icursor [EntryClosestGap $w $x]
  334.     $w selection from insert
  335.     if {[string compare "disabled" [$w cget -state]]} {focus $w}
  336. }
  337.  
  338. # ::tk::EntryMouseSelect --
  339. # This procedure is invoked when dragging out a selection with
  340. # the mouse.  Depending on the selection mode (character, word,
  341. # line) it selects in different-sized units.  This procedure
  342. # ignores mouse motions initially until the mouse has moved from
  343. # one character to another or until there have been multiple clicks.
  344. #
  345. # Arguments:
  346. # w -        The entry window in which the button was pressed.
  347. # x -        The x-coordinate of the mouse.
  348.  
  349. proc ::tk::EntryMouseSelect {w x} {
  350.     variable ::tk::Priv
  351.  
  352.     set cur [EntryClosestGap $w $x]
  353.     set anchor [$w index anchor]
  354.     if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  355.     set Priv(mouseMoved) 1
  356.     }
  357.     switch $Priv(selectMode) {
  358.     char {
  359.         if {$Priv(mouseMoved)} {
  360.         if {$cur < $anchor} {
  361.             $w selection range $cur $anchor
  362.         } elseif {$cur > $anchor} {
  363.             $w selection range $anchor $cur
  364.         } else {
  365.             $w selection clear
  366.         }
  367.         }
  368.     }
  369.     word {
  370.         if {$cur < [$w index anchor]} {
  371.         set before [tcl_wordBreakBefore [$w get] $cur]
  372.         set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  373.         } else {
  374.         set before [tcl_wordBreakBefore [$w get] $anchor]
  375.         set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  376.         }
  377.         if {$before < 0} {
  378.         set before 0
  379.         }
  380.         if {$after < 0} {
  381.         set after end
  382.         }
  383.         $w selection range $before $after
  384.     }
  385.     line {
  386.         $w selection range 0 end
  387.     }
  388.     }
  389.     if {$Priv(mouseMoved)} {
  390.         $w icursor $cur
  391.     }
  392.     update idletasks
  393. }
  394.  
  395. # ::tk::EntryPaste --
  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 ::tk::EntryPaste {w x} {
  404.     $w icursor [EntryClosestGap $w $x]
  405.     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  406.     if {[string compare "disabled" [$w cget -state]]} {focus $w}
  407. }
  408.  
  409. # ::tk::EntryAutoScan --
  410. # This procedure is invoked when the mouse leaves an entry window
  411. # with button 1 down.  It scrolls the window left or right,
  412. # depending on where the mouse is, and reschedules itself as an
  413. # "after" command so that the window continues to scroll until the
  414. # mouse moves back into the window or the mouse button is released.
  415. #
  416. # Arguments:
  417. # w -        The entry window.
  418.  
  419. proc ::tk::EntryAutoScan {w} {
  420.     variable ::tk::Priv
  421.     set x $Priv(x)
  422.     if {![winfo exists $w]} return
  423.     if {$x >= [winfo width $w]} {
  424.     $w xview scroll 2 units
  425.     EntryMouseSelect $w $x
  426.     } elseif {$x < 0} {
  427.     $w xview scroll -2 units
  428.     EntryMouseSelect $w $x
  429.     }
  430.     set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
  431. }
  432.  
  433. # ::tk::EntryKeySelect --
  434. # This procedure is invoked when stroking out selections using the
  435. # keyboard.  It moves the cursor to a new position, then extends
  436. # the selection to that position.
  437. #
  438. # Arguments:
  439. # w -        The entry window.
  440. # new -        A new position for the insertion cursor (the cursor hasn't
  441. #        actually been moved to this position yet).
  442.  
  443. proc ::tk::EntryKeySelect {w new} {
  444.     if {![$w selection present]} {
  445.     $w selection from insert
  446.     $w selection to $new
  447.     } else {
  448.     $w selection adjust $new
  449.     }
  450.     $w icursor $new
  451. }
  452.  
  453. # ::tk::EntryInsert --
  454. # Insert a string into an entry at the point of the insertion cursor.
  455. # If there is a selection in the entry, and it covers the point of the
  456. # insertion cursor, then delete the selection before inserting.
  457. #
  458. # Arguments:
  459. # w -        The entry window in which to insert the string
  460. # s -        The string to insert (usually just a single character)
  461.  
  462. proc ::tk::EntryInsert {w s} {
  463.     if {[string equal $s ""]} {
  464.     return
  465.     }
  466.     catch {
  467.     set insert [$w index insert]
  468.     if {([$w index sel.first] <= $insert)
  469.         && ([$w index sel.last] >= $insert)} {
  470.         $w delete sel.first sel.last
  471.     }
  472.     }
  473.     $w insert insert $s
  474.     EntrySeeInsert $w
  475. }
  476.  
  477. # ::tk::EntryBackspace --
  478. # Backspace over the character just before the insertion cursor.
  479. # If backspacing would move the cursor off the left edge of the
  480. # window, reposition the cursor at about the middle of the window.
  481. #
  482. # Arguments:
  483. # w -        The entry window in which to backspace.
  484.  
  485. proc ::tk::EntryBackspace w {
  486.     if {[$w selection present]} {
  487.     $w delete sel.first sel.last
  488.     } else {
  489.     set x [expr {[$w index insert] - 1}]
  490.     if {$x >= 0} {$w delete $x}
  491.     if {[$w index @0] >= [$w index insert]} {
  492.         set range [$w xview]
  493.         set left [lindex $range 0]
  494.         set right [lindex $range 1]
  495.         $w xview moveto [expr {$left - ($right - $left)/2.0}]
  496.     }
  497.     }
  498. }
  499.  
  500. # ::tk::EntrySeeInsert --
  501. # Make sure that the insertion cursor is visible in the entry window.
  502. # If not, adjust the view so that it is.
  503. #
  504. # Arguments:
  505. # w -        The entry window.
  506.  
  507. proc ::tk::EntrySeeInsert w {
  508.     set c [$w index insert]
  509.     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
  510.     $w xview $c
  511.     }
  512. }
  513.  
  514. # ::tk::EntrySetCursor -
  515. # Move the insertion cursor to a given position in an entry.  Also
  516. # clears the selection, if there is one in the entry, and makes sure
  517. # that the insertion cursor is visible.
  518. #
  519. # Arguments:
  520. # w -        The entry window.
  521. # pos -        The desired new position for the cursor in the window.
  522.  
  523. proc ::tk::EntrySetCursor {w pos} {
  524.     $w icursor $pos
  525.     $w selection clear
  526.     EntrySeeInsert $w
  527. }
  528.  
  529. # ::tk::EntryTranspose -
  530. # This procedure implements the "transpose" function for entry widgets.
  531. # It tranposes the characters on either side of the insertion cursor,
  532. # unless the cursor is at the end of the line.  In this case it
  533. # transposes the two characters to the left of the cursor.  In either
  534. # case, the cursor ends up to the right of the transposed characters.
  535. #
  536. # Arguments:
  537. # w -        The entry window.
  538.  
  539. proc ::tk::EntryTranspose w {
  540.     set i [$w index insert]
  541.     if {$i < [$w index end]} {
  542.     incr i
  543.     }
  544.     set first [expr {$i-2}]
  545.     if {$first < 0} {
  546.     return
  547.     }
  548.     set data [$w get]
  549.     set new [string index $data [expr {$i-1}]][string index $data $first]
  550.     $w delete $first $i
  551.     $w insert insert $new
  552.     EntrySeeInsert $w
  553. }
  554.  
  555. # ::tk::EntryNextWord --
  556. # Returns the index of the next word position after a given position in the
  557. # entry.  The next word is platform dependent and may be either the next
  558. # end-of-word position or the next start-of-word position after the next
  559. # end-of-word position.
  560. #
  561. # Arguments:
  562. # w -        The entry window in which the cursor is to move.
  563. # start -    Position at which to start search.
  564.  
  565. if {[string equal $tcl_platform(platform) "windows"]}  {
  566.     proc ::tk::EntryNextWord {w start} {
  567.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  568.     if {$pos >= 0} {
  569.         set pos [tcl_startOfNextWord [$w get] $pos]
  570.     }
  571.     if {$pos < 0} {
  572.         return end
  573.     }
  574.     return $pos
  575.     }
  576. } else {
  577.     proc ::tk::EntryNextWord {w start} {
  578.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  579.     if {$pos < 0} {
  580.         return end
  581.     }
  582.     return $pos
  583.     }
  584. }
  585.  
  586. # ::tk::EntryPreviousWord --
  587. #
  588. # Returns the index of the previous word position before a given
  589. # position in the entry.
  590. #
  591. # Arguments:
  592. # w -        The entry window in which the cursor is to move.
  593. # start -    Position at which to start search.
  594.  
  595. proc ::tk::EntryPreviousWord {w start} {
  596.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  597.     if {$pos < 0} {
  598.     return 0
  599.     }
  600.     return $pos
  601. }
  602.  
  603. # ::tk::EntryScanMark --
  604. #
  605. # Marks the start of a possible scan drag operation
  606. #
  607. # Arguments:
  608. # w -    The entry window from which the text to get
  609. # x -    x location on screen
  610.  
  611. proc ::tk::EntryScanMark {w x} {
  612.     $w scan mark $x
  613.     set ::tk::Priv(x) $x
  614.     set ::tk::Priv(y) 0 ; # not used
  615.     set ::tk::Priv(mouseMoved) 0
  616. }
  617.  
  618. # ::tk::EntryScanDrag --
  619. #
  620. # Marks the start of a possible scan drag operation
  621. #
  622. # Arguments:
  623. # w -    The entry window from which the text to get
  624. # x -    x location on screen
  625.  
  626. proc ::tk::EntryScanDrag {w x} {
  627.     # Make sure these exist, as some weird situations can trigger the
  628.     # motion binding without the initial press.  [Bug #220269]
  629.     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
  630.     # allow for a delta
  631.     if {abs($x-$::tk::Priv(x)) > 2} {
  632.     set ::tk::Priv(mouseMoved) 1
  633.     }
  634.     $w scan dragto $x
  635. }
  636.  
  637. # ::tk::EntryGetSelection --
  638. #
  639. # Returns the selected text of the entry with respect to the -show option.
  640. #
  641. # Arguments:
  642. # w -         The entry window from which the text to get
  643.  
  644. proc ::tk::EntryGetSelection {w} {
  645.     set entryString [string range [$w get] [$w index sel.first] \
  646.         [expr {[$w index sel.last] - 1}]]
  647.     if {[string compare [$w cget -show] ""]} {
  648.     return [string repeat [string index [$w cget -show] 0] \
  649.         [string length $entryString]]
  650.     }
  651.     return $entryString
  652. }
  653.