1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
#! /usr/bin/env tclsh
#==============================================================================
# Demo: wcb::callback <text> before insert <callback> ...
# wcb::callback <text> before delete <callback>
# wcb::callback <text> before selset <callback>
# wcb::callback <text> before motion <callback>
# wcb::callback <text> after insert <callback>
# wcb::callback <text> after delete <callback>
# wcb::cancel
# wcb::extend <arg>
#
# Copyright (c) 2004-2023 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de)
#==============================================================================
package require Tk
package require wcb
wm title . "Texttest #2"
#
# Add some entries to the Tk option database
#
source [file join [file dirname [info script]] option.tcl]
#
# Text .txt with activated undo mechanism
#
set width 50
text .txt -width $width -height 12 -setgrid true -wrap none -background white \
-font TkFixedFont
.txt configure -undo yes
.txt tag configure prog -foreground red
.txt tag configure user -foreground DarkGreen
.txt insert end "Everything you type or paste into this window will\n" prog
.txt insert end "be displayed in dark green. You cannot make any\n" prog
.txt insert end "changes or selections in this red area, and will\n" prog
.txt insert end "not be able to insert more than $width characters in\n" prog
.txt insert end "any line.\n" prog
.txt insert end "--------------------------------------------------\n" prog
set limit [.txt index insert]
#
# Label .pos displaying the current cursor position
#
label .pos -textvariable pos
#
# Button .close
#
button .close -text Close -command exit
#
# Define 5 before- and 2 after-callbacks for .txt
#
wcb::callback .txt before insert protectRedArea changeColor
wcb::callback .txt before delete protectRedArea
wcb::callback .txt before selset protectRedArea
wcb::callback .txt before motion displayPos
wcb::callback .txt after insert "checkLines $width"
wcb::callback .txt after delete "checkLines $width"
#
# Callback procedure protectRedArea
#
# The parameters following w can be interpreted either as
# "index string ?tagList string tagList ...?" (for an insert
# callback), or as "from ?to?" (for a delete callback),
# or as "from ?to from to ...?" (for a selset callback).
#
proc protectRedArea {w idx args} {
global limit
if {[$w compare $idx < $limit]} {
wcb::cancel
}
}
#
# Callback procedure changeColor
#
proc changeColor {w args} {
wcb::extend user
}
#
# Callback procedure displayPos
#
proc displayPos {w idx} {
set index [$w index $idx]
##nagelfar ignore
scan $index "%d.%d" line column
incr column
global pos
##nagelfar ignore
set pos [format "Line: %d Column: %d" $line $column]
}
#
# Callback procedure checkLines
#
# The parameter args can be interpreted both as "index
# string ?tagList string tagList ...?" (for an insert
# callback) and as "from ?to?" (for a delete callback).
#
proc checkLines {maxCharsPerLine w args} {
#
# Undo the last insert or delete action if necessary
#
##nagelfar ignore
scan [$w index end] "%d" lastLine
for {set line 1} {$line < $lastLine} {incr line} {
##nagelfar ignore
scan [$w index $line.end] "%d.%d" dummy charsInLine
if {$charsInLine > $maxCharsPerLine} {
$w edit undo
bell
break
}
}
#
# Clear the undo and redo stacks, and display the new cursor position
#
$w edit reset
displayPos $w insert
}
#
# Manage the widgets
#
pack .close -side bottom -pady 7p
pack .pos -side bottom
pack .txt -expand yes -fill both
displayPos .txt insert
focus .txt
|
