coqide: le undo

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@3746 85f007b7-540e-0410-9357-904b9bb8a0f7

1 files changed, 124 insertions, 0 deletions

diff --git a/ide/undo.ml b/ide/undo.ml
new file mode 100644
index 0000000000..c05902236b
--- /dev/null
+++ b/ide/undo.ml
@@ -0,0 +1,124 @@
+open GText
+open Ideutils
+type action = 
+  | Insert of string * int * int (* content*pos*length *) 
+  | Delete of string * int * int (* content*pos*length *) 
+
+class undoable_view (tv:Gtk.textview 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)
+
+  method private dump_debug =
+    if !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 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 ();
+	Queue.push (Stack.pop history) redo
+      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
+    ignore (self#buffer#connect#insert_text 
+	      ~callback:
+	      (fun it s ->
+		 if !undo_lock && not (Queue.is_empty redo) then begin
+		   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;
+		 
+		 Stack.push 
+		   (Delete(self#buffer#get_text ~start ~stop (),
+			   start#offset,
+			   stop#offset - start#offset
+			  ))
+		   history;
+		 self#dump_debug
+	      ))
+end
+
+let undoable_view ?(buffer:buffer option) 
+?editable ?cursor_visible ?wrap_mode
+    ?packing ?show () = 
+    let w = match buffer with 
+      | None -> GtkText.View.create ()
+      | Some b -> GtkText.View.create_with_buffer b#as_buffer
+    in
+    GtkText.View.set w ?editable ?cursor_visible ?wrap_mode;
+    GObj.pack_return (new undoable_view w) ~packing ~show
+