text.tcl 33 KB

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