[climacs-cvs] CVS update: climacs/climacs.asd climacs/gui.lisp climacs/pane.lisp

[Aleksandar Bakic]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv6185

Modified Files:
	climacs.asd gui.lisp pane.lisp 
Log Message:
Persistent/persistent-undo.lisp: new file containing the simple
version of the Undo protocol that relies on persistent buffers. Marks
are not persistent (yet?), they are only "fixed" to prevent trivial
errors.

climacs.asd: added Persistent/persistent-undo.lisp.

gui.lisp: added calls to full-redisplay at the end of com-undo and
com-redo (could not find a better way).

pane.lisp: added copyright info; fixed a bug in with-undo macro;
modified extended-binseq2-buffer to inherit from p-undo-mixin; cleaned
up some mark cloning code.

Date: Sat Mar 19 23:08:31 2005
Author: abakic

Index: climacs/climacs.asd
diff -u climacs/climacs.asd:1.24 climacs/climacs.asd:1.25
--- climacs/climacs.asd:1.24	Sun Mar 13 21:51:48 2005
+++ climacs/climacs.asd	Sat Mar 19 23:08:31 2005
@@ -61,6 +61,7 @@
    "undo"
    "delegating-buffer"
    "pane"
+   "Persistent/persistent-undo"
    "html-syntax"
    "gui"
    ;;---- optional ----


Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.127 climacs/gui.lisp:1.128
--- climacs/gui.lisp:1.127	Sat Mar  5 08:03:52 2005
+++ climacs/gui.lisp	Sat Mar 19 23:08:31 2005
@@ -1224,10 +1224,12 @@
 ;;; Undo/redo
 
 (define-named-command com-undo ()
-  (undo (undo-tree (buffer (current-window)))))
+  (undo (undo-tree (buffer (current-window))))
+  (full-redisplay (current-window)))
 
 (define-named-command com-redo ()
-  (redo (undo-tree (buffer (current-window)))))
+  (redo (undo-tree (buffer (current-window))))
+  (full-redisplay (current-window)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 


Index: climacs/pane.lisp
diff -u climacs/pane.lisp:1.22 climacs/pane.lisp:1.23
--- climacs/pane.lisp:1.22	Tue Mar 15 13:51:39 2005
+++ climacs/pane.lisp	Sat Mar 19 23:08:31 2005
@@ -4,6 +4,8 @@
 ;;;           Robert Strandh (strandh at labri.fr)
 ;;;  (c) copyright 2005 by
 ;;;           Matthieu Villeneuve (matthieu.villeneuve at free.fr)
+;;;  (c) copyright 2005 by
+;;;           Aleksandar Bakic (a_bakic at yahoo.com)
 
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Library General Public
@@ -106,9 +108,12 @@
        , at body
        (cond ((null (undo-accumulate ,buffer-var)) nil)
 	     ((null (cdr (undo-accumulate ,buffer-var)))
-	      (add-undo (car (undo-accumulate ,buffer-var)) (undo-tree ,buffer-var)))
+	      (add-undo (car (undo-accumulate ,buffer-var))
+			(undo-tree ,buffer-var)))
 	     (t
-	      (add-undo (make-instance 'compound-record :records (undo-accumulate ,buffer-var))
+	      (add-undo (make-instance 'compound-record
+				       :buffer ,buffer-var
+				       :records (undo-accumulate ,buffer-var))
 			(undo-tree ,buffer-var)))))))
 
 (defmethod flip-undo-record :around ((record climacs-undo-record))
@@ -185,7 +190,7 @@
 (defclass extended-standard-buffer (standard-buffer undo-mixin abbrev-mixin) ()
   (:documentation "Extensions accessible via marks."))
 
-(defclass extended-binseq2-buffer (binseq2-buffer undo-mixin abbrev-mixin) ()
+(defclass extended-binseq2-buffer (binseq2-buffer p-undo-mixin abbrev-mixin) ()
   (:documentation "Extensions accessible via marks."))
 
 (defclass climacs-buffer (delegating-buffer filename-mixin name-mixin)
@@ -251,10 +256,10 @@
 
 (defmethod (setf buffer) :after (buffer (pane climacs-pane))
   (with-slots (point mark top bot) pane
-       (setf point (clone-mark (low-mark (implementation buffer)) :right)
-	     mark (clone-mark (low-mark (implementation buffer)) :right)
-	     top (clone-mark (low-mark (implementation buffer)) :left)
-	     bot (clone-mark (high-mark (implementation buffer)) :right))))
+       (setf point (clone-mark (low-mark buffer) :right)
+	     mark (clone-mark (low-mark buffer) :right)
+	     top (clone-mark (low-mark buffer) :left)
+	     bot (clone-mark (high-mark buffer) :right))))
 
 (define-presentation-type url ()
   :inherit-from 'string)