Commit 48ca0ef4 authored by Aleksandar Bakic's avatar Aleksandar Bakic

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.
parent 236611db
;;; -*- mode: lisp -*-
;;;
;;; (c) copyright 2005 by Aleksandar Bakic (a_bakic@yahoo.com)
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;; Part of the Undo protocol that works with persistent buffers
(in-package :climacs-pane)
(defclass p-undo-mixin ()
((tree :initform (make-instance 'standard-undo-tree) :reader undo-tree)
(undo-accumulate :initform '() :accessor undo-accumulate)
(performing-undo :initform nil :accessor performing-undo)))
(defclass p-undo-record (climacs-undo-record)
((contents :initarg :contents)))
(defun save-p-undo-record (buffer)
(unless (performing-undo buffer)
(push (make-instance
'p-undo-record
:buffer buffer
:contents (slot-value buffer 'climacs-buffer::contents))
(undo-accumulate buffer))))
(defmethod insert-buffer-object :before ((buffer p-undo-mixin) offset object)
(declare (ignore offset object))
(save-p-undo-record buffer))
(defmethod insert-buffer-sequence :before ((buffer p-undo-mixin) offset seq)
(declare (ignore offset seq))
(save-p-undo-record buffer))
(defmethod delete-buffer-range :before ((buffer p-undo-mixin) offset n)
(declare (ignore offset n))
(save-p-undo-record buffer))
(defmethod (setf buffer-object) :before (object (buffer p-undo-mixin) offset)
(declare (ignore object offset))
(save-p-undo-record buffer))
(defmethod flip-undo-record ((record p-undo-record))
(with-slots (buffer contents) record
(setf (slot-value buffer 'climacs-buffer::contents) contents)
(climacs-buffer::filter-and-update
(climacs-buffer::cursors buffer)
#'(lambda (c) (flexichain::weak-pointer-value c buffer))
#'(lambda (wpc)
(setf (cursor-pos wpc) (min (cursor-pos wpc) (1- (size buffer))))))))
\ No newline at end of file
......@@ -61,6 +61,7 @@
"undo"
"delegating-buffer"
"pane"
"Persistent/persistent-undo"
"html-syntax"
"gui"
;;---- optional ----
......
......@@ -1224,10 +1224,12 @@ as two values"
;;; 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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......
......@@ -4,6 +4,8 @@
;;; Robert Strandh (strandh@labri.fr)
;;; (c) copyright 2005 by
;;; Matthieu Villeneuve (matthieu.villeneuve@free.fr)
;;; (c) copyright 2005 by
;;; Aleksandar Bakic (a_bakic@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 @@
,@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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment