diff options
Diffstat (limited to 'emacs.d/lisp/rudel/jupiter')
16 files changed, 1711 insertions, 0 deletions
diff --git a/emacs.d/lisp/rudel/jupiter/.svn/all-wcprops b/emacs.d/lisp/rudel/jupiter/.svn/all-wcprops new file mode 100644 index 0000000..87ab5a7 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/all-wcprops @@ -0,0 +1,47 @@ +K 25 +svn:wc:ra_dav:version-url +V 41 +/svnroot/rudel/!svn/ver/402/trunk/jupiter +END +jupiter-operation.el +K 25 +svn:wc:ra_dav:version-url +V 62 +/svnroot/rudel/!svn/ver/181/trunk/jupiter/jupiter-operation.el +END +jupiter-delete.el +K 25 +svn:wc:ra_dav:version-url +V 59 +/svnroot/rudel/!svn/ver/402/trunk/jupiter/jupiter-delete.el +END +jupiter.el +K 25 +svn:wc:ra_dav:version-url +V 52 +/svnroot/rudel/!svn/ver/401/trunk/jupiter/jupiter.el +END +Project.ede +K 25 +svn:wc:ra_dav:version-url +V 53 +/svnroot/rudel/!svn/ver/127/trunk/jupiter/Project.ede +END +jupiter-compound.el +K 25 +svn:wc:ra_dav:version-url +V 61 +/svnroot/rudel/!svn/ver/401/trunk/jupiter/jupiter-compound.el +END +jupiter-insert.el +K 25 +svn:wc:ra_dav:version-url +V 59 +/svnroot/rudel/!svn/ver/401/trunk/jupiter/jupiter-insert.el +END +jupiter-nop.el +K 25 +svn:wc:ra_dav:version-url +V 56 +/svnroot/rudel/!svn/ver/401/trunk/jupiter/jupiter-nop.el +END diff --git a/emacs.d/lisp/rudel/jupiter/.svn/entries b/emacs.d/lisp/rudel/jupiter/.svn/entries new file mode 100644 index 0000000..9c980a3 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/entries @@ -0,0 +1,266 @@ +10 + +dir +545 +https://rudel.svn.sourceforge.net/svnroot/rudel/trunk/jupiter +https://rudel.svn.sourceforge.net/svnroot/rudel + + + +2009-10-12T01:25:58.278168Z +402 +scymtym + + + + + + + + + + + + + + +694b31df-dcbb-44e8-af88-74c7ea918228 + +jupiter-operation.el +file + + + + +2009-11-18T14:01:45.000000Z +550a78114bf28f2e455b046b044de3ab +2009-10-03T00:38:22.402651Z +181 +scymtym + + + + + + + + + + + + + + + + + + + + + +1768 + +jupiter-delete.el +file + + + + +2009-11-18T14:01:45.000000Z +6d404ed5777e97ebc85ecceccd7c192f +2009-10-12T01:25:58.278168Z +402 +scymtym + + + + + + + + + + + + + + + + + + + + + +4567 + +jupiter.el +file + + + + +2009-11-18T14:01:45.000000Z +f8061c6bda7d06bb8baec72c4ad99455 +2009-10-10T00:40:22.102805Z +401 +scymtym + + + + + + + + + + + + + + + + + + + + + +4289 + +Project.ede +file + + + + +2009-11-18T14:01:45.000000Z +9c70097606c8b04470919770f3ee7f27 +2009-10-03T00:27:43.856107Z +127 +scymtym + + + + + + + + + + + + + + + + + + + + + +380 + +jupiter-compound.el +file + + + + +2009-11-18T14:01:45.000000Z +924928b8dcad42bebf1892a1f8815d84 +2009-10-10T00:40:22.102805Z +401 +scymtym + + + + + + + + + + + + + + + + + + + + + +2569 + +jupiter-insert.el +file + + + + +2009-11-18T14:01:45.000000Z +418f814ecd47f022790826fd91547e19 +2009-10-10T00:40:22.102805Z +401 +scymtym + + + + + + + + + + + + + + + + + + + + + +4126 + +jupiter-nop.el +file + + + + +2009-11-18T14:01:45.000000Z +3af498a68a91644e00dfb63a1a2ca4a7 +2009-10-10T00:40:22.102805Z +401 +scymtym + + + + + + + + + + + + + + + + + + + + + +1457 + diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/Project.ede.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/Project.ede.svn-base new file mode 100644 index 0000000..275d1ed --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/Project.ede.svn-base @@ -0,0 +1,14 @@ +;; Object rudel/jupiter +;; EDE project file. +(ede-proj-project "rudel/jupiter" + :name "jupiter" + :file "Project.ede" + :targets (list + (ede-proj-target-elisp "jupiter" + :name "jupiter" + :path "" + :source '("jupiter.el" "jupiter-operation.el" "jupiter-insert.el" "jupiter-delete.el" "jupiter-compound.el" "jupiter-nop.el") + :aux-packages '("rudel") + ) + ) + ) diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-compound.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-compound.el.svn-base new file mode 100644 index 0000000..789bbc2 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-compound.el.svn-base @@ -0,0 +1,89 @@ +;;; jupiter-compound.el --- Jupiter compound operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, 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 `jupiter-compound' implements a compound operation comprised +;; of a number of child operations. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'jupiter-operation) + + +;;; Class jupiter-compound +;; + +(defclass jupiter-compound (jupiter-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 jupiter-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 (jupiter-transform child next))) + ;; Advance to next child operation. + (setq child (first rest) + rest (rest rest))))) + ) + +(defmethod jupiter-transform ((this jupiter-compound) other) + "Transform OTHER using the child operations of THIS." + (with-slots (children) this + (dolist (child children) ;; TODO reverse children? + (setq other (jupiter-transform child other))) + other)) + +(defmethod object-print ((this jupiter-compound) &rest strings) + "Add number of children to string representation of THIS." + (with-slots (children) this + (call-next-method + this + (format " children %d" (length children))))) + +(provide 'jupiter-compound) +;;; jupiter-compound.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-delete.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-delete.el.svn-base new file mode 100644 index 0000000..db2e985 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-delete.el.svn-base @@ -0,0 +1,176 @@ +;;; jupiter-delete.el --- Jupiter delete operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, 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 `jupiter-delete' implements a delete operation for the +;; Jupiter algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) +(require 'jupiter-operation) + + +;;; Class jupiter-delete +;; + +(defclass jupiter-delete (jupiter-operation + rudel-delete-op) + () + "Objects of this class represent deletions in buffers.") + +(defmethod jupiter-transform ((this jupiter-delete) other) + "Transform other using THIS. +OTHER is destructively modified or replaced." + (cond + + ;; + ;; Transform an insert operation + ;; + ((jupiter-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 + ;; + ((jupiter-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)))) + + ;; <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 (jupiter-nop "nop"))) + + (t (error "logic error in (jupiter-transform (x jupiter-delete) (y jupiter-delete))")) + )))) + + ;; + ;; Transform a compound operation + ;; + ((jupiter-compound-p other) ;; TODO encapsulation violation + (with-slots (children) other + (dolist (child children) + (setf child (jupiter-transform this child))))) + + ;; + ;; Transform a nop operation + ;; + ((jupiter-nop-p other)) + + ;; TODO this is for debugging + (t (error "Cannot transform operation of type `%s'" + (object-class other)))) + other) + +(defmethod object-print ((this jupiter-delete) &rest strings) + "Add from, to and length to string representation of THIS." + (with-slots (from to length) this + (call-next-method + this + (format " from %d" from) + (format " to %d" to) + (format " length %d" length))) + ) + +(provide 'jupiter-delete) +;;; jupiter-delete.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-insert.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-insert.el.svn-base new file mode 100644 index 0000000..339270e --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-insert.el.svn-base @@ -0,0 +1,165 @@ +;;; jupiter-insert.el --- Jupiter insert operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, operation, insert +;; 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 `jupiter-insert' implements an insert operation for the +;; Jupiter algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) +(require 'jupiter-operation) + + +;;; Class jupiter-insert +;; + +(defclass jupiter-insert (jupiter-operation + rudel-insert-op) + () + "Objects of this class represent insertions into buffers.") + +(defmethod jupiter-transform ((this jupiter-insert) other) + "Transform OTHER using THIS." + (cond + + ;; + ;; Transform an insert operation + ;; + ((jupiter-insert-p other) + (with-slots ((this-from :from) + (this-to :to) + (this-length :length) + (this-data :data)) this + (with-slots ((other-from :from) + (other-to :to) + (other-length :length) + (other-data :data)) other + (cond + ;; + ;; <other> + ;; <this> + ;; No need to do anything in this case. + ;; ((< other-from this-from)) + + ;; + ;; <other> + ;; <this> + ;; + ((> other-from this-from) + (incf other-from this-length)) + + ;; + ;; <other> + ;; <this> + ;; OTHER inserted at the same start position as we did. Since + ;; the situation is symmetric in the location properties of + ;; OTHER and THIS, we use the inserted data to construct an + ;; ordering. + ((= other-from this-from) + (when (string< this-data other-data) + (incf other-from this-length))))))) + + ;; + ;; Transform a delete operation + ;; + ((jupiter-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> + ;; just keep OTHER + + ;; + ;; <other> and <other> and <other> + ;; <this> <this> <this> + ((>= other-from this-from) + (incf other-from this-length) + (incf other-to this-length)) + + ;; + ;; < other > + ;; <this> + ;; OTHER deleted a region that includes the point at which THIS + ;; inserted in its interior. OTHER has to be split into one + ;; deletion before and one delete after the inserted data. + ((and (< other-from this-from) (> other-to this-to)) + (setq other + (jupiter-compound "compound" + :children (list (jupiter-delete "delete-left" + :from other-from + :to this-from) + (jupiter-delete "delete-right" + :from this-to + :to (+ other-to this-length)))))) + )))) + + ;; + ;; Transform a compound operation + ;; + ((jupiter-compound-p other) ;; TODO encapsulation violation + (with-slots (children) other + (dolist (child children) + (setf child (jupiter-transform this child))))) + + ;; + ;; Transform a nop operation + ;; + ((jupiter-nop-p other)) + + ;; TODO this is for debugging + (t (error "Cannot transform operation of type `%s'" + (object-class other)))) + other) + +(defmethod object-print ((this jupiter-insert) &rest strings) + "Add from, to, length and data to string representation of THIS." + (with-slots (from to length data) this + (call-next-method + this + (format " from %d" from) + (format " to %d" to) + (format " length %d" length) + (format " data \"%s\"" data))) + ) + +(provide 'jupiter-insert) +;;; jupiter-insert.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-nop.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-nop.el.svn-base new file mode 100644 index 0000000..e0f4a5c --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-nop.el.svn-base @@ -0,0 +1,59 @@ +;;; jupiter-nop.el --- Jupiter no operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, operation, nop +;; 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 `jupiter-nop' implements a no-operation for the Jupiter +;; algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(require 'eieio) + +(require 'jupiter-operation) + + +;;; Class jupiter-nop +;; + +(defclass jupiter-nop (jupiter-operation) + () + "Operation, which does not change anything.") + +(defmethod rudel-apply ((this jupiter-nop) object) + "Applying THIS does not change OBJECT.") + +(defmethod jupiter-transform ((this jupiter-nop) other) + "Transforming OTHER with THIS simply returns OTHER." + other) + +(provide 'jupiter-nop) +;;; jupiter-nop.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-operation.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-operation.el.svn-base new file mode 100644 index 0000000..bc91fee --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter-operation.el.svn-base @@ -0,0 +1,61 @@ +;;; jupiter-operation.el --- Operation base class for jupiter algorithm +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: Jupiter, operation, base +;; 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: +;; +;; The class jupiter-operation is a base class for Jupiter operation +;; classes. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) + + +;;; Class jupiter-operation +;; + +(defclass jupiter-operation (rudel-operation) + () + "Objects of derived classes represent operations, which change documents. +Objects can transform each other to produce sequences of +operations, which produce identical changes than permutations of +the same operations." + :abstract t) + +;; This one really could use multiple dispatch +(defgeneric jupiter-transform ((this jupiter-operation) other) + "Transform OTHER such that the effect of applying it after THIS are equal to applying OTHER before THIS unmodified. +In general, OTHER is destructively modified or replaced.") + +(provide 'jupiter-operation) +;;; jupiter-operation.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter.el.svn-base b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter.el.svn-base new file mode 100644 index 0000000..d285041 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/.svn/text-base/jupiter.el.svn-base @@ -0,0 +1,135 @@ +;;; jupiter.el --- An implementation of the Jupiter algorithm +;; +;; Copyright (C) 2008, 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: rudel, jupiter, algorithm, distributed, integrity +;; 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: +;; +;; This file contains an implementation of the jupiter algorithm, +;; which ensures the synchronization of data shared between multiple +;; peers despite differences in network latency. +;; +;; This implementation is partly based on the implementation used in +;; the obby library <http://gobby.0x539.de/trac/>. Note, however, that +;; the details of the implementations differ. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(eval-when-compile + (require 'cl)) + +(require 'eieio) + +(require 'jupiter-operation) +(require 'jupiter-insert) +(require 'jupiter-delete) +(require 'jupiter-compound) +(require 'jupiter-nop) + + +;;; Class jupiter-context +;; + +(defclass jupiter-context () + ((local-revision :initarg :local-revision + :type (integer 0) + :initform 0 + :documentation + "Revision number of the local data.") + (remote-revision :initarg :remote-revision + :type (integer 0) + :initform 0 + :documentation + "Revision number of the remote data.") + (local-log :initarg :local-log + :type list + :initform nil + :documentation + "List of local operations, that have not been +acknowledged by the remote side.")) + "Objects of this class store the state of one side of a +concurrent modification activity, which is synchronized using the +jupiter algorithm.") + +(defmethod jupiter-local-operation ((this jupiter-context) operation) + "Store OPERATION in the operation log of THIS and increase local revision count." + (with-slots (local-revision local-log) this + (push (cons local-revision operation) local-log) + (incf local-revision))) + +(defmethod jupiter-remote-operation ((this jupiter-context) + local-revision remote-revision + operation) + "Transform OPERATION with revisions LOCAL-REVISION and REMOTE-REVISION using the local operations stored in THIS. +LOCAL-REVISION is the local revision of THIS context, the remote +site is referring to." + (let ((transformed-operation operation)) + (with-slots ((this-remote-revision :remote-revision) + local-log) this + + ;; Discard stored local operations which are older than the + ;; local revision to which the remote site refers. + (setq local-log (delete-if + (lambda (revision) (< revision local-revision)) + local-log + :key 'car)) + + ;; Transform the operation + (mapc + (lambda (log-operation) + + ;; Transform the remote operation using the stored operation. + (setq transformed-operation + (jupiter-transform (cdr log-operation) + transformed-operation)) + + ;; Transform the stored operation using the already + ;; transformed remote operation. + (setf (cdr log-operation) + (jupiter-transform transformed-operation + (cdr log-operation)))) + (reverse local-log)) + + ;; Increase remote revision + (incf this-remote-revision)) + ;; The transformed operation is the result of the computation. + transformed-operation) + ) + +(defmethod object-print ((this jupiter-context) &rest strings) + "Add revisions and log length to string representation of THIS." + (with-slots (local-revision remote-revision local-log) this + (call-next-method + this + (format " local %d" local-revision) + (format " remote %d" remote-revision) + (format " log-items %d" (length local-log))))) + +(provide 'jupiter) +;;; jupiter.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/Project.ede b/emacs.d/lisp/rudel/jupiter/Project.ede new file mode 100644 index 0000000..275d1ed --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/Project.ede @@ -0,0 +1,14 @@ +;; Object rudel/jupiter +;; EDE project file. +(ede-proj-project "rudel/jupiter" + :name "jupiter" + :file "Project.ede" + :targets (list + (ede-proj-target-elisp "jupiter" + :name "jupiter" + :path "" + :source '("jupiter.el" "jupiter-operation.el" "jupiter-insert.el" "jupiter-delete.el" "jupiter-compound.el" "jupiter-nop.el") + :aux-packages '("rudel") + ) + ) + ) diff --git a/emacs.d/lisp/rudel/jupiter/jupiter-compound.el b/emacs.d/lisp/rudel/jupiter/jupiter-compound.el new file mode 100644 index 0000000..789bbc2 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter-compound.el @@ -0,0 +1,89 @@ +;;; jupiter-compound.el --- Jupiter compound operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, 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 `jupiter-compound' implements a compound operation comprised +;; of a number of child operations. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'jupiter-operation) + + +;;; Class jupiter-compound +;; + +(defclass jupiter-compound (jupiter-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 jupiter-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 (jupiter-transform child next))) + ;; Advance to next child operation. + (setq child (first rest) + rest (rest rest))))) + ) + +(defmethod jupiter-transform ((this jupiter-compound) other) + "Transform OTHER using the child operations of THIS." + (with-slots (children) this + (dolist (child children) ;; TODO reverse children? + (setq other (jupiter-transform child other))) + other)) + +(defmethod object-print ((this jupiter-compound) &rest strings) + "Add number of children to string representation of THIS." + (with-slots (children) this + (call-next-method + this + (format " children %d" (length children))))) + +(provide 'jupiter-compound) +;;; jupiter-compound.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/jupiter-delete.el b/emacs.d/lisp/rudel/jupiter/jupiter-delete.el new file mode 100644 index 0000000..db2e985 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter-delete.el @@ -0,0 +1,176 @@ +;;; jupiter-delete.el --- Jupiter delete operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, 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 `jupiter-delete' implements a delete operation for the +;; Jupiter algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) +(require 'jupiter-operation) + + +;;; Class jupiter-delete +;; + +(defclass jupiter-delete (jupiter-operation + rudel-delete-op) + () + "Objects of this class represent deletions in buffers.") + +(defmethod jupiter-transform ((this jupiter-delete) other) + "Transform other using THIS. +OTHER is destructively modified or replaced." + (cond + + ;; + ;; Transform an insert operation + ;; + ((jupiter-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 + ;; + ((jupiter-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)))) + + ;; <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 (jupiter-nop "nop"))) + + (t (error "logic error in (jupiter-transform (x jupiter-delete) (y jupiter-delete))")) + )))) + + ;; + ;; Transform a compound operation + ;; + ((jupiter-compound-p other) ;; TODO encapsulation violation + (with-slots (children) other + (dolist (child children) + (setf child (jupiter-transform this child))))) + + ;; + ;; Transform a nop operation + ;; + ((jupiter-nop-p other)) + + ;; TODO this is for debugging + (t (error "Cannot transform operation of type `%s'" + (object-class other)))) + other) + +(defmethod object-print ((this jupiter-delete) &rest strings) + "Add from, to and length to string representation of THIS." + (with-slots (from to length) this + (call-next-method + this + (format " from %d" from) + (format " to %d" to) + (format " length %d" length))) + ) + +(provide 'jupiter-delete) +;;; jupiter-delete.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/jupiter-insert.el b/emacs.d/lisp/rudel/jupiter/jupiter-insert.el new file mode 100644 index 0000000..339270e --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter-insert.el @@ -0,0 +1,165 @@ +;;; jupiter-insert.el --- Jupiter insert operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, operation, insert +;; 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 `jupiter-insert' implements an insert operation for the +;; Jupiter algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) +(require 'jupiter-operation) + + +;;; Class jupiter-insert +;; + +(defclass jupiter-insert (jupiter-operation + rudel-insert-op) + () + "Objects of this class represent insertions into buffers.") + +(defmethod jupiter-transform ((this jupiter-insert) other) + "Transform OTHER using THIS." + (cond + + ;; + ;; Transform an insert operation + ;; + ((jupiter-insert-p other) + (with-slots ((this-from :from) + (this-to :to) + (this-length :length) + (this-data :data)) this + (with-slots ((other-from :from) + (other-to :to) + (other-length :length) + (other-data :data)) other + (cond + ;; + ;; <other> + ;; <this> + ;; No need to do anything in this case. + ;; ((< other-from this-from)) + + ;; + ;; <other> + ;; <this> + ;; + ((> other-from this-from) + (incf other-from this-length)) + + ;; + ;; <other> + ;; <this> + ;; OTHER inserted at the same start position as we did. Since + ;; the situation is symmetric in the location properties of + ;; OTHER and THIS, we use the inserted data to construct an + ;; ordering. + ((= other-from this-from) + (when (string< this-data other-data) + (incf other-from this-length))))))) + + ;; + ;; Transform a delete operation + ;; + ((jupiter-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> + ;; just keep OTHER + + ;; + ;; <other> and <other> and <other> + ;; <this> <this> <this> + ((>= other-from this-from) + (incf other-from this-length) + (incf other-to this-length)) + + ;; + ;; < other > + ;; <this> + ;; OTHER deleted a region that includes the point at which THIS + ;; inserted in its interior. OTHER has to be split into one + ;; deletion before and one delete after the inserted data. + ((and (< other-from this-from) (> other-to this-to)) + (setq other + (jupiter-compound "compound" + :children (list (jupiter-delete "delete-left" + :from other-from + :to this-from) + (jupiter-delete "delete-right" + :from this-to + :to (+ other-to this-length)))))) + )))) + + ;; + ;; Transform a compound operation + ;; + ((jupiter-compound-p other) ;; TODO encapsulation violation + (with-slots (children) other + (dolist (child children) + (setf child (jupiter-transform this child))))) + + ;; + ;; Transform a nop operation + ;; + ((jupiter-nop-p other)) + + ;; TODO this is for debugging + (t (error "Cannot transform operation of type `%s'" + (object-class other)))) + other) + +(defmethod object-print ((this jupiter-insert) &rest strings) + "Add from, to, length and data to string representation of THIS." + (with-slots (from to length data) this + (call-next-method + this + (format " from %d" from) + (format " to %d" to) + (format " length %d" length) + (format " data \"%s\"" data))) + ) + +(provide 'jupiter-insert) +;;; jupiter-insert.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/jupiter-nop.el b/emacs.d/lisp/rudel/jupiter/jupiter-nop.el new file mode 100644 index 0000000..e0f4a5c --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter-nop.el @@ -0,0 +1,59 @@ +;;; jupiter-nop.el --- Jupiter no operation +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: jupiter, operation, nop +;; 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 `jupiter-nop' implements a no-operation for the Jupiter +;; algorithm. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(require 'eieio) + +(require 'jupiter-operation) + + +;;; Class jupiter-nop +;; + +(defclass jupiter-nop (jupiter-operation) + () + "Operation, which does not change anything.") + +(defmethod rudel-apply ((this jupiter-nop) object) + "Applying THIS does not change OBJECT.") + +(defmethod jupiter-transform ((this jupiter-nop) other) + "Transforming OTHER with THIS simply returns OTHER." + other) + +(provide 'jupiter-nop) +;;; jupiter-nop.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/jupiter-operation.el b/emacs.d/lisp/rudel/jupiter/jupiter-operation.el new file mode 100644 index 0000000..bc91fee --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter-operation.el @@ -0,0 +1,61 @@ +;;; jupiter-operation.el --- Operation base class for jupiter algorithm +;; +;; Copyright (C) 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: Jupiter, operation, base +;; 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: +;; +;; The class jupiter-operation is a base class for Jupiter operation +;; classes. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(require 'eieio) + +(require 'rudel-operations) + + +;;; Class jupiter-operation +;; + +(defclass jupiter-operation (rudel-operation) + () + "Objects of derived classes represent operations, which change documents. +Objects can transform each other to produce sequences of +operations, which produce identical changes than permutations of +the same operations." + :abstract t) + +;; This one really could use multiple dispatch +(defgeneric jupiter-transform ((this jupiter-operation) other) + "Transform OTHER such that the effect of applying it after THIS are equal to applying OTHER before THIS unmodified. +In general, OTHER is destructively modified or replaced.") + +(provide 'jupiter-operation) +;;; jupiter-operation.el ends here diff --git a/emacs.d/lisp/rudel/jupiter/jupiter.el b/emacs.d/lisp/rudel/jupiter/jupiter.el new file mode 100644 index 0000000..d285041 --- /dev/null +++ b/emacs.d/lisp/rudel/jupiter/jupiter.el @@ -0,0 +1,135 @@ +;;; jupiter.el --- An implementation of the Jupiter algorithm +;; +;; Copyright (C) 2008, 2009 Jan Moringen +;; +;; Author: Jan Moringen <scymtym@users.sourceforge.net> +;; Keywords: rudel, jupiter, algorithm, distributed, integrity +;; 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: +;; +;; This file contains an implementation of the jupiter algorithm, +;; which ensures the synchronization of data shared between multiple +;; peers despite differences in network latency. +;; +;; This implementation is partly based on the implementation used in +;; the obby library <http://gobby.0x539.de/trac/>. Note, however, that +;; the details of the implementations differ. + + +;;; History: +;; +;; 0.1 - Initial revision. + + +;;; Code: +;; + +(eval-when-compile + (require 'cl)) + +(require 'eieio) + +(require 'jupiter-operation) +(require 'jupiter-insert) +(require 'jupiter-delete) +(require 'jupiter-compound) +(require 'jupiter-nop) + + +;;; Class jupiter-context +;; + +(defclass jupiter-context () + ((local-revision :initarg :local-revision + :type (integer 0) + :initform 0 + :documentation + "Revision number of the local data.") + (remote-revision :initarg :remote-revision + :type (integer 0) + :initform 0 + :documentation + "Revision number of the remote data.") + (local-log :initarg :local-log + :type list + :initform nil + :documentation + "List of local operations, that have not been +acknowledged by the remote side.")) + "Objects of this class store the state of one side of a +concurrent modification activity, which is synchronized using the +jupiter algorithm.") + +(defmethod jupiter-local-operation ((this jupiter-context) operation) + "Store OPERATION in the operation log of THIS and increase local revision count." + (with-slots (local-revision local-log) this + (push (cons local-revision operation) local-log) + (incf local-revision))) + +(defmethod jupiter-remote-operation ((this jupiter-context) + local-revision remote-revision + operation) + "Transform OPERATION with revisions LOCAL-REVISION and REMOTE-REVISION using the local operations stored in THIS. +LOCAL-REVISION is the local revision of THIS context, the remote +site is referring to." + (let ((transformed-operation operation)) + (with-slots ((this-remote-revision :remote-revision) + local-log) this + + ;; Discard stored local operations which are older than the + ;; local revision to which the remote site refers. + (setq local-log (delete-if + (lambda (revision) (< revision local-revision)) + local-log + :key 'car)) + + ;; Transform the operation + (mapc + (lambda (log-operation) + + ;; Transform the remote operation using the stored operation. + (setq transformed-operation + (jupiter-transform (cdr log-operation) + transformed-operation)) + + ;; Transform the stored operation using the already + ;; transformed remote operation. + (setf (cdr log-operation) + (jupiter-transform transformed-operation + (cdr log-operation)))) + (reverse local-log)) + + ;; Increase remote revision + (incf this-remote-revision)) + ;; The transformed operation is the result of the computation. + transformed-operation) + ) + +(defmethod object-print ((this jupiter-context) &rest strings) + "Add revisions and log length to string representation of THIS." + (with-slots (local-revision remote-revision local-log) this + (call-next-method + this + (format " local %d" local-revision) + (format " remote %d" remote-revision) + (format " log-items %d" (length local-log))))) + +(provide 'jupiter) +;;; jupiter.el ends here |