text.tcl 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # Copyright (c) 1992-1994 The Regents of the University of California.
  7. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  8. # Copyright (c) 1998 by Scriptics Corporation.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. #-------------------------------------------------------------------------
  14. # Elements of ::tk::Priv that are used in this file:
  15. #
  16. # afterId - If non-null, it means that auto-scanning is underway
  17. # and it gives the "after" id for the next auto-scan
  18. # command to be executed.
  19. # char - Character position on the line; kept in order
  20. # to allow moving up or down past short lines while
  21. # still remembering the desired position.
  22. # mouseMoved - Non-zero means the mouse has moved a significant
  23. # amount since the button went down (so, for example,
  24. # start dragging out a selection).
  25. # prevPos - Used when moving up or down lines via the keyboard.
  26. # Keeps track of the previous insert position, so
  27. # we can distinguish a series of ups and downs, all
  28. # in a row, from a new up or down.
  29. # selectMode - The style of selection currently underway:
  30. # char, word, or line.
  31. # x, y - Last known mouse coordinates for scanning
  32. # and auto-scanning.
  33. #
  34. #-------------------------------------------------------------------------
  35. #-------------------------------------------------------------------------
  36. # The code below creates the default class bindings for text widgets.
  37. #-------------------------------------------------------------------------
  38. # Standard Motif bindings:
  39. bind Text <1> {
  40. tk::TextButton1 %W %x %y
  41. %W tag remove sel 0.0 end
  42. }
  43. bind Text <B1-Motion> {
  44. set tk::Priv(x) %x
  45. set tk::Priv(y) %y
  46. tk::TextSelectTo %W %x %y
  47. }
  48. bind Text <Double-1> {
  49. set tk::Priv(selectMode) word
  50. tk::TextSelectTo %W %x %y
  51. catch {%W mark set insert sel.first}
  52. }
  53. bind Text <Triple-1> {
  54. set tk::Priv(selectMode) line
  55. tk::TextSelectTo %W %x %y
  56. catch {%W mark set insert sel.first}
  57. }
  58. bind Text <Shift-1> {
  59. tk::TextResetAnchor %W @%x,%y
  60. set tk::Priv(selectMode) char
  61. tk::TextSelectTo %W %x %y
  62. }
  63. bind Text <Double-Shift-1> {
  64. set tk::Priv(selectMode) word
  65. tk::TextSelectTo %W %x %y 1
  66. }
  67. bind Text <Triple-Shift-1> {
  68. set tk::Priv(selectMode) line
  69. tk::TextSelectTo %W %x %y
  70. }
  71. bind Text <B1-Leave> {
  72. set tk::Priv(x) %x
  73. set tk::Priv(y) %y
  74. tk::TextAutoScan %W
  75. }
  76. bind Text <B1-Enter> {
  77. tk::CancelRepeat
  78. }
  79. bind Text <ButtonRelease-1> {
  80. tk::CancelRepeat
  81. }
  82. bind Text <Control-1> {
  83. %W mark set insert @%x,%y
  84. }
  85. bind Text <Left> {
  86. tk::TextSetCursor %W insert-1displayindices
  87. }
  88. bind Text <Right> {
  89. tk::TextSetCursor %W insert+1displayindices
  90. }
  91. bind Text <Up> {
  92. tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  93. }
  94. bind Text <Down> {
  95. tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  96. }
  97. bind Text <Shift-Left> {
  98. tk::TextKeySelect %W [%W index {insert - 1displayindices}]
  99. }
  100. bind Text <Shift-Right> {
  101. tk::TextKeySelect %W [%W index {insert + 1displayindices}]
  102. }
  103. bind Text <Shift-Up> {
  104. tk::TextKeySelect %W [tk::TextUpDownLine %W -1]
  105. }
  106. bind Text <Shift-Down> {
  107. tk::TextKeySelect %W [tk::TextUpDownLine %W 1]
  108. }
  109. bind Text <Control-Left> {
  110. tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  111. }
  112. bind Text <Control-Right> {
  113. tk::TextSetCursor %W [tk::TextNextWord %W insert]
  114. }
  115. bind Text <Control-Up> {
  116. tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  117. }
  118. bind Text <Control-Down> {
  119. tk::TextSetCursor %W [tk::TextNextPara %W insert]
  120. }
  121. bind Text <Shift-Control-Left> {
  122. tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  123. }
  124. bind Text <Shift-Control-Right> {
  125. tk::TextKeySelect %W [tk::TextNextWord %W insert]
  126. }
  127. bind Text <Shift-Control-Up> {
  128. tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  129. }
  130. bind Text <Shift-Control-Down> {
  131. tk::TextKeySelect %W [tk::TextNextPara %W insert]
  132. }
  133. bind Text <Prior> {
  134. tk::TextSetCursor %W [tk::TextScrollPages %W -1]
  135. }
  136. bind Text <Shift-Prior> {
  137. tk::TextKeySelect %W [tk::TextScrollPages %W -1]
  138. }
  139. bind Text <Next> {
  140. tk::TextSetCursor %W [tk::TextScrollPages %W 1]
  141. }
  142. bind Text <Shift-Next> {
  143. tk::TextKeySelect %W [tk::TextScrollPages %W 1]
  144. }
  145. bind Text <Control-Prior> {
  146. %W xview scroll -1 page
  147. }
  148. bind Text <Control-Next> {
  149. %W xview scroll 1 page
  150. }
  151. bind Text <Home> {
  152. tk::TextSetCursor %W {insert display linestart}
  153. }
  154. bind Text <Shift-Home> {
  155. tk::TextKeySelect %W {insert display linestart}
  156. }
  157. bind Text <End> {
  158. tk::TextSetCursor %W {insert display lineend}
  159. }
  160. bind Text <Shift-End> {
  161. tk::TextKeySelect %W {insert display lineend}
  162. }
  163. bind Text <Control-Home> {
  164. tk::TextSetCursor %W 1.0
  165. }
  166. bind Text <Control-Shift-Home> {
  167. tk::TextKeySelect %W 1.0
  168. }
  169. bind Text <Control-End> {
  170. tk::TextSetCursor %W {end - 1 indices}
  171. }
  172. bind Text <Control-Shift-End> {
  173. tk::TextKeySelect %W {end - 1 indices}
  174. }
  175. bind Text <Tab> {
  176. if {[%W cget -state] eq "normal"} {
  177. tk::TextInsert %W \t
  178. focus %W
  179. break
  180. }
  181. }
  182. bind Text <Shift-Tab> {
  183. # Needed only to keep <Tab> binding from triggering; doesn't
  184. # have to actually do anything.
  185. break
  186. }
  187. bind Text <Control-Tab> {
  188. focus [tk_focusNext %W]
  189. }
  190. bind Text <Control-Shift-Tab> {
  191. focus [tk_focusPrev %W]
  192. }
  193. bind Text <Control-i> {
  194. tk::TextInsert %W \t
  195. }
  196. bind Text <Return> {
  197. tk::TextInsert %W \n
  198. if {[%W cget -autoseparators]} {
  199. %W edit separator
  200. }
  201. }
  202. bind Text <Delete> {
  203. if {[tk::TextCursorInSelection %W]} {
  204. %W delete sel.first sel.last
  205. } elseif {[%W compare end != insert+1c]} {
  206. %W delete insert
  207. }
  208. %W see insert
  209. }
  210. bind Text <BackSpace> {
  211. if {[tk::TextCursorInSelection %W]} {
  212. %W delete sel.first sel.last
  213. } elseif {[%W compare insert != 1.0]} {
  214. %W delete insert-1c
  215. }
  216. %W see insert
  217. }
  218. bind Text <Control-space> {
  219. %W mark set [tk::TextAnchor %W] insert
  220. }
  221. bind Text <Select> {
  222. %W mark set [tk::TextAnchor %W] insert
  223. }
  224. bind Text <Control-Shift-space> {
  225. set tk::Priv(selectMode) char
  226. tk::TextKeyExtend %W insert
  227. }
  228. bind Text <Shift-Select> {
  229. set tk::Priv(selectMode) char
  230. tk::TextKeyExtend %W insert
  231. }
  232. bind Text <Control-slash> {
  233. %W tag add sel 1.0 end
  234. }
  235. bind Text <Control-backslash> {
  236. %W tag remove sel 1.0 end
  237. }
  238. bind Text <<Cut>> {
  239. tk_textCut %W
  240. }
  241. bind Text <<Copy>> {
  242. tk_textCopy %W
  243. }
  244. bind Text <<Paste>> {
  245. tk_textPaste %W
  246. }
  247. bind Text <<Clear>> {
  248. catch {%W delete sel.first sel.last}
  249. }
  250. bind Text <<PasteSelection>> {
  251. if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  252. || !$tk::Priv(mouseMoved)} {
  253. tk::TextPasteSelection %W %x %y
  254. }
  255. }
  256. bind Text <Insert> {
  257. catch {tk::TextInsert %W [::tk::GetSelection %W PRIMARY]}
  258. }
  259. bind Text <KeyPress> {
  260. tk::TextInsert %W %A
  261. }
  262. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  263. # Otherwise, if a widget binding for one of these is defined, the
  264. # <KeyPress> class binding will also fire and insert the character,
  265. # which is wrong. Ditto for <Escape>.
  266. bind Text <Alt-KeyPress> {# nothing }
  267. bind Text <Meta-KeyPress> {# nothing}
  268. bind Text <Control-KeyPress> {# nothing}
  269. bind Text <Escape> {# nothing}
  270. bind Text <KP_Enter> {# nothing}
  271. if {[tk windowingsystem] eq "aqua"} {
  272. bind Text <Command-KeyPress> {# nothing}
  273. }
  274. # Additional emacs-like bindings:
  275. bind Text <Control-a> {
  276. if {!$tk_strictMotif} {
  277. tk::TextSetCursor %W {insert display linestart}
  278. }
  279. }
  280. bind Text <Control-b> {
  281. if {!$tk_strictMotif} {
  282. tk::TextSetCursor %W insert-1displayindices
  283. }
  284. }
  285. bind Text <Control-d> {
  286. if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  287. %W delete insert
  288. }
  289. }
  290. bind Text <Control-e> {
  291. if {!$tk_strictMotif} {
  292. tk::TextSetCursor %W {insert display lineend}
  293. }
  294. }
  295. bind Text <Control-f> {
  296. if {!$tk_strictMotif} {
  297. tk::TextSetCursor %W insert+1displayindices
  298. }
  299. }
  300. bind Text <Control-k> {
  301. if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  302. if {[%W compare insert == {insert lineend}]} {
  303. %W delete insert
  304. } else {
  305. %W delete insert {insert lineend}
  306. }
  307. }
  308. }
  309. bind Text <Control-n> {
  310. if {!$tk_strictMotif} {
  311. tk::TextSetCursor %W [tk::TextUpDownLine %W 1]
  312. }
  313. }
  314. bind Text <Control-o> {
  315. if {!$tk_strictMotif} {
  316. %W insert insert \n
  317. %W mark set insert insert-1c
  318. }
  319. }
  320. bind Text <Control-p> {
  321. if {!$tk_strictMotif} {
  322. tk::TextSetCursor %W [tk::TextUpDownLine %W -1]
  323. }
  324. }
  325. bind Text <Control-t> {
  326. if {!$tk_strictMotif} {
  327. tk::TextTranspose %W
  328. }
  329. }
  330. bind Text <<Undo>> {
  331. catch { %W edit undo }
  332. }
  333. bind Text <<Redo>> {
  334. catch { %W edit redo }
  335. }
  336. bind Text <Meta-b> {
  337. if {!$tk_strictMotif} {
  338. tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  339. }
  340. }
  341. bind Text <Meta-d> {
  342. if {!$tk_strictMotif && [%W compare end != insert+1c]} {
  343. %W delete insert [tk::TextNextWord %W insert]
  344. }
  345. }
  346. bind Text <Meta-f> {
  347. if {!$tk_strictMotif} {
  348. tk::TextSetCursor %W [tk::TextNextWord %W insert]
  349. }
  350. }
  351. bind Text <Meta-less> {
  352. if {!$tk_strictMotif} {
  353. tk::TextSetCursor %W 1.0
  354. }
  355. }
  356. bind Text <Meta-greater> {
  357. if {!$tk_strictMotif} {
  358. tk::TextSetCursor %W end-1c
  359. }
  360. }
  361. bind Text <Meta-BackSpace> {
  362. if {!$tk_strictMotif} {
  363. %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  364. }
  365. }
  366. bind Text <Meta-Delete> {
  367. if {!$tk_strictMotif} {
  368. %W delete [tk::TextPrevPos %W insert tcl_startOfPreviousWord] insert
  369. }
  370. }
  371. # Macintosh only bindings:
  372. if {[tk windowingsystem] eq "aqua"} {
  373. bind Text <Option-Left> {
  374. tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  375. }
  376. bind Text <Option-Right> {
  377. tk::TextSetCursor %W [tk::TextNextWord %W insert]
  378. }
  379. bind Text <Option-Up> {
  380. tk::TextSetCursor %W [tk::TextPrevPara %W insert]
  381. }
  382. bind Text <Option-Down> {
  383. tk::TextSetCursor %W [tk::TextNextPara %W insert]
  384. }
  385. bind Text <Shift-Option-Left> {
  386. tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord]
  387. }
  388. bind Text <Shift-Option-Right> {
  389. tk::TextKeySelect %W [tk::TextNextWord %W insert]
  390. }
  391. bind Text <Shift-Option-Up> {
  392. tk::TextKeySelect %W [tk::TextPrevPara %W insert]
  393. }
  394. bind Text <Shift-Option-Down> {
  395. tk::TextKeySelect %W [tk::TextNextPara %W insert]
  396. }
  397. bind Text <Control-v> {
  398. tk::TextScrollPages %W 1
  399. }
  400. # End of Mac only bindings
  401. }
  402. # A few additional bindings of my own.
  403. bind Text <Control-h> {
  404. if {!$tk_strictMotif && [%W compare insert != 1.0]} {
  405. %W delete insert-1c
  406. %W see insert
  407. }
  408. }
  409. bind Text <2> {
  410. if {!$tk_strictMotif} {
  411. tk::TextScanMark %W %x %y
  412. }
  413. }
  414. bind Text <B2-Motion> {
  415. if {!$tk_strictMotif} {
  416. tk::TextScanDrag %W %x %y
  417. }
  418. }
  419. set ::tk::Priv(prevPos) {}
  420. # The MouseWheel will typically only fire on Windows and MacOS X.
  421. # However, someone could use the "event generate" command to produce one
  422. # on other platforms. We must be careful not to round -ve values of %D
  423. # down to zero.
  424. if {[tk windowingsystem] eq "aqua"} {
  425. bind Text <MouseWheel> {
  426. %W yview scroll [expr {-15 * (%D)}] pixels
  427. }
  428. bind Text <Option-MouseWheel> {
  429. %W yview scroll [expr {-150 * (%D)}] pixels
  430. }
  431. bind Text <Shift-MouseWheel> {
  432. %W xview scroll [expr {-15 * (%D)}] pixels
  433. }
  434. bind Text <Shift-Option-MouseWheel> {
  435. %W xview scroll [expr {-150 * (%D)}] pixels
  436. }
  437. } else {
  438. # We must make sure that positive and negative movements are rounded
  439. # equally to integers, avoiding the problem that
  440. # (int)1/3 = 0,
  441. # but
  442. # (int)-1/3 = -1
  443. # The following code ensure equal +/- behaviour.
  444. bind Text <MouseWheel> {
  445. if {%D >= 0} {
  446. %W yview scroll [expr {-%D/3}] pixels
  447. } else {
  448. %W yview scroll [expr {(2-%D)/3}] pixels
  449. }
  450. }
  451. }
  452. if {"x11" eq [tk windowingsystem]} {
  453. # Support for mousewheels on Linux/Unix commonly comes through mapping
  454. # the wheel to the extended buttons. If you have a mousewheel, find
  455. # Linux configuration info at:
  456. # http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  457. bind Text <4> {
  458. if {!$tk_strictMotif} {
  459. %W yview scroll -50 pixels
  460. }
  461. }
  462. bind Text <5> {
  463. if {!$tk_strictMotif} {
  464. %W yview scroll 50 pixels
  465. }
  466. }
  467. }
  468. # ::tk::TextClosestGap --
  469. # Given x and y coordinates, this procedure finds the closest boundary
  470. # between characters to the given coordinates and returns the index
  471. # of the character just after the boundary.
  472. #
  473. # Arguments:
  474. # w - The text window.
  475. # x - X-coordinate within the window.
  476. # y - Y-coordinate within the window.
  477. proc ::tk::TextClosestGap {w x y} {
  478. set pos [$w index @$x,$y]
  479. set bbox [$w bbox $pos]
  480. if {$bbox eq ""} {
  481. return $pos
  482. }
  483. if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  484. return $pos
  485. }
  486. $w index "$pos + 1 char"
  487. }
  488. # ::tk::TextButton1 --
  489. # This procedure is invoked to handle button-1 presses in text
  490. # widgets. It moves the insertion cursor, sets the selection anchor,
  491. # and claims the input focus.
  492. #
  493. # Arguments:
  494. # w - The text window in which the button was pressed.
  495. # x - The x-coordinate of the button press.
  496. # y - The x-coordinate of the button press.
  497. proc ::tk::TextButton1 {w x y} {
  498. variable ::tk::Priv
  499. set Priv(selectMode) char
  500. set Priv(mouseMoved) 0
  501. set Priv(pressX) $x
  502. set anchorname [tk::TextAnchor $w]
  503. $w mark set insert [TextClosestGap $w $x $y]
  504. $w mark set $anchorname insert
  505. # Set the anchor mark's gravity depending on the click position
  506. # relative to the gap
  507. set bbox [$w bbox [$w index $anchorname]]
  508. if {$x > [lindex $bbox 0]} {
  509. $w mark gravity $anchorname right
  510. } else {
  511. $w mark gravity $anchorname left
  512. }
  513. # Allow focus in any case on Windows, because that will let the
  514. # selection be displayed even for state disabled text widgets.
  515. if {[tk windowingsystem] eq "win32" \
  516. || [$w cget -state] eq "normal"} {
  517. focus $w
  518. }
  519. if {[$w cget -autoseparators]} {
  520. $w edit separator
  521. }
  522. }
  523. # ::tk::TextSelectTo --
  524. # This procedure is invoked to extend the selection, typically when
  525. # dragging it with the mouse. Depending on the selection mode (character,
  526. # word, line) it selects in different-sized units. This procedure
  527. # ignores mouse motions initially until the mouse has moved from
  528. # one character to another or until there have been multiple clicks.
  529. #
  530. # Note that the 'anchor' is implemented programmatically using
  531. # a text widget mark, and uses a name that will be unique for each
  532. # text widget (even when there are multiple peers). Currently the
  533. # anchor is considered private to Tk, hence the name 'tk::anchor$w'.
  534. #
  535. # Arguments:
  536. # w - The text window in which the button was pressed.
  537. # x - Mouse x position.
  538. # y - Mouse y position.
  539. set ::tk::Priv(textanchoruid) 0
  540. proc ::tk::TextAnchor {w} {
  541. variable Priv
  542. if {![info exists Priv(textanchor,$w)]} {
  543. set Priv(textanchor,$w) tk::anchor[incr Priv(textanchoruid)]
  544. }
  545. return $Priv(textanchor,$w)
  546. }
  547. proc ::tk::TextSelectTo {w x y {extend 0}} {
  548. global tcl_platform
  549. variable ::tk::Priv
  550. set anchorname [tk::TextAnchor $w]
  551. set cur [TextClosestGap $w $x $y]
  552. if {[catch {$w index $anchorname}]} {
  553. $w mark set $anchorname $cur
  554. }
  555. set anchor [$w index $anchorname]
  556. if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
  557. set Priv(mouseMoved) 1
  558. }
  559. switch -- $Priv(selectMode) {
  560. char {
  561. if {[$w compare $cur < $anchorname]} {
  562. set first $cur
  563. set last $anchorname
  564. } else {
  565. set first $anchorname
  566. set last $cur
  567. }
  568. }
  569. word {
  570. # Set initial range based only on the anchor (1 char min width)
  571. if {[$w mark gravity $anchorname] eq "right"} {
  572. set first $anchorname
  573. set last "$anchorname + 1c"
  574. } else {
  575. set first "$anchorname - 1c"
  576. set last $anchorname
  577. }
  578. # Extend range (if necessary) based on the current point
  579. if {[$w compare $cur < $first]} {
  580. set first $cur
  581. } elseif {[$w compare $cur > $last]} {
  582. set last $cur
  583. }
  584. # Now find word boundaries
  585. set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
  586. set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
  587. }
  588. line {
  589. # Set initial range based only on the anchor
  590. set first "$anchorname linestart"
  591. set last "$anchorname lineend"
  592. # Extend range (if necessary) based on the current point
  593. if {[$w compare $cur < $first]} {
  594. set first "$cur linestart"
  595. } elseif {[$w compare $cur > $last]} {
  596. set last "$cur lineend"
  597. }
  598. set first [$w index $first]
  599. set last [$w index "$last + 1c"]
  600. }
  601. }
  602. if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
  603. $w tag remove sel 0.0 end
  604. $w mark set insert $cur
  605. $w tag add sel $first $last
  606. $w tag remove sel $last end
  607. update idletasks
  608. }
  609. }
  610. # ::tk::TextKeyExtend --
  611. # This procedure handles extending the selection from the keyboard,
  612. # where the point to extend to is really the boundary between two
  613. # characters rather than a particular character.
  614. #
  615. # Arguments:
  616. # w - The text window.
  617. # index - The point to which the selection is to be extended.
  618. proc ::tk::TextKeyExtend {w index} {
  619. set anchorname [tk::TextAnchor $w]
  620. set cur [$w index $index]
  621. if {[catch {$w index $anchorname}]} {
  622. $w mark set $anchorname $cur
  623. }
  624. set anchor [$w index $anchorname]
  625. if {[$w compare $cur < $anchorname]} {
  626. set first $cur
  627. set last $anchorname
  628. } else {
  629. set first $anchorname
  630. set last $cur
  631. }
  632. $w tag remove sel 0.0 $first
  633. $w tag add sel $first $last
  634. $w tag remove sel $last end
  635. }
  636. # ::tk::TextPasteSelection --
  637. # This procedure sets the insertion cursor to the mouse position,
  638. # inserts the selection, and sets the focus to the window.
  639. #
  640. # Arguments:
  641. # w - The text window.
  642. # x, y - Position of the mouse.
  643. proc ::tk::TextPasteSelection {w x y} {
  644. $w mark set insert [TextClosestGap $w $x $y]
  645. if {![catch {::tk::GetSelection $w PRIMARY} sel]} {
  646. set oldSeparator [$w cget -autoseparators]
  647. if {$oldSeparator} {
  648. $w configure -autoseparators 0
  649. $w edit separator
  650. }
  651. $w insert insert $sel
  652. if {$oldSeparator} {
  653. $w edit separator
  654. $w configure -autoseparators 1
  655. }
  656. }
  657. if {[$w cget -state] eq "normal"} {
  658. focus $w
  659. }
  660. }
  661. # ::tk::TextAutoScan --
  662. # This procedure is invoked when the mouse leaves a text window
  663. # with button 1 down. It scrolls the window up, down, left, or right,
  664. # depending on where the mouse is (this information was saved in
  665. # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after"
  666. # command so that the window continues to scroll until the mouse
  667. # moves back into the window or the mouse button is released.
  668. #
  669. # Arguments:
  670. # w - The text window.
  671. proc ::tk::TextAutoScan {w} {
  672. variable ::tk::Priv
  673. if {![winfo exists $w]} {
  674. return
  675. }
  676. if {$Priv(y) >= [winfo height $w]} {
  677. $w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
  678. } elseif {$Priv(y) < 0} {
  679. $w yview scroll [expr {-1 + $Priv(y)}] pixels
  680. } elseif {$Priv(x) >= [winfo width $w]} {
  681. $w xview scroll 2 units
  682. } elseif {$Priv(x) < 0} {
  683. $w xview scroll -2 units
  684. } else {
  685. return
  686. }
  687. TextSelectTo $w $Priv(x) $Priv(y)
  688. set Priv(afterId) [after 50 [list tk::TextAutoScan $w]]
  689. }
  690. # ::tk::TextSetCursor
  691. # Move the insertion cursor to a given position in a text. Also
  692. # clears the selection, if there is one in the text, and makes sure
  693. # that the insertion cursor is visible. Also, don't let the insertion
  694. # cursor appear on the dummy last line of the text.
  695. #
  696. # Arguments:
  697. # w - The text window.
  698. # pos - The desired new position for the cursor in the window.
  699. proc ::tk::TextSetCursor {w pos} {
  700. if {[$w compare $pos == end]} {
  701. set pos {end - 1 chars}
  702. }
  703. $w mark set insert $pos
  704. $w tag remove sel 1.0 end
  705. $w see insert
  706. if {[$w cget -autoseparators]} {
  707. $w edit separator
  708. }
  709. }
  710. # ::tk::TextKeySelect
  711. # This procedure is invoked when stroking out selections using the
  712. # keyboard. It moves the cursor to a new position, then extends
  713. # the selection to that position.
  714. #
  715. # Arguments:
  716. # w - The text window.
  717. # new - A new position for the insertion cursor (the cursor hasn't
  718. # actually been moved to this position yet).
  719. proc ::tk::TextKeySelect {w new} {
  720. set anchorname [tk::TextAnchor $w]
  721. if {[$w tag nextrange sel 1.0 end] eq ""} {
  722. if {[$w compare $new < insert]} {
  723. $w tag add sel $new insert
  724. } else {
  725. $w tag add sel insert $new
  726. }
  727. $w mark set $anchorname insert
  728. } else {
  729. if {[$w compare $new < $anchorname]} {
  730. set first $new
  731. set last $anchorname
  732. } else {
  733. set first $anchorname
  734. set last $new
  735. }
  736. $w tag remove sel 1.0 $first
  737. $w tag add sel $first $last
  738. $w tag remove sel $last end
  739. }
  740. $w mark set insert $new
  741. $w see insert
  742. update idletasks
  743. }
  744. # ::tk::TextResetAnchor --
  745. # Set the selection anchor to whichever end is farthest from the
  746. # index argument. One special trick: if the selection has two or
  747. # fewer characters, just leave the anchor where it is. In this
  748. # case it doesn't matter which point gets chosen for the anchor,
  749. # and for the things like Shift-Left and Shift-Right this produces
  750. # better behavior when the cursor moves back and forth across the
  751. # anchor.
  752. #
  753. # Arguments:
  754. # w - The text widget.
  755. # index - Position at which mouse button was pressed, which determines
  756. # which end of selection should be used as anchor point.
  757. proc ::tk::TextResetAnchor {w index} {
  758. if {[$w tag ranges sel] eq ""} {
  759. # Don't move the anchor if there is no selection now; this
  760. # makes the widget behave "correctly" when the user clicks
  761. # once, then shift-clicks somewhere -- ie, the area between
  762. # the two clicks will be selected. [Bug: 5929].
  763. return
  764. }
  765. set anchorname [tk::TextAnchor $w]
  766. set a [$w index $index]
  767. set b [$w index sel.first]
  768. set c [$w index sel.last]
  769. if {[$w compare $a < $b]} {
  770. $w mark set $anchorname sel.last
  771. return
  772. }
  773. if {[$w compare $a > $c]} {
  774. $w mark set $anchorname sel.first
  775. return
  776. }
  777. scan $a "%d.%d" lineA chA
  778. scan $b "%d.%d" lineB chB
  779. scan $c "%d.%d" lineC chC
  780. if {$lineB < $lineC+2} {
  781. set total [string length [$w get $b $c]]
  782. if {$total <= 2} {
  783. return
  784. }
  785. if {[string length [$w get $b $a]] < ($total/2)} {
  786. $w mark set $anchorname sel.last
  787. } else {
  788. $w mark set $anchorname sel.first
  789. }
  790. return
  791. }
  792. if {($lineA-$lineB) < ($lineC-$lineA)} {
  793. $w mark set $anchorname sel.last
  794. } else {
  795. $w mark set $anchorname sel.first
  796. }
  797. }
  798. # ::tk::TextCursorInSelection --
  799. # Check whether the selection exists and contains the insertion cursor. Note
  800. # that it assumes that the selection is contiguous.
  801. #
  802. # Arguments:
  803. # w - The text widget whose selection is to be checked
  804. proc ::tk::TextCursorInSelection {w} {
  805. expr {
  806. [llength [$w tag ranges sel]]
  807. && [$w compare sel.first <= insert]
  808. && [$w compare sel.last >= insert]
  809. }
  810. }
  811. # ::tk::TextInsert --
  812. # Insert a string into a text at the point of the insertion cursor.
  813. # If there is a selection in the text, and it covers the point of the
  814. # insertion cursor, then delete the selection before inserting.
  815. #
  816. # Arguments:
  817. # w - The text window in which to insert the string
  818. # s - The string to insert (usually just a single character)
  819. proc ::tk::TextInsert {w s} {
  820. if {$s eq "" || [$w cget -state] eq "disabled"} {
  821. return
  822. }
  823. set compound 0
  824. if {[TextCursorInSelection $w]} {
  825. set compound [$w cget -autoseparators]
  826. if {$compound} {
  827. $w configure -autoseparators 0
  828. $w edit separator
  829. }
  830. $w delete sel.first sel.last
  831. }
  832. $w insert insert $s
  833. $w see insert
  834. if {$compound} {
  835. $w edit separator
  836. $w configure -autoseparators 1
  837. }
  838. }
  839. # ::tk::TextUpDownLine --
  840. # Returns the index of the character one display line above or below the
  841. # insertion cursor. There are two tricky things here. First, we want to
  842. # maintain the original x position across repeated operations, even though
  843. # some lines that will get passed through don't have enough characters to
  844. # cover the original column. Second, don't try to scroll past the
  845. # beginning or end of the text.
  846. #
  847. # Arguments:
  848. # w - The text window in which the cursor is to move.
  849. # n - The number of display lines to move: -1 for up one line,
  850. # +1 for down one line.
  851. proc ::tk::TextUpDownLine {w n} {
  852. variable ::tk::Priv
  853. set i [$w index insert]
  854. if {$Priv(prevPos) ne $i} {
  855. set Priv(textPosOrig) $i
  856. }
  857. set lines [$w count -displaylines $Priv(textPosOrig) $i]
  858. set new [$w index \
  859. "$Priv(textPosOrig) + [expr {$lines + $n}] displaylines"]
  860. if {[$w compare $new == end] \
  861. || [$w compare $new == "insert display linestart"]} {
  862. set new $i
  863. }
  864. set Priv(prevPos) $new
  865. return $new
  866. }
  867. # ::tk::TextPrevPara --
  868. # Returns the index of the beginning of the paragraph just before a given
  869. # position in the text (the beginning of a paragraph is the first non-blank
  870. # character after a blank line).
  871. #
  872. # Arguments:
  873. # w - The text window in which the cursor is to move.
  874. # pos - Position at which to start search.
  875. proc ::tk::TextPrevPara {w pos} {
  876. set pos [$w index "$pos linestart"]
  877. while {1} {
  878. if {([$w get "$pos - 1 line"] eq "\n" && ([$w get $pos] ne "\n")) \
  879. || $pos eq "1.0"} {
  880. if {[regexp -indices -- {^[ \t]+(.)} \
  881. [$w get $pos "$pos lineend"] -> index]} {
  882. set pos [$w index "$pos + [lindex $index 0] chars"]
  883. }
  884. if {[$w compare $pos != insert] || [lindex [split $pos .] 0]==1} {
  885. return $pos
  886. }
  887. }
  888. set pos [$w index "$pos - 1 line"]
  889. }
  890. }
  891. # ::tk::TextNextPara --
  892. # Returns the index of the beginning of the paragraph just after a given
  893. # position in the text (the beginning of a paragraph is the first non-blank
  894. # character after a blank line).
  895. #
  896. # Arguments:
  897. # w - The text window in which the cursor is to move.
  898. # start - Position at which to start search.
  899. proc ::tk::TextNextPara {w start} {
  900. set pos [$w index "$start linestart + 1 line"]
  901. while {[$w get $pos] ne "\n"} {
  902. if {[$w compare $pos == end]} {
  903. return [$w index "end - 1c"]
  904. }
  905. set pos [$w index "$pos + 1 line"]
  906. }
  907. while {[$w get $pos] eq "\n"} {
  908. set pos [$w index "$pos + 1 line"]
  909. if {[$w compare $pos == end]} {
  910. return [$w index "end - 1c"]
  911. }
  912. }
  913. if {[regexp -indices -- {^[ \t]+(.)} \
  914. [$w get $pos "$pos lineend"] -> index]} {
  915. return [$w index "$pos + [lindex $index 0] chars"]
  916. }
  917. return $pos
  918. }
  919. # ::tk::TextScrollPages --
  920. # This is a utility procedure used in bindings for moving up and down
  921. # pages and possibly extending the selection along the way. It scrolls
  922. # the view in the widget by the number of pages, and it returns the
  923. # index of the character that is at the same position in the new view
  924. # as the insertion cursor used to be in the old view.
  925. #
  926. # Arguments:
  927. # w - The text window in which the cursor is to move.
  928. # count - Number of pages forward to scroll; may be negative
  929. # to scroll backwards.
  930. proc ::tk::TextScrollPages {w count} {
  931. set bbox [$w bbox insert]
  932. $w yview scroll $count pages
  933. if {$bbox eq ""} {
  934. return [$w index @[expr {[winfo height $w]/2}],0]
  935. }
  936. return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  937. }
  938. # ::tk::TextTranspose --
  939. # This procedure implements the "transpose" function for text widgets.
  940. # It tranposes the characters on either side of the insertion cursor,
  941. # unless the cursor is at the end of the line. In this case it
  942. # transposes the two characters to the left of the cursor. In either
  943. # case, the cursor ends up to the right of the transposed characters.
  944. #
  945. # Arguments:
  946. # w - Text window in which to transpose.
  947. proc ::tk::TextTranspose w {
  948. set pos insert
  949. if {[$w compare $pos != "$pos lineend"]} {
  950. set pos [$w index "$pos + 1 char"]
  951. }
  952. set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"]
  953. if {[$w compare "$pos - 1 char" == 1.0]} {
  954. return
  955. }
  956. # ensure this is seen as an atomic op to undo
  957. set autosep [$w cget -autoseparators]
  958. if {$autosep} {
  959. $w configure -autoseparators 0
  960. $w edit separator
  961. }
  962. $w delete "$pos - 2 char" $pos
  963. $w insert insert $new
  964. $w see insert
  965. if {$autosep} {
  966. $w edit separator
  967. $w configure -autoseparators $autosep
  968. }
  969. }
  970. # ::tk_textCopy --
  971. # This procedure copies the selection from a text widget into the
  972. # clipboard.
  973. #
  974. # Arguments:
  975. # w - Name of a text widget.
  976. proc ::tk_textCopy w {
  977. if {![catch {set data [$w get sel.first sel.last]}]} {
  978. clipboard clear -displayof $w
  979. clipboard append -displayof $w $data
  980. }
  981. }
  982. # ::tk_textCut --
  983. # This procedure copies the selection from a text widget into the
  984. # clipboard, then deletes the selection (if it exists in the given
  985. # widget).
  986. #
  987. # Arguments:
  988. # w - Name of a text widget.
  989. proc ::tk_textCut w {
  990. if {![catch {set data [$w get sel.first sel.last]}]} {
  991. clipboard clear -displayof $w
  992. clipboard append -displayof $w $data
  993. $w delete sel.first sel.last
  994. }
  995. }
  996. # ::tk_textPaste --
  997. # This procedure pastes the contents of the clipboard to the insertion
  998. # point in a text widget.
  999. #
  1000. # Arguments:
  1001. # w - Name of a text widget.
  1002. proc ::tk_textPaste w {
  1003. global tcl_platform
  1004. if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} {
  1005. set oldSeparator [$w cget -autoseparators]
  1006. if {$oldSeparator} {
  1007. $w configure -autoseparators 0
  1008. $w edit separator
  1009. }
  1010. if {[tk windowingsystem] ne "x11"} {
  1011. catch { $w delete sel.first sel.last }
  1012. }
  1013. $w insert insert $sel
  1014. if {$oldSeparator} {
  1015. $w edit separator
  1016. $w configure -autoseparators 1
  1017. }
  1018. }
  1019. }
  1020. # ::tk::TextNextWord --
  1021. # Returns the index of the next word position after a given position in the
  1022. # text. The next word is platform dependent and may be either the next
  1023. # end-of-word position or the next start-of-word position after the next
  1024. # end-of-word position.
  1025. #
  1026. # Arguments:
  1027. # w - The text window in which the cursor is to move.
  1028. # start - Position at which to start search.
  1029. if {[tk windowingsystem] eq "win32"} {
  1030. proc ::tk::TextNextWord {w start} {
  1031. TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \
  1032. tcl_startOfNextWord
  1033. }
  1034. } else {
  1035. proc ::tk::TextNextWord {w start} {
  1036. TextNextPos $w $start tcl_endOfWord
  1037. }
  1038. }
  1039. # ::tk::TextNextPos --
  1040. # Returns the index of the next position after the given starting
  1041. # position in the text as computed by a specified function.
  1042. #
  1043. # Arguments:
  1044. # w - The text window in which the cursor is to move.
  1045. # start - Position at which to start search.
  1046. # op - Function to use to find next position.
  1047. proc ::tk::TextNextPos {w start op} {
  1048. set text ""
  1049. set cur $start
  1050. while {[$w compare $cur < end]} {
  1051. set text $text[$w get -displaychars $cur "$cur lineend + 1c"]
  1052. set pos [$op $text 0]
  1053. if {$pos >= 0} {
  1054. return [$w index "$start + $pos display chars"]
  1055. }
  1056. set cur [$w index "$cur lineend +1c"]
  1057. }
  1058. return end
  1059. }
  1060. # ::tk::TextPrevPos --
  1061. # Returns the index of the previous position before the given starting
  1062. # position in the text as computed by a specified function.
  1063. #
  1064. # Arguments:
  1065. # w - The text window in which the cursor is to move.
  1066. # start - Position at which to start search.
  1067. # op - Function to use to find next position.
  1068. proc ::tk::TextPrevPos {w start op} {
  1069. set text ""
  1070. set cur $start
  1071. while {[$w compare $cur > 0.0]} {
  1072. set text [$w get -displaychars "$cur linestart - 1c" $cur]$text
  1073. set pos [$op $text end]
  1074. if {$pos >= 0} {
  1075. return [$w index "$cur linestart - 1c + $pos display chars"]
  1076. }
  1077. set cur [$w index "$cur linestart - 1c"]
  1078. }
  1079. return 0.0
  1080. }
  1081. # ::tk::TextScanMark --
  1082. #
  1083. # Marks the start of a possible scan drag operation
  1084. #
  1085. # Arguments:
  1086. # w - The text window from which the text to get
  1087. # x - x location on screen
  1088. # y - y location on screen
  1089. proc ::tk::TextScanMark {w x y} {
  1090. variable ::tk::Priv
  1091. $w scan mark $x $y
  1092. set Priv(x) $x
  1093. set Priv(y) $y
  1094. set Priv(mouseMoved) 0
  1095. }
  1096. # ::tk::TextScanDrag --
  1097. #
  1098. # Marks the start of a possible scan drag operation
  1099. #
  1100. # Arguments:
  1101. # w - The text window from which the text to get
  1102. # x - x location on screen
  1103. # y - y location on screen
  1104. proc ::tk::TextScanDrag {w x y} {
  1105. variable ::tk::Priv
  1106. # Make sure these exist, as some weird situations can trigger the
  1107. # motion binding without the initial press. [Bug #220269]
  1108. if {![info exists Priv(x)]} {
  1109. set Priv(x) $x
  1110. }
  1111. if {![info exists Priv(y)]} {
  1112. set Priv(y) $y
  1113. }
  1114. if {($x != $Priv(x)) || ($y != $Priv(y))} {
  1115. set Priv(mouseMoved) 1
  1116. }
  1117. if {[info exists Priv(mouseMoved)] && $Priv(mouseMoved)} {
  1118. $w scan dragto $x $y
  1119. }
  1120. }