]> git.zerfleddert.de Git - micropolis/blame - src/tk/library/text.tcl
XINCLUDE: use /usr/X11R6/include everywhere
[micropolis] / src / tk / library / text.tcl
CommitLineData
6a5fa4e0
MG
1# text.tcl --
2#
3# This file contains Tcl procedures used to manage Tk entries.
4#
5# $Header: /user6/ouster/wish/scripts/RCS/text.tcl,v 1.2 92/07/16 16:26:33 ouster Exp $ SPRITE (Berkeley)
6#
7# Copyright 1992 Regents of the University of California
8# Permission to use, copy, modify, and distribute this
9# software and its documentation for any purpose and without
10# fee is hereby granted, provided that this copyright
11# notice appears in all copies. The University of California
12# makes no representations about the suitability of this
13# software for any purpose. It is provided "as is" without
14# express or implied warranty.
15#
16
17# The procedure below is invoked when dragging one end of the selection.
18# The arguments are the text window name and the index of the character
19# that is to be the new end of the selection.
20
21proc tk_textSelectTo {w index} {
22 global tk_priv
23
24 case $tk_priv(selectMode) {
25 char {
26 if [$w compare $index < anchor] {
27 set first $index
28 set last anchor
29 } else {
30 set first anchor
31 set last [$w index $index+1c]
32 }
33 }
34 word {
35 if [$w compare $index < anchor] {
36 set first [$w index "$index wordstart"]
37 set last [$w index "anchor wordend"]
38 } else {
39 set first [$w index "anchor wordstart"]
40 set last [$w index "$index wordend"]
41 }
42 }
43 line {
44 if [$w compare $index < anchor] {
45 set first [$w index "$index linestart"]
46 set last [$w index "anchor lineend + 1c"]
47 } else {
48 set first [$w index "anchor linestart"]
49 set last [$w index "$index lineend + 1c"]
50 }
51 }
52 }
53 $w tag remove sel 0.0 $first
54 $w tag add sel $first $last
55 $w tag remove sel $last end
56}
57
58# The procedure below is invoked to backspace over one character in
59# a text widget. The name of the widget is passed as argument.
60
61proc tk_textBackspace w {
62 $w delete insert-1c insert
63}
64
65# The procedure below compares three indices, a, b, and c. Index b must
66# be less than c. The procedure returns 1 if a is closer to b than to c,
67# and 0 otherwise. The "w" argument is the name of the text widget in
68# which to do the comparison.
69
70proc tk_textIndexCloser {w a b c} {
71 set a [$w index $a]
72 set b [$w index $b]
73 set c [$w index $c]
74 if [$w compare $a <= $b] {
75 return 1
76 }
77 if [$w compare $a >= $c] {
78 return 0
79 }
80 scan $a "%d.%d" lineA chA
81 scan $b "%d.%d" lineB chB
82 scan $c "%d.%d" lineC chC
83 if {$chC == 0} {
84 incr lineC -1
85 set chC [string length [$w get $lineC.0 $lineC.end]]
86 }
87 if {$lineB != $lineC} {
88 return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
89 }
90 return [expr {($chA-$chB) < ($chC-$chA)}]
91}
92
93# The procedure below is called to reset the selection anchor to
94# whichever end is FARTHEST from the index argument.
95
96proc tk_textResetAnchor {w index} {
97 global tk_priv
98 if {[$w tag ranges sel] == ""} {
99 set tk_priv(selectMode) char
100 $w mark set anchor $index
101 return
102 }
103 if [tk_textIndexCloser $w $index sel.first sel.last] {
104 if {$tk_priv(selectMode) == "char"} {
105 $w mark set anchor sel.last
106 } else {
107 $w mark set anchor sel.last-1c
108 }
109 } else {
110 $w mark set anchor sel.first
111 }
112}
Impressum, Datenschutz