branch: externals/rudel
commit 901a96e5342d74003d5620d059ad1deea43dd0da
Author: Stefan Monnier <monn...@iro.umontreal.ca>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Adjust code to current cl-generic practices
Delete all `object-print` methods. Use `eieio-object-p` instead of
`object-p`. Use slot names rather than initargs when accessing slots.
Make sure `:initform`s aren't ambiguous.
Remove most obsolete "object name" arguments.
Catch `cl-no-next-method` instead of testing `cl-next-method-p`.
Use `cl-typep` instead of `<classname>-child-p`.
Fix some "docstring wider than 80 characters" warnings, as well as
most "unknown slot" warnings.
Avoid `object-class`.
* jupiter-operation.el (jupiter-insert, jupiter-delete): Move here to
avoid circular dependencies.
* jupiter-nop.el (jupiter-transform) <t jupiter-nop>: New method.
* jupiter-insert.el (jupiter-insert): Move to jupiter-operation.el.
(jupiter-transform): Dispatch on both args.
* jupiter-delete.el (jupiter-delete): Move to jupiter-operation.el.
(jupiter-transform): Dispatch on both args.
* jupiter-compound.el (jupiter-transform) <t jupiter-compound>: New method.
* adopted-operation.el (adopted-insert, adopted-delete): Move here to
avoid circular dependencies.
(adopted-transform): Define the generic function.
* adopted-nop.el (adopted-transform) <t adopted-nop>: New method.
* adopted-insert.el (adopted-insert): Move to adopted-operation.el.
(adopted-transform): Dispatch on both args.
* adopted-delete.el (adopted-delete): Move to adopted-operation.el.
(adopted-transform): Dispatch on both args.
* adopted-compound.el (adopted-transform) <t adopted-compound>:
New method, extracted from adopted-(delete|insert).el.
---
adopted-compound.el | 9 +-
adopted-delete.el | 191 ++++++++++++------------------
adopted-insert.el | 160 ++++++++++---------------
adopted-nop.el | 5 +-
adopted-operation.el | 19 ++-
jupiter-compound.el | 14 +--
jupiter-delete.el | 216 ++++++++++++++--------------------
jupiter-insert.el | 193 ++++++++++++------------------
jupiter-nop.el | 5 +-
jupiter-operation.el | 19 ++-
jupiter.el | 16 +--
rudel-backend.el | 18 +--
rudel-debug.el | 14 +--
rudel-display.el | 6 +-
rudel-hooks.el | 5 +-
rudel-infinote-client.el | 27 ++---
rudel-infinote-display.el | 4 +-
rudel-infinote-document.el | 4 +-
rudel-infinote-group-directory.el | 9 +-
rudel-infinote-group-document.el | 24 ++--
rudel-infinote-group-text-document.el | 29 ++---
rudel-infinote-group.el | 50 ++++----
rudel-infinote-node-directory.el | 16 +--
rudel-infinote-user.el | 6 +-
rudel-interactive.el | 6 +-
rudel-obby-client.el | 75 ++++++------
rudel-obby-display.el | 6 +-
rudel-obby-server.el | 99 ++++++++--------
rudel-obby-state.el | 6 +-
rudel-obby.el | 18 +--
rudel-operations.el | 23 ++--
rudel-operators.el | 4 +-
rudel-overlay.el | 6 +-
rudel-protocol.el | 8 +-
rudel-session-initiation.el | 10 +-
rudel-socket.el | 4 +-
rudel-speedbar.el | 3 +-
rudel-state-machine.el | 20 +---
rudel-tls.el | 6 +-
rudel-transport-util.el | 16 +--
rudel-xmpp.el | 9 +-
rudel-zeroconf.el | 6 +-
rudel.el | 24 +---
43 files changed, 633 insertions(+), 775 deletions(-)
diff --git a/adopted-compound.el b/adopted-compound.el
index 4514b60..db9f13a 100644
--- a/adopted-compound.el
+++ b/adopted-compound.el
@@ -1,6 +1,6 @@
;;; adopted-compound.el --- Adopted compound operation -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, adopted, algorithm, operation, compound
@@ -77,5 +77,12 @@ number of child operation.")
(setq other (adopted-transform child other)))
other))
+(cl-defmethod adopted-transform (this (other adopted-compound))
+ ;; Transform a compound operation
+ (with-slots (children) other
+ (dolist (child children)
+ (adopted-transform this child)))
+ other)
+
(provide 'adopted-compound)
;;; adopted-compound.el ends here
diff --git a/adopted-delete.el b/adopted-delete.el
index a0d85b0..e913d37 100644
--- a/adopted-delete.el
+++ b/adopted-delete.el
@@ -1,6 +1,6 @@
;;; adopted-delete.el --- Adopted delete operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, adopted, algorithm, operation, delete
@@ -45,119 +45,84 @@
(require 'adopted-nop)
-;;; Class adopted-delete
-;;
+(cl-defmethod adopted-transform ((this adopted-delete) (other adopted-insert))
+ ;; Transform an insert operation
+ (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)
+ (cl-decf other-from this-length))
+
+ ;; <other>
+ ;; < this >
+ ((and (> other-from this-from) (< other-to this-to))
+ (setq other-from this-from))
+ )))
+ other)
-(defclass adopted-delete (adopted-operation
- rudel-delete-op)
- ()
- "Objects of this class represent deletions in buffers.")
-
-(cl-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)
- (cl-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)
- (cl-decf other-from this-length)
- (cl-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))
- (cl-decf other-to this-length))
-
- ;; <other>
- ;; <this>
- ((and (< other-from this-from) (< other-to this-to))
- (cl-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)
- (cl-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))))
+(cl-defmethod adopted-transform ((this adopted-delete) (other adopted-delete))
+ ;; Transform a delete operation
+ (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)
+ (cl-decf other-from this-length)
+ (cl-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))
+ (cl-decf other-to this-length))
+
+ ;; <other>
+ ;; <this>
+ ((and (< other-from this-from) (< other-to this-to))
+ (cl-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)
+ (cl-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)))
+
+ (t
+ (error "logic error in adopted-delete::transform(adopted-delete)"))
+ )))
other)
(provide 'adopted-delete)
diff --git a/adopted-insert.el b/adopted-insert.el
index 6c07611..d08dbb5 100644
--- a/adopted-insert.el
+++ b/adopted-insert.el
@@ -1,6 +1,6 @@
;;; adopted-insert.el --- Adopted insert operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, adopted, algorithm, operation, insert
@@ -45,102 +45,70 @@
(require 'adopted-nop)
-;;; Class adopted-insert
-;;
-
-(defclass adopted-insert (adopted-operation
- rudel-insert-op)
- ()
- "Objects of this class represent insertions into buffers.")
-
-(cl-defmethod adopted-transform ((this adopted-insert) other)
- "Transform OTHER using THIS."
- (cond
-
- ;;
- ;; Transform an insert operation
- ;;
- ((adopted-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)) ;; TODO remove this case; but not the
comment
-
- ;;
- ;; <other>
- ;; <this>
- ;;
- ((> other-from this-from)
- (cl-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)
- (cl-incf other-from this-length)))))))
-
- ;;
- ;; 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>
- ;; just keep OTHER
-
- ;;
- ;; <other> and <other> and <other>
- ;; <this> <this> <this>
- ((>= other-from this-from)
- (cl-incf other-from this-length)
- (cl-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
- (adopted-compound "compound"
- :children (list (adopted-delete "delete-left"
- :from other-from
- :to this-from)
- (adopted-delete "delete-right"
- :from this-to
- :to (+ other-to this-length))))))
- ))))
-
- ;;
- ;; 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))
+(cl-defmethod adopted-transform ((this adopted-insert) (other adopted-insert))
+ ;; Transform an insert operation
+ (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)) ;; TODO remove this case; but not the comment
+
+ ;;
+ ;; <other>
+ ;; <this>
+ ;;
+ ((> other-from this-from)
+ (cl-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)
+ (cl-incf other-from this-length))))))
+ other)
- ;; TODO this is for debugging
- (t (error "Cannot transform operation of type `%s'"
- (object-class other))))
+(cl-defmethod adopted-transform ((this adopted-insert) (other adopted-delete))
+ ;; Transform a delete operation
+ (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)
+ (cl-incf other-from this-length)
+ (cl-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
+ (adopted-compound
+ :children (list (adopted-delete
+ :from other-from
+ :to this-from)
+ (adopted-delete
+ :from this-to
+ :to (+ other-to this-length))))))
+ )))
other)
(provide 'adopted-insert)
diff --git a/adopted-nop.el b/adopted-nop.el
index 4ed432f..bbab0c9 100644
--- a/adopted-nop.el
+++ b/adopted-nop.el
@@ -1,6 +1,6 @@
;;; adopted-nop.el --- Adopted no operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, adopted, algorithm, operation, nop
@@ -55,5 +55,8 @@
"Transforming OTHER with THIS simply returns OTHER."
other)
+(cl-defmethod adopted-transform (_this (other adopted-nop))
+ other)
+
(provide 'adopted-nop)
;;; adopted-nop.el ends here
diff --git a/adopted-operation.el b/adopted-operation.el
index 2178589..c659060 100644
--- a/adopted-operation.el
+++ b/adopted-operation.el
@@ -1,6 +1,6 @@
;;; adopted-operation.el --- Base class for Adopted operations -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, adopted, algorithm, operation
@@ -40,5 +40,22 @@
()
"")
+(defclass adopted-insert (adopted-operation
+ rudel-insert-op)
+ ()
+ "Objects of this class represent insertions into buffers.")
+
+(defclass adopted-delete (adopted-operation
+ rudel-delete-op)
+ ()
+ "Objects of this class represent deletions in buffers.")
+
+(cl-defgeneric adopted-transform (this other)
+ "Transform OTHER so as to apply before THIS.
+Returns operation 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 'adopted-operation)
;;; adopted-operation.el ends here
diff --git a/jupiter-compound.el b/jupiter-compound.el
index 71877c3..5a76211 100644
--- a/jupiter-compound.el
+++ b/jupiter-compound.el
@@ -1,6 +1,6 @@
;;; jupiter-compound.el --- Jupiter compound operation -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: jupiter, operation, compound
@@ -77,12 +77,12 @@ number of child operation.")
(setq other (jupiter-transform child other)))
other))
-(cl-defmethod object-print ((this jupiter-compound) &rest _strings)
- "Add number of children to string representation of THIS."
- (with-slots (children) this
- (cl-call-next-method
- this
- (format " children %d" (length children)))))
+(cl-defmethod jupiter-transform (this (other jupiter-compound))
+ ;; Transform a compound operation
+ (with-slots (children) other
+ (dolist (child children)
+ (jupiter-transform this child)))
+ other)
(provide 'jupiter-compound)
;;; jupiter-compound.el ends here
diff --git a/jupiter-delete.el b/jupiter-delete.el
index aafb8cd..e62b59c 100644
--- a/jupiter-delete.el
+++ b/jupiter-delete.el
@@ -1,6 +1,6 @@
;;; jupiter-delete.el --- Jupiter delete operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: jupiter, operation, delete
@@ -45,135 +45,95 @@
(require 'jupiter-insert)
-;;; Class jupiter-delete
-;;
-
-(defclass jupiter-delete (jupiter-operation
- rudel-delete-op)
- ()
- "Objects of this class represent deletions in buffers.")
-
-(cl-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)
- (cl-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)
- (cl-decf other-from this-length)
- (cl-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))
- (cl-decf other-to this-length))
-
- ;; <other>
- ;; <this>
- ((and (< other-from this-from) (< other-to this-to))
- (cl-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)
- (cl-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))))
+(cl-defmethod jupiter-transform ((this jupiter-delete) (other jupiter-insert))
+ ;; Transform an insert operation
+ (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)
+ (cl-decf other-from this-length))
+
+ ;; <other>
+ ;; < this >
+ ((and (> other-from this-from) (< other-to this-to))
+ (setq other-from this-from))
+ )))
other)
-(cl-defmethod object-print ((this jupiter-delete) &rest _strings)
- "Add from, to and length to string representation of THIS."
- (with-slots (from to length) this
- (cl-call-next-method
- this
- (format " from %d" from)
- (format " to %d" to)
- (format " length %d" length)))
- )
+
+(cl-defmethod jupiter-transform ((this jupiter-delete) (other jupiter-delete))
+ (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)
+ (cl-decf other-from this-length)
+ (cl-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))
+ (cl-decf other-to this-length))
+
+ ;; <other>
+ ;; <this>
+ ((and (< other-from this-from) (< other-to this-to))
+ (cl-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)
+ (cl-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)))
+
+ (t (error "logic error in (jupiter-transform (x jupiter-delete) (y
jupiter-delete))"))
+ )))
+ other)
(provide 'jupiter-delete)
;;; jupiter-delete.el ends here
diff --git a/jupiter-insert.el b/jupiter-insert.el
index 1e9975d..e44287a 100644
--- a/jupiter-insert.el
+++ b/jupiter-insert.el
@@ -1,6 +1,6 @@
;;; jupiter-insert.el --- Jupiter insert operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: jupiter, operation, insert
@@ -42,126 +42,85 @@
(require 'rudel-operations)
(require 'jupiter-operation)
(require 'jupiter-nop)
+(require 'jupiter-compound)
-;;; Class jupiter-insert
-;;
-
-(defclass jupiter-insert (jupiter-operation
- rudel-insert-op)
- ()
- "Objects of this class represent insertions into buffers.")
-
-(cl-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)
- (cl-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)
- (cl-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)
- (cl-incf other-from this-length)
- (cl-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))))
+(cl-defmethod jupiter-transform ((this jupiter-insert) (other jupiter-insert))
+ ;; Transform an insert operation
+ (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)
+ (cl-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)
+ (cl-incf other-from this-length))))))
other)
-(cl-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
- (cl-call-next-method
- this
- (format " from %d" from)
- (format " to %d" to)
- (format " length %d" length)
- (format " data \"%s\"" data)))
- )
+(cl-defmethod jupiter-transform ((this jupiter-insert) (other jupiter-delete))
+ ;; Transform a delete operation
+ (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)
+ (cl-incf other-from this-length)
+ (cl-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 :children (list (jupiter-delete :from other-from
+ :to this-from)
+ (jupiter-delete :from this-to
+ :to (+
other-to this-length))))))
+ )))
+ other)
(provide 'jupiter-insert)
;;; jupiter-insert.el ends here
diff --git a/jupiter-nop.el b/jupiter-nop.el
index 32fbc5c..561bc41 100644
--- a/jupiter-nop.el
+++ b/jupiter-nop.el
@@ -1,6 +1,6 @@
;;; jupiter-nop.el --- Jupiter no operation -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: jupiter, operation, nop
@@ -55,5 +55,8 @@
"Transforming OTHER with THIS simply returns OTHER."
other)
+(cl-defmethod jupiter-transform (_this (other jupiter-nop))
+ other)
+
(provide 'jupiter-nop)
;;; jupiter-nop.el ends here
diff --git a/jupiter-operation.el b/jupiter-operation.el
index 2f63544..410d5b8 100644
--- a/jupiter-operation.el
+++ b/jupiter-operation.el
@@ -1,6 +1,6 @@
;;; jupiter-operation.el --- Operation base class for jupiter algorithm -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Jupiter, operation, base
@@ -54,8 +54,21 @@ the same operations."
:abstract t)
;; This one really could use multiple dispatch
-(cl-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.
+
+(defclass jupiter-insert (jupiter-operation
+ rudel-insert-op)
+ ()
+ "Objects of this class represent insertions into buffers.")
+
+(defclass jupiter-delete (jupiter-operation
+ rudel-delete-op)
+ ()
+ "Objects of this class represent deletions in buffers.")
+
+(cl-defgeneric jupiter-transform (this other)
+ "Transform OTHER so as to apply before THIS.
+Returns operation 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)
diff --git a/jupiter.el b/jupiter.el
index 04a380d..d921d54 100644
--- a/jupiter.el
+++ b/jupiter.el
@@ -1,6 +1,6 @@
;;; jupiter.el --- An implementation of the Jupiter algorithm -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2008, 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, jupiter, algorithm, distributed, integrity
@@ -89,8 +89,9 @@ jupiter algorithm.")
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
+ (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.
@@ -121,14 +122,5 @@ site is referring to."
transformed-operation)
)
-(cl-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
- (cl-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/rudel-backend.el b/rudel-backend.el
index 3a42625..ae05638 100644
--- a/rudel-backend.el
+++ b/rudel-backend.el
@@ -1,6 +1,6 @@
;;; rudel-backend.el --- A generic backend management mechanism for Rudel -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, backend, factory
@@ -160,7 +160,7 @@ for which CLASS-OR-OBJECT is an object."
(with-slots (backends) this
(maphash (lambda (name class)
(when (or (not only-loaded)
- (object-p class))
+ (eieio-object-p class))
(push (cons name class) backend-list)))
backends))
backend-list)
@@ -193,7 +193,7 @@ objects."
(with-slots (backends) this
(maphash
(lambda (name class)
- (unless (object-p class)
+ (unless (eieio-object-p class)
(condition-case error
(puthash name (make-instance
class (symbol-name name))
@@ -222,7 +222,7 @@ objects."
"Check whether CELL is a cons of a backend name and object."
(and (consp cell)
(symbolp (car cell))
- (object-p (cdr cell))))
+ (eieio-object-p (cdr cell))))
;;;###rudel-autoload
(defun rudel-backend-get (category name)
@@ -299,7 +299,7 @@ available information available for the backends"
;; Insert all backends provided by this factory.
(dolist (backend (rudel-all-backends factory))
- (insert (if (or (object-p (cdr backend))
+ (insert (if (or (eieio-object-p (cdr backend))
(null (get (car backend)
'rudel-backend-last-load-error)))
(rudel-backend--format-backend-normal backend)
@@ -319,11 +319,11 @@ available information available for the backends"
'face 'font-lock-type-face)
;; Backend loading status
(propertize
- (prin1-to-string (object-p (cdr backend)))
+ (prin1-to-string (eieio-object-p (cdr backend)))
'face 'font-lock-variable-name-face)
;; Backend version
(propertize
- (if (object-p (cdr backend))
+ (if (eieio-object-p (cdr backend))
(mapconcat #'prin1-to-string
(oref (cdr backend) version)
".")
@@ -331,7 +331,7 @@ available information available for the backends"
'face 'font-lock-constant-face)
;; Backend capabilities
(propertize
- (if (object-p (cdr backend))
+ (if (eieio-object-p (cdr backend))
(mapconcat #'prin1-to-string
(oref (cdr backend) capabilities)
" ")
@@ -356,4 +356,6 @@ available information available for the backends"
)
(provide 'rudel-backend)
+
+(require 'rudel-interactive) ;; for `rudel-read-backend'.
;;; rudel-backend.el ends here
diff --git a/rudel-debug.el b/rudel-debug.el
index 6c1fd63..75a9f47 100644
--- a/rudel-debug.el
+++ b/rudel-debug.el
@@ -1,6 +1,6 @@
;;; rudel-debug.el --- Debugging functions for Rudel -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, debugging
@@ -59,23 +59,19 @@
(defface rudel-debug-sent-data-face
'((default (:background "orange")))
- "Face used for sent data."
- :group 'rudel-debug)
+ "Face used for sent data.")
(defface rudel-debug-received-data-face
'((default (:background "light sky blue")))
- "Face used for received (but not yet processed) data."
- :group 'rudel-debug)
+ "Face used for received (but not yet processed) data.")
(defface rudel-debug-state-face
'((default (:background "light gray")))
- "Face used when indicating state changes."
- :group 'rudel-debug)
+ "Face used when indicating state changes.")
(defface rudel-debug-special-face
'((default (:background "light sea green")))
- "Face used for additional information."
- :group 'rudel-debug)
+ "Face used for additional information.")
(defvar rudel-debug-tag-faces
'((:sent . (rudel-debug-sent-data-face "< "))
diff --git a/rudel-display.el b/rudel-display.el
index 39a509a..1270889 100644
--- a/rudel-display.el
+++ b/rudel-display.el
@@ -1,6 +1,6 @@
;;; rudel-display.el --- Display functions for Rudel objects -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, display, icons, text, representation
@@ -53,7 +53,7 @@ the text representation.
When ALIGN is non-nil, align the text representation. If ALIGN is
t, align it to a fixed width. When ALIGN is a number, align it to
a width equal to that number."
- (with-slots ((name :object-name) color) this
+ (with-slots ((name object-name) color) this
(propertize
(concat
(when use-images
@@ -70,7 +70,7 @@ to the text representation.
When ALIGN is non-nil, align the text representation. If ALIGN is
t, align it to a fixed width. When ALIGN is a number, align it to
a width equal to that number."
- (with-slots ((name :object-name)) this
+ (with-slots ((name object-name)) this
(concat
(when use-images
(propertize "*" 'display rudel-icon-document))
diff --git a/rudel-hooks.el b/rudel-hooks.el
index 13dd4f2..152180a 100644
--- a/rudel-hooks.el
+++ b/rudel-hooks.el
@@ -1,6 +1,6 @@
;;; rudel-hooks.el --- Hooks for Rudel events -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, hook
@@ -37,7 +37,6 @@
;;
(require 'eieio)
-
(require 'rudel-util) ;; for `object-add-hook', `object-remove-hook'
@@ -86,6 +85,8 @@ The arguments are the document and the buffer.")
;;; Handlers
;;
+(eieio-declare-slots users documents) ;FIXME: (require 'rudel) creates a cycle!
+
(defun rudel-hooks--session-start (session)
"Watch SESSION for added/removed users and documents."
;; Install handlers for the hooks of the session.
diff --git a/rudel-infinote-client.el b/rudel-infinote-client.el
index 24adb7a..30d4d1d 100644
--- a/rudel-infinote-client.el
+++ b/rudel-infinote-client.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-client.el --- Client part of the infinote backend for Rudel
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, client
@@ -55,6 +55,7 @@
(require 'rudel-infinote-text-document)
(require 'rudel-infinote-user)
+(require 'rudel-infinote-node)
(require 'adopted)
@@ -114,7 +115,6 @@ side."))
;;
(with-slots (session) this
(let ((user (rudel-infinote-user
- "scymtym"
:color "red"
;:status 'active
)))
@@ -125,14 +125,12 @@ side."))
;; The special 'InfDirectory' group is there from the beginning.
(let ((directory-group (rudel-infinote-group-directory
- "InfDirectory"
:publisher "you"))) ;; TODO use correct publisher
name
(rudel-add-group this directory-group)
(require 'rudel-infinote-node-directory)
(rudel-add-node this
(rudel-infinote-node-directory
- "root"
:id 0
:parent nil
:group directory-group))
@@ -149,7 +147,7 @@ side."))
(cl-defmethod rudel-add-group ((this rudel-infinote-client-connection) group)
""
- (with-slots ((name :object-name) connection) group
+ (with-slots ((name object-name) connection) group
;;
(setq connection this) ;; TODO encapsulation violation?
@@ -165,7 +163,7 @@ GROUP-OR-NAME is a `rudel-infinote-group' object or a
string in
which case it is the name of a group."
(with-slots (groups) this
(let ((name (cond
- ((rudel-infinote-group-child-p group-or-name)
+ ((cl-typep group-or-name 'rudel-infinote-group)
(object-name group-or-name))
(t
@@ -274,8 +272,9 @@ WHICH is compared to the result of KEY using TEST."
;;
(_
- (when (cl-next-method-p)
- (cl-call-next-method)))) ;; TODO what is actually called here?
+ (condition-case nil
+ (cl-call-next-method)
+ (cl-no-next-method nil)))) ;; TODO what is actually called here?
)
(cl-defmethod rudel-disconnect ((this rudel-infinote-client-connection)) ;;
TODO maybe we could automatically delegate to the transport
@@ -328,7 +327,7 @@ WHICH is compared to the result of KEY using TEST."
;; Announce the subscription to the server and wait until the
;; subscription is finished
(let ((group (rudel-get-group this "InfDirectory"))) ;; TODO (with-group?
- (rudel-switch group 'subscribing (oref document :id))
+ (rudel-switch group 'subscribing (oref document id))
(rudel-state-wait group '(idle) nil))
;; TODO responsibility of the group?
@@ -388,8 +387,7 @@ WHICH is compared to the result of KEY using TEST."
(rudel-local-operation
this
document
- (adopted-insert "insert"
- :from position
+ (adopted-insert :from position
:data data))
)
@@ -399,8 +397,7 @@ WHICH is compared to the result of KEY using TEST."
(rudel-local-operation
this
document
- (adopted-delete "delete"
- :from position
+ (adopted-delete :from position
:to (+ position length)))
)
@@ -411,8 +408,8 @@ WHICH is compared to the result of KEY using TEST."
;;(let ((context (rudel-find-context this document)))
;; Notify the server of the operation
- (let ((self (rudel-self (oref this :session))))
- (with-slots (id group) document
+ (let ((self (rudel-self (oref this session))))
+ (with-slots (group) document
(rudel-send group
(rudel-infinote-embed-in-request
self (rudel-operation->xml operation)))))
diff --git a/rudel-infinote-display.el b/rudel-infinote-display.el
index dacdcd9..7983084 100644
--- a/rudel-infinote-display.el
+++ b/rudel-infinote-display.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-display.el --- Display functions for infinote users -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, user interface
@@ -43,7 +43,7 @@
(cl-defmethod rudel-display-string ((this rudel-infinote-document-user)
&optional _use-images)
"Return a textual representation of THIS for user interface purposes."
- (with-slots ((name :object-name) status) this
+ (with-slots ((name object-name) status) this
(concat
(cl-call-next-method)
diff --git a/rudel-infinote-document.el b/rudel-infinote-document.el
index 82a8499..1c5ae83 100644
--- a/rudel-infinote-document.el
+++ b/rudel-infinote-document.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-document.el --- Infinote document class -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, document
@@ -58,7 +58,7 @@
"Add USER to THIS document.
The :session-user slot of user is set to the session user. The
session user is looked up and created if necessary."
- (with-slots ((name :object-name) color) user
+ (with-slots ((name object-name) color) user
;; First, find an existing session user or create a new one.
(let ((session-user
(with-slots (session) this
diff --git a/rudel-infinote-group-directory.el
b/rudel-infinote-group-directory.el
index 799cb28..0d158c0 100644
--- a/rudel-infinote-group-directory.el
+++ b/rudel-infinote-group-directory.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-directory.el --- Infinote directory group -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, group, communication
@@ -202,7 +202,7 @@ explored.")
(cl-defmethod rudel-enter
((this rudel-infinote-directory-state-subscribing) id)
"Send 'subscribe-session' message and store ID in THIS for later."
- (with-slots ((id1 :id)) this
+ (with-slots ((id1 id)) this
(setq id1 id)
(rudel-send this
`(subscribe-session
@@ -212,10 +212,11 @@ explored.")
(cl-defmethod rudel-infinote/subscribe-session
((this rudel-infinote-directory-state-subscribing) xml)
""
- (with-slots ((id1 :id)) this
+ (with-slots ((id1 id)) this
(with-tag-attrs ((name group)
method
- (id id number)) xml ;; optional seq
+ (id id number))
+ xml ;; optional seq
;; Check received id against stored id.
(unless (= id1 id)
diff --git a/rudel-infinote-group-document.el b/rudel-infinote-group-document.el
index 4a749ea..6a945f0 100644
--- a/rudel-infinote-group-document.el
+++ b/rudel-infinote-group-document.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-document.el --- Infinote document group -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, group, communication
@@ -70,7 +70,8 @@
status
;; (caret caret number)
;; (selection selection number)
- (hue hue number)) xml
+ (hue hue number))
+ xml
(if (rudel-find-user this id #'= #'rudel-id)
;; If the user is already subscribed to the document,
;; display a warning and ignore the request.
@@ -103,7 +104,8 @@
status
;; (caret caret number)
;; (selection selection number)
- (hue hue number)) xml
+ (hue hue number))
+ xml
(let ((user (rudel-find-user this id #'= #'rudel-id)))
(if (not user)
;; We did not find the user, display a warning and give up.
@@ -339,10 +341,11 @@ expect a 'user-join' or 'user-rejoin' message in
response.")
(cl-defmethod rudel-enter
((this rudel-infinote-group-document-state-joining))
""
- (let ((self (rudel-self (oref this :session))))
- (with-slots ((name :object-name)
+ (let ((self (rudel-self (slot-value this 'session))))
+ (with-slots ((name object-name)
color
- status) self
+ status)
+ self
(let ((hue (car (apply #'rudel-rgb->hsv
(color-values color)))))
(rudel-send this
@@ -363,11 +366,12 @@ expect a 'user-join' or 'user-rejoin' message in
response.")
status
;; (caret caret number)
;; (selection selection number)
- (hue hue number)) xml
+ (hue hue number))
+ xml
;; In the joining state, the join message has to refer to our own
;; user. Therefore, we obtain the self user object from the
;; session, update its slots and add it to the document.
- (let ((self (rudel-self (oref this :session))))
+ (let ((self (rudel-self (slot-value this 'session))))
;; When we did not find the self user display a warning.
(when (not self)
(display-warning
@@ -447,8 +451,8 @@ expect a 'user-join' or 'user-rejoin' message in response.")
:type rudel-infinote-document-child
:documentation
"")
- (impersonation-target-slot :initform document)
- (delegation-target-slot :initform document))
+ (impersonation-target-slot :initform 'document)
+ (delegation-target-slot :initform 'document))
"")
(cl-defmethod initialize-instance ((this rudel-infinote-group-document)
diff --git a/rudel-infinote-group-text-document.el
b/rudel-infinote-group-text-document.el
index 3db0650..3e82ca5 100644
--- a/rudel-infinote-group-text-document.el
+++ b/rudel-infinote-group-text-document.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-text-document.el --- Communication group used by text
documents -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, communication, group, text, document
@@ -57,11 +57,11 @@
user xml)
""
(with-tag-attrs ((position pos number)
- (text text)) xml
+ (text text))
+ xml
(rudel-remote-operation
this user
(rudel-insert-op
- "insert"
:position position
:data (or text "\n")))) ;; TODO is this correct?
nil)
@@ -71,12 +71,12 @@
user xml)
""
(with-tag-attrs ((position pos number)
- (text text)) xml
+ (text text))
+ xml
;; Perform the insert operation
(rudel-remote-operation
this user
(rudel-insert-op
- "insert"
:from position
:data (or text "\n")))
@@ -84,7 +84,6 @@
(rudel-remote-operation
this user
(rudel-move-cursor-op
- "move-cursor"
:from position)))
nil)
@@ -93,11 +92,11 @@
user xml)
""
(with-tag-attrs ((position pos number)
- (length len number)) xml
+ (length len number))
+ xml
(rudel-remote-operation
this user
(rudel-delete-op
- "delete"
:from position
:length length)))
nil)
@@ -107,12 +106,12 @@
user xml)
""
(with-tag-attrs ((position pos number)
- (length len number)) xml
+ (length len number))
+ xml
;; Perform the delete operation
(rudel-remote-operation
this user
(rudel-delete-op
- "delete"
:from position
:length length))
@@ -120,7 +119,6 @@
(rudel-remote-operation
this user
(rudel-move-cursor-op
- "move-cursor"
:from position)))
nil)
@@ -135,19 +133,18 @@
user xml)
""
(with-tag-attrs ((position caret number)
- (length selection number)) xml
+ (length selection number))
+ xml
;; Perform the cursor movement operation
(rudel-remote-operation
this user
(rudel-move-cursor-op
- "move-cursor"
:from position))
;; Perform the selection movement operation
(rudel-remote-operation
this user
(rudel-move-selection-op
- "move-selection"
:from position
:length length)))
nil)
@@ -186,7 +183,8 @@
""
(with-slots (remaining-items document) this
(with-tag-attrs ((author-id author number)
- (text text)) xml
+ (text text))
+ xml
(let ((author (rudel-find-user
document author-id #'= #'rudel-id)))
(if (not author)
@@ -200,7 +198,6 @@
(rudel-remote-operation
this author
(rudel-insert-op
- "insert-sync-segment"
:from nil
:data (or text "\n")))))
diff --git a/rudel-infinote-group.el b/rudel-infinote-group.el
index b59fee4..7a1099d 100644
--- a/rudel-infinote-group.el
+++ b/rudel-infinote-group.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group.el --- Common aspects of infinote communication
groups -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, group, communication
@@ -59,7 +59,27 @@
(require 'rudel-state-machine)
(require 'rudel-infinote-state)
-
+;;; Miscellaneous functions
+;;
+
+(defmacro rudel-infinote-embed-in-group (group &rest forms) ;; TODO bad name
+ "Construct a message out of FORMS by adding data from GROUP.
+The returned message consists of an outer <group> element with
+GROUP's properties in its attributes and FORMS as children."
+ (declare (indent 1)
+ (debug (form &rest form)))
+ (let ((group-var (make-symbol "group"))
+ (name (make-symbol "name"))
+ (publisher (make-symbol "publisher")))
+ `(let* ((,group-var ,group)
+ (,name (object-name-string ,group-var))
+ (,publisher (slot-value ,group-var 'publisher)))
+ `(group
+ ((name . ,,name)
+ (publisher . ,,publisher))
+ ,,@forms)))
+ )
+
;;; Class rudel-infinote-group-state
;;
@@ -86,7 +106,8 @@
;; <request-failed><text>Bla</text></request-failed>
(with-tag-attrs (domain
(code code number)
- (sequence-number seq number)) xml
+ (sequence-number seq number))
+ xml
(display-warning
'(rudel infinote)
(format "request failed; sequence number: `%s', \
@@ -201,7 +222,7 @@ If NO-SEQUENCE-NUMBER is non-nil, do not add a sequence
number
and do not increment the sequence number counter."
(if no-sequence-number
(cl-call-next-method this data)
- (with-slots ((seq-num :next-sequence-number)) this
+ (with-slots ((seq-num next-sequence-number)) this
(let ((data (xml-node-name data))
(attributes (xml-node-attributes data))
(children (xml-node-children data)))
@@ -217,26 +238,5 @@ and do not increment the sequence number counter."
)
-;;; Miscellaneous functions
-;;
-
-(defmacro rudel-infinote-embed-in-group (group &rest forms) ;; TODO bad name
- "Construct a message out of FORMS by adding data from GROUP.
-The returned message consists of an outer <group> element with
-GROUP's properties in its attributes and FORMS as children."
- (declare (indent 1)
- (debug (form &rest form)))
- (let ((group-var (make-symbol "group"))
- (name (make-symbol "name"))
- (publisher (make-symbol "publisher")))
- `(let* ((,group-var ,group)
- (,name (object-name-string ,group-var))
- (,publisher (oref ,group-var :publisher)))
- `(group
- ((name . ,,name)
- (publisher . ,,publisher))
- ,,@forms)))
- )
-
(provide 'rudel-infinote-group)
;;; rudel-infinote-group.el ends here
diff --git a/rudel-infinote-node-directory.el b/rudel-infinote-node-directory.el
index dfddf44..a7f709b 100644
--- a/rudel-infinote-node-directory.el
+++ b/rudel-infinote-node-directory.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-node-directory.el --- Infinote directory node class -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, document, directory
@@ -58,19 +58,19 @@ Infinote tree.")
(with-slots (child-cache) this
(push document child-cache))) ;; TODO object-add-to-list or add-to-list?
+(eieio-declare-slots children)
+
(cl-defmethod slot-missing ((this rudel-infinote-node-directory)
slot-name operation &optional _new-value) ;; TODO why
not use slot-unbound?
- "Simulate slot :children. The value of the slot is fetched as
-necessary."
+ "Simulate slot `children'. The value of the slot is fetched as necessary."
(cond
;; Slot :children
- ((and (or (eq slot-name :children)
- (eq slot-name 'children))
+ ((and (eq slot-name 'children)
(eq operation 'oref))
;; Retrieve children when the slot is accessed for the first time.
- (unless (slot-boundp this :child-cache)
+ (unless (slot-boundp this 'child-cache)
;; Bind slot
- (oset this :child-cache nil)
+ (setf (slot-value this 'child-cache) nil)
;; Make group fetch children
(with-slots (id group) this
@@ -86,7 +86,7 @@ necessary."
(rudel-state-wait group '(idle) nil)))
;; Return children
- (oref this :child-cache))
+ (slot-value this 'child-cache))
;; Call next method
(t
diff --git a/rudel-infinote-user.el b/rudel-infinote-user.el
index 7a5e027..f93ae58 100644
--- a/rudel-infinote-user.el
+++ b/rudel-infinote-user.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-user.el --- Infinote user class -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, infinote, user
@@ -58,8 +58,8 @@ sessions.")
:type rudel-infinote-user-child
:documentation
"")
- (impersonation-target-slot :initform session-user)
- (delegation-target-slot :initform session-user)
+ (impersonation-target-slot :initform 'session-user)
+ (delegation-target-slot :initform 'session-user)
(id :initarg :id
:type integer
:reader rudel-id
diff --git a/rudel-interactive.el b/rudel-interactive.el
index 15cb809..72737fd 100644
--- a/rudel-interactive.el
+++ b/rudel-interactive.el
@@ -1,6 +1,6 @@
;;; rudel-interactive.el --- User interaction functions for Rudel. -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2008-2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, user, interface, interaction
@@ -39,7 +39,7 @@
;;; Code:
;;
(require 'rudel-backend) ;; for `rudel-backend-cons-p'
-
+(eieio-declare-slots users documents) ;FIXME: (require 'rudel) creates a cycle!
;;; Function for reading Rudel objects from the user.
;;
@@ -135,7 +135,7 @@ the name as string."
;; Construct a list of user name, read a name with completion and
;; return a user name of object.
- (let* ((user-names (mapcar 'object-name-string users))
+ (let* ((user-names (mapcar #'object-name-string users))
(user-name (completing-read prompt user-names nil t)))
(cond
((eq return 'object)
diff --git a/rudel-obby-client.el b/rudel-obby-client.el
index 0049740..ec08c07 100644
--- a/rudel-obby-client.el
+++ b/rudel-obby-client.el
@@ -1,6 +1,6 @@
;;; rudel-obby-client.el --- Client functions of the Rudel obby backend -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2008-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, obby, backend, client
@@ -54,6 +54,7 @@
(require 'rudel-obby-errors)
(require 'rudel-obby-util)
(require 'rudel-obby-state)
+(require 'rudel-obby)
;;; Class rudel-obby-client-state-new
@@ -100,22 +101,24 @@
"Second state of the encryption handshake."
:method-invocation-order :c3)
+(eieio-declare-slots transport info contexts) ;FIXME: Move defclass before use!
+
(cl-defmethod rudel-obby/net6_encryption_begin
((this rudel-obby-client-state-encryption-start))
"Handle net6 'encryption_begin' message."
;; Start TLS encryption for the connection.
- (let* ((connection (oref this :connection))
- (info (oref connection :info))
- (transport (oref connection :transport))
- (root-transport (oref transport :root-transport)))
+ (let* ((connection (slot-value this 'connection))
+ (info (slot-value connection 'info))
+ (transport (slot-value connection 'transport))
+ (root-transport (slot-value transport 'root-transport)))
(when (plist-get info :encryption)
- (if (rudel-start-tls-transport-child-p root-transport)
+ (if (cl-typep root-transport 'rudel-start-tls-transport)
(progn
(rudel-enable-encryption root-transport)
(sit-for 1))
(warn "An encrypted connection has been requested, but
-the selected transport `%s' does not support encryption"
- (object-class root-transport)))))
+the selected transport does not support encryption: %s"
+ (cl-prin1-to-string root-transport)))))
;; The connection is now established
'waiting-for-join-info)
@@ -181,7 +184,7 @@ session."
(list 'session-synching count)))
(cl-defmethod rudel-obby/net6_login_failed
- ((_this rudel-obby-client-state-joining) reason)
+ ((this rudel-obby-client-state-joining) reason)
"Handle net6 'login_failed' message."
(with-parsed-arguments ((reason number))
(with-slots (connection) this
@@ -330,7 +333,7 @@ failure."))
(with-slots (session) connection
(let ((user (rudel-find-user session user-id
#'= #'rudel-id)))
- (with-slots ((name :object-name) (color1 :color)) user
+ (with-slots ((name object-name) (color1 color)) user
;; Set color in user object.
(setq color1 color)
@@ -375,7 +378,7 @@ failure."))
(if document
(progn
(rudel-remove-document session document)
- (with-slots ((name :object-name)) document
+ (with-slots ((name object-name)) document
(message "Document removed: %s" name)))
(display-warning
'(rudel obby)
@@ -526,7 +529,7 @@ failure."))
sender text)
"Handle obby 'message' message"
(with-parsed-arguments ((sender number))
- (with-slots (session) (oref this :connection)
+ (with-slots (session) (slot-value this 'connection)
(let ((sender (rudel-find-user session sender #'eq #'rudel-id)))
(rudel-chat-dispatch-message sender text))))
nil)
@@ -650,12 +653,6 @@ a 'self' user object."))
'idle
'we-finalized)))
-(cl-defmethod object-print ((this rudel-obby-client-state-session-synching)
- &rest _strings)
- "Append number of remaining items to string representation."
- (with-slots (remaining-items) this
- (cl-call-next-method this (format " remaining: %d" remaining-items))))
-
;;; Class rudel-obby-client-state-subscribing
;;
@@ -674,10 +671,10 @@ a 'self' user object."))
(cl-defmethod rudel-enter ((this rudel-obby-client-state-subscribing)
user document)
"When entering this state, send a subscription request to the server."
- (with-slots ((document1 :document)) this
+ (with-slots ((document1 document)) this
(setq document1 document)
- (with-slots ((doc-id :id) owner-id) document1
+ (with-slots ((doc-id id) owner-id) document1
(with-slots (user-id) user
(rudel-send this "obby_document"
(format "%x %x" owner-id doc-id)
@@ -738,8 +735,7 @@ a 'self' user object."))
(let ((user (unless (zerop user-id)
(rudel-find-user session user-id
#'= #'rudel-id)))
- (operation (rudel-insert-op "bulk-insert"
- :from nil
+ (operation (rudel-insert-op :from nil
:data data)))
(rudel-remote-operation document user operation)))
@@ -750,12 +746,6 @@ a 'self' user object."))
nil)))
)
-(cl-defmethod object-print ((this rudel-obby-client-state-document-synching)
- &rest _strings)
- "Append number of remaining items to string representation."
- (with-slots (remaining-bytes) this
- (cl-call-next-method this (format " remaining: %d" remaining-bytes))))
-
;;; Class rudel-obby-client-state-we-finalized
;;
@@ -775,7 +765,7 @@ a 'self' user object."))
(with-slots (reason) this
(setq reason reason1))
- (with-slots (transport) (oref this :connection)
+ (with-slots (transport) (slot-value this 'connection)
(rudel-close transport))
'disconnected)
@@ -799,7 +789,7 @@ a 'self' user object."))
(with-slots (reason) this
(setq reason reason1))
- (with-slots (transport) (oref this :connection)
+ (with-slots (transport) (slot-value this 'connection)
(rudel-close transport))
'disconnected)
@@ -915,8 +905,9 @@ documents."))
(rudel-switch this 'we-finalized)
(rudel-state-wait this '(disconnected) nil)
- (when (cl-next-method-p)
- (cl-call-next-method)))
+ (condition-case nil
+ (cl-call-next-method)
+ (cl-no-next-method nil)))
(cl-defmethod rudel-close ((this rudel-obby-connection))
"Cleanup after THIS has been disconnected."
@@ -930,12 +921,12 @@ documents."))
(cl-defmethod rudel-find-context ((this rudel-obby-connection) document)
"Return the jupiter context associated to DOCUMENT in THIS connection."
(with-slots (contexts) this
- (gethash (oref document :id) contexts)))
+ (gethash (slot-value document 'id) contexts)))
(cl-defmethod rudel-add-context ((this rudel-obby-connection) document)
"Add a jupiter context for DOCUMENT to THIS connection."
(with-slots (contexts) this
- (with-slots ((doc-name :object-name) (doc-id :id)) document
+ (with-slots ((doc-name object-name) (doc-id id)) document
(puthash doc-id
(jupiter-context (format "%s" doc-name))
contexts)))
@@ -944,7 +935,7 @@ documents."))
(cl-defmethod rudel-remove-context ((this rudel-obby-connection) document)
"Remove the jupiter context associated to DOCUMENT from THIS connection."
(with-slots (contexts) this
- (remhash (oref document :id) contexts)))
+ (remhash (slot-value document 'id) contexts)))
(cl-defmethod rudel-change-color- ((this rudel-obby-connection) color)
""
@@ -957,7 +948,7 @@ documents."))
(rudel-add-context this document)
;; Announce the new document to the server.
- (with-slots ((name :object-name) id buffer) document
+ (with-slots ((name object-name) id buffer) document
(rudel-send this "obby_document_create"
(format "%x" id)
name
@@ -969,7 +960,7 @@ documents."))
(cl-defmethod rudel-unpublish ((this rudel-obby-connection) document)
"Remove DOCUMENT from the obby session THIS is connected to."
;; Request removal of DOCUMENT.
- (with-slots ((doc-id :id) owner-id) document
+ (with-slots ((doc-id id) owner-id) document
(rudel-send this "obby_document_remove"
(format "%x %x" owner-id doc-id)))
@@ -1029,8 +1020,8 @@ documents."))
;; Announce the end of our subscription to the server.
(with-slots (session) this
- (with-slots (user-id) (oref session :self)
- (with-slots ((doc-id :id) owner-id) document
+ (with-slots (user-id) (slot-value session 'self)
+ (with-slots ((doc-id id) owner-id) document
(rudel-send this "obby_document"
(format "%x %x" owner-id doc-id)
"unsubscribe"
@@ -1047,7 +1038,7 @@ documents."))
(rudel-local-operation
this
document
- (jupiter-insert "insert" :from position :data data)))
+ (jupiter-insert :from position :data data)))
(cl-defmethod rudel-local-delete ((this rudel-obby-connection)
document position length)
@@ -1055,7 +1046,7 @@ documents."))
(rudel-local-operation
this
document
- (jupiter-delete "delete" :from position :to (+ position length))))
+ (jupiter-delete :from position :to (+ position length))))
(cl-defmethod rudel-local-operation ((this rudel-obby-connection)
document operation)
@@ -1070,7 +1061,7 @@ documents."))
(let ((context (rudel-find-context this document)))
;; Notify the server of the operation.
- (with-slots (owner-id (doc-id :id)) document
+ (with-slots (owner-id (doc-id id)) document
(with-slots (local-revision remote-revision) context
(apply #'rudel-send
this
diff --git a/rudel-obby-display.el b/rudel-obby-display.el
index 9ad18fc..efbfe86 100644
--- a/rudel-obby-display.el
+++ b/rudel-obby-display.el
@@ -1,6 +1,6 @@
;;; rudel-obby-display.el --- Display functions for obby documents and users
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, user interface
@@ -46,8 +46,8 @@
&optional use-images align)
"Return a textual representation of THIS for user interface purposes."
(with-slots (connected color) this
- (let ((encryption (and (slot-boundp this :encryption) ;; TODO this is bad
- (oref this :encryption)))
+ (let ((encryption (and (slot-boundp this 'encryption) ;; TODO this is bad
+ (slot-value this 'encryption)))
(name-string (cl-call-next-method)))
(concat
;; Name bit
diff --git a/rudel-obby-server.el b/rudel-obby-server.el
index 76e6249..9f1ee14 100644
--- a/rudel-obby-server.el
+++ b/rudel-obby-server.el
@@ -1,6 +1,6 @@
;;; rudel-obby-server.el --- Server component of the Rudel obby backend -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, obby, backend, server
@@ -125,15 +125,18 @@ failed encryption negotiation."
"Waiting for client request joining the session."
:method-invocation-order :c3)
+(eieio-declare-slots server clients) ;FIXME: Move defclass before first use!
+
(cl-defmethod rudel-obby/net6_client_login
((this rudel-obby-server-state-before-join) username color
&optional _global-password _user-password)
"Handle net6 'client_login' message."
(with-parsed-arguments ((color color))
(with-slots (server
- (client-id :id)
+ (client-id id)
user
- encryption) (oref this :connection)
+ encryption)
+ (slot-value this 'connection)
;; Make sure USERNAME and COLOR are valid.
(let ((error (rudel-check-username-and-color
server username color)))
@@ -155,8 +158,8 @@ failed encryption negotiation."
;; Broadcast the join event to all clients (including the
;; new one).
- (with-slots ((name :object-name) color (user-id :user-id)) user
- (rudel-broadcast this (list 'exclude (oref this :connection))
+ (with-slots ((name object-name) color (user-id user-id)) user
+ (rudel-broadcast this (list 'exclude (slot-value this 'connection))
"net6_client_join"
(format "%x" client-id)
name
@@ -179,11 +182,12 @@ failed encryption negotiation."
;; Transmit list of connected users.
(dolist (client clients)
- (with-slots ((client-id :id) user) client
+ (with-slots ((client-id id) user) client
(when user
- (with-slots ((name :object-name)
+ (with-slots ((name object-name)
color
- (user-id :user-id)) user
+ (user-id user-id))
+ user
(rudel-send this
"net6_client_join"
(format "%x" client-id)
@@ -195,7 +199,7 @@ failed encryption negotiation."
;; Transmit list of disconnected users.
(let ((offline-users (cl-remove-if #'rudel-connected users)))
(dolist (user offline-users)
- (with-slots ((name :object-name) user-id color) user
+ (with-slots ((name object-name) user-id color) user
(rudel-send this
"obby_sync_usertable_user"
(format "%x" user-id)
@@ -204,11 +208,12 @@ failed encryption negotiation."
;; Transmit document list
(dolist (document documents)
- (with-slots ((name :object-name)
- (doc-id :id)
+ (with-slots ((name object-name)
+ (doc-id id)
owner-id
suffix
- subscribed) document
+ subscribed)
+ document
(apply #'rudel-send
this
"obby_sync_doclist_document"
@@ -250,15 +255,15 @@ the idle state."
This method is called when the connected user requests a change
of her color to COLOR."
(with-parsed-arguments ((color- color))
- (with-slots (user) (oref this :connection)
- (with-slots (color (user-id :user-id)) user
+ (with-slots (user) (slot-value this 'connection)
+ (with-slots (color user-id) user
;; Set color slot value and notify the user object.
(setq color color-)
(rudel-change-notify user)
;; Broadcast to other clients.
- (rudel-broadcast this (list 'exclude (oref this :connection))
+ (rudel-broadcast this (list 'exclude (slot-value this 'connection))
"obby_user_colour"
(format "%x" user-id)
(rudel-obby-format-color color)))))
@@ -270,8 +275,8 @@ of her color to COLOR."
"Handle obby 'document_create' message."
(with-parsed-arguments ((doc-id number)
(encoding coding-system))
- (with-slots (user server) (oref this :connection)
- (with-slots ((user-id :user-id)) user
+ (with-slots (user server) (slot-value this 'connection)
+ (with-slots (user-id) user
;; Create a (hidden) buffer for the new document.
(let* ((buffer (get-buffer-create
(generate-new-buffer-name
@@ -313,7 +318,7 @@ of her color to COLOR."
(format "%x" suffix)))
;; Notify other clients of the new document
- (rudel-broadcast this (list 'exclude (oref this :connection))
+ (rudel-broadcast this (list 'exclude (slot-value this 'connection))
"obby_document_create"
(format "%x" user-id)
(format "%x" doc-id)
@@ -322,7 +327,7 @@ of her color to COLOR."
(upcase (symbol-name encoding))))
;; Add a jupiter context for (THIS DOCUMENT).
- (rudel-add-context server (oref this :connection) document))))
+ (rudel-add-context server (slot-value this 'connection) document))))
nil)
)
@@ -330,10 +335,10 @@ of her color to COLOR."
((this rudel-obby-server-state-idle) document user-id)
"Handle 'subscribe' submessage of obby 'document' message."
(with-parsed-arguments ((user-id number))
- (let ((user (with-slots (server) (oref this :connection)
+ (let ((user (with-slots (server) (slot-value this 'connection)
(rudel-find-user server user-id
#'= #'rudel-id))))
- (with-slots (owner-id (doc-id :id) subscribed buffer) document
+ (with-slots (owner-id (doc-id id) subscribed buffer) document
;; Track subscription, handle duplicate subscription requests.
(when (memq user subscribed)
@@ -361,12 +366,12 @@ of her color to COLOR."
string
(format "%x"
(if author
- (oref author :user-id)
+ (slot-value author 'user-id)
0)))))))
;; Notify clients of the new subscription (including our own
;; client, who requested the subscription).
- (with-slots ((user-id :user-id)) user
+ (with-slots (user-id) user
(rudel-broadcast this nil
"obby_document"
(format "%x %x" owner-id doc-id)
@@ -374,8 +379,8 @@ of her color to COLOR."
(format "%x" user-id)))))
;; Add a jupiter context for (THIS document).
- (with-slots (server) (oref this :connection)
- (rudel-add-context server (oref this :connection) document))
+ (with-slots (server) (slot-value this 'connection)
+ (rudel-add-context server (slot-value this 'connection) document))
nil)
)
@@ -383,10 +388,10 @@ of her color to COLOR."
((this rudel-obby-server-state-idle) document user-id)
"Handle 'unsubscribe' submessage of 'obby_document' message."
(with-parsed-arguments ((user-id number))
- (let ((user (with-slots (server) (oref this :connection)
+ (let ((user (with-slots (server) (slot-value this 'connection)
(rudel-find-user server user-id
#'= #'rudel-id))))
- (with-slots (owner-id (doc-id :id) subscribed) document
+ (with-slots (owner-id (doc-id id) subscribed) document
;; Track subscription, handle invalid unsubscribe requests
(unless (memq user subscribed)
@@ -396,7 +401,7 @@ of her color to COLOR."
;; Notify clients of the canceled subscription (including our
;; own client, who requested being unsubscribed).
- (with-slots ((user-id :user-id)) user
+ (with-slots (user-id) user
(rudel-broadcast this nil
"obby_document"
(format "%x %x" owner-id doc-id)
@@ -404,8 +409,8 @@ of her color to COLOR."
(format "%x" user-id))))
;; Remove jupiter context for (THIS DOCUMENT).
- (with-slots (server) (oref this :connection)
- (rudel-remove-context server (oref this :connection) document)))
+ (with-slots (server) (slot-value this 'connection)
+ (rudel-remove-context server (slot-value this 'connection) document)))
nil)
)
@@ -429,7 +434,7 @@ of her color to COLOR."
(with-parsed-arguments ((position number))
;; Construct the operation object and process it.
(rudel-remote-operation
- (oref this :connection) document
+ (slot-value this 'connection) document
remote-revision local-revision
(jupiter-insert
(format "insert-%d-%d"
@@ -447,7 +452,7 @@ of her color to COLOR."
(length number))
;; Construct the operation object and process it.
(rudel-remote-operation
- (oref this :connection) document
+ (slot-value this 'connection) document
remote-revision local-revision
(jupiter-delete
(format "delete-%d-%d"
@@ -582,7 +587,7 @@ handled by the server.")
;; TRANSFORMED before the byte -> char conversion which is what
;; the receivers expect.
(with-slots (user-id) user
- (with-slots (owner-id (doc-id :id)) document
+ (with-slots (owner-id (doc-id id)) document
;; Construct and send messages to all receivers individually
;; since the contents of the messages depends on the state
;; of the jupiter context associated the respective
@@ -619,7 +624,7 @@ handled by the server.")
(cl-defmethod rudel-subscribed-clients-not-self ((this rudel-obby-client)
document)
"Return a list of clients subscribed to DOCUMENT excluding THIS."
- (with-slots (clients) (oref this :server)
+ (with-slots (clients) (slot-value this 'server)
(with-slots (subscribed) document
(cl-remove-if
(lambda (client)
@@ -696,11 +701,11 @@ such objects derived from rudel-obby-client."
(cond
;; If RECEIVERS is nil, the message should be broadcast to
;; all clients.
- ((null receivers) (oref this :clients))
+ ((null receivers) (slot-value this 'clients))
;; If RECEIVERS is a (non-empty) list of rudel-obby-client
;; (or derived) objects, treat it as a list of receivers.
((and (listp receivers)
- (rudel-obby-client-child-p (car receivers)))
+ (cl-typep (car receivers) 'rudel-obby-client))
receivers)
;; If RECEIVERS is a (non-empty) list with cdr equal to
;; 'exclude treat it as a list of receivers to exclude.
@@ -711,7 +716,7 @@ such objects derived from rudel-obby-client."
:key #'rudel-id)))
;; If RECEIVERS is a single rudel-obby-client (or derived)
;; object, send the message to that client.
- ((rudel-obby-client-child-p receivers)
+ ((cl-typep receivers 'rudel-obby-client)
(list receivers))
;;
(t (signal 'wrong-type-argument (type-of receivers))))))
@@ -780,7 +785,7 @@ user. COLOR has to be sufficiently different from used
colors."
(cl-defmethod rudel-remove-client ((this rudel-obby-server)
client)
""
- (with-slots ((client-id :id) user) client
+ (with-slots ((client-id id) user) client
;; Broadcast the part event to all remaining clients.
(rudel-broadcast this (list 'exclude client)
"net6_client_part"
@@ -807,8 +812,8 @@ user. COLOR has to be sufficiently different from used
colors."
(cl-defmethod rudel-add-context ((this rudel-obby-server) client document)
"Add a jupiter context for (CLIENT DOCUMENT) to THIS."
(with-slots (contexts) this
- (with-slots ((client-id :id)) client
- (with-slots ((doc-name :object-name)) document
+ (with-slots ((client-id id)) client
+ (with-slots ((doc-name object-name)) document
(puthash
(rudel-obby-context-key client document)
(jupiter-context (format "%d-%s" client-id doc-name))
@@ -824,19 +829,9 @@ user. COLOR has to be sufficiently different from used
colors."
(defun rudel-obby-context-key (client document)
"Generate hash key based on CLIENT and DOCUMENT."
- (with-slots ((client-id :id)) client
- (with-slots ((doc-id :id)) document
+ (with-slots ((client-id id)) client
+ (with-slots ((doc-id id)) document
(list client-id doc-id))))
-(cl-defmethod object-print ((this rudel-obby-server) &rest strings)
- "Print THIS with number of clients."
- (with-slots (clients) this
- (apply #'cl-call-next-method
- this
- (format " clients: %d"
- (length clients))
- strings))
- )
-
(provide 'rudel-obby-server)
;;; rudel-obby-server.el ends here
diff --git a/rudel-obby-state.el b/rudel-obby-state.el
index 25ebfbc..d0d4bbc 100644
--- a/rudel-obby-state.el
+++ b/rudel-obby-state.el
@@ -1,6 +1,6 @@
;;; rudel-obby-state.el --- Base class for states used in the obby backend
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, obby, state machine
@@ -143,8 +143,8 @@ obby 'document' messages."
;; warn.
(with-parsed-arguments ((doc-id document-id))
;; Locate the document based on owner id and document id.
- (let* ((container (slot-value (oref this :connection)
- (oref this document-container-slot)))
+ (let* ((container (slot-value (slot-value this 'connection)
+ (slot-value this 'document-container-slot)))
(document (rudel-find-document container doc-id
#'equal #'rudel-both-ids)))
(if document
diff --git a/rudel-obby.el b/rudel-obby.el
index 69c3c69..d132e48 100644
--- a/rudel-obby.el
+++ b/rudel-obby.el
@@ -1,6 +1,6 @@
;;; rudel-obby.el --- An obby backend for Rudel -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2008-2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, obby, backend, implementation
@@ -122,6 +122,10 @@ connections and creates obby servers.")
info))
)
+;; FIXME: Cyclic dependency with rudel-obby-client.
+(eieio-declare-slots error-symbol error-data reason)
+(eieio-declare-slots user-id) ;FIXME: Move defclass before first use!
+
(cl-defmethod rudel-connect ((this rudel-obby-backend) transport
info info-callback
&optional progress-callback)
@@ -257,7 +261,7 @@ Return the created server."
Return the new document."
;; Find an unused document id and create a document with that id.
(let ((id (rudel-available-document-id this session)))
- (with-slots (user-id) (oref session :self)
+ (with-slots (user-id) (slot-value session 'self)
(rudel-obby-document name
:session session
:id id
@@ -270,7 +274,7 @@ Return the new document."
"Return a document id, which is not in use in SESSION."
;; Look through some candidates until an unused id is hit.
(let* ((used-ids (with-slots (documents) session
- (mapcar 'rudel-id documents)))
+ (mapcar #'rudel-id documents)))
(test-ids (number-sequence 0 (length used-ids))))
(car (sort (cl-set-difference test-ids used-ids) #'<)))
)
@@ -306,9 +310,9 @@ otherwise.")
(cl-defmethod eieio-speedbar-description ((this rudel-obby-user))
"Provide a speedbar description for THIS."
- (let ((connected (oref this :connected))
- (encryption (if (slot-boundp this :encryption)
- (oref this :encryption)
+ (let ((connected (slot-value this 'connected))
+ (encryption (if (slot-boundp this 'encryption)
+ (slot-value this 'encryption)
nil)))
(format "User %s (%s, %s)" (object-name-string this)
(if connected "Online" "Offline")
@@ -345,7 +349,7 @@ documents in obby sessions.")
(cl-defmethod rudel-both-ids ((this rudel-obby-document))
"Return a list consisting of document and owner id of THIS document."
- (with-slots ((doc-id :id) owner-id) this
+ (with-slots ((doc-id id) owner-id) this
(list owner-id doc-id)))
(cl-defmethod rudel-unique-name ((this rudel-obby-document))
diff --git a/rudel-operations.el b/rudel-operations.el
index 21df2b5..7dbdff3 100644
--- a/rudel-operations.el
+++ b/rudel-operations.el
@@ -1,6 +1,6 @@
;;; rudel-operations.el --- Rudel domain operations -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016, 2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, operations
@@ -91,13 +91,14 @@ end of buffer"))
""
:abstract t)
+(eieio-declare-slots length to)
+
(cl-defmethod slot-missing ((this rudel-range-operation)
slot-name operation &optional new-value)
- "Simulate slot :length"
+ "Simulate slot `length'"
(cond
- ;; Slot :length
- ((or (eq slot-name :length)
- (eq slot-name 'length))
+ ;; Slot `length'
+ ((eq slot-name 'length)
(with-slots (from to) this
(if (eq operation 'oref)
(- to from)
@@ -125,17 +126,15 @@ end of buffer"))
(cl-defmethod slot-missing ((this rudel-insert-op)
slot-name operation &optional _new-value)
- "Simulate read-only slots :length and :to."
+ "Simulate read-only slots `length' and `to'."
(cond
- ;; Slot :length
- ((and (or (eq slot-name :length)
- (eq slot-name 'length))
+ ;; Slot `length'
+ ((and (eq slot-name 'length)
(eq operation 'oref))
(with-slots (data) this
(length data)))
- ;; Slot :to
- ((and (or (eq slot-name :to)
- (eq slot-name 'to))
+ ;; Slot `to'
+ ((and (eq slot-name 'to)
(eq operation 'oref))
(with-slots (from length) this
(+ from length)))
diff --git a/rudel-operators.el b/rudel-operators.el
index 8e75d57..7c365ef 100644
--- a/rudel-operators.el
+++ b/rudel-operators.el
@@ -1,6 +1,6 @@
;;; rudel-operators.el --- Sets of modification operators for Rudel objects
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, operators
@@ -117,6 +117,8 @@ operations are applied")
"Provides operation methods which affect the overlays of a
buffer.")
+(eieio-declare-slots buffer) ;FIXME: (require 'rudel) creates a cycle!
+
(cl-defmethod rudel-insert ((this rudel-overlay-operators) position data)
"Update the overlays associated to THIS to incorporate an insertion of DATA
at POSITION."
(with-slots (document user) this
diff --git a/rudel-overlay.el b/rudel-overlay.el
index 55299af..99eb03b 100644
--- a/rudel-overlay.el
+++ b/rudel-overlay.el
@@ -1,6 +1,6 @@
;;; rudel-overlay.el --- Overlay functions for Rudel -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2008-2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, overlay
@@ -152,10 +152,12 @@ AUTHOR has to be an object of type rudel-user-child."
(rudel-overlay-author-set-properties overlay author)
overlay))
+(eieio-declare-slots color) ;FIXME: (require 'cl) creates a cycle!
+
(defun rudel-overlay-author-set-properties (overlay author)
"Set properties of OVERLAY according to slots of AUTHOR.
AUTHOR has to be an object of type rudel-user-child."
- (with-slots ((name :object-name) color) author
+ (with-slots ((name object-name) color) author
(overlay-put overlay :rudel 'author)
(overlay-put overlay :user author)
(overlay-put overlay 'face (when rudel-overlay-author-display
diff --git a/rudel-protocol.el b/rudel-protocol.el
index 967df6e..6cd7b8e 100644
--- a/rudel-protocol.el
+++ b/rudel-protocol.el
@@ -1,6 +1,6 @@
;;; rudel-protocol.el --- Interface implemented by Rudel protocol backends
-*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, backend, protocol
@@ -66,13 +66,13 @@ When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
(cl-defgeneric rudel-connect ((this rudel-protocol-backend) transport
- info info-callback
- &optional progress-callback)
+ info info-callback
+ &optional progress-callback)
"Create a new connection through TRANSPORT according to the data in INFO.
TRANSPORT has to be an object of a class derived from `rudel-transport'.
INFO has to be a property list.
INFO-CALLBACK has to be a function of two arguments which will be
-bound to THIS and INFO. When called, INFO-CALLBACK should return
+bound to THIS and INFO. When called, INFO-CALLBACK should return
a modified version of the INFO argument in which no information
is missing.
When non-nil, PROGRESS-CALLBACK has to be a function that may be
diff --git a/rudel-session-initiation.el b/rudel-session-initiation.el
index de2bd68..707bd51 100644
--- a/rudel-session-initiation.el
+++ b/rudel-session-initiation.el
@@ -1,6 +1,6 @@
;;; rudel-session-initiation.el --- Session discovery and advertising
functions -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, session, initiation, service, discovery, advertising
@@ -259,8 +259,8 @@ advertise the session."
;;;###rudel-autoload
(defclass rudel-ask-protocol-backend (rudel-session-initiation-backend)
- ((capabilities :initform (discover))
- (priority :initform fallback))
+ ((capabilities :initform '(discover))
+ (priority :initform 'fallback))
"This fallback backend can \"discover\" sessions by letting the
user select a suitable backend and asking for connect information
required by the chosen backend.")
@@ -306,8 +306,8 @@ required by the chosen backend.")
;;;###rudel-autoload
(defclass rudel-configured-sessions-backend
(rudel-session-initiation-backend)
- ((capabilities :initform (discover))
- (priority :initform primary))
+ ((capabilities :initform '(discover))
+ (priority :initform 'primary))
"This fallback backend can \"discover\" sessions the user has
configured using customization.")
diff --git a/rudel-socket.el b/rudel-socket.el
index 756bea5..08abedf 100644
--- a/rudel-socket.el
+++ b/rudel-socket.el
@@ -1,6 +1,6 @@
;;; rudel-tcp.el --- socket transport backend for Rudel -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, socket, transport, backend
@@ -163,7 +163,7 @@ be a transport object representing the incoming
connection."))
;;;###rudel-autoload
(defclass rudel-tcp-backend (rudel-transport-backend)
- ((capabilities :initform (listen connect)))
+ ((capabilities :initform '(listen connect)))
"TCP transport backend.
The transport backend is a factory for TCP transport objects.")
diff --git a/rudel-speedbar.el b/rudel-speedbar.el
index 39292e0..eb3cfea 100644
--- a/rudel-speedbar.el
+++ b/rudel-speedbar.el
@@ -1,6 +1,6 @@
;;; rudel-speedbar.el --- Speedbar rendering of Rudel objects -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2008, 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, collaboration, speedbar
@@ -37,6 +37,7 @@
(require 'speedbar)
(require 'eieio-speedbar)
+(eieio-declare-slots users documents) ;FIXME: (require 'cl) creates a cycle!
;;; Class rudel-user methods
;;
diff --git a/rudel-state-machine.el b/rudel-state-machine.el
index 3f16282..a24a8f3 100644
--- a/rudel-state-machine.el
+++ b/rudel-state-machine.el
@@ -1,6 +1,6 @@
;;; rudel-state-machine.el --- A simple state machine for Rudel -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, fsm
@@ -152,7 +152,7 @@ that fails as well, the first state in the state list is
used."
(cdr start-arg)))
(start (or ;; First look for :start initarg.
(cond
- ((rudel-state-child-p start-arg)
+ ((cl-typep start-arg 'rudel-state)
start-arg)
((symbolp start-arg)
(rudel-find-state this start-arg))
@@ -212,7 +212,7 @@ just NAME."
(cond
;; If NEXT is nil, a symbol or a state object, we switch states
;; without passing any data.
- ((or (null next) (symbolp next) (rudel-state-child-p next))
+ ((or (null next) (symbolp next) (cl-typep next 'rudel-state))
(rudel-switch this next))
;; If NEXT is a list, it contains the symbol of the successor
@@ -233,7 +233,7 @@ state."
(with-slots (states state) this
(cond
;; When NEXT is a state object, use it.
- ((rudel-state-child-p next))
+ ((cl-typep next 'rudel-state))
;; When NEXT is nil, stay in the current state.
((null next)
@@ -290,18 +290,6 @@ NEXT can nil, a list or a `rudel-state' object."
(rudel-switch this next)))
)
-(cl-defmethod object-print ((this rudel-state-machine) &rest strings)
- "Add current state to the string representation of THIS."
- (if (slot-boundp this 'state)
- (with-slots (state) this
- (apply #'cl-call-next-method
- this
- (format " state: %s"
- (object-name-string state))
- strings))
- (cl-call-next-method this " state: #start" strings))
- )
-
;;; Class rudel-hook-state-machine
;;
diff --git a/rudel-tls.el b/rudel-tls.el
index 6ef9502..f172179 100644
--- a/rudel-tls.el
+++ b/rudel-tls.el
@@ -1,6 +1,6 @@
;;; rudel-tls.el --- Start TLS protocol. -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2008, 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: Rudel, TLS, encryption, starttls, gnutls
@@ -247,7 +247,7 @@ capability.")
;;;###rudel-autoload
(defclass rudel-start-tls-backend (rudel-transport-backend)
- ((capabilities :initform (connect encrypt)))
+ ((capabilities :initform '(connect encrypt)))
"STARTTLS transport backend.
The transport backend is a factory for transport objects that
support STARTTLS behavior.")
@@ -298,7 +298,7 @@ INFO has to be a property list containing the keys :host
and :port."
;; Ensure that INFO contains all necessary information.
(unless (cl-every (lambda (keyword) (member keyword info))
- '(:host :port))
+ '(:host :port))
(setq info (funcall info-callback this info)))
;; Extract information from INFO and create the socket.
diff --git a/rudel-transport-util.el b/rudel-transport-util.el
index 86948f5..f2970e1 100644
--- a/rudel-transport-util.el
+++ b/rudel-transport-util.el
@@ -1,6 +1,6 @@
;;; rudel-transport-util.el --- Utility functions for Rudel transport
functionality -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, backend, transport, utility, miscellaneous
@@ -102,25 +102,25 @@ transform a bidirectional data stream as it passes
through them."
slot-name operation &optional new-value)
"Make slots of underlying transport available as virtual slots of THIS."
(cond
- ((and (or (eq slot-name :root-transport)
- (eq slot-name 'root-transport))
+ ((and (eq slot-name 'root-transport)
(eq operation 'oref))
+ (eieio-declare-slots root-transport) ;FIXME: No such slot in Rudel!
(with-slots (transport) this
- (if (rudel-transport-filter-child-p transport)
- (oref transport :root-transport)
+ (if (cl-typep transport 'rudel-transport-filter)
+ (slot-value transport 'root-transport)
transport)))
((eq operation 'oref)
- (slot-value (oref this :transport) slot-name))
+ (slot-value (slot-value this 'transport) slot-name))
((eq operation 'oset)
- (set-slot-value (oref this :transport) slot-name new-value)))
+ (setf (slot-value (slot-value this 'transport) slot-name) new-value)))
)
(cl-defmethod cl-no-applicable-method (method
(this rudel-transport-filter) &rest
args)
"Make methods of underlying transport callable as virtual methods of THIS."
- (apply method (oref this :transport) (cdr args)))
+ (apply method (slot-value this 'transport) (cdr args)))
;;; Class rudel-assembling-transport-filter
diff --git a/rudel-xmpp.el b/rudel-xmpp.el
index b2d2927..b7e2fe9 100644
--- a/rudel-xmpp.el
+++ b/rudel-xmpp.el
@@ -1,6 +1,6 @@
;;; rudel-xmpp.el --- XMPP transport backend for Rudel -*- lexical-binding:t
-*-
;;
-;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, xmpp, transport, backend
@@ -262,6 +262,8 @@ id=\"%s\">"
negotiation and the negotiation of the actual stream are
complete.")
+(eieio-declare-slots shelve-buffer) ;FIXME: Move defclass before first use!
+
(cl-defmethod rudel-accept ((this rudel-xmpp-state-established) xml)
"Store XML in buffer of THIS for later processing."
(with-slots (shelve-buffer) this
@@ -407,8 +409,9 @@ previously shelved data"
(rudel-state-wait this '(disconnected))
- (when (cl-next-method-p)
- (cl-call-next-method)) ;; TODO does this call rudel-close again?
+ (condition-case nil
+ (cl-call-next-method)
+ (cl-no-next-method nil)) ;; TODO does this call rudel-close again?
)
diff --git a/rudel-zeroconf.el b/rudel-zeroconf.el
index c4c18ef..8a4ed4f 100644
--- a/rudel-zeroconf.el
+++ b/rudel-zeroconf.el
@@ -1,6 +1,6 @@
;;; rudel-zeroconf.el --- Zeroconf support for Rudel -*- lexical-binding:t -*-
;;
-;; Copyright (C) 2008, 2009, 2014, 2016 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, service, discovery, advertising, zeroconf,
@@ -110,8 +110,8 @@ service type TYPE."
;;;###rudel-autoload
(defclass rudel-zeroconf-backend (rudel-session-initiation-backend)
- ((capabilities :initform (discover advertise))
- (priority :initform primary))
+ ((capabilities :initform '(discover advertise))
+ (priority :initform 'primary))
"")
(cl-defmethod initialize-instance ((this rudel-zeroconf-backend) _slots)
diff --git a/rudel.el b/rudel.el
index e902be9..ab65bdd 100644
--- a/rudel.el
+++ b/rudel.el
@@ -1,6 +1,6 @@
;;; rudel.el --- A collaborative editing framework for Emacs -*-
lexical-binding:t -*-
;;
-;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
+;; Copyright (C) 2018-2021 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <scym...@users.sourceforge.net>
;; Keywords: rudel, collaboration
@@ -70,8 +70,7 @@
(require 'rudel-operators)
(require 'rudel-overlay)
(require 'rudel-hooks)
-(require 'rudel-interactive) ;; for `rudel-read-backend',
- ;; `rudel-read-document',
+(require 'rudel-interactive) ;; `rudel-read-document',
;; `rudel-read-session'
(require 'rudel-icons)
@@ -94,7 +93,7 @@ nil if there is no active session.")
(put 'rudel-buffer-document 'permanent-local t)
(defvar rudel-buffer-change-workaround-data nil
- "Buffer-local variable which holds change data that could not be accessed
otherwise.
+ "Change data that could not be accessed otherwise.
It would be nice to find another way to do this.")
(make-variable-buffer-local 'rudel-buffer-change-workaround-data)
(put 'rudel-buffer-change-workaround-data 'permanent-local t)
@@ -123,7 +122,6 @@ It would be nice to find another way to do this.")
The function is called with the document name as the sole
argument and has to return a buffer object which will be attached
to the document in question."
- :group 'rudel
:type '(choice (const :tag "Clear content of existing buffer"
rudel-allocate-buffer-clear-existing)
(const :tag "Create a new uniquely named buffer"
@@ -133,7 +131,6 @@ to the document in question."
(defcustom rudel-default-username (user-login-name)
"*"
- :group 'rudel
:type '(string))
@@ -149,14 +146,12 @@ to the document in question."
:type list
:initform nil
:documentation
- "The list of users participating in this
-session.")
+ "The list of users participating in this session.")
(documents :initarg :documents
:type list
:initform nil
:documentation
- "This list of documents available in
-this session.")
+ "This list of documents available in this session.")
;; Hooks
(end-hook :initarg :end-hook
:type list
@@ -309,6 +304,7 @@ client perspective.")
(cl-remove-if
(lambda (document)
;; FIXME: Move this use of the slot to after the class that defines it.
+ (eieio-declare-slots subscribed)
(with-slots (subscribed) document
(memq self subscribed)))
documents))
@@ -609,13 +605,11 @@ Modification hooks are disabled during the insertion."
;; Update overlays
(rudel-overlay-operators
- "overlay-operators"
:document this
:user user)
;; Notify connection
(rudel-connection-operators
- "connection-operators"
:connection connection
:document this)))
@@ -629,13 +623,11 @@ Modification hooks are disabled during the insertion."
;; Update buffer contents
(list (rudel-document-operators
- "document-operators"
:document this))
;; Update overlays
(when user
(list (rudel-overlay-operators
- "overlay-operators"
:document this
:user user)))))
@@ -740,7 +732,6 @@ See `after-change-functions' for more information."
(setq text (buffer-substring-no-properties from to)))
(rudel-local-operation document
(rudel-insert-op
- "insert"
:from (- from 1)
:data text))))
@@ -749,7 +740,6 @@ See `after-change-functions' for more information."
(not (zerop length)))
(rudel-local-operation document
(rudel-delete-op
- "delete"
:from (- from 1)
:length length)))
@@ -763,12 +753,10 @@ See `after-change-functions' for more information."
(setq text (buffer-substring-no-properties from to)))
(rudel-local-operation document
(rudel-delete-op
- "delete"
:from (- from 1)
:length length))
(rudel-local-operation document
(rudel-insert-op
- "insert"
:from (- from 1)
:data text)))))))
)
