← Back to branch summary

~ubuntu-branches/ubuntu/gutsy/vnc4/gutsy

« back to all changes in this revision

Viewing changes to unix/xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/text.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Ola Lundqvist
  • Date: 2006-05-15 20:35:17 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060515203517-l4lre1ku942mn26k
Tags: 4.1.1+X4.3.0-10
* Correction of critical security issue. Thanks to Martin Kogler
  <e9925248@student.tuwien.ac.at> that informed me about the issue,
  and provided the patch.
  This flaw was originally found by Steve Wiseman of intelliadmin.com.
* Applied patch from Javier Kohen <jkohen@users.sourceforge.net> that
  inform the user that only 8 first characters of the password will
  actually be used when typing more than 8 characters, closes:
  #355619.

Show diffs side-by-side

added added

removed removed

Lines of Context:
unix/xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/text.tcl
 
1
# $XConsortium: text.tcl /main/1 1996/09/21 14:16:15 kaleb $
 
2
#
 
3
#
 
4
#
 
5
#
 
6
# $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/tcllib/text.tcl,v 3.1 1996/12/27 06:55:08 dawes Exp $
 
7
#
 
8
# text.tcl --
 
9
#
 
10
# This file defines the default bindings for Tk text widgets and provides
 
11
# procedures that help in implementing the bindings.
 
12
#
 
13
# @(#) text.tcl 1.36 95/06/28 10:24:23
 
14
#
 
15
# Copyright (c) 1992-1994 The Regents of the University of California.
 
16
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
 
17
#
 
18
# See the file "license.terms" for information on usage and redistribution
 
19
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
20
#
 
21
 
 
22
#-------------------------------------------------------------------------
 
23
# Elements of tkPriv that are used in this file:
 
24
#
 
25
# afterId -             If non-null, it means that auto-scanning is underway
 
26
#                       and it gives the "after" id for the next auto-scan
 
27
#                       command to be executed.
 
28
# char -                Character position on the line;  kept in order
 
29
#                       to allow moving up or down past short lines while
 
30
#                       still remembering the desired position.
 
31
# mouseMoved -          Non-zero means the mouse has moved a significant
 
32
#                       amount since the button went down (so, for example,
 
33
#                       start dragging out a selection).
 
34
# prevPos -             Used when moving up or down lines via the keyboard.
 
35
#                       Keeps track of the previous insert position, so
 
36
#                       we can distinguish a series of ups and downs, all
 
37
#                       in a row, from a new up or down.
 
38
# selectMode -          The style of selection currently underway:
 
39
#                       char, word, or line.
 
40
# x, y -                Last known mouse coordinates for scanning
 
41
#                       and auto-scanning.
 
42
#-------------------------------------------------------------------------
 
43
 
 
44
# tkTextClipboardKeysyms --
 
45
# This procedure is invoked to identify the keys that correspond to
 
46
# the "copy", "cut", and "paste" functions for the clipboard.
 
47
#
 
48
# Arguments:
 
49
# copy -        Name of the key (keysym name plus modifiers, if any,
 
50
#               such as "Meta-y") used for the copy operation.
 
51
# cut -         Name of the key used for the cut operation.
 
52
# paste -       Name of the key used for the paste operation.
 
53
 
 
54
proc tkTextClipboardKeysyms {copy cut paste} {
 
55
    bind Text <$copy> {
 
56
        if {[selection own -displayof %W] == "%W"} {
 
57
            clipboard clear -displayof %W
 
58
            catch {
 
59
                clipboard append -displayof %W [selection get -displayof %W]
 
60
            }
 
61
        }
 
62
    }
 
63
    bind Text <$cut> {
 
64
        if {[selection own -displayof %W] == "%W"} {
 
65
            clipboard clear -displayof %W
 
66
            catch {
 
67
                clipboard append -displayof %W [selection get -displayof %W]
 
68
                %W delete sel.first sel.last
 
69
            }
 
70
        }
 
71
    }
 
72
    bind Text <$paste> {
 
73
        catch {
 
74
            %W insert insert [selection get -displayof %W \
 
75
                    -selection CLIPBOARD]
 
76
        }
 
77
    }
 
78
}
 
79
 
 
80
#-------------------------------------------------------------------------
 
81
# The code below creates the default class bindings for entries.
 
82
#-------------------------------------------------------------------------
 
83
 
 
84
    # Standard Motif bindings:
 
85
 
 
86
bind Text <1> {
 
87
    tkTextButton1 %W %x %y
 
88
    %W tag remove sel 0.0 end
 
89
}
 
90
bind Text <B1-Motion> {
 
91
    set tkPriv(x) %x
 
92
    set tkPriv(y) %y
 
93
    tkTextSelectTo %W %x %y
 
94
}
 
95
bind Text <Double-1> {
 
96
    set tkPriv(selectMode) word
 
97
    tkTextSelectTo %W %x %y
 
98
    catch {%W mark set insert sel.first}
 
99
}
 
100
bind Text <Triple-1> {
 
101
    set tkPriv(selectMode) line
 
102
    tkTextSelectTo %W %x %y
 
103
    catch {%W mark set insert sel.first}
 
104
}
 
105
bind Text <Shift-1> {
 
106
    tkTextResetAnchor %W @%x,%y
 
107
    set tkPriv(selectMode) char
 
108
    tkTextSelectTo %W %x %y
 
109
}
 
110
bind Text <Double-Shift-1>      {
 
111
    set tkPriv(selectMode) word
 
112
    tkTextSelectTo %W %x %y
 
113
}
 
114
bind Text <Triple-Shift-1>      {
 
115
    set tkPriv(selectMode) line
 
116
    tkTextSelectTo %W %x %y
 
117
}
 
118
bind Text <B1-Leave> {
 
119
    set tkPriv(x) %x
 
120
    set tkPriv(y) %y
 
121
    tkTextAutoScan %W
 
122
}
 
123
bind Text <B1-Enter> {
 
124
    tkCancelRepeat
 
125
}
 
126
bind Text <ButtonRelease-1> {
 
127
    tkCancelRepeat
 
128
}
 
129
bind Text <Control-1> {
 
130
    %W mark set insert @%x,%y
 
131
}
 
132
bind Text <Left> {
 
133
    tkTextSetCursor %W [%W index {insert - 1c}]
 
134
}
 
135
bind Text <Right> {
 
136
    tkTextSetCursor %W [%W index {insert + 1c}]
 
137
}
 
138
bind Text <Up> {
 
139
    tkTextSetCursor %W [tkTextUpDownLine %W -1]
 
140
}
 
141
bind Text <Down> {
 
142
    tkTextSetCursor %W [tkTextUpDownLine %W 1]
 
143
}
 
144
bind Text <Shift-Left> {
 
145
    tkTextKeySelect %W [%W index {insert - 1c}]
 
146
}
 
147
bind Text <Shift-Right> {
 
148
    tkTextKeySelect %W [%W index {insert + 1c}]
 
149
}
 
150
bind Text <Shift-Up> {
 
151
    tkTextKeySelect %W [tkTextUpDownLine %W -1]
 
152
}
 
153
bind Text <Shift-Down> {
 
154
    tkTextKeySelect %W [tkTextUpDownLine %W 1]
 
155
}
 
156
bind Text <Control-Left> {
 
157
    tkTextSetCursor %W [%W index {insert - 1c wordstart}]
 
158
}
 
159
bind Text <Control-Right> {
 
160
    tkTextSetCursor %W [%W index {insert wordend}]
 
161
}
 
162
bind Text <Control-Up> {
 
163
    tkTextSetCursor %W [tkTextPrevPara %W insert]
 
164
}
 
165
bind Text <Control-Down> {
 
166
    tkTextSetCursor %W [tkTextNextPara %W insert]
 
167
}
 
168
bind Text <Shift-Control-Left> {
 
169
    tkTextKeySelect %W [%W index {insert - 1c wordstart}]
 
170
}
 
171
bind Text <Shift-Control-Right> {
 
172
    tkTextKeySelect %W [%W index {insert wordend}]
 
173
}
 
174
bind Text <Shift-Control-Up> {
 
175
    tkTextKeySelect %W [tkTextPrevPara %W insert]
 
176
}
 
177
bind Text <Shift-Control-Down> {
 
178
    tkTextKeySelect %W [tkTextNextPara %W insert]
 
179
}
 
180
bind Text <Prior> {
 
181
    tkTextSetCursor %W [tkTextScrollPages %W -1]
 
182
}
 
183
bind Text <Shift-Prior> {
 
184
    tkTextKeySelect %W [tkTextScrollPages %W -1]
 
185
}
 
186
bind Text <Next> {
 
187
    tkTextSetCursor %W [tkTextScrollPages %W 1]
 
188
}
 
189
bind Text <Shift-Next> {
 
190
    tkTextKeySelect %W [tkTextScrollPages %W 1]
 
191
}
 
192
bind Text <Control-Prior> {
 
193
    %W xview scroll -1 page
 
194
}
 
195
bind Text <Control-Next> {
 
196
    %W xview scroll 1 page
 
197
}
 
198
 
 
199
bind Text <Home> {
 
200
    tkTextSetCursor %W {insert linestart}
 
201
}
 
202
bind Text <Shift-Home> {
 
203
    tkTextKeySelect %W {insert linestart}
 
204
}
 
205
bind Text <End> {
 
206
    tkTextSetCursor %W {insert lineend}
 
207
}
 
208
bind Text <Shift-End> {
 
209
    tkTextKeySelect %W {insert lineend}
 
210
}
 
211
bind Text <Control-Home> {
 
212
    tkTextSetCursor %W 1.0
 
213
}
 
214
bind Text <Control-Shift-Home> {
 
215
    tkTextKeySelect %W 1.0
 
216
}
 
217
bind Text <Control-End> {
 
218
    tkTextSetCursor %W {end - 1 char}
 
219
}
 
220
bind Text <Control-Shift-End> {
 
221
    tkTextKeySelect %W {end - 1 char}
 
222
}
 
223
 
 
224
bind Text <Tab> {
 
225
    tkTextInsert %W \t
 
226
    focus %W
 
227
    break
 
228
}
 
229
bind Text <Shift-Tab> {
 
230
    # Needed only to keep <Tab> binding from triggering;  doesn't
 
231
    # have to actually do anything.
 
232
}
 
233
bind Text <Control-Tab> {
 
234
    focus [tk_focusNext %W]
 
235
}
 
236
bind Text <Control-Shift-Tab> {
 
237
    focus [tk_focusPrev %W]
 
238
}
 
239
bind Text <Control-i> {
 
240
    tkTextInsert %W \t
 
241
}
 
242
bind Text <Return> {
 
243
    tkTextInsert %W \n
 
244
}
 
245
bind Text <Delete> {
 
246
    if {[%W tag nextrange sel 1.0 end] != ""} {
 
247
        %W delete sel.first sel.last
 
248
    } else {
 
249
        %W delete insert
 
250
        %W see insert
 
251
    }
 
252
}
 
253
bind Text <BackSpace> {
 
254
    if {[%W tag nextrange sel 1.0 end] != ""} {
 
255
        %W delete sel.first sel.last
 
256
    } elseif [%W compare insert != 1.0] {
 
257
        %W delete insert-1c
 
258
        %W see insert
 
259
    }
 
260
}
 
261
 
 
262
bind Text <Control-space> {
 
263
    %W mark set anchor insert
 
264
}
 
265
bind Text <Select> {
 
266
    %W mark set anchor insert
 
267
}
 
268
bind Text <Control-Shift-space> {
 
269
    set tkPriv(selectMode) char
 
270
    tkTextKeyExtend %W insert
 
271
}
 
272
bind Text <Shift-Select> {
 
273
    set tkPriv(selectMode) char
 
274
    tkTextKeyExtend %W insert
 
275
}
 
276
bind Text <Control-slash> {
 
277
    %W tag add sel 1.0 end
 
278
}
 
279
bind Text <Control-backslash> {
 
280
    %W tag remove sel 1.0 end
 
281
}
 
282
tkTextClipboardKeysyms F16 F20 F18
 
283
bind Text <Insert> {
 
284
    catch {tkTextInsert %W [selection get -displayof %W]}
 
285
}
 
286
bind Text <KeyPress> {
 
287
    tkTextInsert %W %A
 
288
}
 
289
 
 
290
# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
 
291
# Otherwise, if a widget binding for one of these is defined, the
 
292
# <KeyPress> class binding will also fire and insert the character,
 
293
# which is wrong.  Ditto for <Escape>.
 
294
 
 
295
bind Text <Alt-KeyPress> {# nothing }
 
296
bind Text <Meta-KeyPress> {# nothing}
 
297
bind Text <Control-KeyPress> {# nothing}
 
298
bind Text <Escape> {# nothing}
 
299
bind Text <KP_Enter> {# nothing}
 
300
 
 
301
# Additional emacs-like bindings:
 
302
 
 
303
if !$tk_strictMotif {
 
304
    bind Text <Control-a> {
 
305
        tkTextSetCursor %W {insert linestart}
 
306
    }
 
307
    bind Text <Control-b> {
 
308
        tkTextSetCursor %W insert-1c
 
309
    }
 
310
    bind Text <Control-d> {
 
311
        %W delete insert
 
312
    }
 
313
    bind Text <Control-e> {
 
314
        tkTextSetCursor %W {insert lineend}
 
315
    }
 
316
    bind Text <Control-f> {
 
317
        tkTextSetCursor %W insert+1c
 
318
    }
 
319
    bind Text <Control-k> {
 
320
        if [%W compare insert == {insert lineend}] {
 
321
            %W delete insert
 
322
        } else {
 
323
            %W delete insert {insert lineend}
 
324
        }
 
325
    }
 
326
    bind Text <Control-n> {
 
327
        tkTextSetCursor %W [tkTextUpDownLine %W 1]
 
328
    }
 
329
    bind Text <Control-o> {
 
330
        %W insert insert \n
 
331
        %W mark set insert insert-1c
 
332
    }
 
333
    bind Text <Control-p> {
 
334
        tkTextSetCursor %W [tkTextUpDownLine %W -1]
 
335
    }
 
336
    bind Text <Control-t> {
 
337
        tkTextTranspose %W
 
338
    }
 
339
    bind Text <Control-v> {
 
340
        tkTextScrollPages %W 1
 
341
    }
 
342
    bind Text <Meta-b> {
 
343
        tkTextSetCursor %W {insert - 1c wordstart}
 
344
    }
 
345
    bind Text <Meta-d> {
 
346
        %W delete insert {insert wordend}
 
347
    }
 
348
    bind Text <Meta-f> {
 
349
        tkTextSetCursor %W {insert wordend}
 
350
    }
 
351
    bind Text <Meta-less> {
 
352
        tkTextSetCursor %W 1.0
 
353
    }
 
354
    bind Text <Meta-greater> {
 
355
        tkTextSetCursor %W end-1c
 
356
    }
 
357
    bind Text <Meta-BackSpace> {
 
358
        %W delete {insert -1c wordstart} insert
 
359
    }
 
360
    bind Text <Meta-Delete> {
 
361
        %W delete {insert -1c wordstart} insert
 
362
    }
 
363
    tkTextClipboardKeysyms Meta-w Control-w Control-y
 
364
 
 
365
    # A few additional bindings of my own.
 
366
 
 
367
    bind Text <Control-h> {
 
368
        if [%W compare insert != 1.0] {
 
369
            %W delete insert-1c
 
370
            %W see insert
 
371
        }
 
372
    }
 
373
    bind Text <2> {
 
374
        %W scan mark %x %y
 
375
        set tkPriv(x) %x
 
376
        set tkPriv(y) %y
 
377
        set tkPriv(mouseMoved) 0
 
378
    }
 
379
    bind Text <B2-Motion> {
 
380
        if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
 
381
            set tkPriv(mouseMoved) 1
 
382
        }
 
383
        if $tkPriv(mouseMoved) {
 
384
            %W scan dragto %x %y
 
385
        }
 
386
    }
 
387
    bind Text <ButtonRelease-2> {
 
388
        if !$tkPriv(mouseMoved) {
 
389
            catch {
 
390
                %W insert @%x,%y [selection get -displayof %W]
 
391
            }
 
392
        }
 
393
    }
 
394
}
 
395
set tkPriv(prevPos) {}
 
396
 
 
397
# tkTextButton1 --
 
398
# This procedure is invoked to handle button-1 presses in text
 
399
# widgets.  It moves the insertion cursor, sets the selection anchor,
 
400
# and claims the input focus.
 
401
#
 
402
# Arguments:
 
403
# w -           The text window in which the button was pressed.
 
404
# x -           The x-coordinate of the button press.
 
405
# y -           The x-coordinate of the button press.
 
406
 
 
407
proc tkTextButton1 {w x y} {
 
408
    global tkPriv
 
409
 
 
410
    set tkPriv(selectMode) char
 
411
    set tkPriv(mouseMoved) 0
 
412
    set tkPriv(pressX) $x
 
413
    $w mark set insert @$x,$y
 
414
    $w mark set anchor insert
 
415
    if {[$w cget -state] == "normal"} {focus $w}
 
416
}
 
417
 
 
418
# tkTextSelectTo --
 
419
# This procedure is invoked to extend the selection, typically when
 
420
# dragging it with the mouse.  Depending on the selection mode (character,
 
421
# word, line) it selects in different-sized units.  This procedure
 
422
# ignores mouse motions initially until the mouse has moved from
 
423
# one character to another or until there have been multiple clicks.
 
424
#
 
425
# Arguments:
 
426
# w -           The text window in which the button was pressed.
 
427
# x -           Mouse x position.
 
428
# y -           Mouse y position.
 
429
 
 
430
proc tkTextSelectTo {w x y} {
 
431
    global tkPriv
 
432
 
 
433
    set cur [$w index @$x,$y]
 
434
    if [catch {$w index anchor}] {
 
435
        $w mark set anchor $cur
 
436
    }
 
437
    set anchor [$w index anchor]
 
438
    if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
 
439
        set tkPriv(mouseMoved) 1
 
440
    }
 
441
    switch $tkPriv(selectMode) {
 
442
        char {
 
443
            if [$w compare $cur < anchor] {
 
444
                set first $cur
 
445
                set last anchor
 
446
            } else {
 
447
                set first anchor
 
448
                set last [$w index "$cur + 1c"]
 
449
            }
 
450
        }
 
451
        word {
 
452
            if [$w compare $cur < anchor] {
 
453
                set first [$w index "$cur wordstart"]
 
454
                set last [$w index "anchor - 1c wordend"]
 
455
            } else {
 
456
                set first [$w index "anchor wordstart"]
 
457
                set last [$w index "$cur wordend"]
 
458
            }
 
459
        }
 
460
        line {
 
461
            if [$w compare $cur < anchor] {
 
462
                set first [$w index "$cur linestart"]
 
463
                set last [$w index "anchor - 1c lineend + 1c"]
 
464
            } else {
 
465
                set first [$w index "anchor linestart"]
 
466
                set last [$w index "$cur lineend + 1c"]
 
467
            }
 
468
        }
 
469
    }
 
470
    if {$tkPriv(mouseMoved) || ($tkPriv(selectMode) != "char")} {
 
471
        $w tag remove sel 0.0 $first
 
472
        $w tag add sel $first $last
 
473
        $w tag remove sel $last end
 
474
        update idletasks
 
475
    }
 
476
}
 
477
 
 
478
# tkTextKeyExtend --
 
479
# This procedure handles extending the selection from the keyboard,
 
480
# where the point to extend to is really the boundary between two
 
481
# characters rather than a particular character.
 
482
#
 
483
# Arguments:
 
484
# w -           The text window.
 
485
# index -       The point to which the selection is to be extended.
 
486
 
 
487
proc tkTextKeyExtend {w index} {
 
488
    global tkPriv
 
489
 
 
490
    set cur [$w index $index]
 
491
    if [catch {$w index anchor}] {
 
492
        $w mark set anchor $cur
 
493
    }
 
494
    set anchor [$w index anchor]
 
495
    if [$w compare $cur < anchor] {
 
496
        set first $cur
 
497
        set last anchor
 
498
    } else {
 
499
        set first anchor
 
500
        set last $cur
 
501
    }
 
502
    $w tag remove sel 0.0 $first
 
503
    $w tag add sel $first $last
 
504
    $w tag remove sel $last end
 
505
}
 
506
 
 
507
# tkTextAutoScan --
 
508
# This procedure is invoked when the mouse leaves a text window
 
509
# with button 1 down.  It scrolls the window up, down, left, or right,
 
510
# depending on where the mouse is (this information was saved in
 
511
# tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
 
512
# command so that the window continues to scroll until the mouse
 
513
# moves back into the window or the mouse button is released.
 
514
#
 
515
# Arguments:
 
516
# w -           The text window.
 
517
 
 
518
proc tkTextAutoScan {w} {
 
519
    global tkPriv
 
520
    if {$tkPriv(y) >= [winfo height $w]} {
 
521
        $w yview scroll 2 units
 
522
    } elseif {$tkPriv(y) < 0} {
 
523
        $w yview scroll -2 units
 
524
    } elseif {$tkPriv(x) >= [winfo width $w]} {
 
525
        $w xview scroll 2 units
 
526
    } elseif {$tkPriv(x) < 0} {
 
527
        $w xview scroll -2 units
 
528
    } else {
 
529
        return
 
530
    }
 
531
    tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
 
532
    set tkPriv(afterId) [after 50 tkTextAutoScan $w]
 
533
}
 
534
 
 
535
# tkTextSetCursor
 
536
# Move the insertion cursor to a given position in a text.  Also
 
537
# clears the selection, if there is one in the text, and makes sure
 
538
# that the insertion cursor is visible.  Also, don't let the insertion
 
539
# cursor appear on the dummy last line of the text.
 
540
#
 
541
# Arguments:
 
542
# w -           The text window.
 
543
# pos -         The desired new position for the cursor in the window.
 
544
 
 
545
proc tkTextSetCursor {w pos} {
 
546
    global tkPriv
 
547
 
 
548
    if [$w compare $pos == end] {
 
549
        set pos {end - 1 chars}
 
550
    }
 
551
    $w mark set insert $pos
 
552
    $w tag remove sel 1.0 end
 
553
    $w see insert
 
554
}
 
555
 
 
556
# tkTextKeySelect
 
557
# This procedure is invoked when stroking out selections using the
 
558
# keyboard.  It moves the cursor to a new position, then extends
 
559
# the selection to that position.
 
560
#
 
561
# Arguments:
 
562
# w -           The text window.
 
563
# new -         A new position for the insertion cursor (the cursor hasn't
 
564
#               actually been moved to this position yet).
 
565
 
 
566
proc tkTextKeySelect {w new} {
 
567
    global tkPriv
 
568
 
 
569
    if {[$w tag nextrange sel 1.0 end] == ""} {
 
570
        if [$w compare $new < insert] {
 
571
            $w tag add sel $new insert
 
572
        } else {
 
573
            $w tag add sel insert $new
 
574
        }
 
575
        $w mark set anchor insert
 
576
    } else {
 
577
        if [$w compare $new < anchor] {
 
578
            set first $new
 
579
            set last anchor
 
580
        } else {
 
581
            set first anchor
 
582
            set last $new
 
583
        }
 
584
        $w tag remove sel 1.0 $first
 
585
        $w tag add sel $first $last
 
586
        $w tag remove sel $last end
 
587
    }
 
588
    $w mark set insert $new
 
589
    $w see insert
 
590
    update idletasks
 
591
}
 
592
 
 
593
# tkTextResetAnchor --
 
594
# Set the selection anchor to whichever end is farthest from the
 
595
# index argument.  One special trick: if the selection has two or
 
596
# fewer characters, just leave the anchor where it is.  In this
 
597
# case it doesn't matter which point gets chosen for the anchor,
 
598
# and for the things like Shift-Left and Shift-Right this produces
 
599
# better behavior when the cursor moves back and forth across the
 
600
# anchor.
 
601
#
 
602
# Arguments:
 
603
# w -           The text widget.
 
604
# index -       Position at which mouse button was pressed, which determines
 
605
#               which end of selection should be used as anchor point.
 
606
 
 
607
proc tkTextResetAnchor {w index} {
 
608
    global tkPriv
 
609
 
 
610
    if {[$w tag ranges sel] == ""} {
 
611
        $w mark set anchor $index
 
612
        return
 
613
    }
 
614
    set a [$w index $index]
 
615
    set b [$w index sel.first]
 
616
    set c [$w index sel.last]
 
617
    if [$w compare $a < $b] {
 
618
        $w mark set anchor sel.last
 
619
        return
 
620
    }
 
621
    if [$w compare $a > $c] {
 
622
        $w mark set anchor sel.first
 
623
        return
 
624
    }
 
625
    scan $a "%d.%d" lineA chA
 
626
    scan $b "%d.%d" lineB chB
 
627
    scan $c "%d.%d" lineC chC
 
628
    if {$lineB < $lineC+2} {
 
629
        set total [string length [$w get $b $c]]
 
630
        if {$total <= 2} {
 
631
            return
 
632
        }
 
633
        if {[string length [$w get $b $a]] < ($total/2)} {
 
634
            $w mark set anchor sel.last
 
635
        } else {
 
636
            $w mark set anchor sel.first
 
637
        }
 
638
        return
 
639
    }
 
640
    if {($lineA-$lineB) < ($lineC-$lineA)} {
 
641
        $w mark set anchor sel.last
 
642
    } else {
 
643
        $w mark set anchor sel.first
 
644
    }
 
645
}
 
646
 
 
647
# tkTextInsert --
 
648
# Insert a string into a text at the point of the insertion cursor.
 
649
# If there is a selection in the text, and it covers the point of the
 
650
# insertion cursor, then delete the selection before inserting.
 
651
#
 
652
# Arguments:
 
653
# w -           The text window in which to insert the string
 
654
# s -           The string to insert (usually just a single character)
 
655
 
 
656
proc tkTextInsert {w s} {
 
657
    if {($s == "") || ([$w cget -state] == "disabled")} {
 
658
        return
 
659
    }
 
660
    catch {
 
661
        if {[$w compare sel.first <= insert]
 
662
                && [$w compare sel.last >= insert]} {
 
663
            $w delete sel.first sel.last
 
664
        }
 
665
    }
 
666
    $w insert insert $s
 
667
    $w see insert
 
668
}
 
669
 
 
670
# tkTextUpDownLine --
 
671
# Returns the index of the character one line above or below the
 
672
# insertion cursor.  There are two tricky things here.  First,
 
673
# we want to maintain the original column across repeated operations,
 
674
# even though some lines that will get passed through don't have
 
675
# enough characters to cover the original column.  Second, don't
 
676
# try to scroll past the beginning or end of the text.
 
677
#
 
678
# Arguments:
 
679
# w -           The text window in which the cursor is to move.
 
680
# n -           The number of lines to move: -1 for up one line,
 
681
#               +1 for down one line.
 
682
 
 
683
proc tkTextUpDownLine {w n} {
 
684
    global tkPriv
 
685
 
 
686
    set i [$w index insert]
 
687
    scan $i "%d.%d" line char
 
688
    if {[string compare $tkPriv(prevPos) $i] != 0} {
 
689
        set tkPriv(char) $char
 
690
    }
 
691
    set new [$w index [expr $line + $n].$tkPriv(char)]
 
692
    if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
 
693
        set new $i
 
694
    }
 
695
    set tkPriv(prevPos) $new
 
696
    return $new
 
697
}
 
698
 
 
699
# tkTextPrevPara --
 
700
# Returns the index of the beginning of the paragraph just before a given
 
701
# position in the text (the beginning of a paragraph is the first non-blank
 
702
# character after a blank line).
 
703
#
 
704
# Arguments:
 
705
# w -           The text window in which the cursor is to move.
 
706
# pos -         Position at which to start search.
 
707
 
 
708
proc tkTextPrevPara {w pos} {
 
709
    set pos [$w index "$pos linestart"]
 
710
    while 1 {
 
711
        if {(([$w get "$pos - 1 line"] == "\n") && ([$w get $pos] != "\n"))
 
712
                || ($pos == "1.0")} {
 
713
            if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
 
714
                    dummy index] {
 
715
                set pos [$w index "$pos + [lindex $index 0] chars"]
 
716
            }
 
717
            if {[$w compare $pos != insert] || ($pos == "1.0")} {
 
718
                return $pos
 
719
            }
 
720
        }
 
721
        set pos [$w index "$pos - 1 line"]
 
722
    }
 
723
}
 
724
 
 
725
# tkTextNextPara --
 
726
# Returns the index of the beginning of the paragraph just after a given
 
727
# position in the text (the beginning of a paragraph is the first non-blank
 
728
# character after a blank line).
 
729
#
 
730
# Arguments:
 
731
# w -           The text window in which the cursor is to move.
 
732
# start -       Position at which to start search.
 
733
 
 
734
proc tkTextNextPara {w start} {
 
735
    set pos [$w index "$start linestart + 1 line"]
 
736
    while {[$w get $pos] != "\n"} {
 
737
        if [$w compare $pos == end] {
 
738
            return [$w index "end - 1c"]
 
739
        }
 
740
        set pos [$w index "$pos + 1 line"]
 
741
    }
 
742
    while {[$w get $pos] == "\n"} {
 
743
        set pos [$w index "$pos + 1 line"]
 
744
        if [$w compare $pos == end] {
 
745
            return [$w index "end - 1c"]
 
746
        }
 
747
    }
 
748
    if [regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
 
749
            dummy index] {
 
750
        return [$w index "$pos + [lindex $index 0] chars"]
 
751
    }
 
752
    return $pos
 
753
}
 
754
 
 
755
# tkTextScrollPages --
 
756
# This is a utility procedure used in bindings for moving up and down
 
757
# pages and possibly extending the selection along the way.  It scrolls
 
758
# the view in the widget by the number of pages, and it returns the
 
759
# index of the character that is at the same position in the new view
 
760
# as the insertion cursor used to be in the old view.
 
761
#
 
762
# Arguments:
 
763
# w -           The text window in which the cursor is to move.
 
764
# count -       Number of pages forward to scroll;  may be negative
 
765
#               to scroll backwards.
 
766
 
 
767
proc tkTextScrollPages {w count} {
 
768
    set bbox [$w bbox insert]
 
769
    $w yview scroll $count pages
 
770
    if {$bbox == ""} {
 
771
        return [$w index @[expr [winfo height $w]/2],0]
 
772
    }
 
773
    return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
 
774
}
 
775
 
 
776
# tkTextTranspose --
 
777
# This procedure implements the "transpose" function for text widgets.
 
778
# It tranposes the characters on either side of the insertion cursor,
 
779
# unless the cursor is at the end of the line.  In this case it
 
780
# transposes the two characters to the left of the cursor.  In either
 
781
# case, the cursor ends up to the right of the transposed characters.
 
782
#
 
783
# Arguments:
 
784
# w -           Text window in which to transpose.
 
785
 
 
786
proc tkTextTranspose w {
 
787
    set pos insert
 
788
    if [$w compare $pos != "$pos lineend"] {
 
789
        set pos [$w index "$pos + 1 char"]
 
790
    }
 
791
    set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
 
792
    if [$w compare "$pos - 1 char" == 1.0] {
 
793
        return
 
794
    }
 
795
    $w delete "$pos - 2 char" $pos
 
796
    $w insert insert $new
 
797
    $w see insert
 
798
}