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