]> git.zerfleddert.de Git - micropolis/blame - res/text.tcl
add .gitignore to ignore build-products
[micropolis] / res / 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# $tk_priv(selectMode@$w) holds one of "char", "word", or "line" to
18# indicate which selection mode is active.
19
20# The procedure below is invoked when dragging one end of the selection.
21# The arguments are the text window name and the index of the character
22# that is to be the new end of the selection.
23
24proc tk_textSelectTo {w x {y ""}} {
25 global tk_priv
26 if {$y != ""} {
27 set index @$x,$y
28 } else {
29 set index $x
30 }
31
32 if {![info exists tk_priv(selectMode@$w)]} {
33 set tk_priv(selectMode@$w) "char"
34 }
35 case $tk_priv(selectMode@$w) {
36 char {
37 if [$w compare $index < anchor] {
38 set first $index
39 set last anchor
40 } else {
41 set first anchor
42 set last [$w index $index+1c]
43 }
44 }
45 word {
46 if [$w compare $index < anchor] {
47 set first [$w index "$index wordstart"]
48 set last [$w index "anchor wordend"]
49 } else {
50 set first [$w index "anchor wordstart"]
51 set last [$w index "$index wordend"]
52 }
53 }
54 line {
55 if [$w compare $index < anchor] {
56 set first [$w index "$index linestart"]
57 set last [$w index "anchor lineend + 1c"]
58 } else {
59 set first [$w index "anchor linestart"]
60 set last [$w index "$index lineend + 1c"]
61 }
62 }
63 }
64 $w tag remove sel 0.0 $first
65 $w tag add sel $first $last
66 $w tag remove sel $last end
67}
68
69# The procedure below is invoked to backspace over one character in
70# a text widget. The name of the widget is passed as argument.
71
72proc tk_textBackspace w {
73 catch {$w delete insert-1c insert}
74}
75
76# The procedure below compares three indices, a, b, and c. Index b must
77# be less than c. The procedure returns 1 if a is closer to b than to c,
78# and 0 otherwise. The "w" argument is the name of the text widget in
79# which to do the comparison.
80
81proc tk_textIndexCloser {w a b c} {
82 set a [$w index $a]
83 set b [$w index $b]
84 set c [$w index $c]
85 if [$w compare $a <= $b] {
86 return 1
87 }
88 if [$w compare $a >= $c] {
89 return 0
90 }
91 scan $a "%d.%d" lineA chA
92 scan $b "%d.%d" lineB chB
93 scan $c "%d.%d" lineC chC
94 if {$chC == 0} {
95 incr lineC -1
96 set chC [string length [$w get $lineC.0 $lineC.end]]
97 }
98 if {$lineB != $lineC} {
99 return [expr {($lineA-$lineB) < ($lineC-$lineA)}]
100 }
101 return [expr {($chA-$chB) < ($chC-$chA)}]
102}
103
104# The procedure below is called to reset the selection anchor to
105# whichever end is FARTHEST from the index argument.
106
107proc tk_textResetAnchor {w x y} {
108 global tk_priv
109 set index @$x,$y
110 if {[$w tag ranges sel] == ""} {
111 set tk_priv(selectMode@$w) char
112 $w mark set anchor $index
113 return
114 }
115 if [tk_textIndexCloser $w $index sel.first sel.last] {
116 if {![info exists tk_priv(selectMode@$w)]} {
117 set tk_priv(selectMode@$w) "char"
118 }
119 if {$tk_priv(selectMode@$w) == "char"} {
120 $w mark set anchor sel.last
121 } else {
122 $w mark set anchor sel.last-1c
123 }
124 } else {
125 $w mark set anchor sel.first
126 }
127}
128
129proc tk_textDown {w x y} {
130 global tk_priv
131 set tk_priv(selectMode@$w) char
132 $w mark set insert @$x,$y
133 $w mark set anchor insert
134 if {[lindex [$w config -state] 4] == "normal"} {focus $w}
135}
136
137proc tk_textDoubleDown {w x y} {
138 global tk_priv
139 set tk_priv(selectMode@$w) word
140 $w mark set insert "@$x,$y wordstart"
141 tk_textSelectTo $w insert
142}
143
144proc tk_textTripleDown {w x y} {
145 global tk_priv
146 set tk_priv(selectMode@$w) line
147 $w mark set insert "@$x,$y linestart"
148 tk_textSelectTo $w insert
149}
150
151proc tk_textAdjustTo {w x y} {
152 tk_textResetAnchor $w $x $y
153 tk_textSelectTo $w $x $y
154}
155
156proc tk_textKeyPress {w a} {
157 if {"$a" != ""} {
158 $w insert insert $a
159 $w yview -pickplace insert
160 }
161}
162
163proc tk_textReturnPress {w} {
164 $w insert insert \n
165 $w yview -pickplace insert
166}
167
168proc tk_textDelPress {w} {
169 tk_textBackspace $w
170 $w yview -pickplace insert
171}
172
173proc tk_textCutPress {w} {
174 catch {$w delete sel.first sel.last}
175}
176
177proc tk_textCopyPress {w} {
178 set sel ""
179 catch {set sel [selection -window $w get]}
180 $w insert $sel
181 $w yview -pickplace insert
182}
183
184
Impressum, Datenschutz