开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
text.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：30k
源码类别：

通讯编程

开发平台：

Visual C++

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