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
|
(************************************************************************)
(* v * The Coq Proof Assistant / The Coq Development Team *)
(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
(* \VV/ **************************************************************)
(* // * This file is distributed under the terms of the *)
(* * GNU Lesser General Public License Version 2.1 *)
(************************************************************************)
(* $Id$ *)
open GText
open Ideutils
type action =
| Insert of string * int * int (* content*pos*length *)
| Delete of string * int * int (* content*pos*length *)
let neg act = match act with
| Insert (s,i,l) -> Delete (s,i,l)
| Delete (s,i,l) -> Insert (s,i,l)
class undoable_view (tv:Gtk.text_view Gtk.obj) =
let undo_lock = ref true in
object(self)
inherit GText.view tv as super
val history = (Stack.create () : action Stack.t)
val redo = (Queue.create () : action Queue.t)
val nredo = (Stack.create () : action Stack.t)
method private dump_debug =
if false (* !debug *) then begin
prerr_endline "==========Stack top=============";
Stack.iter
(fun e -> match e with
| Insert(s,p,l) ->
Printf.eprintf "Insert of '%s' at %d (length %d)\n" s p l
| Delete(s,p,l) ->
Printf.eprintf "Delete '%s' from %d (length %d)\n" s p l)
history;
Printf.eprintf "Stack size %d\n" (Stack.length history);
prerr_endline "==========Stack Bottom==========";
prerr_endline "==========Queue start=============";
Queue.iter
(fun e -> match e with
| Insert(s,p,l) ->
Printf.eprintf "Insert of '%s' at %d (length %d)\n" s p l
| Delete(s,p,l) ->
Printf.eprintf "Delete '%s' from %d (length %d)\n" s p l)
redo;
Printf.eprintf "Stack size %d\n" (Queue.length redo);
prerr_endline "==========Queue End=========="
end
method clear_undo = Stack.clear history; Stack.clear nredo; Queue.clear redo
method undo = if !undo_lock then begin
undo_lock := false;
prerr_endline "UNDO";
try begin
let r =
match Stack.pop history with
| Insert(s,p,l) as act ->
let start = self#buffer#get_iter_at_char p in
(self#buffer#delete_interactive
~start
~stop:(start#forward_chars l)
()) or
(Stack.push act history; false)
| Delete(s,p,l) as act ->
let iter = self#buffer#get_iter_at_char p in
(self#buffer#insert_interactive ~iter s) or
(Stack.push act history; false)
in if r then begin
process_pending ();
let act = Stack.pop history in
Queue.push act redo;
Stack.push act nredo
end;
undo_lock := true;
r
end
with Stack.Empty ->
undo_lock := true;
false
end else
(prerr_endline "UNDO DISCARDED"; true)
method redo = prerr_endline "REDO"; true
initializer
(* INCORRECT: is called even while undoing...
ignore (self#buffer#connect#mark_set
~callback:
(fun it tm -> if !undo_lock && not (Queue.is_empty redo) then begin
Stack.iter (fun e -> Stack.push (neg e) history) nredo;
Stack.clear nredo;
Queue.iter (fun e -> Stack.push e history) redo;
Queue.clear redo;
end)
);
*)
ignore (self#buffer#connect#insert_text
~callback:
(fun it s ->
if !undo_lock && not (Queue.is_empty redo) then begin
Stack.iter (fun e -> Stack.push (neg e) history) nredo;
Stack.clear nredo;
Queue.iter (fun e -> Stack.push e history) redo;
Queue.clear redo;
end;
let pos = it#offset in
(* if Stack.is_empty history or
s=" " or s="\t" or s="\n" or
(match Stack.top history with
| Insert(old,opos,olen) ->
opos + olen <> pos
| _ -> true)
then *)
Stack.push (Insert(s,it#offset,Glib.Utf8.length s)) history
(*else begin
match Stack.pop history with
| Insert(olds,offset,len) ->
Stack.push
(Insert(olds^s,
offset,
len+(Glib.Utf8.length s)))
history
| _ -> assert false
end*);
self#dump_debug
));
ignore (self#buffer#connect#delete_range
~callback:
(fun ~start ~stop ->
if !undo_lock && not (Queue.is_empty redo) then begin
Queue.iter (fun e -> Stack.push e history) redo;
Queue.clear redo;
end;
let start_offset = start#offset in
let stop_offset = stop#offset in
let s = self#buffer#get_text ~start ~stop () in
(* if Stack.is_empty history or (match Stack.top history with
| Delete(old,opos,olen) ->
olen=1 or opos <> start_offset
| _ -> true
)
then
*) Stack.push
(Delete(s,
start_offset,
stop_offset - start_offset
))
history
(* else begin
match Stack.pop history with
| Delete(olds,offset,len) ->
Stack.push
(Delete(olds^s,
offset,
len+(Glib.Utf8.length s)))
history
| _ -> assert false
end*);
self#dump_debug
))
end
let undoable_view ?(buffer:GText.buffer option) =
GtkText.View.make_params []
~cont:(GContainer.pack_container
~create:
(fun pl -> let w = match buffer with
| None -> GtkText.View.create []
| Some b -> GtkText.View.create_with_buffer b#as_buffer
in
Gobject.set_params w pl; ((new undoable_view w):undoable_view)))
|
