entry.tcl 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654
  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. # Copyright (c) 1992-1994 The Regents of the University of California.
  7. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. #-------------------------------------------------------------------------
  13. # Elements of tk::Priv that are used in this file:
  14. #
  15. # afterId - If non-null, it means that auto-scanning is underway
  16. # and it gives the "after" id for the next auto-scan
  17. # command to be executed.
  18. # mouseMoved - Non-zero means the mouse has moved a significant
  19. # amount since the button went down (so, for example,
  20. # start dragging out a selection).
  21. # pressX - X-coordinate at which the mouse button was pressed.
  22. # selectMode - The style of selection currently underway:
  23. # char, word, or line.
  24. # x, y - Last known mouse coordinates for scanning
  25. # and auto-scanning.
  26. # data - Used for Cut and Copy
  27. #-------------------------------------------------------------------------
  28. #-------------------------------------------------------------------------
  29. # The code below creates the default class bindings for entries.
  30. #-------------------------------------------------------------------------
  31. bind Entry <<Cut>> {
  32. if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  33. clipboard clear -displayof %W
  34. clipboard append -displayof %W $tk::Priv(data)
  35. %W delete sel.first sel.last
  36. unset tk::Priv(data)
  37. }
  38. }
  39. bind Entry <<Copy>> {
  40. if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  41. clipboard clear -displayof %W
  42. clipboard append -displayof %W $tk::Priv(data)
  43. unset tk::Priv(data)
  44. }
  45. }
  46. bind Entry <<Paste>> {
  47. catch {
  48. if {[tk windowingsystem] ne "x11"} {
  49. catch {
  50. %W delete sel.first sel.last
  51. }
  52. }
  53. %W insert insert [::tk::GetSelection %W CLIPBOARD]
  54. tk::EntrySeeInsert %W
  55. }
  56. }
  57. bind Entry <<Clear>> {
  58. # ignore if there is no selection
  59. catch { %W delete sel.first sel.last }
  60. }
  61. bind Entry <<PasteSelection>> {
  62. if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  63. || !$tk::Priv(mouseMoved)} {
  64. tk::EntryPaste %W %x
  65. }
  66. }
  67. bind Entry <<TraverseIn>> {
  68. %W selection range 0 end
  69. %W icursor end
  70. }
  71. # Standard Motif bindings:
  72. bind Entry <1> {
  73. tk::EntryButton1 %W %x
  74. %W selection clear
  75. }
  76. bind Entry <B1-Motion> {
  77. set tk::Priv(x) %x
  78. tk::EntryMouseSelect %W %x
  79. }
  80. bind Entry <Double-1> {
  81. set tk::Priv(selectMode) word
  82. tk::EntryMouseSelect %W %x
  83. catch {%W icursor sel.last}
  84. }
  85. bind Entry <Triple-1> {
  86. set tk::Priv(selectMode) line
  87. tk::EntryMouseSelect %W %x
  88. catch {%W icursor sel.last}
  89. }
  90. bind Entry <Shift-1> {
  91. set tk::Priv(selectMode) char
  92. %W selection adjust @%x
  93. }
  94. bind Entry <Double-Shift-1> {
  95. set tk::Priv(selectMode) word
  96. tk::EntryMouseSelect %W %x
  97. }
  98. bind Entry <Triple-Shift-1> {
  99. set tk::Priv(selectMode) line
  100. tk::EntryMouseSelect %W %x
  101. }
  102. bind Entry <B1-Leave> {
  103. set tk::Priv(x) %x
  104. tk::EntryAutoScan %W
  105. }
  106. bind Entry <B1-Enter> {
  107. tk::CancelRepeat
  108. }
  109. bind Entry <ButtonRelease-1> {
  110. tk::CancelRepeat
  111. }
  112. bind Entry <Control-1> {
  113. %W icursor @%x
  114. }
  115. bind Entry <<PrevChar>> {
  116. tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  117. }
  118. bind Entry <<NextChar>> {
  119. tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  120. }
  121. bind Entry <<SelectPrevChar>> {
  122. tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
  123. tk::EntrySeeInsert %W
  124. }
  125. bind Entry <<SelectNextChar>> {
  126. tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
  127. tk::EntrySeeInsert %W
  128. }
  129. bind Entry <<PrevWord>> {
  130. tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  131. }
  132. bind Entry <<NextWord>> {
  133. tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  134. }
  135. bind Entry <<SelectPrevWord>> {
  136. tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
  137. tk::EntrySeeInsert %W
  138. }
  139. bind Entry <<SelectNextWord>> {
  140. tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
  141. tk::EntrySeeInsert %W
  142. }
  143. bind Entry <<LineStart>> {
  144. tk::EntrySetCursor %W 0
  145. }
  146. bind Entry <<SelectLineStart>> {
  147. tk::EntryKeySelect %W 0
  148. tk::EntrySeeInsert %W
  149. }
  150. bind Entry <<LineEnd>> {
  151. tk::EntrySetCursor %W end
  152. }
  153. bind Entry <<SelectLineEnd>> {
  154. tk::EntryKeySelect %W end
  155. tk::EntrySeeInsert %W
  156. }
  157. bind Entry <Delete> {
  158. if {[%W selection present]} {
  159. %W delete sel.first sel.last
  160. } else {
  161. %W delete insert
  162. }
  163. }
  164. bind Entry <BackSpace> {
  165. tk::EntryBackspace %W
  166. }
  167. bind Entry <Control-space> {
  168. %W selection from insert
  169. }
  170. bind Entry <Select> {
  171. %W selection from insert
  172. }
  173. bind Entry <Control-Shift-space> {
  174. %W selection adjust insert
  175. }
  176. bind Entry <Shift-Select> {
  177. %W selection adjust insert
  178. }
  179. bind Entry <<SelectAll>> {
  180. %W selection range 0 end
  181. }
  182. bind Entry <<SelectNone>> {
  183. %W selection clear
  184. }
  185. bind Entry <KeyPress> {
  186. tk::CancelRepeat
  187. tk::EntryInsert %W %A
  188. }
  189. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  190. # Otherwise, if a widget binding for one of these is defined, the
  191. # <KeyPress> class binding will also fire and insert the character,
  192. # which is wrong. Ditto for Escape, Return, and Tab.
  193. bind Entry <Alt-KeyPress> {# nothing}
  194. bind Entry <Meta-KeyPress> {# nothing}
  195. bind Entry <Control-KeyPress> {# nothing}
  196. bind Entry <Escape> {# nothing}
  197. bind Entry <Return> {# nothing}
  198. bind Entry <KP_Enter> {# nothing}
  199. bind Entry <Tab> {# nothing}
  200. bind Entry <Prior> {# nothing}
  201. bind Entry <Next> {# nothing}
  202. if {[tk windowingsystem] eq "aqua"} {
  203. bind Entry <Command-KeyPress> {# nothing}
  204. }
  205. # Tk-on-Cocoa generates characters for these two keys. [Bug 2971663]
  206. bind Entry <<NextLine>> {# nothing}
  207. bind Entry <<PrevLine>> {# nothing}
  208. # On Windows, paste is done using Shift-Insert. Shift-Insert already
  209. # generates the <<Paste>> event, so we don't need to do anything here.
  210. if {[tk windowingsystem] ne "win32"} {
  211. bind Entry <Insert> {
  212. catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  213. }
  214. }
  215. # Additional emacs-like bindings:
  216. bind Entry <Control-d> {
  217. if {!$tk_strictMotif} {
  218. %W delete insert
  219. }
  220. }
  221. bind Entry <Control-h> {
  222. if {!$tk_strictMotif} {
  223. tk::EntryBackspace %W
  224. }
  225. }
  226. bind Entry <Control-k> {
  227. if {!$tk_strictMotif} {
  228. %W delete insert end
  229. }
  230. }
  231. bind Entry <Control-t> {
  232. if {!$tk_strictMotif} {
  233. tk::EntryTranspose %W
  234. }
  235. }
  236. bind Entry <Meta-b> {
  237. if {!$tk_strictMotif} {
  238. tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  239. }
  240. }
  241. bind Entry <Meta-d> {
  242. if {!$tk_strictMotif} {
  243. %W delete insert [tk::EntryNextWord %W insert]
  244. }
  245. }
  246. bind Entry <Meta-f> {
  247. if {!$tk_strictMotif} {
  248. tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  249. }
  250. }
  251. bind Entry <Meta-BackSpace> {
  252. if {!$tk_strictMotif} {
  253. %W delete [tk::EntryPreviousWord %W insert] insert
  254. }
  255. }
  256. bind Entry <Meta-Delete> {
  257. if {!$tk_strictMotif} {
  258. %W delete [tk::EntryPreviousWord %W insert] insert
  259. }
  260. }
  261. # A few additional bindings of my own.
  262. bind Entry <2> {
  263. if {!$tk_strictMotif} {
  264. ::tk::EntryScanMark %W %x
  265. }
  266. }
  267. bind Entry <B2-Motion> {
  268. if {!$tk_strictMotif} {
  269. ::tk::EntryScanDrag %W %x
  270. }
  271. }
  272. # ::tk::EntryClosestGap --
  273. # Given x and y coordinates, this procedure finds the closest boundary
  274. # between characters to the given coordinates and returns the index
  275. # of the character just after the boundary.
  276. #
  277. # Arguments:
  278. # w - The entry window.
  279. # x - X-coordinate within the window.
  280. proc ::tk::EntryClosestGap {w x} {
  281. set pos [$w index @$x]
  282. set bbox [$w bbox $pos]
  283. if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  284. return $pos
  285. }
  286. incr pos
  287. }
  288. # ::tk::EntryButton1 --
  289. # This procedure is invoked to handle button-1 presses in entry
  290. # widgets. It moves the insertion cursor, sets the selection anchor,
  291. # and claims the input focus.
  292. #
  293. # Arguments:
  294. # w - The entry window in which the button was pressed.
  295. # x - The x-coordinate of the button press.
  296. proc ::tk::EntryButton1 {w x} {
  297. variable ::tk::Priv
  298. set Priv(selectMode) char
  299. set Priv(mouseMoved) 0
  300. set Priv(pressX) $x
  301. $w icursor [EntryClosestGap $w $x]
  302. $w selection from insert
  303. if {"disabled" ne [$w cget -state]} {
  304. focus $w
  305. }
  306. }
  307. # ::tk::EntryMouseSelect --
  308. # This procedure is invoked when dragging out a selection with
  309. # the mouse. Depending on the selection mode (character, word,
  310. # line) it selects in different-sized units. This procedure
  311. # ignores mouse motions initially until the mouse has moved from
  312. # one character to another or until there have been multiple clicks.
  313. #
  314. # Arguments:
  315. # w - The entry window in which the button was pressed.
  316. # x - The x-coordinate of the mouse.
  317. proc ::tk::EntryMouseSelect {w x} {
  318. variable ::tk::Priv
  319. set cur [EntryClosestGap $w $x]
  320. set anchor [$w index anchor]
  321. if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  322. set Priv(mouseMoved) 1
  323. }
  324. switch $Priv(selectMode) {
  325. char {
  326. if {$Priv(mouseMoved)} {
  327. if {$cur < $anchor} {
  328. $w selection range $cur $anchor
  329. } elseif {$cur > $anchor} {
  330. $w selection range $anchor $cur
  331. } else {
  332. $w selection clear
  333. }
  334. }
  335. }
  336. word {
  337. if {$cur < $anchor} {
  338. set before [tcl_wordBreakBefore [$w get] $cur]
  339. set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  340. } elseif {$cur > $anchor} {
  341. set before [tcl_wordBreakBefore [$w get] $anchor]
  342. set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  343. } else {
  344. if {[$w index @$Priv(pressX)] < $anchor} {
  345. incr anchor -1
  346. }
  347. set before [tcl_wordBreakBefore [$w get] $anchor]
  348. set after [tcl_wordBreakAfter [$w get] $anchor]
  349. }
  350. if {$before < 0} {
  351. set before 0
  352. }
  353. if {$after < 0} {
  354. set after end
  355. }
  356. $w selection range $before $after
  357. }
  358. line {
  359. $w selection range 0 end
  360. }
  361. }
  362. if {$Priv(mouseMoved)} {
  363. $w icursor $cur
  364. }
  365. update idletasks
  366. }
  367. # ::tk::EntryPaste --
  368. # This procedure sets the insertion cursor to the current mouse position,
  369. # pastes the selection there, and sets the focus to the window.
  370. #
  371. # Arguments:
  372. # w - The entry window.
  373. # x - X position of the mouse.
  374. proc ::tk::EntryPaste {w x} {
  375. $w icursor [EntryClosestGap $w $x]
  376. catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  377. if {"disabled" ne [$w cget -state]} {
  378. focus $w
  379. }
  380. }
  381. # ::tk::EntryAutoScan --
  382. # This procedure is invoked when the mouse leaves an entry window
  383. # with button 1 down. It scrolls the window left or right,
  384. # depending on where the mouse is, and reschedules itself as an
  385. # "after" command so that the window continues to scroll until the
  386. # mouse moves back into the window or the mouse button is released.
  387. #
  388. # Arguments:
  389. # w - The entry window.
  390. proc ::tk::EntryAutoScan {w} {
  391. variable ::tk::Priv
  392. set x $Priv(x)
  393. if {![winfo exists $w]} {
  394. return
  395. }
  396. if {$x >= [winfo width $w]} {
  397. $w xview scroll 2 units
  398. EntryMouseSelect $w $x
  399. } elseif {$x < 0} {
  400. $w xview scroll -2 units
  401. EntryMouseSelect $w $x
  402. }
  403. set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
  404. }
  405. # ::tk::EntryKeySelect --
  406. # This procedure is invoked when stroking out selections using the
  407. # keyboard. It moves the cursor to a new position, then extends
  408. # the selection to that position.
  409. #
  410. # Arguments:
  411. # w - The entry window.
  412. # new - A new position for the insertion cursor (the cursor hasn't
  413. # actually been moved to this position yet).
  414. proc ::tk::EntryKeySelect {w new} {
  415. if {![$w selection present]} {
  416. $w selection from insert
  417. $w selection to $new
  418. } else {
  419. $w selection adjust $new
  420. }
  421. $w icursor $new
  422. }
  423. # ::tk::EntryInsert --
  424. # Insert a string into an entry at the point of the insertion cursor.
  425. # If there is a selection in the entry, and it covers the point of the
  426. # insertion cursor, then delete the selection before inserting.
  427. #
  428. # Arguments:
  429. # w - The entry window in which to insert the string
  430. # s - The string to insert (usually just a single character)
  431. proc ::tk::EntryInsert {w s} {
  432. if {$s eq ""} {
  433. return
  434. }
  435. catch {
  436. set insert [$w index insert]
  437. if {([$w index sel.first] <= $insert)
  438. && ([$w index sel.last] >= $insert)} {
  439. $w delete sel.first sel.last
  440. }
  441. }
  442. $w insert insert $s
  443. EntrySeeInsert $w
  444. }
  445. # ::tk::EntryBackspace --
  446. # Backspace over the character just before the insertion cursor.
  447. # If backspacing would move the cursor off the left edge of the
  448. # window, reposition the cursor at about the middle of the window.
  449. #
  450. # Arguments:
  451. # w - The entry window in which to backspace.
  452. proc ::tk::EntryBackspace w {
  453. if {[$w selection present]} {
  454. $w delete sel.first sel.last
  455. } else {
  456. set x [expr {[$w index insert] - 1}]
  457. if {$x >= 0} {
  458. $w delete $x
  459. }
  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 {[tk windowingsystem] eq "win32"} {
  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. }