home *** CD-ROM | disk | FTP | other *** search
/ Freelog Special Freeware 31 / FreelogHS31.iso / Texte / scribus / scribus-1.3.3.9-win32-install.exe / tcl / tk8.4 / entry.tcl < prev    next >
Text File  |  2003-01-23  |  17KB  |  654 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.21 2003/01/23 23:30:11 drh 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::CancelRepeat
  192.     tk::EntryInsert %W %A
  193. }
  194.  
  195. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  196. # Otherwise, if a widget binding for one of these is defined, the
  197. # <KeyPress> class binding will also fire and insert the character,
  198. # which is wrong.  Ditto for Escape, Return, and Tab.
  199.  
  200. bind Entry <Alt-KeyPress> {# nothing}
  201. bind Entry <Meta-KeyPress> {# nothing}
  202. bind Entry <Control-KeyPress> {# nothing}
  203. bind Entry <Escape> {# nothing}
  204. bind Entry <Return> {# nothing}
  205. bind Entry <KP_Enter> {# nothing}
  206. bind Entry <Tab> {# nothing}
  207. if {[string equal [tk windowingsystem] "classic"]
  208.     || [string equal [tk windowingsystem] "aqua"]} {
  209.     bind Entry <Command-KeyPress> {# nothing}
  210. }
  211.  
  212. # On Windows, paste is done using Shift-Insert.  Shift-Insert already
  213. # generates the <<Paste>> event, so we don't need to do anything here.
  214. if {[string compare $tcl_platform(platform) "windows"]} {
  215.     bind Entry <Insert> {
  216.     catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  217.     }
  218. }
  219.  
  220. # Additional emacs-like bindings:
  221.  
  222. bind Entry <Control-a> {
  223.     if {!$tk_strictMotif} {
  224.     tk::EntrySetCursor %W 0
  225.     }
  226. }
  227. bind Entry <Control-b> {
  228.     if {!$tk_strictMotif} {
  229.     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  230.     }
  231. }
  232. bind Entry <Control-d> {
  233.     if {!$tk_strictMotif} {
  234.     %W delete insert
  235.     }
  236. }
  237. bind Entry <Control-e> {
  238.     if {!$tk_strictMotif} {
  239.     tk::EntrySetCursor %W end
  240.     }
  241. }
  242. bind Entry <Control-f> {
  243.     if {!$tk_strictMotif} {
  244.     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  245.     }
  246. }
  247. bind Entry <Control-h> {
  248.     if {!$tk_strictMotif} {
  249.     tk::EntryBackspace %W
  250.     }
  251. }
  252. bind Entry <Control-k> {
  253.     if {!$tk_strictMotif} {
  254.     %W delete insert end
  255.     }
  256. }
  257. bind Entry <Control-t> {
  258.     if {!$tk_strictMotif} {
  259.     tk::EntryTranspose %W
  260.     }
  261. }
  262. bind Entry <Meta-b> {
  263.     if {!$tk_strictMotif} {
  264.     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  265.     }
  266. }
  267. bind Entry <Meta-d> {
  268.     if {!$tk_strictMotif} {
  269.     %W delete insert [tk::EntryNextWord %W insert]
  270.     }
  271. }
  272. bind Entry <Meta-f> {
  273.     if {!$tk_strictMotif} {
  274.     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  275.     }
  276. }
  277. bind Entry <Meta-BackSpace> {
  278.     if {!$tk_strictMotif} {
  279.     %W delete [tk::EntryPreviousWord %W insert] insert
  280.     }
  281. }
  282. bind Entry <Meta-Delete> {
  283.     if {!$tk_strictMotif} {
  284.     %W delete [tk::EntryPreviousWord %W insert] insert
  285.     }
  286. }
  287.  
  288. # A few additional bindings of my own.
  289.  
  290. bind Entry <2> {
  291.     if {!$tk_strictMotif} {
  292.     ::tk::EntryScanMark %W %x
  293.     }
  294. }
  295. bind Entry <B2-Motion> {
  296.     if {!$tk_strictMotif} {
  297.     ::tk::EntryScanDrag %W %x
  298.     }
  299. }
  300.  
  301. # ::tk::EntryClosestGap --
  302. # Given x and y coordinates, this procedure finds the closest boundary
  303. # between characters to the given coordinates and returns the index
  304. # of the character just after the boundary.
  305. #
  306. # Arguments:
  307. # w -        The entry window.
  308. # x -        X-coordinate within the window.
  309.  
  310. proc ::tk::EntryClosestGap {w x} {
  311.     set pos [$w index @$x]
  312.     set bbox [$w bbox $pos]
  313.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  314.     return $pos
  315.     }
  316.     incr pos
  317. }
  318.  
  319. # ::tk::EntryButton1 --
  320. # This procedure is invoked to handle button-1 presses in entry
  321. # widgets.  It moves the insertion cursor, sets the selection anchor,
  322. # and claims the input focus.
  323. #
  324. # Arguments:
  325. # w -        The entry window in which the button was pressed.
  326. # x -        The x-coordinate of the button press.
  327.  
  328. proc ::tk::EntryButton1 {w x} {
  329.     variable ::tk::Priv
  330.  
  331.     set Priv(selectMode) char
  332.     set Priv(mouseMoved) 0
  333.     set Priv(pressX) $x
  334.     $w icursor [EntryClosestGap $w $x]
  335.     $w selection from insert
  336.     if {[string compare "disabled" [$w cget -state]]} {focus $w}
  337. }
  338.  
  339. # ::tk::EntryMouseSelect --
  340. # This procedure is invoked when dragging out a selection with
  341. # the mouse.  Depending on the selection mode (character, word,
  342. # line) it selects in different-sized units.  This procedure
  343. # ignores mouse motions initially until the mouse has moved from
  344. # one character to another or until there have been multiple clicks.
  345. #
  346. # Arguments:
  347. # w -        The entry window in which the button was pressed.
  348. # x -        The x-coordinate of the mouse.
  349.  
  350. proc ::tk::EntryMouseSelect {w x} {
  351.     variable ::tk::Priv
  352.  
  353.     set cur [EntryClosestGap $w $x]
  354.     set anchor [$w index anchor]
  355.     if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  356.     set Priv(mouseMoved) 1
  357.     }
  358.     switch $Priv(selectMode) {
  359.     char {
  360.         if {$Priv(mouseMoved)} {
  361.         if {$cur < $anchor} {
  362.             $w selection range $cur $anchor
  363.         } elseif {$cur > $anchor} {
  364.             $w selection range $anchor $cur
  365.         } else {
  366.             $w selection clear
  367.         }
  368.         }
  369.     }
  370.     word {
  371.         if {$cur < [$w index anchor]} {
  372.         set before [tcl_wordBreakBefore [$w get] $cur]
  373.         set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  374.         } else {
  375.         set before [tcl_wordBreakBefore [$w get] $anchor]
  376.         set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  377.         }
  378.         if {$before < 0} {
  379.         set before 0
  380.         }
  381.         if {$after < 0} {
  382.         set after end
  383.         }
  384.         $w selection range $before $after
  385.     }
  386.     line {
  387.         $w selection range 0 end
  388.     }
  389.     }
  390.     if {$Priv(mouseMoved)} {
  391.         $w icursor $cur
  392.     }
  393.     update idletasks
  394. }
  395.  
  396. # ::tk::EntryPaste --
  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 ::tk::EntryPaste {w x} {
  405.     $w icursor [EntryClosestGap $w $x]
  406.     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  407.     if {[string compare "disabled" [$w cget -state]]} {focus $w}
  408. }
  409.  
  410. # ::tk::EntryAutoScan --
  411. # This procedure is invoked when the mouse leaves an entry window
  412. # with button 1 down.  It scrolls the window left or right,
  413. # depending on where the mouse is, and reschedules itself as an
  414. # "after" command so that the window continues to scroll until the
  415. # mouse moves back into the window or the mouse button is released.
  416. #
  417. # Arguments:
  418. # w -        The entry window.
  419.  
  420. proc ::tk::EntryAutoScan {w} {
  421.     variable ::tk::Priv
  422.     set x $Priv(x)
  423.     if {![winfo exists $w]} return
  424.     if {$x >= [winfo width $w]} {
  425.     $w xview scroll 2 units
  426.     EntryMouseSelect $w $x
  427.     } elseif {$x < 0} {
  428.     $w xview scroll -2 units
  429.     EntryMouseSelect $w $x
  430.     }
  431.     set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
  432. }
  433.  
  434. # ::tk::EntryKeySelect --
  435. # This procedure is invoked when stroking out selections using the
  436. # keyboard.  It moves the cursor to a new position, then extends
  437. # the selection to that position.
  438. #
  439. # Arguments:
  440. # w -        The entry window.
  441. # new -        A new position for the insertion cursor (the cursor hasn't
  442. #        actually been moved to this position yet).
  443.  
  444. proc ::tk::EntryKeySelect {w new} {
  445.     if {![$w selection present]} {
  446.     $w selection from insert
  447.     $w selection to $new
  448.     } else {
  449.     $w selection adjust $new
  450.     }
  451.     $w icursor $new
  452. }
  453.  
  454. # ::tk::EntryInsert --
  455. # Insert a string into an entry at the point of the insertion cursor.
  456. # If there is a selection in the entry, and it covers the point of the
  457. # insertion cursor, then delete the selection before inserting.
  458. #
  459. # Arguments:
  460. # w -        The entry window in which to insert the string
  461. # s -        The string to insert (usually just a single character)
  462.  
  463. proc ::tk::EntryInsert {w s} {
  464.     if {[string equal $s ""]} {
  465.     return
  466.     }
  467.     catch {
  468.     set insert [$w index insert]
  469.     if {([$w index sel.first] <= $insert)
  470.         && ([$w index sel.last] >= $insert)} {
  471.         $w delete sel.first sel.last
  472.     }
  473.     }
  474.     $w insert insert $s
  475.     EntrySeeInsert $w
  476. }
  477.  
  478. # ::tk::EntryBackspace --
  479. # Backspace over the character just before the insertion cursor.
  480. # If backspacing would move the cursor off the left edge of the
  481. # window, reposition the cursor at about the middle of the window.
  482. #
  483. # Arguments:
  484. # w -        The entry window in which to backspace.
  485.  
  486. proc ::tk::EntryBackspace w {
  487.     if {[$w selection present]} {
  488.     $w delete sel.first sel.last
  489.     } else {
  490.     set x [expr {[$w index insert] - 1}]
  491.     if {$x >= 0} {$w delete $x}
  492.     if {[$w index @0] >= [$w index insert]} {
  493.         set range [$w xview]
  494.         set left [lindex $range 0]
  495.         set right [lindex $range 1]
  496.         $w xview moveto [expr {$left - ($right - $left)/2.0}]
  497.     }
  498.     }
  499. }
  500.  
  501. # ::tk::EntrySeeInsert --
  502. # Make sure that the insertion cursor is visible in the entry window.
  503. # If not, adjust the view so that it is.
  504. #
  505. # Arguments:
  506. # w -        The entry window.
  507.  
  508. proc ::tk::EntrySeeInsert w {
  509.     set c [$w index insert]
  510.     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
  511.     $w xview $c
  512.     }
  513. }
  514.  
  515. # ::tk::EntrySetCursor -
  516. # Move the insertion cursor to a given position in an entry.  Also
  517. # clears the selection, if there is one in the entry, and makes sure
  518. # that the insertion cursor is visible.
  519. #
  520. # Arguments:
  521. # w -        The entry window.
  522. # pos -        The desired new position for the cursor in the window.
  523.  
  524. proc ::tk::EntrySetCursor {w pos} {
  525.     $w icursor $pos
  526.     $w selection clear
  527.     EntrySeeInsert $w
  528. }
  529.  
  530. # ::tk::EntryTranspose -
  531. # This procedure implements the "transpose" function for entry widgets.
  532. # It tranposes the characters on either side of the insertion cursor,
  533. # unless the cursor is at the end of the line.  In this case it
  534. # transposes the two characters to the left of the cursor.  In either
  535. # case, the cursor ends up to the right of the transposed characters.
  536. #
  537. # Arguments:
  538. # w -        The entry window.
  539.  
  540. proc ::tk::EntryTranspose w {
  541.     set i [$w index insert]
  542.     if {$i < [$w index end]} {
  543.     incr i
  544.     }
  545.     set first [expr {$i-2}]
  546.     if {$first < 0} {
  547.     return
  548.     }
  549.     set data [$w get]
  550.     set new [string index $data [expr {$i-1}]][string index $data $first]
  551.     $w delete $first $i
  552.     $w insert insert $new
  553.     EntrySeeInsert $w
  554. }
  555.  
  556. # ::tk::EntryNextWord --
  557. # Returns the index of the next word position after a given position in the
  558. # entry.  The next word is platform dependent and may be either the next
  559. # end-of-word position or the next start-of-word position after the next
  560. # end-of-word position.
  561. #
  562. # Arguments:
  563. # w -        The entry window in which the cursor is to move.
  564. # start -    Position at which to start search.
  565.  
  566. if {[string equal $tcl_platform(platform) "windows"]}  {
  567.     proc ::tk::EntryNextWord {w start} {
  568.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  569.     if {$pos >= 0} {
  570.         set pos [tcl_startOfNextWord [$w get] $pos]
  571.     }
  572.     if {$pos < 0} {
  573.         return end
  574.     }
  575.     return $pos
  576.     }
  577. } else {
  578.     proc ::tk::EntryNextWord {w start} {
  579.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  580.     if {$pos < 0} {
  581.         return end
  582.     }
  583.     return $pos
  584.     }
  585. }
  586.  
  587. # ::tk::EntryPreviousWord --
  588. #
  589. # Returns the index of the previous word position before a given
  590. # position in the entry.
  591. #
  592. # Arguments:
  593. # w -        The entry window in which the cursor is to move.
  594. # start -    Position at which to start search.
  595.  
  596. proc ::tk::EntryPreviousWord {w start} {
  597.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  598.     if {$pos < 0} {
  599.     return 0
  600.     }
  601.     return $pos
  602. }
  603.  
  604. # ::tk::EntryScanMark --
  605. #
  606. # Marks the start of a possible scan drag operation
  607. #
  608. # Arguments:
  609. # w -    The entry window from which the text to get
  610. # x -    x location on screen
  611.  
  612. proc ::tk::EntryScanMark {w x} {
  613.     $w scan mark $x
  614.     set ::tk::Priv(x) $x
  615.     set ::tk::Priv(y) 0 ; # not used
  616.     set ::tk::Priv(mouseMoved) 0
  617. }
  618.  
  619. # ::tk::EntryScanDrag --
  620. #
  621. # Marks the start of a possible scan drag operation
  622. #
  623. # Arguments:
  624. # w -    The entry window from which the text to get
  625. # x -    x location on screen
  626.  
  627. proc ::tk::EntryScanDrag {w x} {
  628.     # Make sure these exist, as some weird situations can trigger the
  629.     # motion binding without the initial press.  [Bug #220269]
  630.     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
  631.     # allow for a delta
  632.     if {abs($x-$::tk::Priv(x)) > 2} {
  633.     set ::tk::Priv(mouseMoved) 1
  634.     }
  635.     $w scan dragto $x
  636. }
  637.  
  638. # ::tk::EntryGetSelection --
  639. #
  640. # Returns the selected text of the entry with respect to the -show option.
  641. #
  642. # Arguments:
  643. # w -         The entry window from which the text to get
  644.  
  645. proc ::tk::EntryGetSelection {w} {
  646.     set entryString [string range [$w get] [$w index sel.first] \
  647.         [expr {[$w index sel.last] - 1}]]
  648.     if {[string compare [$w cget -show] ""]} {
  649.     return [string repeat [string index [$w cget -show] 0] \
  650.         [string length $entryString]]
  651.     }
  652.     return $entryString
  653. }
  654.