Permalink
Browse files

Initial import of Adopted algorithm

* Project.ede (autoloads): added adopted directory
* rudel-compile.el (header): updated copyright
  (top level autoload):
  (top level): added adopted directory
* adopted/Project.ede: new file; project file adopted subdirectory
* adopted/adopted.el: new file; Adopted algorithm entry point
* adopted/adopted-operation.el: new file; Adopted operation base class
* adopted/adopted-nop.el: new file; Adopted no operation class
* adopted/adopted-insert.el: new file; Adopted insert operation
* adopted/adopted-delete.el: new file; Adopted delete operation
* adopted/adopted-compound.el: new file Adapted compound operation
  • Loading branch information...
1 parent 6d9c9ca commit 399536cc24e7294b177aac70c10b482a99046163 @scymtym committed Jan 30, 2010
View
@@ -1,3 +1,18 @@
+2010-01-31 Jan Moringen <scymtym@users.sourceforge.net>
+
+ Initial import of Adopted algorithm
+ * Project.ede (autoloads): added adopted directory
+ * rudel-compile.el (header): updated copyright
+ (top level autoload):
+ (top level): added adopted directory
+ * adopted/Project.ede: new file; project file adopted subdirectory
+ * adopted/adopted.el: new file; Adopted algorithm entry point
+ * adopted/adopted-operation.el: new file; Adopted operation base class
+ * adopted/adopted-nop.el: new file; Adopted no operation class
+ * adopted/adopted-insert.el: new file; Adopted insert operation
+ * adopted/adopted-delete.el: new file; Adopted delete operation
+ * adopted/adopted-compound.el: new file Adapted compound operation
+
2010-01-27 Jan Moringen <scymtym@users.sourceforge.net>
Integrated new debugging framework
View
@@ -9,7 +9,7 @@
:name "autoloads"
:path ""
:autoload-file "rudel-loaddefs.el"
- :autoload-dirs '("." "jupiter" "socket" "tls" "xmpp" "obby" "wave" "zeroconf")
+ :autoload-dirs '("." "jupiter" "adopted" "socket" "tls" "xmpp" "obby" "wave" "zeroconf")
)
(ede-proj-target-elisp "compile"
:name "rudel"
View
@@ -0,0 +1,13 @@
+;; Object adopted
+;; EDE project file.
+(ede-proj-project "rudel/adopted"
+ :name "adopted"
+ :file "Project.ede"
+ :targets (list
+ (ede-proj-target-elisp "adopted"
+ :name "adopted"
+ :path ""
+ :source '("adopted.el" "adopted-operation.el" "adopted-compound.el" "adopted-delete.el" "adopted-insert.el" "adopted-nop.el" )
+ )
+ )
+ )
@@ -0,0 +1,82 @@
+;;; adopted-compound.el --- Adopted compound operation
+;;
+;; Copyright (C) 2009, 2010 Jan Moringen
+;;
+;; Author: Jan Moringen <scymtym@users.sourceforge.net>
+;; Keywords: rudel, adopted, algorithm, operation, compound
+;; X-RCS: $Id:$
+;;
+;; This file is part of Rudel.
+;;
+;; Rudel is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Rudel 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
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with rudel. If not, see <http://www.gnu.org/licenses>.
+
+
+;;; Commentary:
+;;
+;; Class `adopted-compound' implements a compound operation comprised
+;; of a number of child operations.
+
+
+;;; History:
+;;
+;; 0.1 - Initial version
+
+
+;;; Code:
+;;
+
+(require 'eieio)
+
+(require 'adopted-operation)
+
+
+;;; Class adopted-compound
+;;
+
+(defclass adopted-compound (adopted-operation)
+ ((children :initarg :children
+ :type list
+ :initform nil
+ :documentation
+ ""))
+ "Objects of this class are operations, which are composed of a
+number of child operation.")
+
+;; TODO this has side effects. It can only be called once
+(defmethod rudel-apply ((this adopted-compound) object)
+ "Apply THIS to BUFFER by applying the child operation."
+ (with-slots (children) this
+ (let ((child (first children))
+ (rest (rest children)))
+ ;; Apply all child operations
+ (while child
+ (rudel-apply child object)
+ ;; For each applied child operation, transform remaining
+ ;; operation with the applied operation.
+ (dolist (next rest)
+ (setf next (adopted-transform child next)))
+ ;; Advance to next child operation.
+ (setq child (first rest)
+ rest (rest rest)))))
+ )
+
+(defmethod adopted-transform ((this adopted-compound) other)
+ "Transform OTHER using the child operations of THIS."
+ (with-slots (children) this
+ (dolist (child children) ;; TODO reverse children?
+ (setq other (adopted-transform child other)))
+ other))
+
+(provide 'adopted-compound)
+;;; adopted-compound.el ends here
@@ -0,0 +1,163 @@
+;;; adopted-delete.el --- Adopted delete operation
+;;
+;; Copyright (C) 2009, 2010 Jan Moringen
+;;
+;; Author: Jan Moringen <scymtym@users.sourceforge.net>
+;; Keywords: rudel, adopted, algorithm, operation, delete
+;; X-RCS: $Id:$
+;;
+;; This file is part of Rudel.
+;;
+;; Rudel is free software: you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; Rudel 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
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with rudel. If not, see <http://www.gnu.org/licenses>.
+
+
+;;; Commentary:
+;;
+;; Class `adopted-delete' implements a delete operation for the
+;; Adopted algorithm.
+
+
+;;; History:
+;;
+;; 0.1 - Initial version
+
+
+;;; Code:
+;;
+
+(require 'eieio)
+
+(require 'rudel-operations)
+(require 'adopted-operation)
+(require 'adopted-insert)
+(require 'adopted-nop)
+
+
+;;; Class adopted-delete
+;;
+
+(defclass adopted-delete (adopted-operation
+ rudel-delete-op)
+ ()
+ "Objects of this class represent deletions in buffers.")
+
+(defmethod adopted-transform ((this adopted-delete) other)
+ "Transform other using THIS.
+OTHER is destructively modified or replaced."
+ (cond
+
+ ;;
+ ;; Transform an insert operation
+ ;;
+ ((adopted-insert-p other)
+ (with-slots ((this-from :from) (this-to :to) (this-length :length)) this
+ (with-slots ((other-from :from) (other-to :to) (other-length :length)) other
+ (cond
+ ;;
+ ;; <other>
+ ;; <this>
+ ;;
+ ((<= other-to this-from))
+
+ ;; <other>
+ ;; <this>
+ ((> other-from this-to)
+ (decf other-from this-length))
+
+ ;; <other>
+ ;; < this >
+ ((and (> other-from this-from) (< other-to this-to))
+ (setq other-from this-from))
+ )))
+ )
+
+ ;;
+ ;; Transform a delete operation
+ ;;
+ ((adopted-delete-p other)
+ (with-slots ((this-from :from) (this-to :to) (this-length :length)) this
+ (with-slots ((other-from :from) (other-to :to) (other-length :length)) other
+ (cond
+
+ ;; <other>
+ ;; <this>
+ ;; OTHER deleted a region after the region deleted by
+ ;; THIS. Therefore OTHER has to be shifted by the length of
+ ;; the deleted region.
+ ((> other-from this-to)
+ (decf other-from this-length)
+ (decf other-to this-length))
+
+ ;; <other>
+ ;; <this>
+ ;; OTHER deleted a region before the region affected by
+ ;; THIS. That is not affected by THIS operation.
+ ((<= other-to this-from))
+
+ ;; < other >
+ ;; <this>
+ ((and (>= other-from this-from) (>= other-to this-to))
+ (decf other-to this-length))
+
+ ;; <other>
+ ;; <this>
+ ((and (< other-from this-from) (< other-to this-to))
+ (decf other-to (- other-to this-to)))
+
+ ;; <other>
+ ;; <this>
+ ;; The region deleted by OTHER overlaps with the region
+ ;; deleted by THIS, such that a part of the region of this is
+ ;; before the region of OTHER. The first part of the region
+ ;; deleted by OTHER has already been deleted. Therefore, the
+ ;; start of OTHER has to be shifted by the length of the
+ ;; overlap.
+ ((and (< other-from this-to) (> other-to this-to))
+ (setq other-from this-from)
+ (incf other-to (+ other-from (- other-to this-to))))
+ ;; (setq other-to (this-to - other-from))
+
+ ;; <other>
+ ;; < this >
+ ;; The region deleted by OTHER is completely contained in
+ ;; the region affected by THIS. Therefore, OTHER must not
+ ;; be executed.
+ ((and (>= other-from this-from) (<= other-to this-to))
+ (setq other (adopted-nop "nop")))
+
+ (t
+ (error "logic error in adopted-delete::transform(adopted-delete)"))
+ ))))
+
+ ;;
+ ;; Transform a compound operation
+ ;;
+ ((adopted-compound-p other) ;; TODO encapsulation violation
+ (with-slots (children) other
+ (dolist (child children)
+ (setf child (adopted-transform this child)))))
+
+ ;;
+ ;; Transform a nop operation
+ ;;
+ ((adopted-nop-p other))
+
+ ;; TODO this is for debugging
+ (t
+ (error "Cannot transform operation of type `%s'"
+ (object-class other))))
+ other)
+
+(provide 'adopted-delete)
+;;; adopted-delete.el ends here
Oops, something went wrong.

0 comments on commit 399536c

Please sign in to comment.