entry.tcl
上传用户:rrhhcc
上传日期:2015-12-11
资源大小:54129k
文件大小:17k
源码类别:

通讯编程

开发平台:

Visual C++

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