![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to text.tcl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Micropolis - Activity] / micropolis / res|
Return to text.tcl CVS log | Up to [Micropolis - Activity] / micropolis / res |
1.1 root 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:
24: proc 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:
72: proc 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:
81: proc 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:
107: proc 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:
129: proc 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:
137: proc 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:
144: proc 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:
151: proc tk_textAdjustTo {w x y} {
152: tk_textResetAnchor $w $x $y
153: tk_textSelectTo $w $x $y
154: }
155:
156: proc tk_textKeyPress {w a} {
157: if {"$a" != ""} {
158: $w insert insert $a
159: $w yview -pickplace insert
160: }
161: }
162:
163: proc tk_textReturnPress {w} {
164: $w insert insert \n
165: $w yview -pickplace insert
166: }
167:
168: proc tk_textDelPress {w} {
169: tk_textBackspace $w
170: $w yview -pickplace insert
171: }
172:
173: proc tk_textCutPress {w} {
174: catch {$w delete sel.first sel.last}
175: }
176:
177: proc 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:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.