Commit | Line | Data |
---|---|---|
86530b38 AT |
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.6 2005/05/13 13:48:21 vincentdarley 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 | # | |
15 | ||
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 | #------------------------------------------------------------------------- | |
37 | ||
38 | #------------------------------------------------------------------------- | |
39 | # The code below creates the default class bindings for text widgets. | |
40 | #------------------------------------------------------------------------- | |
41 | ||
42 | # Standard Motif bindings: | |
43 | ||
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 | } | |
156 | ||
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 | } | |
181 | ||
182 | bind Text <Tab> { | |
183 | if { [string equal [%W cget -state] "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 | } | |
223 | ||
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 | } | |
268 | ||
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>. | |
273 | ||
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} | |
279 | if {[string equal [tk windowingsystem] "classic"] | |
280 | || [string equal [tk windowingsystem] "aqua"]} { | |
281 | bind Text <Command-KeyPress> {# nothing} | |
282 | } | |
283 | ||
284 | # Additional emacs-like bindings: | |
285 | ||
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 | } | |
341 | ||
342 | bind Text <<Undo>> { | |
343 | catch { %W edit undo } | |
344 | } | |
345 | ||
346 | bind Text <<Redo>> { | |
347 | catch { %W edit redo } | |
348 | } | |
349 | ||
350 | if {$tcl_platform(platform) ne "windows"} { | |
351 | bind Text <Control-v> { | |
352 | if {!$tk_strictMotif} { | |
353 | tk::TextScrollPages %W 1 | |
354 | } | |
355 | } | |
356 | } | |
357 | ||
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 | } | |
393 | ||
394 | # Macintosh only bindings: | |
395 | ||
396 | # if text black & highlight black -> text white, other text the same | |
397 | if {[string equal [tk windowingsystem] "classic"] | |
398 | || [string equal [tk windowingsystem] "aqua"]} { | |
399 | bind Text <FocusIn> { | |
400 | %W tag configure sel -borderwidth 0 | |
401 | %W configure -selectbackground systemHighlight -selectforeground systemHighlightText | |
402 | } | |
403 | bind Text <FocusOut> { | |
404 | %W tag configure sel -borderwidth 1 | |
405 | %W configure -selectbackground white -selectforeground black | |
406 | } | |
407 | bind Text <Option-Left> { | |
408 | tk::TextSetCursor %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] | |
409 | } | |
410 | bind Text <Option-Right> { | |
411 | tk::TextSetCursor %W [tk::TextNextWord %W insert] | |
412 | } | |
413 | bind Text <Option-Up> { | |
414 | tk::TextSetCursor %W [tk::TextPrevPara %W insert] | |
415 | } | |
416 | bind Text <Option-Down> { | |
417 | tk::TextSetCursor %W [tk::TextNextPara %W insert] | |
418 | } | |
419 | bind Text <Shift-Option-Left> { | |
420 | tk::TextKeySelect %W [tk::TextPrevPos %W insert tcl_startOfPreviousWord] | |
421 | } | |
422 | bind Text <Shift-Option-Right> { | |
423 | tk::TextKeySelect %W [tk::TextNextWord %W insert] | |
424 | } | |
425 | bind Text <Shift-Option-Up> { | |
426 | tk::TextKeySelect %W [tk::TextPrevPara %W insert] | |
427 | } | |
428 | bind Text <Shift-Option-Down> { | |
429 | tk::TextKeySelect %W [tk::TextNextPara %W insert] | |
430 | } | |
431 | ||
432 | # End of Mac only bindings | |
433 | } | |
434 | ||
435 | # A few additional bindings of my own. | |
436 | ||
437 | bind Text <Control-h> { | |
438 | if {!$tk_strictMotif} { | |
439 | if {[%W compare insert != 1.0]} { | |
440 | %W delete insert-1c | |
441 | %W see insert | |
442 | } | |
443 | } | |
444 | } | |
445 | bind Text <2> { | |
446 | if {!$tk_strictMotif} { | |
447 | tk::TextScanMark %W %x %y | |
448 | } | |
449 | } | |
450 | bind Text <B2-Motion> { | |
451 | if {!$tk_strictMotif} { | |
452 | tk::TextScanDrag %W %x %y | |
453 | } | |
454 | } | |
455 | set ::tk::Priv(prevPos) {} | |
456 | ||
457 | # The MouseWheel will typically only fire on Windows. However, | |
458 | # someone could use the "event generate" command to produce one | |
459 | # on other platforms. | |
460 | ||
461 | if {[string equal [tk windowingsystem] "classic"] | |
462 | || [string equal [tk windowingsystem] "aqua"]} { | |
463 | bind Text <MouseWheel> { | |
464 | %W yview scroll [expr {- (%D)}] units | |
465 | } | |
466 | bind Text <Option-MouseWheel> { | |
467 | %W yview scroll [expr {-10 * (%D)}] units | |
468 | } | |
469 | bind Text <Shift-MouseWheel> { | |
470 | %W xview scroll [expr {- (%D)}] units | |
471 | } | |
472 | bind Text <Shift-Option-MouseWheel> { | |
473 | %W xview scroll [expr {-10 * (%D)}] units | |
474 | } | |
475 | } else { | |
476 | bind Text <MouseWheel> { | |
477 | %W yview scroll [expr {- (%D / 120) * 4}] units | |
478 | } | |
479 | } | |
480 | ||
481 | if {[string equal "x11" [tk windowingsystem]]} { | |
482 | # Support for mousewheels on Linux/Unix commonly comes through mapping | |
483 | # the wheel to the extended buttons. If you have a mousewheel, find | |
484 | # Linux configuration info at: | |
485 | # http://www.inria.fr/koala/colas/mouse-wheel-scroll/ | |
486 | bind Text <4> { | |
487 | if {!$tk_strictMotif} { | |
488 | %W yview scroll -5 units | |
489 | } | |
490 | } | |
491 | bind Text <5> { | |
492 | if {!$tk_strictMotif} { | |
493 | %W yview scroll 5 units | |
494 | } | |
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 | ||
508 | proc ::tk::TextClosestGap {w x y} { | |
509 | set pos [$w index @$x,$y] | |
510 | set bbox [$w bbox $pos] | |
511 | if {[string equal $bbox ""]} { | |
512 | return $pos | |
513 | } | |
514 | if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} { | |
515 | return $pos | |
516 | } | |
517 | $w index "$pos + 1 char" | |
518 | } | |
519 | ||
520 | # ::tk::TextButton1 -- | |
521 | # This procedure is invoked to handle button-1 presses in text | |
522 | # widgets. It moves the insertion cursor, sets the selection anchor, | |
523 | # and claims the input focus. | |
524 | # | |
525 | # Arguments: | |
526 | # w - The text window in which the button was pressed. | |
527 | # x - The x-coordinate of the button press. | |
528 | # y - The x-coordinate of the button press. | |
529 | ||
530 | proc ::tk::TextButton1 {w x y} { | |
531 | variable ::tk::Priv | |
532 | ||
533 | set Priv(selectMode) char | |
534 | set Priv(mouseMoved) 0 | |
535 | set Priv(pressX) $x | |
536 | $w mark set insert [TextClosestGap $w $x $y] | |
537 | $w mark set anchor insert | |
538 | # Allow focus in any case on Windows, because that will let the | |
539 | # selection be displayed even for state disabled text widgets. | |
540 | if {[string equal $::tcl_platform(platform) "windows"] \ | |
541 | || [string equal [$w cget -state] "normal"]} {focus $w} | |
542 | if {[$w cget -autoseparators]} {$w edit separator} | |
543 | } | |
544 | ||
545 | # ::tk::TextSelectTo -- | |
546 | # This procedure is invoked to extend the selection, typically when | |
547 | # dragging it with the mouse. Depending on the selection mode (character, | |
548 | # word, line) it selects in different-sized units. This procedure | |
549 | # ignores mouse motions initially until the mouse has moved from | |
550 | # one character to another or until there have been multiple clicks. | |
551 | # | |
552 | # Arguments: | |
553 | # w - The text window in which the button was pressed. | |
554 | # x - Mouse x position. | |
555 | # y - Mouse y position. | |
556 | ||
557 | proc ::tk::TextSelectTo {w x y {extend 0}} { | |
558 | global tcl_platform | |
559 | variable ::tk::Priv | |
560 | ||
561 | set cur [TextClosestGap $w $x $y] | |
562 | if {[catch {$w index anchor}]} { | |
563 | $w mark set anchor $cur | |
564 | } | |
565 | set anchor [$w index anchor] | |
566 | if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} { | |
567 | set Priv(mouseMoved) 1 | |
568 | } | |
569 | switch $Priv(selectMode) { | |
570 | char { | |
571 | if {[$w compare $cur < anchor]} { | |
572 | set first $cur | |
573 | set last anchor | |
574 | } else { | |
575 | set first anchor | |
576 | set last $cur | |
577 | } | |
578 | } | |
579 | word { | |
580 | if {[$w compare $cur < anchor]} { | |
581 | set first [TextPrevPos $w "$cur + 1c" tcl_wordBreakBefore] | |
582 | if { !$extend } { | |
583 | set last [TextNextPos $w "anchor" tcl_wordBreakAfter] | |
584 | } else { | |
585 | set last anchor | |
586 | } | |
587 | } else { | |
588 | set last [TextNextPos $w "$cur - 1c" tcl_wordBreakAfter] | |
589 | if { !$extend } { | |
590 | set first [TextPrevPos $w anchor tcl_wordBreakBefore] | |
591 | } else { | |
592 | set first anchor | |
593 | } | |
594 | } | |
595 | } | |
596 | line { | |
597 | if {[$w compare $cur < anchor]} { | |
598 | set first [$w index "$cur linestart"] | |
599 | set last [$w index "anchor - 1c lineend + 1c"] | |
600 | } else { | |
601 | set first [$w index "anchor linestart"] | |
602 | set last [$w index "$cur lineend + 1c"] | |
603 | } | |
604 | } | |
605 | } | |
606 | if {$Priv(mouseMoved) || $Priv(selectMode) ne "char"} { | |
607 | $w tag remove sel 0.0 end | |
608 | $w mark set insert $cur | |
609 | $w tag add sel $first $last | |
610 | $w tag remove sel $last end | |
611 | update idletasks | |
612 | } | |
613 | } | |
614 | ||
615 | # ::tk::TextKeyExtend -- | |
616 | # This procedure handles extending the selection from the keyboard, | |
617 | # where the point to extend to is really the boundary between two | |
618 | # characters rather than a particular character. | |
619 | # | |
620 | # Arguments: | |
621 | # w - The text window. | |
622 | # index - The point to which the selection is to be extended. | |
623 | ||
624 | proc ::tk::TextKeyExtend {w index} { | |
625 | ||
626 | set cur [$w index $index] | |
627 | if {[catch {$w index anchor}]} { | |
628 | $w mark set anchor $cur | |
629 | } | |
630 | set anchor [$w index anchor] | |
631 | if {[$w compare $cur < anchor]} { | |
632 | set first $cur | |
633 | set last anchor | |
634 | } else { | |
635 | set first anchor | |
636 | set last $cur | |
637 | } | |
638 | $w tag remove sel 0.0 $first | |
639 | $w tag add sel $first $last | |
640 | $w tag remove sel $last end | |
641 | } | |
642 | ||
643 | # ::tk::TextPasteSelection -- | |
644 | # This procedure sets the insertion cursor to the mouse position, | |
645 | # inserts the selection, and sets the focus to the window. | |
646 | # | |
647 | # Arguments: | |
648 | # w - The text window. | |
649 | # x, y - Position of the mouse. | |
650 | ||
651 | proc ::tk::TextPasteSelection {w x y} { | |
652 | $w mark set insert [TextClosestGap $w $x $y] | |
653 | if {![catch {::tk::GetSelection $w PRIMARY} sel]} { | |
654 | set oldSeparator [$w cget -autoseparators] | |
655 | if {$oldSeparator} { | |
656 | $w configure -autoseparators 0 | |
657 | $w edit separator | |
658 | } | |
659 | $w insert insert $sel | |
660 | if {$oldSeparator} { | |
661 | $w edit separator | |
662 | $w configure -autoseparators 1 | |
663 | } | |
664 | } | |
665 | if {[string equal [$w cget -state] "normal"]} {focus $w} | |
666 | } | |
667 | ||
668 | # ::tk::TextAutoScan -- | |
669 | # This procedure is invoked when the mouse leaves a text window | |
670 | # with button 1 down. It scrolls the window up, down, left, or right, | |
671 | # depending on where the mouse is (this information was saved in | |
672 | # ::tk::Priv(x) and ::tk::Priv(y)), and reschedules itself as an "after" | |
673 | # command so that the window continues to scroll until the mouse | |
674 | # moves back into the window or the mouse button is released. | |
675 | # | |
676 | # Arguments: | |
677 | # w - The text window. | |
678 | ||
679 | proc ::tk::TextAutoScan {w} { | |
680 | variable ::tk::Priv | |
681 | if {![winfo exists $w]} return | |
682 | if {$Priv(y) >= [winfo height $w]} { | |
683 | $w yview scroll 2 units | |
684 | } elseif {$Priv(y) < 0} { | |
685 | $w yview scroll -2 units | |
686 | } elseif {$Priv(x) >= [winfo width $w]} { | |
687 | $w xview scroll 2 units | |
688 | } elseif {$Priv(x) < 0} { | |
689 | $w xview scroll -2 units | |
690 | } else { | |
691 | return | |
692 | } | |
693 | TextSelectTo $w $Priv(x) $Priv(y) | |
694 | set Priv(afterId) [after 50 [list tk::TextAutoScan $w]] | |
695 | } | |
696 | ||
697 | # ::tk::TextSetCursor | |
698 | # Move the insertion cursor to a given position in a text. Also | |
699 | # clears the selection, if there is one in the text, and makes sure | |
700 | # that the insertion cursor is visible. Also, don't let the insertion | |
701 | # cursor appear on the dummy last line of the text. | |
702 | # | |
703 | # Arguments: | |
704 | # w - The text window. | |
705 | # pos - The desired new position for the cursor in the window. | |
706 | ||
707 | proc ::tk::TextSetCursor {w pos} { | |
708 | ||
709 | if {[$w compare $pos == end]} { | |
710 | set pos {end - 1 chars} | |
711 | } | |
712 | $w mark set insert $pos | |
713 | $w tag remove sel 1.0 end | |
714 | $w see insert | |
715 | if {[$w cget -autoseparators]} {$w edit separator} | |
716 | } | |
717 | ||
718 | # ::tk::TextKeySelect | |
719 | # This procedure is invoked when stroking out selections using the | |
720 | # keyboard. It moves the cursor to a new position, then extends | |
721 | # the selection to that position. | |
722 | # | |
723 | # Arguments: | |
724 | # w - The text window. | |
725 | # new - A new position for the insertion cursor (the cursor hasn't | |
726 | # actually been moved to this position yet). | |
727 | ||
728 | proc ::tk::TextKeySelect {w new} { | |
729 | ||
730 | if {[string equal [$w tag nextrange sel 1.0 end] ""]} { | |
731 | if {[$w compare $new < insert]} { | |
732 | $w tag add sel $new insert | |
733 | } else { | |
734 | $w tag add sel insert $new | |
735 | } | |
736 | $w mark set anchor insert | |
737 | } else { | |
738 | if {[$w compare $new < anchor]} { | |
739 | set first $new | |
740 | set last anchor | |
741 | } else { | |
742 | set first anchor | |
743 | set last $new | |
744 | } | |
745 | $w tag remove sel 1.0 $first | |
746 | $w tag add sel $first $last | |
747 | $w tag remove sel $last end | |
748 | } | |
749 | $w mark set insert $new | |
750 | $w see insert | |
751 | update idletasks | |
752 | } | |
753 | ||
754 | # ::tk::TextResetAnchor -- | |
755 | # Set the selection anchor to whichever end is farthest from the | |
756 | # index argument. One special trick: if the selection has two or | |
757 | # fewer characters, just leave the anchor where it is. In this | |
758 | # case it doesn't matter which point gets chosen for the anchor, | |
759 | # and for the things like Shift-Left and Shift-Right this produces | |
760 | # better behavior when the cursor moves back and forth across the | |
761 | # anchor. | |
762 | # | |
763 | # Arguments: | |
764 | # w - The text widget. | |
765 | # index - Position at which mouse button was pressed, which determines | |
766 | # which end of selection should be used as anchor point. | |
767 | ||
768 | proc ::tk::TextResetAnchor {w index} { | |
769 | ||
770 | if {[string equal [$w tag ranges sel] ""]} { | |
771 | # Don't move the anchor if there is no selection now; this makes | |
772 | # the widget behave "correctly" when the user clicks once, then | |
773 | # shift-clicks somewhere -- ie, the area between the two clicks will be | |
774 | # selected. [Bug: 5929]. | |
775 | return | |
776 | } | |
777 | set a [$w index $index] | |
778 | set b [$w index sel.first] | |
779 | set c [$w index sel.last] | |
780 | if {[$w compare $a < $b]} { | |
781 | $w mark set anchor sel.last | |
782 | return | |
783 | } | |
784 | if {[$w compare $a > $c]} { | |
785 | $w mark set anchor sel.first | |
786 | return | |
787 | } | |
788 | scan $a "%d.%d" lineA chA | |
789 | scan $b "%d.%d" lineB chB | |
790 | scan $c "%d.%d" lineC chC | |
791 | if {$lineB < $lineC+2} { | |
792 | set total [string length [$w get $b $c]] | |
793 | if {$total <= 2} { | |
794 | return | |
795 | } | |
796 | if {[string length [$w get $b $a]] < ($total/2)} { | |
797 | $w mark set anchor sel.last | |
798 | } else { | |
799 | $w mark set anchor sel.first | |
800 | } | |
801 | return | |
802 | } | |
803 | if {($lineA-$lineB) < ($lineC-$lineA)} { | |
804 | $w mark set anchor sel.last | |
805 | } else { | |
806 | $w mark set anchor sel.first | |
807 | } | |
808 | } | |
809 | ||
810 | # ::tk::TextInsert -- | |
811 | # Insert a string into a text at the point of the insertion cursor. | |
812 | # If there is a selection in the text, and it covers the point of the | |
813 | # insertion cursor, then delete the selection before inserting. | |
814 | # | |
815 | # Arguments: | |
816 | # w - The text window in which to insert the string | |
817 | # s - The string to insert (usually just a single character) | |
818 | ||
819 | proc ::tk::TextInsert {w s} { | |
820 | if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} { | |
821 | return | |
822 | } | |
823 | set compound 0 | |
824 | catch { | |
825 | if {[$w compare sel.first <= insert] \ | |
826 | && [$w compare sel.last >= insert]} { | |
827 | set oldSeparator [$w cget -autoseparators] | |
828 | if { $oldSeparator } { | |
829 | $w configure -autoseparators 0 | |
830 | $w edit separator | |
831 | set compound 1 | |
832 | } | |
833 | $w delete sel.first sel.last | |
834 | } | |
835 | } | |
836 | $w insert insert $s | |
837 | $w see insert | |
838 | if { $compound && $oldSeparator } { | |
839 | $w edit separator | |
840 | $w configure -autoseparators 1 | |
841 | } | |
842 | } | |
843 | ||
844 | # ::tk::TextUpDownLine -- | |
845 | # Returns the index of the character one line above or below the | |
846 | # insertion cursor. There are two tricky things here. First, | |
847 | # we want to maintain the original column across repeated operations, | |
848 | # even though some lines that will get passed through don't have | |
849 | # enough characters to cover the original column. Second, don't | |
850 | # try to scroll past the beginning or end of the text. | |
851 | # | |
852 | # Arguments: | |
853 | # w - The text window in which the cursor is to move. | |
854 | # n - The number of lines to move: -1 for up one line, | |
855 | # +1 for down one line. | |
856 | ||
857 | proc ::tk::TextUpDownLine {w n} { | |
858 | variable ::tk::Priv | |
859 | ||
860 | set i [$w index insert] | |
861 | scan $i "%d.%d" line char | |
862 | if {$Priv(prevPos) ne $i} { | |
863 | set Priv(char) $char | |
864 | } | |
865 | set new [$w index [expr {$line + $n}].$Priv(char)] | |
866 | if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} { | |
867 | set new $i | |
868 | } | |
869 | set Priv(prevPos) $new | |
870 | return $new | |
871 | } | |
872 | ||
873 | # ::tk::TextPrevPara -- | |
874 | # Returns the index of the beginning of the paragraph just before a given | |
875 | # position in the text (the beginning of a paragraph is the first non-blank | |
876 | # character after a blank line). | |
877 | # | |
878 | # Arguments: | |
879 | # w - The text window in which the cursor is to move. | |
880 | # pos - Position at which to start search. | |
881 | ||
882 | proc ::tk::TextPrevPara {w pos} { | |
883 | set pos [$w index "$pos linestart"] | |
884 | while {1} { | |
885 | if {([string equal [$w get "$pos - 1 line"] "\n"] \ | |
886 | && [$w get $pos] ne "\n") || [string equal $pos 1.0]} { | |
887 | if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ | |
888 | dummy index]} { | |
889 | set pos [$w index "$pos + [lindex $index 0] chars"] | |
890 | } | |
891 | if {[$w compare $pos != insert] || [lindex [split $pos .] 0] == 1} { | |
892 | return $pos | |
893 | } | |
894 | } | |
895 | set pos [$w index "$pos - 1 line"] | |
896 | } | |
897 | } | |
898 | ||
899 | # ::tk::TextNextPara -- | |
900 | # Returns the index of the beginning of the paragraph just after a given | |
901 | # position in the text (the beginning of a paragraph is the first non-blank | |
902 | # character after a blank line). | |
903 | # | |
904 | # Arguments: | |
905 | # w - The text window in which the cursor is to move. | |
906 | # start - Position at which to start search. | |
907 | ||
908 | proc ::tk::TextNextPara {w start} { | |
909 | set pos [$w index "$start linestart + 1 line"] | |
910 | while {[$w get $pos] ne "\n"} { | |
911 | if {[$w compare $pos == end]} { | |
912 | return [$w index "end - 1c"] | |
913 | } | |
914 | set pos [$w index "$pos + 1 line"] | |
915 | } | |
916 | while {[$w get $pos] eq "\n"} { | |
917 | set pos [$w index "$pos + 1 line"] | |
918 | if {[$w compare $pos == end]} { | |
919 | return [$w index "end - 1c"] | |
920 | } | |
921 | } | |
922 | if {[regexp -indices {^[ ]+(.)} [$w get $pos "$pos lineend"] \ | |
923 | dummy index]} { | |
924 | return [$w index "$pos + [lindex $index 0] chars"] | |
925 | } | |
926 | return $pos | |
927 | } | |
928 | ||
929 | # ::tk::TextScrollPages -- | |
930 | # This is a utility procedure used in bindings for moving up and down | |
931 | # pages and possibly extending the selection along the way. It scrolls | |
932 | # the view in the widget by the number of pages, and it returns the | |
933 | # index of the character that is at the same position in the new view | |
934 | # as the insertion cursor used to be in the old view. | |
935 | # | |
936 | # Arguments: | |
937 | # w - The text window in which the cursor is to move. | |
938 | # count - Number of pages forward to scroll; may be negative | |
939 | # to scroll backwards. | |
940 | ||
941 | proc ::tk::TextScrollPages {w count} { | |
942 | set bbox [$w bbox insert] | |
943 | $w yview scroll $count pages | |
944 | if {[string equal $bbox ""]} { | |
945 | return [$w index @[expr {[winfo height $w]/2}],0] | |
946 | } | |
947 | return [$w index @[lindex $bbox 0],[lindex $bbox 1]] | |
948 | } | |
949 | ||
950 | # ::tk::TextTranspose -- | |
951 | # This procedure implements the "transpose" function for text widgets. | |
952 | # It tranposes the characters on either side of the insertion cursor, | |
953 | # unless the cursor is at the end of the line. In this case it | |
954 | # transposes the two characters to the left of the cursor. In either | |
955 | # case, the cursor ends up to the right of the transposed characters. | |
956 | # | |
957 | # Arguments: | |
958 | # w - Text window in which to transpose. | |
959 | ||
960 | proc ::tk::TextTranspose w { | |
961 | set pos insert | |
962 | if {[$w compare $pos != "$pos lineend"]} { | |
963 | set pos [$w index "$pos + 1 char"] | |
964 | } | |
965 | set new [$w get "$pos - 1 char"][$w get "$pos - 2 char"] | |
966 | if {[$w compare "$pos - 1 char" == 1.0]} { | |
967 | return | |
968 | } | |
969 | # ensure this is seen as an atomic op to undo | |
970 | set autosep [$w cget -autoseparators] | |
971 | if {$autosep} { | |
972 | $w configure -autoseparators 0 | |
973 | $w edit separator | |
974 | } | |
975 | $w delete "$pos - 2 char" $pos | |
976 | $w insert insert $new | |
977 | $w see insert | |
978 | if {$autosep} { | |
979 | $w edit separator | |
980 | $w configure -autoseparators $autosep | |
981 | } | |
982 | } | |
983 | ||
984 | # ::tk_textCopy -- | |
985 | # This procedure copies the selection from a text widget into the | |
986 | # clipboard. | |
987 | # | |
988 | # Arguments: | |
989 | # w - Name of a text widget. | |
990 | ||
991 | proc ::tk_textCopy w { | |
992 | if {![catch {set data [$w get sel.first sel.last]}]} { | |
993 | clipboard clear -displayof $w | |
994 | clipboard append -displayof $w $data | |
995 | } | |
996 | } | |
997 | ||
998 | # ::tk_textCut -- | |
999 | # This procedure copies the selection from a text widget into the | |
1000 | # clipboard, then deletes the selection (if it exists in the given | |
1001 | # widget). | |
1002 | # | |
1003 | # Arguments: | |
1004 | # w - Name of a text widget. | |
1005 | ||
1006 | proc ::tk_textCut w { | |
1007 | if {![catch {set data [$w get sel.first sel.last]}]} { | |
1008 | clipboard clear -displayof $w | |
1009 | clipboard append -displayof $w $data | |
1010 | $w delete sel.first sel.last | |
1011 | } | |
1012 | } | |
1013 | ||
1014 | # ::tk_textPaste -- | |
1015 | # This procedure pastes the contents of the clipboard to the insertion | |
1016 | # point in a text widget. | |
1017 | # | |
1018 | # Arguments: | |
1019 | # w - Name of a text widget. | |
1020 | ||
1021 | proc ::tk_textPaste w { | |
1022 | global tcl_platform | |
1023 | if {![catch {::tk::GetSelection $w CLIPBOARD} sel]} { | |
1024 | # ensure this is seen as an atomic op to undo | |
1025 | set oldSeparator [$w cget -autoseparators] | |
1026 | if { $oldSeparator } { | |
1027 | $w configure -autoseparators 0 | |
1028 | $w edit separator | |
1029 | } | |
1030 | if {[tk windowingsystem] ne "x11"} { | |
1031 | catch { $w delete sel.first sel.last } | |
1032 | } | |
1033 | $w insert insert $sel | |
1034 | if { $oldSeparator } { | |
1035 | $w edit separator | |
1036 | $w configure -autoseparators 1 | |
1037 | } | |
1038 | } | |
1039 | } | |
1040 | ||
1041 | # ::tk::TextNextWord -- | |
1042 | # Returns the index of the next word position after a given position in the | |
1043 | # text. The next word is platform dependent and may be either the next | |
1044 | # end-of-word position or the next start-of-word position after the next | |
1045 | # end-of-word position. | |
1046 | # | |
1047 | # Arguments: | |
1048 | # w - The text window in which the cursor is to move. | |
1049 | # start - Position at which to start search. | |
1050 | ||
1051 | if {[string equal $tcl_platform(platform) "windows"]} { | |
1052 | proc ::tk::TextNextWord {w start} { | |
1053 | TextNextPos $w [TextNextPos $w $start tcl_endOfWord] \ | |
1054 | tcl_startOfNextWord | |
1055 | } | |
1056 | } else { | |
1057 | proc ::tk::TextNextWord {w start} { | |
1058 | TextNextPos $w $start tcl_endOfWord | |
1059 | } | |
1060 | } | |
1061 | ||
1062 | # ::tk::TextNextPos -- | |
1063 | # Returns the index of the next position after the given starting | |
1064 | # position in the text as computed by a specified function. | |
1065 | # | |
1066 | # Arguments: | |
1067 | # w - The text window in which the cursor is to move. | |
1068 | # start - Position at which to start search. | |
1069 | # op - Function to use to find next position. | |
1070 | ||
1071 | proc ::tk::TextNextPos {w start op} { | |
1072 | set text "" | |
1073 | set cur $start | |
1074 | while {[$w compare $cur < end]} { | |
1075 | set text $text[$w get $cur "$cur lineend + 1c"] | |
1076 | set pos [$op $text 0] | |
1077 | if {$pos >= 0} { | |
1078 | ## Adjust for embedded windows and images | |
1079 | ## dump gives us 3 items per window/image | |
1080 | set dump [$w dump -image -window $start "$start + $pos c"] | |
1081 | if {[llength $dump]} { | |
1082 | set pos [expr {$pos + ([llength $dump]/3)}] | |
1083 | } | |
1084 | return [$w index "$start + $pos c"] | |
1085 | } | |
1086 | set cur [$w index "$cur lineend +1c"] | |
1087 | } | |
1088 | return end | |
1089 | } | |
1090 | ||
1091 | # ::tk::TextPrevPos -- | |
1092 | # Returns the index of the previous position before the given starting | |
1093 | # position in the text as computed by a specified function. | |
1094 | # | |
1095 | # Arguments: | |
1096 | # w - The text window in which the cursor is to move. | |
1097 | # start - Position at which to start search. | |
1098 | # op - Function to use to find next position. | |
1099 | ||
1100 | proc ::tk::TextPrevPos {w start op} { | |
1101 | set text "" | |
1102 | set cur $start | |
1103 | while {[$w compare $cur > 0.0]} { | |
1104 | set text [$w get "$cur linestart - 1c" $cur]$text | |
1105 | set pos [$op $text end] | |
1106 | if {$pos >= 0} { | |
1107 | ## Adjust for embedded windows and images | |
1108 | ## dump gives us 3 items per window/image | |
1109 | set dump [$w dump -image -window "$cur linestart" "$start - 1c"] | |
1110 | if {[llength $dump]} { | |
1111 | ## This is a hokey extra hack for control-arrow movement | |
1112 | ## that should be in a while loop to be correct (hobbs) | |
1113 | if {[$w compare [lindex $dump 2] > \ | |
1114 | "$cur linestart - 1c + $pos c"]} { | |
1115 | incr pos -1 | |
1116 | } | |
1117 | set pos [expr {$pos + ([llength $dump]/3)}] | |
1118 | } | |
1119 | return [$w index "$cur linestart - 1c + $pos c"] | |
1120 | } | |
1121 | set cur [$w index "$cur linestart - 1c"] | |
1122 | } | |
1123 | return 0.0 | |
1124 | } | |
1125 | ||
1126 | # ::tk::TextScanMark -- | |
1127 | # | |
1128 | # Marks the start of a possible scan drag operation | |
1129 | # | |
1130 | # Arguments: | |
1131 | # w - The text window from which the text to get | |
1132 | # x - x location on screen | |
1133 | # y - y location on screen | |
1134 | ||
1135 | proc ::tk::TextScanMark {w x y} { | |
1136 | $w scan mark $x $y | |
1137 | set ::tk::Priv(x) $x | |
1138 | set ::tk::Priv(y) $y | |
1139 | set ::tk::Priv(mouseMoved) 0 | |
1140 | } | |
1141 | ||
1142 | # ::tk::TextScanDrag -- | |
1143 | # | |
1144 | # Marks the start of a possible scan drag operation | |
1145 | # | |
1146 | # Arguments: | |
1147 | # w - The text window from which the text to get | |
1148 | # x - x location on screen | |
1149 | # y - y location on screen | |
1150 | ||
1151 | proc ::tk::TextScanDrag {w x y} { | |
1152 | # Make sure these exist, as some weird situations can trigger the | |
1153 | # motion binding without the initial press. [Bug #220269] | |
1154 | if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x } | |
1155 | if {![info exists ::tk::Priv(y)]} { set ::tk::Priv(y) $y } | |
1156 | if {($x != $::tk::Priv(x)) || ($y != $::tk::Priv(y))} { | |
1157 | set ::tk::Priv(mouseMoved) 1 | |
1158 | } | |
1159 | if {[info exists ::tk::Priv(mouseMoved)] && $::tk::Priv(mouseMoved)} { | |
1160 | $w scan dragto $x $y | |
1161 | } | |
1162 | } |