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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
|
### -------------------------------------------------------------------------------------------------------
#
# PROCEDURE
# textUndoable
#
# DESCRIPTION
# Creates a text widget with the enhancement of a history of (update) actions performed on the widget.
# Can also modify an existing text widget to add a history
#
# ARGUMENTS
# As for the ordinary text command, plus:
# -historycommand This is new widget option which specifies a procedure to call whenever the history
# state changes. This can be retrieved/updated in the usual manner.
#
# ADDED WIDGET COMMANDS
# hclear clears the history
# hget gets info from the histlist
# undo undoes the last update operation on the histlist
# redo redoes the last undone operation on the histlist
# revert keeps undoing until the histlist is empty (only one call of callback though)
#
# WIDGET COMMAND FORMAT
# configure -historycommand proc_name
# proc_name should take 3 args (widget path, size of undo list, size of redo list)
# hclear ?-redo?
# hget index ?-redo?
# undo
# redo
# revert
#
# RETURN VALUE
# That of the text operation (probably)
#
# ERRORS
# none
#
# GLOBALS
# textUndoable(callback,widgetname)
# textUndoable(undo,widgetname)
# textUndoable(redo,widgetname)
# textUndoable(realwidget,widgetname)
#
# (SEMI-)PUBLIC ROUTINES
# textUndoable_cmdproc Parses/handles the changes to the text widget commands
# textUndoable_callback Performs the assigned undo callback if it is set
#
# PROBLEMS/BUGS
# Makes no attempt to preserve the tags (probably a good idea... :)
# Bound to be some others... :)
#
# TO DO
#
option add "*Text.historyCommand" {} widgetDefault
proc textUndoable {w args} {
global textUndoable
# First we find a free name for the widget to be moved to
for {set name "_$w"} {[string length [info commands $name]]} {set name "_$name"} {
# Dummy
}
# Now we create the widget if needed
set wanted(-historycommand) 2
if ![winfo exists $w] {
set got(-historycommand) " "
set retval [uplevel text $w [parseargs wanted got $args]]
if {" " == $got(-historycommand)} {
set got(-historycommand) [option get $w historyCommand HistoryCommand]
}
} else {
set got(-historycommand) [option get $w historyCommand HistoryCommand]
parseargs wanted got $args
set retval $w
}
# Move that widget
rename $w $name
# Install our replacement command
;proc $w {opt args} "uplevel textUndoable_cmdproc $w \$opt \$args"
# Initialise the globals
set textUndoable(callback,$w) $got(-historycommand)
set textUndoable(undo,$w) {}
set textUndoable(redo,$w) {}
set textUndoable(realwidget,$w) $name
# Return the correct result...
return $retval
}
;proc textUndoable_callback w {
upvar #0 textUndoable(callback,$w) callback \
textUndoable(undo,$w) undolist \
textUndoable(redo,$w) redolist
if [llength [info proc [lindex $callback 0]]] {
$callback $w [llength $undolist] [llength $redolist]
}
}
;proc textUndoable_cmdproc {w opt args} {
upvar #0 textUndoable(callback,$w) callback \
textUndoable(undo,$w) undolist \
textUndoable(redo,$w) redolist \
textUndoable(realwidget,$w) wdgt
switch -- $opt {
configure {
set wanted(-historycommand) 2
set got(-historycommand) " "
set nargs [parseargs wanted got $args]
if {" " != $got(-historycommand)} {
set callback $got(-historycommand)
textUndoable_callback $w
}
if [llength $nargs] {
return [uplevel $wdgt configure $nargs]
}
return
}
cget {
if {"-historycommand" == $args} {
return $callback
}
}
hclear {
if {[llength $args] && [string compare $args "-redo"]} {
error "Usage: $w hclear ?-redo?"
}
set redolist {}
if ![llength $args] {
set undolist {}
}
textUndoable_callback $w
return
}
hget {
if {[set ll [llength $args]] != 1 && ($ll != 2 || [string compare [lindex $args 1] "-redo"])} {
error "Usage: $w hget index ?-redo?"
}
if {$ll - 1} {
return [lindex $redolist [lindex $args 0]]
} else {
return [lindex $undolist [lindex $args 0]]
}
}
undo {
if [llength $undolist] {
set cmd [lindex $undolist end]
if {"d" == [lindex $cmd 0]} {
lappend redolist [list \
i [lindex $cmd 1] [lindex $cmd 2] [$wdgt get [lindex $cmd 1] [lindex $cmd 2]]]
$wdgt delete [lindex $cmd 1] [lindex $cmd 2]
$wdgt mark set insert [lindex $cmd 1]
} else {
lappend redolist [list \
d [lindex $cmd 1] [lindex $cmd 2]]
$wdgt insert [lindex $cmd 1] [lindex $cmd 3]
$wdgt mark set insert [lindex $cmd 2]
}
set undolist [lreplace $undolist end end]
}
textUndoable_callback $w
return
}
redo {
if [llength $redolist] {
set cmd [lindex $redolist end]
if {"d" == [lindex $cmd 0]} {
lappend undolist [list \
i [lindex $cmd 1] [lindex $cmd 2] [$wdgt get [lindex $cmd 1] [lindex $cmd 2]]]
$wdgt delete [lindex $cmd 1] [lindex $cmd 2]
$wdgt mark set insert [lindex $cmd 1]
} else {
lappend undolist [list \
d [lindex $cmd 1] [lindex $cmd 2]]
$wdgt insert [lindex $cmd 1] [lindex $cmd 3]
$wdgt mark set insert [lindex $cmd 2]
}
set redolist [lreplace $redolist end end]
}
textUndoable_callback $w
return
}
revert {
while {[llength $undolist]} {
set cmd [lindex $undolist end]
if {"d" == [lindex $cmd 0]} {
lappend redolist [list \
i [lindex $cmd 1] [lindex $cmd 2] [$wdgt get [lindex $cmd 1] [lindex $cmd 2]]]
$wdgt delete [lindex $cmd 1] [lindex $cmd 2]
} else {
lappend redolist [list \
d [lindex $cmd 1] [lindex $cmd 2]]
$wdgt insert [lindex $cmd 1] [lindex $cmd 2] [lindex $cmd 3]
}
set undolist [lreplace $undolist end end]
}
textUndoable_callback $w
return
}
insert {
if {[llength $args] < 2} {
lappend args wibble
return -code error "wrong # args: should be \".t insert index chars ?tagList chars tagList ...?\""
}
set index1 [$wdgt index [lindex $args 0]]
uplevel $wdgt $opt $args
for {set posn 1} {$posn < [llength $args]} {incr posn 2} {
if {"\n" == [$wdgt get $index1]} {
set index1 [$wdgt index "$index1 -1c"]
}
set length [string length [lindex $args $posn]]
set index2 "$index1 + $length chars"
# Must put the undo info on the undo list in reverse order!
lappend undoing [list d $index1 $index2]
set index1 $index2
}
foreach action $undoing {
lappend undolist $action
}
set redolist {}
textUndoable_callback $w
return
}
delete {
if {![llength $args] || [llength $args] > 2} {
error "wrong # args: should be \".t delete index1 ?index2?\""
}
set index1 [$wdgt index [lindex $args 0]]
if {[llength $args] > 1} {
set index2 [$wdgt index [lindex $args 1]]
} else {
set index2 "$index1 +1c"
}
lappend undolist [list i $index1 $index2 [$wdgt get $index1 $index2]]
set redolist {}
uplevel $wdgt $opt $args
textUndoable_callback $w
return
}
}
uplevel $wdgt $opt $args
}
|
