[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/rudel 243d132: Use cl-generic
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/rudel 243d132: Use cl-generic |
|
Date: |
Tue, 12 Jul 2016 05:38:54 +0000 (UTC) |
branch: externals/rudel
commit 243d132ee1a3b6b82b8065aec66faebdbde5f038
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Use cl-generic
---
adopted-compound.el | 4 +-
adopted-delete.el | 2 +-
adopted-insert.el | 2 +-
adopted-nop.el | 4 +-
jupiter-compound.el | 8 +--
jupiter-delete.el | 6 +-
jupiter-insert.el | 6 +-
jupiter-nop.el | 4 +-
jupiter-operation.el | 3 +-
jupiter.el | 8 +--
rudel-backend.el | 23 +++----
rudel-debug.el | 29 ++++----
rudel-display.el | 4 +-
rudel-infinote-client.el | 49 +++++++-------
rudel-infinote-display.el | 4 +-
rudel-infinote-document.el | 6 +-
rudel-infinote-group-directory.el | 33 +++++----
rudel-infinote-group-document.el | 37 +++++------
rudel-infinote-group-text-document.el | 31 +++++----
rudel-infinote-group.el | 17 +++--
rudel-infinote-node-directory.el | 6 +-
rudel-infinote-node.el | 2 +-
rudel-infinote-state.el | 6 +-
rudel-infinote-util.el | 11 +--
rudel-infinote.el | 15 ++---
rudel-loaddefs.el | 13 ++--
rudel-obby-client.el | 118 ++++++++++++++++-----------------
rudel-obby-debug.el | 4 +-
rudel-obby-display.el | 4 +-
rudel-obby-server.el | 70 ++++++++++---------
rudel-obby-state.el | 12 ++--
rudel-obby-util.el | 31 ++++-----
rudel-obby.el | 32 +++++----
rudel-operations.el | 19 +++---
rudel-operators.el | 17 ++---
rudel-protocol.el | 11 +--
rudel-session-initiation.el | 19 +++---
rudel-socket.el | 23 +++----
rudel-speedbar.el | 8 +--
rudel-state-machine.el | 40 +++++------
rudel-telepathy.el | 5 +-
rudel-tls.el | 13 ++--
rudel-transport-util.el | 53 +++++++--------
rudel-transport.el | 21 +++---
rudel-util.el | 36 +++++-----
rudel-wave.el | 5 +-
rudel-xmpp-debug.el | 8 +--
rudel-xmpp-sasl.el | 12 ++--
rudel-xmpp-state.el | 8 +--
rudel-xmpp-tls.el | 2 +-
rudel-xmpp-tunnel.el | 4 +-
rudel-xmpp.el | 49 +++++++-------
rudel-zeroconf.el | 11 ++-
rudel.el | 74 ++++++++++-----------
54 files changed, 511 insertions(+), 531 deletions(-)
diff --git a/adopted-compound.el b/adopted-compound.el
index fe788c5..4514b60 100644
--- a/adopted-compound.el
+++ b/adopted-compound.el
@@ -54,7 +54,7 @@
number of child operation.")
;; TODO this has side effects. It can only be called once
-(defmethod rudel-apply ((this adopted-compound) object)
+(cl-defmethod rudel-apply ((this adopted-compound) object)
"Apply THIS to BUFFER by applying the child operation."
(with-slots (children) this
(let ((child (car children))
@@ -70,7 +70,7 @@ number of child operation.")
(setq child (pop rest)))))
)
-(defmethod adopted-transform ((this adopted-compound) other)
+(cl-defmethod adopted-transform ((this adopted-compound) other)
"Transform OTHER using the child operations of THIS."
(with-slots (children) this
(dolist (child children) ;; TODO reverse children?
diff --git a/adopted-delete.el b/adopted-delete.el
index d904ad2..a0d85b0 100644
--- a/adopted-delete.el
+++ b/adopted-delete.el
@@ -53,7 +53,7 @@
()
"Objects of this class represent deletions in buffers.")
-(defmethod adopted-transform ((this adopted-delete) other)
+(cl-defmethod adopted-transform ((this adopted-delete) other)
"Transform other using THIS.
OTHER is destructively modified or replaced."
(cond
diff --git a/adopted-insert.el b/adopted-insert.el
index 9523224..6c07611 100644
--- a/adopted-insert.el
+++ b/adopted-insert.el
@@ -53,7 +53,7 @@
()
"Objects of this class represent insertions into buffers.")
-(defmethod adopted-transform ((this adopted-insert) other)
+(cl-defmethod adopted-transform ((this adopted-insert) other)
"Transform OTHER using THIS."
(cond
diff --git a/adopted-nop.el b/adopted-nop.el
index 622acf7..4ed432f 100644
--- a/adopted-nop.el
+++ b/adopted-nop.el
@@ -48,10 +48,10 @@
()
"Operation, which does not change anything.")
-(defmethod rudel-apply ((_this adopted-nop) _object)
+(cl-defmethod rudel-apply ((_this adopted-nop) _object)
"Applying THIS does not change OBJECT.")
-(defmethod adopted-transform ((_this adopted-nop) other)
+(cl-defmethod adopted-transform ((_this adopted-nop) other)
"Transforming OTHER with THIS simply returns OTHER."
other)
diff --git a/jupiter-compound.el b/jupiter-compound.el
index a624409..71877c3 100644
--- a/jupiter-compound.el
+++ b/jupiter-compound.el
@@ -54,7 +54,7 @@
number of child operation.")
;; TODO this has side effects. It can only be called once
-(defmethod rudel-apply ((this jupiter-compound) object)
+(cl-defmethod rudel-apply ((this jupiter-compound) object)
"Apply THIS to BUFFER by applying the child operation."
(with-slots (children) this
(let ((child (car children))
@@ -70,17 +70,17 @@ number of child operation.")
(setq child (pop rest)))))
)
-(defmethod jupiter-transform ((this jupiter-compound) other)
+(cl-defmethod jupiter-transform ((this jupiter-compound) other)
"Transform OTHER using the child operations of THIS."
(with-slots (children) this
(dolist (child children) ;; TODO reverse children?
(setq other (jupiter-transform child other)))
other))
-(defmethod object-print ((this jupiter-compound) &rest _strings)
+(cl-defmethod object-print ((this jupiter-compound) &rest _strings)
"Add number of children to string representation of THIS."
(with-slots (children) this
- (call-next-method
+ (cl-call-next-method
this
(format " children %d" (length children)))))
diff --git a/jupiter-delete.el b/jupiter-delete.el
index 1906fe3..aafb8cd 100644
--- a/jupiter-delete.el
+++ b/jupiter-delete.el
@@ -53,7 +53,7 @@
()
"Objects of this class represent deletions in buffers.")
-(defmethod jupiter-transform ((this jupiter-delete) other)
+(cl-defmethod jupiter-transform ((this jupiter-delete) other)
"Transform other using THIS.
OTHER is destructively modified or replaced."
(cond
@@ -165,10 +165,10 @@ OTHER is destructively modified or replaced."
(object-class other))))
other)
-(defmethod object-print ((this jupiter-delete) &rest _strings)
+(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
- (call-next-method
+ (cl-call-next-method
this
(format " from %d" from)
(format " to %d" to)
diff --git a/jupiter-insert.el b/jupiter-insert.el
index 2161621..1e9975d 100644
--- a/jupiter-insert.el
+++ b/jupiter-insert.el
@@ -52,7 +52,7 @@
()
"Objects of this class represent insertions into buffers.")
-(defmethod jupiter-transform ((this jupiter-insert) other)
+(cl-defmethod jupiter-transform ((this jupiter-insert) other)
"Transform OTHER using THIS."
(cond
@@ -152,10 +152,10 @@
(object-class other))))
other)
-(defmethod object-print ((this jupiter-insert) &rest _strings)
+(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
- (call-next-method
+ (cl-call-next-method
this
(format " from %d" from)
(format " to %d" to)
diff --git a/jupiter-nop.el b/jupiter-nop.el
index 7a39225..32fbc5c 100644
--- a/jupiter-nop.el
+++ b/jupiter-nop.el
@@ -48,10 +48,10 @@
()
"Operation, which does not change anything.")
-(defmethod rudel-apply ((_this jupiter-nop) _object)
+(cl-defmethod rudel-apply ((_this jupiter-nop) _object)
"Applying THIS does not change OBJECT.")
-(defmethod jupiter-transform ((_this jupiter-nop) other)
+(cl-defmethod jupiter-transform ((_this jupiter-nop) other)
"Transforming OTHER with THIS simply returns OTHER."
other)
diff --git a/jupiter-operation.el b/jupiter-operation.el
index 7c07614..2f63544 100644
--- a/jupiter-operation.el
+++ b/jupiter-operation.el
@@ -36,6 +36,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'eieio)
(require 'rudel-operations)
@@ -53,7 +54,7 @@ the same operations."
:abstract t)
;; This one really could use multiple dispatch
-(defgeneric jupiter-transform ((this jupiter-operation) other)
+(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.
In general, OTHER is destructively modified or replaced.")
diff --git a/jupiter.el b/jupiter.el
index 8918d12..04a380d 100644
--- a/jupiter.el
+++ b/jupiter.el
@@ -76,13 +76,13 @@ acknowledged by the remote side."))
concurrent modification activity, which is synchronized using the
jupiter algorithm.")
-(defmethod jupiter-local-operation ((this jupiter-context) operation)
+(cl-defmethod jupiter-local-operation ((this jupiter-context) operation)
"Store OPERATION in the operation log of THIS and increase local revision
count."
(with-slots (local-revision local-log) this
(push (cons local-revision operation) local-log)
(cl-incf local-revision)))
-(defmethod jupiter-remote-operation ((this jupiter-context)
+(cl-defmethod jupiter-remote-operation ((this jupiter-context)
local-revision _remote-revision
operation)
"Transform OPERATION with revisions LOCAL-REVISION and REMOTE-REVISION using
the local operations stored in THIS.
@@ -121,10 +121,10 @@ site is referring to."
transformed-operation)
)
-(defmethod object-print ((this jupiter-context) &rest _strings)
+(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
- (call-next-method
+ (cl-call-next-method
this
(format " local %d" local-revision)
(format " remote %d" remote-revision)
diff --git a/rudel-backend.el b/rudel-backend.el
index 17fe1d5..3a42625 100644
--- a/rudel-backend.el
+++ b/rudel-backend.el
@@ -48,6 +48,7 @@
(require 'cl-lib)
+(require 'cl-generic)
(require 'warnings)
(require 'eieio)
@@ -71,7 +72,7 @@ symbol, that each describe one capability of the backend."))
"Base class for backend classes."
:abstract t)
-(defmethod rudel-capable-of-p ((this rudel-backend) capability)
+(cl-defmethod rudel-capable-of-p ((this rudel-backend) capability)
"Return t if the backend THIS is capable of CAPABILITY."
(with-slots (capabilities) this
(member capability capabilities)))
@@ -89,6 +90,7 @@ symbol, that each describe one capability of the backend."))
instantiation) or objects (after instantiation) for all backends
known to the factory object.")
(factories :type hash-table
+ :initform (make-hash-table :test #'eq)
:allocation :class
:documentation
"Mapping of backend categories to responsible
@@ -96,13 +98,10 @@ factory objects."))
"Factory class that holds an object for each known backend
category. Objects manage backend implementation for one backend
category each.")
-(oset-default 'rudel-backend-factory factories
- (make-hash-table :test #'eq))
-(defmethod initialize-instance ((this rudel-backend-factory) &rest _slots)
+(cl-defmethod initialize-instance ((this rudel-backend-factory) &rest _slots)
"Initialize slots of THIS with SLOTS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this backends (make-hash-table :test #'eq)))
;;;###rudel-autoload
@@ -117,7 +116,7 @@ category each.")
,val))))))
;;;###rudel-autoload
-(defmethod rudel-get-factory :static ((this rudel-backend-factory)
+(cl-defmethod rudel-get-factory ((this (subclass rudel-backend-factory))
category)
"Return the factory responsible for CATEGORY.
If there is no responsible factory, create one and return it."
@@ -126,7 +125,7 @@ If there is no responsible factory, create one and return
it."
(make-instance 'rudel-backend-factory))) ;; category
;;;###rudel-autoload
-(defmethod rudel-add-backend ((this rudel-backend-factory)
+(cl-defmethod rudel-add-backend ((this rudel-backend-factory)
name class &optional replace)
"Add factory class CLASS with name NAME to THIS.
if REPLACE is non-nil, replace a registered implementation of the
@@ -136,7 +135,7 @@ same name."
replace)
(puthash name class backends))))
-(defmethod rudel-get-backend ((this rudel-backend-factory) name)
+(cl-defmethod rudel-get-backend ((this rudel-backend-factory) name)
"Return backend object for name NAME or nil if there is none.
The returned backend is of the form (NAME . OBJECT).
@@ -151,7 +150,7 @@ Backends are loaded, if necessary."
(cons name backend))))
)
-(defmethod rudel-all-backends ((this rudel-backend-factory)
+(cl-defmethod rudel-all-backends ((this rudel-backend-factory)
&optional only-loaded)
"Return a list of all backends registered with THIS.
Each list element is of the form (NAME . CLASS-OR-OBJECT).
@@ -167,7 +166,7 @@ for which CLASS-OR-OBJECT is an object."
backend-list)
)
-(defmethod rudel-suitable-backends ((this rudel-backend-factory) predicate)
+(cl-defmethod rudel-suitable-backends ((this rudel-backend-factory) predicate)
"Return a list of backends which satisfy PREDICATE.
Each list element is of the form (NAME . OBJECT).
Backends are loaded, if necessary."
@@ -184,7 +183,7 @@ Backends are loaded, if necessary."
(rudel-all-backends this t))
)
-(defmethod rudel-load-backends ((this rudel-backend-factory))
+(cl-defmethod rudel-load-backends ((this rudel-backend-factory))
"Load backends in THIS factory if necessary.
Loading errors are not reported explicitly, but can be detected
by checking for backends that still are classes rather than
diff --git a/rudel-debug.el b/rudel-debug.el
index 586abe1..396bfaa 100644
--- a/rudel-debug.el
+++ b/rudel-debug.el
@@ -39,6 +39,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'eieio)
(require 'data-debug)
(require 'eieio-datadebug)
@@ -179,10 +180,10 @@
;;; Utility functions
;;
-(defgeneric rudel-debug-target (object)
+(cl-defgeneric rudel-debug-target (object)
"Return debug stream name for OBJECT.")
-(defmethod rudel-debug-target ((this eieio-default-superclass))
+(cl-defmethod rudel-debug-target ((this eieio-default-superclass))
"Default implementation simply uses the object name of THIS."
(object-name-string this))
@@ -239,7 +240,7 @@ TAG and LABEL determine the logging style."
(defvar rudel-debug-old-state nil
"Saves state of state machines across one function call.")
-(defmethod rudel-switch :before
+(cl-defmethod rudel-switch :before
((this rudel-state-machine) _state &rest _)
"Store name of STATE for later printing."
(with-slots (state) this
@@ -247,7 +248,7 @@ TAG and LABEL determine the logging style."
(if state (object-name-string state) "#start")))
)
-(defmethod rudel-switch :after
+(cl-defmethod rudel-switch :after
((this rudel-state-machine) _state &rest arguments)
"Log STATE and ARGUMENTS to debug stream."
(with-slots (state) this
@@ -267,7 +268,7 @@ TAG and LABEL determine the logging style."
;;; Debugging functions for `rudel-transport-filter'
;;
-(defmethod rudel-debug-target ((this rudel-transport-filter))
+(cl-defmethod rudel-debug-target ((this rudel-transport-filter))
"Find target of filter THIS by looking at underlying transport."
(with-slots (transport) this
(rudel-debug-target transport)))
@@ -276,7 +277,7 @@ TAG and LABEL determine the logging style."
;;; Debugging functions for `rudel-assembling-transport-filter'
;;
-(defmethod rudel-set-assembly-function :before
+(cl-defmethod rudel-set-assembly-function :before
((this rudel-assembling-transport-filter) function)
"Log change of assembly function to FUNCTION."
(with-slots (socket assembly-function) this
@@ -289,7 +290,7 @@ TAG and LABEL determine the logging style."
(symbol-name function))))
)
-(defmethod rudel-set-filter ((this rudel-assembling-transport-filter)
+(cl-defmethod rudel-set-filter ((this rudel-assembling-transport-filter)
filter1)
"Log DATA as it goes through THIS."
(with-slots (filter) this
@@ -301,7 +302,7 @@ TAG and LABEL determine the logging style."
data)
(funcall filter1 data)))))
-(defmethod rudel-send :before
+(cl-defmethod rudel-send :before
((this rudel-assembling-transport-filter) data)
"Log DATA as it goes through THIS."
(rudel-debug-write this :sent "RAW" data nil))
@@ -310,7 +311,7 @@ TAG and LABEL determine the logging style."
;;; Debugging function `rudel-parsing-transport-filter'
;;
-(defmethod rudel-set-parse-function :before
+(cl-defmethod rudel-set-parse-function :before
((this rudel-parsing-transport-filter) function)
"Log parse function change to FUNCTION."
(with-slots (parse-function) this
@@ -323,7 +324,7 @@ TAG and LABEL determine the logging style."
(symbol-name function))))
)
-(defmethod rudel-set-generate-function :before
+(cl-defmethod rudel-set-generate-function :before
((this rudel-parsing-transport-filter) function)
"Log generate function change to FUNCTION."
(with-slots (generate-function) this
@@ -336,7 +337,7 @@ TAG and LABEL determine the logging style."
(symbol-name function))))
)
-(defmethod rudel-set-filter ((this rudel-parsing-transport-filter)
+(cl-defmethod rudel-set-filter ((this rudel-parsing-transport-filter)
filter1)
"Log DATA as it goes through THIS."
(with-slots (filter) this
@@ -348,7 +349,7 @@ TAG and LABEL determine the logging style."
(format "%s" data) data)
(funcall filter1 data)))))
-(defmethod rudel-send :before
+(cl-defmethod rudel-send :before
((this rudel-parsing-transport-filter) string-or-data)
"Log STRING-OR-DATA as it goes through THIS."
(let ((formatted (cond
@@ -372,7 +373,7 @@ TAG and LABEL determine the logging style."
;;; Socket transport debugging
;;
-(defmethod rudel-set-filter ((this rudel-socket-transport)
+(cl-defmethod rudel-set-filter ((this rudel-socket-transport)
filter)
"Log DATA as it goes through THIS."
(oset
@@ -381,7 +382,7 @@ TAG and LABEL determine the logging style."
(rudel-debug-write this :received "SOCKET" data)
(funcall filter data))))
-(defmethod rudel-send :before ((this rudel-socket-transport)
+(cl-defmethod rudel-send :before ((this rudel-socket-transport)
data)
"Log DATA verbatim as it is sent through the socket of THIS."
(rudel-debug-write this :sent "SOCKET" data nil))
diff --git a/rudel-display.el b/rudel-display.el
index 78ead29..39a509a 100644
--- a/rudel-display.el
+++ b/rudel-display.el
@@ -45,7 +45,7 @@
;;; Display functions for basic objects
;;
-(defmethod rudel-display-string ((this rudel-user)
+(cl-defmethod rudel-display-string ((this rudel-user)
&optional use-images _align)
"Return a textual representation of THIS for user interface purposes.
When USE-IMAGES is non-nil, add an icon that indicates a user to
@@ -62,7 +62,7 @@ a width equal to that number."
'face (list :background color)))
)
-(defmethod rudel-display-string ((this rudel-document)
+(cl-defmethod rudel-display-string ((this rudel-document)
&optional use-images _align)
"Return a textual representation of THIS for user interface purposes.
When USE-IMAGES is non-nil, add an icon that indicates a document
diff --git a/rudel-infinote-client.el b/rudel-infinote-client.el
index 6affdf5..24adb7a 100644
--- a/rudel-infinote-client.el
+++ b/rudel-infinote-client.el
@@ -95,12 +95,11 @@ objects.")
side."))
"TODO")
-(defmethod initialize-instance ((this rudel-infinote-client-connection)
+(cl-defmethod initialize-instance ((this rudel-infinote-client-connection)
_slots)
""
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Create hash-table for groups.
(with-slots (groups) this
@@ -143,12 +142,12 @@ side."))
))
)
-(defmethod rudel-get-group ((this rudel-infinote-client-connection) name)
+(cl-defmethod rudel-get-group ((this rudel-infinote-client-connection) name)
"Return group named NAME or nil if there is no such group."
(with-slots (groups) this
(gethash name groups)))
-(defmethod rudel-add-group ((this rudel-infinote-client-connection) group)
+(cl-defmethod rudel-add-group ((this rudel-infinote-client-connection) group)
""
(with-slots ((name :object-name) connection) group
;;
@@ -159,7 +158,7 @@ side."))
(puthash name group groups)))
)
-(defmethod rudel-remove-group ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-remove-group ((this rudel-infinote-client-connection)
group-or-name)
"Remove GROUP-OR-NAME from the list of groups of THIS.
GROUP-OR-NAME is a `rudel-infinote-group' object or a string in
@@ -173,7 +172,7 @@ which case it is the name of a group."
group-or-name))))
(remhash name groups))))
-(defmethod rudel-make-and-add-group ((_this rudel-infinote-client-connection)
+(cl-defmethod rudel-make-and-add-group ((_this
rudel-infinote-client-connection)
_type name method &optional node)
"Create a group object and add it to THIS."
;; TODO the backend creates these
@@ -185,7 +184,7 @@ which case it is the name of a group."
:document node)))
(rudel-add-group group)))
-(defmethod rudel-find-node ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-find-node ((this rudel-infinote-client-connection)
which &optional test key)
"Find node WHICH in the node list of THIS.
WHICH is compared to the result of KEY using TEST."
@@ -194,15 +193,15 @@ WHICH is compared to the result of KEY using TEST."
:key (or key #'rudel-id)
:test (or test #'=))))
-(defmethod rudel-add-node ((this rudel-infinote-client-connection) node)
+(cl-defmethod rudel-add-node ((this rudel-infinote-client-connection) node)
"Add NODE to the list of nodes of THIS."
(object-add-to-list this :nodes node))
-(defmethod rudel-remove-node ((this rudel-infinote-client-connection) node)
+(cl-defmethod rudel-remove-node ((this rudel-infinote-client-connection) node)
"Remove NODE from the list of nodes of THIS."
(object-remove-from-list this :nodes node))
-(defmethod rudel-make-and-add-node ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-make-and-add-node ((this rudel-infinote-client-connection)
id parent-id name type)
;; TODO the backend does the creation
(with-slots (session) this
@@ -247,12 +246,12 @@ WHICH is compared to the result of KEY using TEST."
(rudel-add-document session node)))))
)
-(defmethod rudel-send ((this rudel-infinote-client-connection) xml)
+(cl-defmethod rudel-send ((this rudel-infinote-client-connection) xml)
""
(with-slots (transport) this
(rudel-send transport xml)))
-(defmethod rudel-receive ((this rudel-infinote-client-connection) xml)
+(cl-defmethod rudel-receive ((this rudel-infinote-client-connection) xml)
""
(pcase (xml-node-name xml)
;;
@@ -275,22 +274,22 @@ WHICH is compared to the result of KEY using TEST."
;;
(_
- (when (next-method-p)
- (call-next-method)))) ;; TODO what is actually called here?
+ (when (cl-next-method-p)
+ (cl-call-next-method)))) ;; TODO what is actually called here?
)
-(defmethod rudel-disconnect ((this rudel-infinote-client-connection)) ;; TODO
maybe we could automatically delegate to the transport
+(cl-defmethod rudel-disconnect ((this rudel-infinote-client-connection)) ;;
TODO maybe we could automatically delegate to the transport
""
(with-slots (transport) this
(rudel-disconnect transport)))
-(defmethod rudel-wait ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-wait ((this rudel-infinote-client-connection)
&optional progress-callback)
"Block until THIS is done with the session setup."
(let ((group (rudel-get-group this "InfDirectory")))
(rudel-state-wait group '(idle) '() progress-callback)))
-(defmethod rudel-publish ((this rudel-infinote-client-connection) document)
+(cl-defmethod rudel-publish ((this rudel-infinote-client-connection) document)
""
;; Create a new adopted context for DOCUMENT.
;(rudel-add-context this document)
@@ -317,7 +316,7 @@ WHICH is compared to the result of KEY using TEST."
)
;; TODO should be a method of the directory group
-(defmethod rudel-subscribe-to ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-subscribe-to ((this rudel-infinote-client-connection)
document)
""
;; Create a new adopted context for DOCUMENT.
@@ -344,7 +343,7 @@ WHICH is compared to the result of KEY using TEST."
;; list of subscribed users of DOCUMENT.
)
-(defmethod rudel-unsubscribe-from ((_this rudel-infinote-client-connection)
+(cl-defmethod rudel-unsubscribe-from ((_this rudel-infinote-client-connection)
document)
""
;; Delete the jupiter context for DOCUMENT.
@@ -363,7 +362,7 @@ WHICH is compared to the result of KEY using TEST."
;; the list of subscribed users of DOCUMENT.
)
-(defmethod rudel-subscribe-session ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-subscribe-session ((this rudel-infinote-client-connection)
name method id)
""
;; TODO this makes sense for document sessions only, but we want to
@@ -383,7 +382,7 @@ WHICH is compared to the result of KEY using TEST."
(oset document :group group))) ;; TODO temp
)
-(defmethod rudel-local-insert ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-local-insert ((this rudel-infinote-client-connection)
document position data)
""
(rudel-local-operation
@@ -394,7 +393,7 @@ WHICH is compared to the result of KEY using TEST."
:data data))
)
-(defmethod rudel-local-delete ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-local-delete ((this rudel-infinote-client-connection)
document position length)
""
(rudel-local-operation
@@ -405,7 +404,7 @@ WHICH is compared to the result of KEY using TEST."
:to (+ position length)))
)
-(defmethod rudel-local-operation ((this rudel-infinote-client-connection)
+(cl-defmethod rudel-local-operation ((this rudel-infinote-client-connection)
document operation)
"Handle OPERATION performed on DOCUMENT by sending a message through THIS
connection."
;; Find jupiter context for DOCUMENT.
@@ -422,7 +421,7 @@ WHICH is compared to the result of KEY using TEST."
;; (jupiter-local-operation context operation))
)
-(defmethod rudel-remote-operation ((_this rudel-infinote-client-connection)
+(cl-defmethod rudel-remote-operation ((_this rudel-infinote-client-connection)
document user
_remote-revision _local-revision
operation)
diff --git a/rudel-infinote-display.el b/rudel-infinote-display.el
index 839fc44..dacdcd9 100644
--- a/rudel-infinote-display.el
+++ b/rudel-infinote-display.el
@@ -40,12 +40,12 @@
(require 'rudel-infinote-user)
-(defmethod rudel-display-string ((this rudel-infinote-document-user)
+(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
(concat
- (call-next-method)
+ (cl-call-next-method)
(pcase status
(`active
diff --git a/rudel-infinote-document.el b/rudel-infinote-document.el
index ffe1277..82a8499 100644
--- a/rudel-infinote-document.el
+++ b/rudel-infinote-document.el
@@ -54,7 +54,7 @@
"The user object belonging to the local side."))
"Super class of infinote document classes.")
-(defmethod rudel-add-user ((this rudel-infinote-document) user)
+(cl-defmethod rudel-add-user ((this rudel-infinote-document) user)
"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."
@@ -75,11 +75,11 @@ session user is looked up and created if necessary."
(oset user :session-user session-user))
;; This actually adds the user to THIS.
- (call-next-method this user) ;; TODO the next method should return the
user
+ (cl-call-next-method this user) ;; TODO the next method should return
the user
user))
)
-(defmethod rudel-set-self ((this rudel-infinote-document) user)
+(cl-defmethod rudel-set-self ((this rudel-infinote-document) user)
"Set USER as self user of THIS.
If the session associated to THIS does not have a self user, the
session user object corresponding to USER is set as self user of
diff --git a/rudel-infinote-group-directory.el
b/rudel-infinote-group-directory.el
index f54ef74..799cb28 100644
--- a/rudel-infinote-group-directory.el
+++ b/rudel-infinote-group-directory.el
@@ -71,7 +71,7 @@ temporarily after receiving it from the server."))
Initial state of the state machine of the infinote directory
group.")
-(defmethod rudel-infinote/welcome
+(cl-defmethod rudel-infinote/welcome
((this rudel-infinote-directory-state-new) xml)
"Handle infinote welcome message."
;; Temporarily store list of plugins and sequence
@@ -101,7 +101,7 @@ group.")
()
"Idle state of the directory group.")
-(defmethod rudel-infinote/add-node
+(cl-defmethod rudel-infinote/add-node
((this rudel-infinote-directory-state-idle) xml)
""
;; TODO there can be a child:
@@ -118,13 +118,13 @@ group.")
(rudel-add-node group id parent name type)))
nil)
-(defmethod rudel-infinote/remove-node
+(cl-defmethod rudel-infinote/remove-node
((_this rudel-infinote-directory-state-idle) _xml)
""
;; (with-tag-attrs (id) xml ;; seq
nil)
-(defmethod rudel-infinote/sync-in
+(cl-defmethod rudel-infinote/sync-in
((_this rudel-infinote-directory-state-idle) _xml)
""
;; TODO can contain child <subscribe group="group_name" method="method_name"
/>
@@ -144,7 +144,7 @@ group.")
"Directory group state entered when the children of a node are
explored.")
-(defmethod rudel-enter
+(cl-defmethod rudel-enter
((this rudel-infinote-directory-state-exploring) id)
""
(rudel-send this
@@ -152,7 +152,7 @@ explored.")
((id . ,(format "%d" id)))))
nil)
-(defmethod rudel-infinote/explore-begin ;; TODO there should be another state
+(cl-defmethod rudel-infinote/explore-begin ;; TODO there should be another
state
((this rudel-infinote-directory-state-exploring) xml)
""
;; <explore-begin total="13" seq="0"/>
@@ -161,7 +161,7 @@ explored.")
(setq remaining-messages total))) ;; TODO in hex?
nil)
-(defmethod rudel-infinote/add-node
+(cl-defmethod rudel-infinote/add-node
((this rudel-infinote-directory-state-exploring) xml)
;; TODO identical to idle state
""
@@ -174,7 +174,7 @@ explored.")
(cl-decf remaining-messages))
nil)
-(defmethod rudel-infinote/explore-end
+(cl-defmethod rudel-infinote/explore-end
((this rudel-infinote-directory-state-exploring) _xml)
""
(with-slots (remaining-messages) this
@@ -199,7 +199,7 @@ explored.")
"The id of the target node of the subscription."))
"Directory group state entered when subscribing to a session.")
-(defmethod rudel-enter
+(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
@@ -209,7 +209,7 @@ explored.")
((id . ,(format "%d" id1))))))
nil)
-(defmethod rudel-infinote/subscribe-session
+(cl-defmethod rudel-infinote/subscribe-session
((this rudel-infinote-directory-state-subscribing) xml)
""
(with-slots ((id1 :id)) this
@@ -237,7 +237,7 @@ explored.")
'idle)
;; TODO this message is used when the server requested the subscription?
-(defmethod rudel-leave ((this rudel-infinote-directory-state-subscribing))
+(cl-defmethod rudel-leave ((this rudel-infinote-directory-state-subscribing))
"Acknowledge the subscription when leaving the state."
(with-slots (id) this
(when id
@@ -268,29 +268,28 @@ explored.")
"Objects of this class represent infinote directory
communication groups.")
-(defmethod initialize-instance ((this rudel-infinote-group-directory)
+(cl-defmethod initialize-instance ((this rudel-infinote-group-directory)
_slots)
""
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Register states.
(rudel-register-states
this rudel-infinote-group-directory-states)
)
-(defmethod rudel-add-node ((this rudel-infinote-group-directory)
+(cl-defmethod rudel-add-node ((this rudel-infinote-group-directory)
id parent name type)
""
(with-slots (connection) this
(rudel-make-and-add-node connection id parent name type)))
-(defmethod rudel-remove-node ((_this rudel-infinote-group-directory))
+(cl-defmethod rudel-remove-node ((_this rudel-infinote-group-directory))
""
(error "Removing nodes is not implemented"))
-(defmethod rudel-subscribe-session ((this rudel-infinote-group-directory)
+(cl-defmethod rudel-subscribe-session ((this rudel-infinote-group-directory)
name method id)
""
(with-slots (connection) this
diff --git a/rudel-infinote-group-document.el b/rudel-infinote-group-document.el
index 4a7ef50..4a749ea 100644
--- a/rudel-infinote-group-document.el
+++ b/rudel-infinote-group-document.el
@@ -55,14 +55,14 @@
()
"")
-(defmethod rudel-infinote/sync-begin
+(cl-defmethod rudel-infinote/sync-begin
((_this rudel-infinote-group-document-state-idle) xml)
"Handle 'sync-begin' message."
(with-tag-attrs ((num-messages num-messages number)) xml
;; Switch to synchronizing state.
(list 'synchronizing num-messages)))
-(defmethod rudel-infinote/user-join
+(cl-defmethod rudel-infinote/user-join
((this rudel-infinote-group-document-state-idle) xml)
"Handle 'user-join' message."
(with-tag-attrs ((id id number)
@@ -95,7 +95,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/user-rejoin
+(cl-defmethod rudel-infinote/user-rejoin
((this rudel-infinote-group-document-state-idle) xml)
""
(with-tag-attrs ((id id number)
@@ -123,7 +123,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/user-status-change
+(cl-defmethod rudel-infinote/user-status-change
((this rudel-infinote-group-document-state-idle) xml)
""
(with-tag-attrs ((id id number)
@@ -143,7 +143,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/user-color-change
+(cl-defmethod rudel-infinote/user-color-change
((this rudel-infinote-group-document-state-idle) xml)
""
(with-tag-attrs ((id id number)
@@ -165,7 +165,7 @@
nil)
;; TODO does this belong here or in derived classes?
-(defmethod rudel-infinote/request
+(cl-defmethod rudel-infinote/request
((this rudel-infinote-group-document-state-idle) xml)
""
(with-tag-attrs ((user-id user number)) xml
@@ -189,7 +189,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/session-close
+(cl-defmethod rudel-infinote/session-close
((_this rudel-infinote-group-document-state-idle) _xml)
"Handle 'session-close' message."
;; Switch to closed state.
@@ -222,7 +222,7 @@
""))
"")
-(defmethod rudel-enter ((this
rudel-infinote-group-document-state-synchronizing)
+(cl-defmethod rudel-enter ((this
rudel-infinote-group-document-state-synchronizing)
num-items)
""
(with-slots (document all-items remaining-items) this
@@ -234,7 +234,7 @@
remaining-items num-items))
nil)
-(defmethod rudel-infinote/sync-user
+(cl-defmethod rudel-infinote/sync-user
((this rudel-infinote-group-document-state-synchronizing) xml)
"Create a user object and add it to the document."
;; TODO send sync-error if remaining-items is already zero
@@ -260,7 +260,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/sync-request
+(cl-defmethod rudel-infinote/sync-request
((this rudel-infinote-group-document-state-synchronizing) _xml)
"Handle 'sync-request' message."
(with-slots (remaining-items) this
@@ -272,7 +272,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/sync-segment ;; TODO text documents only?
+(cl-defmethod rudel-infinote/sync-segment ;; TODO text documents only?
((this rudel-infinote-group-document-state-synchronizing) _xml)
"Handle 'sync-segment' message."
(with-slots (remaining-items) this
@@ -284,7 +284,7 @@
;; Stay in this state.
nil)
-(defmethod rudel-infinote/sync-end
+(cl-defmethod rudel-infinote/sync-end
((this rudel-infinote-group-document-state-synchronizing) _xml)
"Handle 'sync-end' message."
(with-slots (all-items remaining-items) this
@@ -313,7 +313,7 @@
;; Stay in this state.
'idle)
-(defmethod rudel-infinote/sync-cancel
+(cl-defmethod rudel-infinote/sync-cancel
((_this rudel-infinote-group-document-state-synchronizing) _xml)
"Handle 'sync-cancel' message."
;; Stay in this state.
@@ -336,7 +336,7 @@
associated to a document. After sending a 'user-join' message, we
expect a 'user-join' or 'user-rejoin' message in response.")
-(defmethod rudel-enter
+(cl-defmethod rudel-enter
((this rudel-infinote-group-document-state-joining))
""
(let ((self (rudel-self (oref this :session))))
@@ -355,7 +355,7 @@ expect a 'user-join' or 'user-rejoin' message in response.")
;; Remain in this state and wait for reply.
nil)
-(defmethod rudel-infinote/user-join
+(cl-defmethod rudel-infinote/user-join
((this rudel-infinote-group-document-state-joining) xml)
"Handle 'user-join' message."
(with-tag-attrs ((id id number)
@@ -392,7 +392,7 @@ expect a 'user-join' or 'user-rejoin' message in response.")
;; can leave the state and go to idle.
'idle)
-(defmethod rudel-infinote/user-rejoin
+(cl-defmethod rudel-infinote/user-rejoin
((this rudel-infinote-group-document-state-joining) xml)
""
(with-tag-attrs ((id id number)
@@ -451,12 +451,11 @@ expect a 'user-join' or 'user-rejoin' message in
response.")
(delegation-target-slot :initform document))
"")
-(defmethod initialize-instance ((this rudel-infinote-group-document)
+(cl-defmethod initialize-instance ((this rudel-infinote-group-document)
_slots)
""
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Register states.
(rudel-register-states
diff --git a/rudel-infinote-group-text-document.el
b/rudel-infinote-group-text-document.el
index f3212ba..3db0650 100644
--- a/rudel-infinote-group-text-document.el
+++ b/rudel-infinote-group-text-document.el
@@ -52,7 +52,7 @@
()
"")
-(defmethod rudel-infinote/request/insert
+(cl-defmethod rudel-infinote/request/insert
((this rudel-infinote-group-text-document-state-idle)
user xml)
""
@@ -66,7 +66,7 @@
:data (or text "\n")))) ;; TODO is this correct?
nil)
-(defmethod rudel-infinote/request/insert-caret
+(cl-defmethod rudel-infinote/request/insert-caret
((this rudel-infinote-group-text-document-state-idle)
user xml)
""
@@ -88,7 +88,7 @@
:from position)))
nil)
-(defmethod rudel-infinote/request/delete
+(cl-defmethod rudel-infinote/request/delete
((this rudel-infinote-group-text-document-state-idle)
user xml)
""
@@ -102,7 +102,7 @@
:length length)))
nil)
-(defmethod rudel-infinote/request/delete-caret
+(cl-defmethod rudel-infinote/request/delete-caret
((this rudel-infinote-group-text-document-state-idle)
user xml)
""
@@ -124,13 +124,13 @@
:from position)))
nil)
-(defmethod rudel-infinote/request/no-op
+(cl-defmethod rudel-infinote/request/no-op
((_this rudel-infinote-group-text-document-state-idle)
_user _xml)
""
nil)
-(defmethod rudel-infinote/request/move
+(cl-defmethod rudel-infinote/request/move
((this rudel-infinote-group-text-document-state-idle)
user xml)
""
@@ -152,22 +152,22 @@
:length length)))
nil)
-(defmethod rudel-infinote/request/undo
+(cl-defmethod rudel-infinote/request/undo
((_this rudel-infinote-group-text-document-state-idle) _xml)
""
nil)
-(defmethod rudel-infinote/request/undo-caret
+(cl-defmethod rudel-infinote/request/undo-caret
((_this rudel-infinote-group-text-document-state-idle) _xml)
""
nil)
-(defmethod rudel-infinote/request/redo
+(cl-defmethod rudel-infinote/request/redo
((_this rudel-infinote-group-text-document-state-idle) _xml)
""
nil)
-(defmethod rudel-infinote/request/redo-caret
+(cl-defmethod rudel-infinote/request/redo-caret
((_this rudel-infinote-group-text-document-state-idle) _xml)
""
nil)
@@ -181,7 +181,7 @@
()
"")
-(defmethod rudel-infinote/sync-segment ;; TODO text documents only?
+(cl-defmethod rudel-infinote/sync-segment ;; TODO text documents only?
((this rudel-infinote-group-text-document-state-synchronizing) xml)
""
(with-slots (remaining-items document) this
@@ -208,7 +208,7 @@
(cl-decf remaining-items)))
nil)
-(defmethod rudel-infinote/request/delete
+(cl-defmethod rudel-infinote/request/delete
((_this rudel-infinote-group-text-document-state-synchronizing) _xml)
""
;; <delete pos="pos"><segment author="user_id">text</segment>[...]</delete>
@@ -252,19 +252,18 @@
((parent :type rudel-infinote-node-directory-child))
"")
-(defmethod initialize-instance
+(cl-defmethod initialize-instance
((this rudel-infinote-group-text-document) _slots)
""
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; We have our own states, register them.
(oset this :states nil)
(rudel-register-states
this rudel-infinote-group-text-document-states))
-(defmethod rudel-remote-operation
+(cl-defmethod rudel-remote-operation
((this rudel-infinote-group-text-document) user operation)
""
(with-slots (document) this
diff --git a/rudel-infinote-group.el b/rudel-infinote-group.el
index df6f52d..028c2a4 100644
--- a/rudel-infinote-group.el
+++ b/rudel-infinote-group.el
@@ -75,7 +75,7 @@
""
:abstract t)
-(defmethod rudel-accept ((this rudel-infinote-group-state) xml)
+(cl-defmethod rudel-accept ((this rudel-infinote-group-state) xml)
"Dispatch XML to appropriate handler method based on content."
(let ((type (xml-node-name xml)))
(pcase type
@@ -127,7 +127,7 @@ domain: `%s', code: `%s'"
message.")
;; TODO can all groups receive <session-close/> or just document groups?
-(defmethod rudel-accept ((_this rudel-infinote-group-state-closed) _xml)
+(cl-defmethod rudel-accept ((_this rudel-infinote-group-state-closed) _xml)
"Simply ignore all further messages."
nil)
@@ -160,16 +160,15 @@ sessions. Groups are basically modeled as named state
machines. Subclasses have to provide their own states."
:abstract t)
-(defmethod rudel-register-state ((this rudel-infinote-group) _symbol state)
+(cl-defmethod rudel-register-state ((this rudel-infinote-group) _symbol state)
"Set the :group slot of STATE to THIS."
;; Associate THIS connection to STATE.
(oset state :group this)
;;
- (when (next-method-p)
- (call-next-method)))
+ (cl-call-next-method))
-(defmethod rudel-send ((this rudel-infinote-group) data)
+(cl-defmethod rudel-send ((this rudel-infinote-group) data)
"Send DATA through the connection associated to THIS."
(with-slots (connection) this
(rudel-send connection
@@ -194,19 +193,19 @@ side. This is used to identify messages directed at us."))
"Objects of this class inject sequence number into messages
sent via `rudel-send'.")
-(defmethod rudel-send ((this rudel-infinote-sequence-number-group)
+(cl-defmethod rudel-send ((this rudel-infinote-sequence-number-group)
data &optional no-sequence-number)
"Add a sequence number to DATA and send it.
After sending, increment the sequence number counter.
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
- (call-next-method this data)
+ (cl-call-next-method this data)
(with-slots ((seq-num :next-sequence-number)) this
(let ((data (xml-node-name data))
(attributes (xml-node-attributes data))
(children (xml-node-children data)))
- (call-next-method
+ (cl-call-next-method
this
(append
(list
diff --git a/rudel-infinote-node-directory.el b/rudel-infinote-node-directory.el
index 16f4c21..dfddf44 100644
--- a/rudel-infinote-node-directory.el
+++ b/rudel-infinote-node-directory.el
@@ -52,13 +52,13 @@ slot :children. The value is computed on access."))
"Objects of this class represent directory (inner) nodes in the
Infinote tree.")
-(defmethod rudel-add-child ((this rudel-infinote-node-directory)
+(cl-defmethod rudel-add-child ((this rudel-infinote-node-directory)
document)
""
(with-slots (child-cache) this
(push document child-cache))) ;; TODO object-add-to-list or add-to-list?
-(defmethod slot-missing ((this rudel-infinote-node-directory)
+(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."
@@ -90,7 +90,7 @@ necessary."
;; Call next method
(t
- (call-next-method)))
+ (cl-call-next-method)))
)
(provide 'rudel-infinote-node-directory)
diff --git a/rudel-infinote-node.el b/rudel-infinote-node.el
index aa6131c..af302f4 100644
--- a/rudel-infinote-node.el
+++ b/rudel-infinote-node.el
@@ -79,7 +79,7 @@ node.")
correspond to text documents or other content containing
documents.")
-(defmethod rudel-unique-name ((this rudel-infinote-node))
+(cl-defmethod rudel-unique-name ((this rudel-infinote-node))
"Return a unique name for THIS by forming a path from the root node."
(with-slots (parent) this
(concat
diff --git a/rudel-infinote-state.el b/rudel-infinote-state.el
index e741cb9..59a0667 100644
--- a/rudel-infinote-state.el
+++ b/rudel-infinote-state.el
@@ -54,14 +54,14 @@
""))
"Base class for infinote state classes.")
-(defmethod rudel-enter ((_this rudel-infinote-state))
+(cl-defmethod rudel-enter ((_this rudel-infinote-state))
""
nil)
-(defmethod rudel-leave ((_this rudel-infinote-state))
+(cl-defmethod rudel-leave ((_this rudel-infinote-state))
"")
-(defmethod rudel-accept ((_this rudel-infinote-state) _xml)
+(cl-defmethod rudel-accept ((_this rudel-infinote-state) _xml)
""
nil)
diff --git a/rudel-infinote-util.el b/rudel-infinote-util.el
index b5ea0a1..28ce5b2 100644
--- a/rudel-infinote-util.el
+++ b/rudel-infinote-util.el
@@ -35,6 +35,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'rudel-util)
(require 'rudel-xml)
@@ -47,31 +48,31 @@
;;; Message serialization
;;
-(defgeneric rudel-operation->xml ((this adopted-operation))
+(cl-defgeneric rudel-operation->xml ((this adopted-operation))
"Generate an XML infoset from THIS operation.")
-(defmethod rudel-operation->xml ((this adopted-insert))
+(cl-defmethod rudel-operation->xml ((this adopted-insert))
"Serialize THIS insert operation."
(with-slots (from data) this
`(insert
((pos . ,(format "%d" from)))
,data)))
-(defmethod rudel-operation->xml ((this adopted-delete))
+(cl-defmethod rudel-operation->xml ((this adopted-delete))
"Serialize THIS delete operation."
(with-slots (from length) this
`(delete
((pos . ,(format "%d" from))
(len . ,(format "%d" length))))))
-(defmethod rudel-operation->xml ((this adopted-compound))
+(cl-defmethod rudel-operation->xml ((this adopted-compound))
"Serialize THIS compound operation."
(with-slots (children) this
(apply #'append
'(split)
(mapcar #'rudel-operation->xml children))))
-(defmethod rudel-operation->xml ((_this adopted-nop))
+(cl-defmethod rudel-operation->xml ((_this adopted-nop))
"Serialize THIS nop operation."
`(nop))
diff --git a/rudel-infinote.el b/rudel-infinote.el
index d970ca3..e7efc2a 100644
--- a/rudel-infinote.el
+++ b/rudel-infinote.el
@@ -64,14 +64,13 @@
group-undo)))
"")
-(defmethod initialize-instance ((this rudel-infinote-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-infinote-backend) _slots)
""
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-infinote-version))
-(defmethod rudel-ask-connect-info ((_this rudel-infinote-backend)
+(cl-defmethod rudel-ask-connect-info ((_this rudel-infinote-backend)
&optional info)
""
;; Read desired username and color
@@ -85,7 +84,7 @@
info))
)
-(defmethod rudel-connect ((_this rudel-infinote-backend) transport
+(cl-defmethod rudel-connect ((_this rudel-infinote-backend) transport
info _info-callback
&optional progress-callback)
"Connect to an infinote server using the information INFO.
@@ -112,13 +111,13 @@ Return the connection object."
connection)
)
-(defmethod rudel-make-document ((_this rudel-infinote-backend)
+(cl-defmethod rudel-make-document ((_this rudel-infinote-backend)
name _encoding session)
""
(rudel-infinote-text-document name
:session session))
-(defmethod rudel-make-node ((_this rudel-infinote-backend)
+(cl-defmethod rudel-make-node ((_this rudel-infinote-backend)
type name id parent)
"Create a node object according to TYPE, NAME, ID and PARENT.
The new node will be named NAME and have id ID. It will be a
@@ -144,7 +143,7 @@ node will be the root node."
(error "No such node type: `%s'" type)))
)
-(defmethod rudel-make-group ((_this rudel-infinote-backend)
+(cl-defmethod rudel-make-group ((_this rudel-infinote-backend)
type name method &optional node)
"Create a new group according to TYPE, NAME and METHOD.
The optional argument NODE can specify the node (usually a
diff --git a/rudel-loaddefs.el b/rudel-loaddefs.el
index 9e55a12..23377d0 100644
--- a/rudel-loaddefs.el
+++ b/rudel-loaddefs.el
@@ -10,9 +10,11 @@
(defmacro rudel--with-memoization (place &rest code) (declare (indent 1)
(debug t)) (gv-letplace (getter setter) place `(or ,getter ,(macroexp-let2 nil
val (macroexp-progn code) `(progn ,(funcall setter val) ,val)))))
-(defmethod rudel-get-factory :static ((this rudel-backend-factory) category)
"Return the factory responsible for CATEGORY.\nIf there is no responsible
factory, create one and return it." (rudel--with-memoization (gethash category
(eieio-oref-default this 'factories)) (make-instance 'rudel-backend-factory)))
+(cl-defmethod rudel-get-factory ((this (subclass rudel-backend-factory))
category) "\
+Return the factory responsible for CATEGORY.
+If there is no responsible factory, create one and return it."
(rudel--with-memoization (gethash category (eieio-oref-default this (quote
factories))) (make-instance (quote rudel-backend-factory))))
-(defmethod rudel-add-backend ((this rudel-backend-factory) name class
&optional replace) "\
+(cl-defmethod rudel-add-backend ((this rudel-backend-factory) name class
&optional replace) "\
Add factory class CLASS with name NAME to THIS.
if REPLACE is non-nil, replace a registered implementation of the
same name." (with-slots (backends) this (when (or (not (gethash name
backends)) replace) (puthash name class backends))))
@@ -157,10 +159,9 @@ service type TYPE.
;;;;;; "rudel-obby-state.el" "rudel-obby-util.el" "rudel-operations.el"
;;;;;; "rudel-operators.el" "rudel-overlay.el" "rudel-pkg.el"
"rudel-protocol.el"
;;;;;; "rudel-speedbar.el" "rudel-state-machine.el" "rudel-transport-util.el"
-;;;;;; "rudel-transport-util.el" "rudel-transport.el" "rudel-util.el"
-;;;;;; "rudel-xml.el" "rudel-xmpp-debug.el" "rudel-xmpp-sasl.el"
-;;;;;; "rudel-xmpp-state.el" "rudel-xmpp-tls.el" "rudel-xmpp-util.el"
-;;;;;; "rudel.el") (0 0 0 0))
+;;;;;; "rudel-transport.el" "rudel-util.el" "rudel-xml.el"
"rudel-xmpp-debug.el"
+;;;;;; "rudel-xmpp-sasl.el" "rudel-xmpp-state.el" "rudel-xmpp-tls.el"
+;;;;;; "rudel-xmpp-util.el" "rudel.el") (0 0 0 0))
;;;***
diff --git a/rudel-obby-client.el b/rudel-obby-client.el
index 95dcae2..07bfd2a 100644
--- a/rudel-obby-client.el
+++ b/rudel-obby-client.el
@@ -65,7 +65,7 @@
"Start state of newly established connections."
:method-invocation-order :c3)
-(defmethod rudel-obby/obby_welcome
+(cl-defmethod rudel-obby/obby_welcome
((_this rudel-obby-client-state-new) version)
"Handle obby 'welcome' message."
;; Examine announced protocol version.
@@ -84,7 +84,7 @@
"Start state of the encryption handshake."
:method-invocation-order :c3)
-(defmethod rudel-obby/net6_encryption
+(cl-defmethod rudel-obby/net6_encryption
((this rudel-obby-client-state-encryption-negotiate) _value)
"Handle net6 'encryption' message."
(rudel-send this "net6_encryption_ok")
@@ -100,7 +100,7 @@
"Second state of the encryption handshake."
:method-invocation-order :c3)
-(defmethod rudel-obby/net6_encryption_begin
+(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.
@@ -120,7 +120,7 @@ the selected transport `%s' does not support encryption"
;; The connection is now established
'waiting-for-join-info)
-(defmethod rudel-obby/net6_encryption_failed
+(cl-defmethod rudel-obby/net6_encryption_failed
((_this rudel-obby-client-state-encryption-start))
"Handle net6 'encryption_failed' message."
;; The connection is now established; without encryption though.
@@ -148,7 +148,7 @@ session."
"First state after the connection has been properly set up."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-joining) info)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-joining) info)
"When entering this state, send a login request."
;; Send login request with username and color. This can easily fail
;; (resulting in response 'net6_login_failed') if the username or
@@ -172,7 +172,7 @@ session."
(list 'join-failed (cons 'rudel-obby-invalid-color nil))))
)
-(defmethod rudel-obby/obby_sync_init
+(cl-defmethod rudel-obby/obby_sync_init
((_this rudel-obby-client-state-joining) count)
"Handle obby 'sync_init' message."
;; Switch to 'synching' state, passing the number of synchronization
@@ -180,7 +180,7 @@ session."
(with-parsed-arguments ((count number))
(list 'session-synching count)))
-(defmethod rudel-obby/net6_login_failed
+(cl-defmethod rudel-obby/net6_login_failed
((_this rudel-obby-client-state-joining) reason)
"Handle net6 'login_failed' message."
(with-parsed-arguments ((reason number))
@@ -237,7 +237,7 @@ failure."))
"State for failed login attempts."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-join-failed)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-join-failed)
error)
"When the state is entered, store the error data passed in ERROR."
(with-slots (error-symbol error-data) this
@@ -256,7 +256,7 @@ failure."))
"Default state of the connection."
:method-invocation-order :c3)
-(defmethod rudel-obby/net6_client_join
+(cl-defmethod rudel-obby/net6_client_join
((this rudel-obby-client-state-idle)
client-id name encryption user-id color)
"Handle net6 'client_join' message."
@@ -295,7 +295,7 @@ failure."))
(message "Client joined: %s %s" name color))
nil)
-(defmethod rudel-obby/net6_client_part
+(cl-defmethod rudel-obby/net6_client_part
((this rudel-obby-client-state-idle) client-id)
"Handle net6 'client_part' message."
;; Find the user object, associated to the client id. Remove the
@@ -320,7 +320,7 @@ failure."))
:warning))))))
nil)
-(defmethod rudel-obby/obby_user_colour
+(cl-defmethod rudel-obby/obby_user_colour
((this rudel-obby-client-state-idle) user-id color)
"Handle obby 'user_colour' message."
(with-parsed-arguments ((user-id number)
@@ -343,7 +343,7 @@ failure."))
color1))))))
nil)
-(defmethod rudel-obby/obby_document_create
+(cl-defmethod rudel-obby/obby_document_create
((this rudel-obby-client-state-idle)
owner-id doc-id name suffix _encoding)
"Handle obby 'document_create' message."
@@ -363,7 +363,7 @@ failure."))
(message "New document: %s" name))) ;; TODO remove this
nil)
-(defmethod rudel-obby/obby_document_remove
+(cl-defmethod rudel-obby/obby_document_remove
((this rudel-obby-client-state-idle) doc-id)
"Handle obby 'document_remove' message."
(with-parsed-arguments ((doc-id document-id))
@@ -383,7 +383,7 @@ failure."))
:warning))))))
nil)
-(defmethod rudel-obby/obby_document/rename
+(cl-defmethod rudel-obby/obby_document/rename
((_this rudel-obby-client-state-idle)
document _user new-name new-suffix)
"Handle 'rename' submessage of the obby 'document' message."
@@ -393,7 +393,7 @@ failure."))
suffix new-suffix)))
nil)
-(defmethod rudel-obby/obby_document/subscribe
+(cl-defmethod rudel-obby/obby_document/subscribe
((this rudel-obby-client-state-idle) document user-id)
"Handle 'subscribe' submessage of obby 'document' message."
(with-parsed-arguments ((user-id number))
@@ -404,7 +404,7 @@ failure."))
(rudel-add-user document user)))))
nil)
-(defmethod rudel-obby/obby_document/unsubscribe
+(cl-defmethod rudel-obby/obby_document/unsubscribe
((this rudel-obby-client-state-idle) document user-id)
"Handle 'unsubscribe' submessage of obby 'document' message."
(with-parsed-arguments ((user-id number))
@@ -415,7 +415,7 @@ failure."))
(rudel-remove-user document user)))))
nil)
-(defmethod rudel-obby/obby_document/record
+(cl-defmethod rudel-obby/obby_document/record
((this rudel-obby-client-state-idle)
document user-id local-revision remote-revision
action &rest arguments)
@@ -456,7 +456,7 @@ failure."))
nil))))
)
-(defmethod rudel-obby/obby_document/record/ins
+(cl-defmethod rudel-obby/obby_document/record/ins
((this rudel-obby-client-state-idle)
document user local-revision remote-revision
position data)
@@ -474,7 +474,7 @@ failure."))
operation))))
nil)
-(defmethod rudel-obby/obby_document/record/del
+(cl-defmethod rudel-obby/obby_document/record/del
((this rudel-obby-client-state-idle)
document user local-revision remote-revision
position length)
@@ -493,7 +493,7 @@ failure."))
operation))))
nil)
-(defmethod rudel-obby/obby_document/record/split
+(cl-defmethod rudel-obby/obby_document/record/split
((this rudel-obby-client-state-idle)
document user local-revision remote-revision
&rest operations)
@@ -508,7 +508,7 @@ failure."))
operation)))
nil)
-(defmethod rudel-obby/obby_document/record/noop
+(cl-defmethod rudel-obby/obby_document/record/noop
((this rudel-obby-client-state-idle)
document user local-revision remote-revision)
"Handle 'noop' submessage of 'record' submessage of obby 'document' message."
@@ -522,7 +522,7 @@ failure."))
operation)))
nil)
-(defmethod rudel-obby/obby_message ((this rudel-obby-client-state-idle)
+(cl-defmethod rudel-obby/obby_message ((this rudel-obby-client-state-idle)
sender text)
"Handle obby 'message' message"
(with-parsed-arguments ((sender number))
@@ -555,7 +555,7 @@ a 'self' user object."))
"State used for synching session data."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-session-synching)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-session-synching)
num-items)
"When entering state, store number of expected items."
(with-slots (all-items remaining-items have-self) this
@@ -564,7 +564,7 @@ a 'self' user object."))
have-self nil))
nil)
-(defmethod rudel-obby/net6_client_join
+(cl-defmethod rudel-obby/net6_client_join
((this rudel-obby-client-state-session-synching)
client-id name encryption user-id color)
"Handle net6 'client_join' message."
@@ -595,7 +595,7 @@ a 'self' user object."))
(cl-decf remaining-items)))
nil)
-(defmethod rudel-obby/obby_sync_usertable_user
+(cl-defmethod rudel-obby/obby_sync_usertable_user
((this rudel-obby-client-state-session-synching) user-id name color)
"Handle obby 'sync_usertable_user' message."
(with-parsed-arguments ((user-id number)
@@ -612,7 +612,7 @@ a 'self' user object."))
(cl-decf remaining-items)))
nil)
-(defmethod rudel-obby/obby_sync_doclist_document
+(cl-defmethod rudel-obby/obby_sync_doclist_document
((this rudel-obby-client-state-session-synching)
owner-id doc-id name suffix _encoding &rest subscribed-user-ids)
"Handle obby 'sync_doclist_document' message."
@@ -642,7 +642,7 @@ a 'self' user object."))
(cl-decf remaining-items)))
nil)
-(defmethod rudel-obby/obby_sync_final
+(cl-defmethod rudel-obby/obby_sync_final
((this rudel-obby-client-state-session-synching))
"Handle obby 'sync_final' message."
(with-slots (have-self) this
@@ -650,11 +650,11 @@ a 'self' user object."))
'idle
'we-finalized)))
-(defmethod object-print ((this rudel-obby-client-state-session-synching)
+(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
- (call-next-method this (format " remaining: %d" remaining-items))))
+ (cl-call-next-method this (format " remaining: %d" remaining-items))))
;;; Class rudel-obby-client-state-subscribing
@@ -671,7 +671,7 @@ a 'self' user object."))
""
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-subscribing)
+(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
@@ -685,7 +685,7 @@ a 'self' user object."))
(format "%x" user-id)))))
nil)
-(defmethod rudel-obby/obby_document/sync_init
+(cl-defmethod rudel-obby/obby_document/sync_init
((this rudel-obby-client-state-subscribing) _document num-bytes)
"Handle 'sync_init' submessage of the obby 'document' message."
(with-parsed-arguments ((num-bytes number))
@@ -718,7 +718,7 @@ a 'self' user object."))
""
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-document-synching)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-document-synching)
document num-bytes)
""
(with-slots ((document1 :document) all-bytes remaining-bytes) this
@@ -727,7 +727,7 @@ a 'self' user object."))
remaining-bytes num-bytes))
nil)
-(defmethod rudel-obby/obby_document/sync_chunk
+(cl-defmethod rudel-obby/obby_document/sync_chunk
((this rudel-obby-client-state-document-synching)
document data user-id)
"Handle 'sync_chunk' submessage of the obby 'document' message."
@@ -750,11 +750,11 @@ a 'self' user object."))
nil)))
)
-(defmethod object-print ((this rudel-obby-client-state-document-synching)
+(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
- (call-next-method this (format " remaining: %d" remaining-bytes))))
+ (cl-call-next-method this (format " remaining: %d" remaining-bytes))))
;;; Class rudel-obby-client-state-we-finalized
@@ -769,7 +769,7 @@ a 'self' user object."))
"State used to indicate that we closed the connection."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-we-finalized)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-we-finalized)
&optional reason1)
"Close the underlying transport and switch to disconnected state."
(with-slots (reason) this
@@ -793,7 +793,7 @@ a 'self' user object."))
"State used to indicate that the connection was closed by the peer."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-client-state-they-finalized)
+(cl-defmethod rudel-enter ((this rudel-obby-client-state-they-finalized)
&optional reason1)
"Close the underlying transport and switch to disconnected state."
(with-slots (reason) this
@@ -856,10 +856,9 @@ sends and receives its data.")
documents."))
"Class rudel-obby-connection ")
-(defmethod initialize-instance ((this rudel-obby-connection) _slots)
+(cl-defmethod initialize-instance ((this rudel-obby-connection) _slots)
;; Initialize slots of THIS
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Create a new hash-table object to hold jupiter contexts
;; associated to documents.
@@ -894,33 +893,32 @@ documents."))
(`close
(rudel-close this)))))))
-(defmethod rudel-register-state ((this rudel-obby-connection)
+(cl-defmethod rudel-register-state ((this rudel-obby-connection)
_symbol state)
"Register SYMBOL and STATE and set connection slot of STATE."
;; Associate THIS connection to STATE.
(oset state :connection this)
;; Register STATE.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
)
-(defmethod rudel-send ((this rudel-obby-connection) &rest args)
+(cl-defmethod rudel-send ((this rudel-obby-connection) &rest args)
"Send ARGS through the transport of THIS."
(with-slots (transport) this
(rudel-send transport args)))
-(defmethod rudel-disconnect ((this rudel-obby-connection))
+(cl-defmethod rudel-disconnect ((this rudel-obby-connection))
"Disconnect THIS from the remote endpoint."
;; Switch to finalization state and wait until the connection
;; reaches the disconnected state.
(rudel-switch this 'we-finalized)
(rudel-state-wait this '(disconnected) nil)
- (when (next-method-p)
- (call-next-method)))
+ (when (cl-next-method-p)
+ (cl-call-next-method)))
-(defmethod rudel-close ((this rudel-obby-connection))
+(cl-defmethod rudel-close ((this rudel-obby-connection))
"Cleanup after THIS has been disconnected."
;; Move the state machine into an error state.
(rudel-switch this 'they-finalized)
@@ -929,12 +927,12 @@ documents."))
(with-slots (session) this
(rudel-end session)))
-(defmethod rudel-find-context ((this rudel-obby-connection) document)
+(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)))
-(defmethod rudel-add-context ((this rudel-obby-connection) document)
+(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
@@ -943,17 +941,17 @@ documents."))
contexts)))
)
-(defmethod rudel-remove-context ((this rudel-obby-connection) document)
+(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)))
-(defmethod rudel-change-color- ((this rudel-obby-connection) color)
+(cl-defmethod rudel-change-color- ((this rudel-obby-connection) color)
""
(rudel-send this "obby_user_colour"
(rudel-obby-format-color color)))
-(defmethod rudel-publish ((this rudel-obby-connection) document)
+(cl-defmethod rudel-publish ((this rudel-obby-connection) document)
"Publish DOCUMENT to server."
;; Create a new jupiter context for DOCUMENT.
(rudel-add-context this document)
@@ -968,7 +966,7 @@ documents."))
(buffer-string))))
)
-(defmethod rudel-unpublish ((this rudel-obby-connection) document)
+(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
@@ -979,7 +977,7 @@ documents."))
(rudel-remove-context this document)
)
-(defmethod rudel-subscribe-to ((this rudel-obby-connection) document)
+(cl-defmethod rudel-subscribe-to ((this rudel-obby-connection) document)
""
;; Create a new jupiter context for DOCUMENT.
(rudel-add-context this document)
@@ -1024,7 +1022,7 @@ documents."))
;; users of DOCUMENT.
)
-(defmethod rudel-unsubscribe-from ((this rudel-obby-connection) document)
+(cl-defmethod rudel-unsubscribe-from ((this rudel-obby-connection) document)
""
;; Delete the jupiter context for DOCUMENT.
(rudel-remove-context this document)
@@ -1043,7 +1041,7 @@ documents."))
;; subscribed users of DOCUMENT.
)
-(defmethod rudel-local-insert ((this rudel-obby-connection)
+(cl-defmethod rudel-local-insert ((this rudel-obby-connection)
document position data)
""
(rudel-local-operation
@@ -1051,7 +1049,7 @@ documents."))
document
(jupiter-insert "insert" :from position :data data)))
-(defmethod rudel-local-delete ((this rudel-obby-connection)
+(cl-defmethod rudel-local-delete ((this rudel-obby-connection)
document position length)
""
(rudel-local-operation
@@ -1059,7 +1057,7 @@ documents."))
document
(jupiter-delete "delete" :from position :to (+ position length))))
-(defmethod rudel-local-operation ((this rudel-obby-connection)
+(cl-defmethod rudel-local-operation ((this rudel-obby-connection)
document operation)
"Handle OPERATION performed on DOCUMENT by sending a message through THIS
connection."
;; Convert character positions in OPERATION to byte positions, since
@@ -1087,7 +1085,7 @@ documents."))
(jupiter-local-operation context operation))
)
-(defmethod rudel-remote-operation ((this rudel-obby-connection)
+(cl-defmethod rudel-remote-operation ((this rudel-obby-connection)
document user
remote-revision local-revision
operation)
diff --git a/rudel-obby-debug.el b/rudel-obby-debug.el
index 8d2427e..7a75249 100644
--- a/rudel-obby-debug.el
+++ b/rudel-obby-debug.el
@@ -44,7 +44,7 @@
;;; Client connection debugging
;;
-(defmethod rudel-debug-target ((this rudel-obby-connection))
+(cl-defmethod rudel-debug-target ((this rudel-obby-connection))
"Return debug target of the transport as debug target for THIS."
(with-slots (transport) this
(rudel-debug-target transport)))
@@ -53,7 +53,7 @@
;;; Server connection debugging
;;
-(defmethod rudel-debug-target ((this rudel-obby-client))
+(cl-defmethod rudel-debug-target ((this rudel-obby-client))
"Return debug target of the transport as debug target for THIS."
(with-slots (transport) this
(rudel-debug-target transport)))
diff --git a/rudel-obby-display.el b/rudel-obby-display.el
index 308ba4d..9ad18fc 100644
--- a/rudel-obby-display.el
+++ b/rudel-obby-display.el
@@ -42,13 +42,13 @@
(require 'rudel-obby) ;; make sure `rudel-obby-user' is defined
-(defmethod rudel-display-string ((this rudel-obby-user)
+(cl-defmethod rudel-display-string ((this rudel-obby-user)
&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)))
- (name-string (call-next-method)))
+ (name-string (cl-call-next-method)))
(concat
;; Name bit
(cond
diff --git a/rudel-obby-server.el b/rudel-obby-server.el
index f7c1a34..1d46923 100644
--- a/rudel-obby-server.el
+++ b/rudel-obby-server.el
@@ -74,7 +74,7 @@
"State in which new connections start out."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-server-state-new))
+(cl-defmethod rudel-enter ((this rudel-obby-server-state-new))
"Sends welcome messages to the client and starts the session
timeout timer."
;; Send greeting sequence to the client.
@@ -95,12 +95,12 @@ timeout timer."
"Encryption negotiation state."
:method-invocation-order :c3)
-(defmethod rudel-enter ((this rudel-obby-server-state-encryption-negotiate))
+(cl-defmethod rudel-enter ((this rudel-obby-server-state-encryption-negotiate))
"Send net6 'encryption' message requesting to not enable encryption."
(rudel-send this "net6_encryption" "0")
nil)
-(defmethod rudel-obby/net6_encryption_ok
+(cl-defmethod rudel-obby/net6_encryption_ok
((this rudel-obby-server-state-encryption-negotiate))
"Handle net6 'encryption_ok' message.
Even if the client requests an encrypted connection, we cancel
@@ -108,7 +108,7 @@ the negotiation."
(rudel-send this "net6_encryption_failed")
'before-join)
-(defmethod rudel-obby/net6_encryption_failed
+(cl-defmethod rudel-obby/net6_encryption_failed
((_this rudel-obby-server-state-encryption-negotiate))
"Handle net6 'encryption_failed' message.
No action has to be taken, since the client simply proceeds after
@@ -125,7 +125,7 @@ failed encryption negotiation."
"Waiting for client request joining the session."
:method-invocation-order :c3)
-(defmethod rudel-obby/net6_client_login
+(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."
@@ -244,7 +244,7 @@ stateless in this case) operations are performed without
leaving
the idle state."
:method-invocation-order :c3)
-(defmethod rudel-obby/obby_user_colour
+(cl-defmethod rudel-obby/obby_user_colour
((this rudel-obby-server-state-idle) color-)
"Handle obby 'user_colour' message.
This method is called when the connected user requests a change
@@ -264,7 +264,7 @@ of her color to COLOR."
(rudel-obby-format-color color)))))
nil)
-(defmethod rudel-obby/obby_document_create
+(cl-defmethod rudel-obby/obby_document_create
((this rudel-obby-server-state-idle)
doc-id name encoding content)
"Handle obby 'document_create' message."
@@ -326,7 +326,7 @@ of her color to COLOR."
nil)
)
-(defmethod rudel-obby/obby_document/subscribe
+(cl-defmethod rudel-obby/obby_document/subscribe
((this rudel-obby-server-state-idle) document user-id)
"Handle 'subscribe' submessage of obby 'document' message."
(with-parsed-arguments ((user-id number))
@@ -379,7 +379,7 @@ of her color to COLOR."
nil)
)
-(defmethod rudel-obby/obby_document/unsubscribe
+(cl-defmethod rudel-obby/obby_document/unsubscribe
((this rudel-obby-server-state-idle) document user-id)
"Handle 'unsubscribe' submessage of 'obby_document' message."
(with-parsed-arguments ((user-id number))
@@ -409,7 +409,7 @@ of her color to COLOR."
nil)
)
-(defmethod rudel-obby/obby_document/record
+(cl-defmethod rudel-obby/obby_document/record
((this rudel-obby-server-state-idle)
document local-revision remote-revision action &rest arguments)
"Handle 'record' submessages of 'obby_document' message."
@@ -422,7 +422,7 @@ of her color to COLOR."
arguments)))
)
-(defmethod rudel-obby/obby_document/record/ins
+(cl-defmethod rudel-obby/obby_document/record/ins
((this rudel-obby-server-state-idle)
document local-revision remote-revision position data)
"Handle 'ins' submessage of 'record' submessages of 'obby_document' message."
@@ -439,7 +439,7 @@ of her color to COLOR."
nil)
)
-(defmethod rudel-obby/obby_document/record/del
+(cl-defmethod rudel-obby/obby_document/record/del
((this rudel-obby-server-state-idle)
document local-revision remote-revision position length)
"Handle 'del' submessage of 'record' submessages of 'obby_document' message."
@@ -501,11 +501,10 @@ connected to the server. This object handles all direct
communication with the client, while broadcast messages are
handled by the server.")
-(defmethod initialize-instance ((this rudel-obby-client) _slots)
+(cl-defmethod initialize-instance ((this rudel-obby-client) _slots)
"Initialize slots of THIS, register states and install filter."
;; Initialize slots of THIS
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Register states.
(rudel-register-states this rudel-obby-server-connection-states)
@@ -535,35 +534,35 @@ handled by the server.")
(`close
(rudel-close this)))))))
-(defmethod rudel-register-state ((this rudel-obby-client) _symbol state)
+(cl-defmethod rudel-register-state ((this rudel-obby-client) _symbol state)
"Register SYMBOL and STATE and set connection slot of STATE."
;; Associate THIS connection to STATE.
(oset state :connection this)
;; Register STATE.
- (call-next-method))
+ (cl-call-next-method))
-(defmethod rudel-end ((this rudel-obby-client))
+(cl-defmethod rudel-end ((this rudel-obby-client))
""
(rudel-disconnect this))
-(defmethod rudel-close ((this rudel-obby-client))
+(cl-defmethod rudel-close ((this rudel-obby-client))
""
(with-slots (server) this
(rudel-remove-client server this)))
-(defmethod rudel-send ((this rudel-obby-client) &rest args)
+(cl-defmethod rudel-send ((this rudel-obby-client) &rest args)
"Send ARGS through the transport of THIS."
(with-slots (transport) this
(rudel-send transport args)))
-(defmethod rudel-broadcast ((this rudel-obby-client)
+(cl-defmethod rudel-broadcast ((this rudel-obby-client)
receivers name &rest args)
"Broadcast message NAME with arguments ARGS to RECEIVERS."
(with-slots (server) this
(apply #'rudel-broadcast server receivers name args)))
-(defmethod rudel-remote-operation ((this rudel-obby-client)
+(cl-defmethod rudel-remote-operation ((this rudel-obby-client)
document
local-revision remote-revision
operation)
@@ -617,7 +616,7 @@ handled by the server.")
(rudel-remote-operation document user transformed)))
)
-(defmethod rudel-subscribed-clients-not-self ((this rudel-obby-client)
+(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)
@@ -665,11 +664,10 @@ that joins the associated session.")
transformation context objects."))
"Class rudel-obby-server ")
-(defmethod initialize-instance ((this rudel-obby-server) _slots)
+(cl-defmethod initialize-instance ((this rudel-obby-server) _slots)
"Initialize slots of THIS and install a dispatch function."
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Create a hash-table to store the contexts.
(with-slots (contexts) this
@@ -682,11 +680,11 @@ transformation context objects."))
(lambda (client-transport)
(rudel-add-client this client-transport)))))
-(defmethod rudel-end ((this rudel-obby-server))
+(cl-defmethod rudel-end ((this rudel-obby-server))
""
(rudel-disconnect this))
-(defmethod rudel-broadcast ((this rudel-obby-server)
+(cl-defmethod rudel-broadcast ((this rudel-obby-server)
receivers name &rest arguments)
"Send a message of type NAME with arguments ARGUMENTS to RECEIVERS.
@@ -723,7 +721,7 @@ such objects derived from rudel-obby-client."
(apply #'rudel-send receiver name arguments)))
)
-(defmethod rudel-make-user ((this rudel-obby-server)
+(cl-defmethod rudel-make-user ((this rudel-obby-server)
name client-id color encryption)
""
(with-slots (next-user-id) this
@@ -737,7 +735,7 @@ such objects derived from rudel-obby-client."
user))
)
-(defmethod rudel-check-username-and-color ((this rudel-obby-server)
+(cl-defmethod rudel-check-username-and-color ((this rudel-obby-server)
username color)
"Check whether USERNAME and COLOR are valid.
USERNAME must not be empty and must not be used by another
@@ -765,7 +763,7 @@ user. COLOR has to be sufficiently different from used
colors."
rudel-obby-error-color-in-use))
)
-(defmethod rudel-add-client ((this rudel-obby-server)
+(cl-defmethod rudel-add-client ((this rudel-obby-server)
client-transport)
""
(with-slots (next-client-id clients) this
@@ -779,7 +777,7 @@ user. COLOR has to be sufficiently different from used
colors."
(cl-incf next-client-id))
)
-(defmethod rudel-remove-client ((this rudel-obby-server)
+(cl-defmethod rudel-remove-client ((this rudel-obby-server)
client)
""
(with-slots ((client-id :id) user) client
@@ -801,12 +799,12 @@ user. COLOR has to be sufficiently different from used
colors."
(object-remove-from-list this :clients client)
)
-(defmethod rudel-find-context ((this rudel-obby-server) client document)
+(cl-defmethod rudel-find-context ((this rudel-obby-server) client document)
"Return the jupiter context associated to (CLIENT DOCUMENT) in THIS."
(with-slots (contexts) this
(gethash (rudel-obby-context-key client document) contexts)))
-(defmethod rudel-add-context ((this rudel-obby-server) client document)
+(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
@@ -817,7 +815,7 @@ user. COLOR has to be sufficiently different from used
colors."
contexts))))
)
-(defmethod rudel-remove-context ((this rudel-obby-server) client document)
+(cl-defmethod rudel-remove-context ((this rudel-obby-server) client document)
"Remove the jupiter context associated to (CLIENT DOCUMENT) from THIS."
(with-slots (contexts) this
(remhash
@@ -830,7 +828,7 @@ user. COLOR has to be sufficiently different from used
colors."
(with-slots ((doc-id :id)) document
(list client-id doc-id))))
-(defmethod object-print ((this rudel-obby-server) &rest strings)
+(cl-defmethod object-print ((this rudel-obby-server) &rest strings)
"Print THIS with number of clients."
(with-slots (clients) this
(apply #'call-next-method
diff --git a/rudel-obby-state.el b/rudel-obby-state.el
index a8a1fe9..ee42434 100644
--- a/rudel-obby-state.el
+++ b/rudel-obby-state.el
@@ -62,14 +62,14 @@ state."))
"Base class for state classes used in the obby backend."
:abstract t)
-(defmethod rudel-enter ((_this rudel-obby-state))
+(cl-defmethod rudel-enter ((_this rudel-obby-state))
"Default behavior is doing nothing when entering a state."
nil)
-(defmethod rudel-leave ((_this rudel-obby-state))
+(cl-defmethod rudel-leave ((_this rudel-obby-state))
"Default behavior is doing nothing when leaving a state.")
-(defmethod rudel-accept ((this rudel-obby-state) message)
+(cl-defmethod rudel-accept ((this rudel-obby-state) message)
"Dispatch to appropriate handler based on MESSAGE.
Display a warning if no such handler is found."
;; Try to dispatch to the correct message handler. If there is none,
@@ -101,7 +101,7 @@ Display a warning if no such handler is found."
"Base class for state classes used by obby client connections."
:abstract t)
-(defmethod rudel-obby/net6_ping ((this rudel-obby-client-connection-state))
+(cl-defmethod rudel-obby/net6_ping ((this rudel-obby-client-connection-state))
"Handle net6 'ping' message."
(rudel-send this "net6_pong")
nil)
@@ -115,7 +115,7 @@ Display a warning if no such handler is found."
"Base class for server connection states."
:abstract t)
-(defmethod rudel-broadcast ((this rudel-obby-server-connection-state)
+(cl-defmethod rudel-broadcast ((this rudel-obby-server-connection-state)
receivers name &rest arguments)
"Broadcast message NAME with arguments ARGUMENTS to RECEIVERS."
(with-slots (connection) this
@@ -136,7 +136,7 @@ called to retrieved document object by their ids."))
obby 'document' messages."
:abstract t)
-(defmethod rudel-obby/obby_document
+(cl-defmethod rudel-obby/obby_document
((this rudel-obby-document-handler) doc-id action &rest arguments)
"Handle obby 'document' message family."
;; Try to dispatch to the correct message handler. If there is none,
diff --git a/rudel-obby-util.el b/rudel-obby-util.el
index 0b1b5df..cae27c3 100644
--- a/rudel-obby-util.el
+++ b/rudel-obby-util.el
@@ -41,6 +41,7 @@
;;
(require 'cl-lib)
+(require 'cl-generic)
(require 'eieio)
(require 'jupiter)
@@ -53,27 +54,27 @@
;;; Message serialization
;;
-(defgeneric rudel-operation->message ((this jupiter-operation))
+(cl-defgeneric rudel-operation->message ((this jupiter-operation))
"Generate a list obby message components from THIS operation.")
-(defmethod rudel-operation->message ((this jupiter-insert))
+(cl-defmethod rudel-operation->message ((this jupiter-insert))
"Serialize THIS insert operation."
(with-slots (from data) this
(list "ins" (format "%x" from) data)))
-(defmethod rudel-operation->message ((this jupiter-delete))
+(cl-defmethod rudel-operation->message ((this jupiter-delete))
"Serialize THIS delete operation."
(with-slots (from length) this
(list "del" (format "%x" from) (format "%x" length))))
-(defmethod rudel-operation->message ((this jupiter-compound))
+(cl-defmethod rudel-operation->message ((this jupiter-compound))
"Serialize THIS compound operation."
(with-slots (children) this
(apply #'append
(list "split" )
(mapcar #'rudel-operation->message children))))
-(defmethod rudel-operation->message ((_this jupiter-nop))
+(cl-defmethod rudel-operation->message ((_this jupiter-nop))
"Serialize THIS nop operation."
(list "nop"))
@@ -137,16 +138,16 @@ construction of the name of the new operation. "
;;; Character <-> byte position conversion
;;
-(defgeneric rudel-obby-char->byte ((this jupiter-operation) buffer)
+(cl-defgeneric rudel-obby-char->byte ((this jupiter-operation) buffer)
"Convert character positions and lengths in THIS to bytes.")
-(defmethod rudel-obby-char->byte ((this jupiter-insert) buffer)
+(cl-defmethod rudel-obby-char->byte ((this jupiter-insert) buffer)
"Convert character positions and lengths in THIS insert to bytes."
(with-slots (from) this
(with-current-buffer buffer
(setq from (- (position-bytes (+ from 1)) 1)))))
-(defmethod rudel-obby-char->byte ((this jupiter-delete) buffer)
+(cl-defmethod rudel-obby-char->byte ((this jupiter-delete) buffer)
"Convert character positions and lengths in THIS delete to bytes."
(with-slots (from to length) this
(let ((old-from (+ from 1))
@@ -161,7 +162,7 @@ construction of the name of the new operation. "
(- old-to change-from))))))))
)
-(defmethod rudel-obby-char->byte ((this jupiter-compound) buffer)
+(cl-defmethod rudel-obby-char->byte ((this jupiter-compound) buffer)
"Convert character positions and lengths in THIS compound to bytes.."
(with-slots (children) this
(mapc
@@ -170,19 +171,19 @@ construction of the name of the new operation. "
children))
)
-(defmethod rudel-obby-char->byte ((_this jupiter-nop) _buffer)
+(cl-defmethod rudel-obby-char->byte ((_this jupiter-nop) _buffer)
"Nothing to convert if THIS is a nop.")
-(defgeneric rudel-obby-byte->char ((this jupiter-operation) buffer)
+(cl-defgeneric rudel-obby-byte->char ((this jupiter-operation) buffer)
"Convert byte positions and lengths in THIS to character positions.")
-(defmethod rudel-obby-byte->char ((this jupiter-insert) buffer)
+(cl-defmethod rudel-obby-byte->char ((this jupiter-insert) buffer)
"Convert byte positions and lengths in THIS insert to character positions."
(with-slots (from) this
(with-current-buffer buffer
(setq from (- (byte-to-position (+ from 1)) 1)))))
-(defmethod rudel-obby-byte->char ((this jupiter-delete) buffer)
+(cl-defmethod rudel-obby-byte->char ((this jupiter-delete) buffer)
"Convert byte positions and lengths in THIS delete to character positions."
(with-slots (from to length) this
(let ((old-from from)
@@ -192,7 +193,7 @@ construction of the name of the new operation. "
to (- (byte-to-position (+ old-from old-length 1)) 1)))))
)
-(defmethod rudel-obby-byte->char ((this jupiter-compound) buffer)
+(cl-defmethod rudel-obby-byte->char ((this jupiter-compound) buffer)
"Convert byte positions and lengths in THIS compound to character positions."
(with-slots (children) this
(mapc
@@ -201,7 +202,7 @@ construction of the name of the new operation. "
children))
)
-(defmethod rudel-obby-byte->char ((_this jupiter-nop) _buffer)
+(cl-defmethod rudel-obby-byte->char ((_this jupiter-nop) _buffer)
"Nothing to convert if THIS is a nop.")
diff --git a/rudel-obby.el b/rudel-obby.el
index e5adc77..69c3c69 100644
--- a/rudel-obby.el
+++ b/rudel-obby.el
@@ -85,14 +85,13 @@ multiple chunks.")
"Main class of the Rudel obby backend. Creates obby client
connections and creates obby servers.")
-(defmethod initialize-instance ((this rudel-obby-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-obby-backend) _slots)
"Initialize slots of THIS with SLOTS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-obby-version))
-(defmethod rudel-ask-connect-info ((_this rudel-obby-backend)
+(cl-defmethod rudel-ask-connect-info ((_this rudel-obby-backend)
&optional info)
"Ask user for the information required to connect to an obby server."
;; Read server host and port.
@@ -123,7 +122,7 @@ connections and creates obby servers.")
info))
)
-(defmethod rudel-connect ((this rudel-obby-backend) transport
+(cl-defmethod rudel-connect ((this rudel-obby-backend) transport
info info-callback
&optional progress-callback)
"Connect to an obby server using the information INFO.
@@ -227,7 +226,7 @@ Return the connection object."
;; The connection is now usable; return it.
connection))
-(defmethod rudel-ask-host-info ((_this rudel-obby-backend)
+(cl-defmethod rudel-ask-host-info ((_this rudel-obby-backend)
&optional info)
"Ask user for information required to host an obby session."
;; Read address and port unless they are already specified in INFO.
@@ -241,7 +240,7 @@ Return the connection object."
info))
)
-(defmethod rudel-host ((_this rudel-obby-backend) listener _info)
+(cl-defmethod rudel-host ((_this rudel-obby-backend) listener _info)
"Host an obby session using the information INFO.
Return the created server."
;; Before we start, we load the server functionality.
@@ -252,7 +251,7 @@ Return the created server."
"obby-server"
:listener listener))
-(defmethod rudel-make-document ((this rudel-obby-backend)
+(cl-defmethod rudel-make-document ((this rudel-obby-backend)
name session)
"Make a new document in SESSION named NAME.
Return the new document."
@@ -266,7 +265,7 @@ Return the new document."
:suffix 1)))
)
-(defmethod rudel-available-document-id ((_this rudel-obby-backend)
+(cl-defmethod rudel-available-document-id ((_this rudel-obby-backend)
session)
"Return a document id, which is not in use in SESSION."
;; Look through some candidates until an unused id is hit.
@@ -305,7 +304,7 @@ otherwise.")
""))
"Class rudel-obby-user ")
-(defmethod eieio-speedbar-description ((this rudel-obby-user))
+(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)
@@ -316,7 +315,7 @@ otherwise.")
(if encryption "Encryption" "Plain")))
)
-(defmethod eieio-speedbar-object-buttonname ((this rudel-obby-user))
+(cl-defmethod eieio-speedbar-object-buttonname ((this rudel-obby-user))
"Return a string to use as a speedbar button for THIS."
(rudel-display-string this))
@@ -344,25 +343,24 @@ documents."))
"Objects of the class rudel-obby-document represent shared
documents in obby sessions.")
-(defmethod rudel-both-ids ((this rudel-obby-document))
+(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
(list owner-id doc-id)))
-(defmethod rudel-unique-name ((this rudel-obby-document))
+(cl-defmethod rudel-unique-name ((this rudel-obby-document))
"Generate a unique name for THIS based on the name and the suffix."
(with-slots (suffix) this
- (concat (when (next-method-p)
- (call-next-method))
+ (concat (cl-call-next-method)
(when (> suffix 1)
(format "<%d>" suffix))))
)
-(defmethod eieio-speedbar-description ((this rudel-obby-document))
+(cl-defmethod eieio-speedbar-description ((this rudel-obby-document))
"Construct a description for from the name of document object THIS."
(format "Document %s" (object-name-string this)))
-(defmethod eieio-speedbar-object-buttonname ((this rudel-obby-document))
+(cl-defmethod eieio-speedbar-object-buttonname ((this rudel-obby-document))
"Return a string to use as a speedbar button for OBJECT."
(with-slots (subscribed) this
(format "%-12s %s" (object-name-string this)
diff --git a/rudel-operations.el b/rudel-operations.el
index 598e6b2..21df2b5 100644
--- a/rudel-operations.el
+++ b/rudel-operations.el
@@ -47,6 +47,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'eieio)
@@ -58,7 +59,7 @@
"Abstract base class for operations."
:abstract t)
-(defgeneric rudel-apply ((this rudel-operation) object)
+(cl-defgeneric rudel-apply ((this rudel-operation) object)
"Apply the change represented by THIS to OBJECT.")
@@ -90,7 +91,7 @@ end of buffer"))
""
:abstract t)
-(defmethod slot-missing ((this rudel-range-operation)
+(cl-defmethod slot-missing ((this rudel-range-operation)
slot-name operation &optional new-value)
"Simulate slot :length"
(cond
@@ -102,7 +103,7 @@ end of buffer"))
(- to from)
(setq to (+ from new-value)))))
;; Call next method
- (t (call-next-method)))
+ (t (cl-call-next-method)))
)
@@ -117,12 +118,12 @@ end of buffer"))
"The inserted string."))
"Objects of this class represent insertion operations.")
-(defmethod rudel-apply ((this rudel-insert-op) object)
+(cl-defmethod rudel-apply ((this rudel-insert-op) object)
"Apply THIS to OBJECT by inserting the associated data."
(with-slots (from data) this
(rudel-insert object from data)))
-(defmethod slot-missing ((this rudel-insert-op)
+(cl-defmethod slot-missing ((this rudel-insert-op)
slot-name operation &optional _new-value)
"Simulate read-only slots :length and :to."
(cond
@@ -139,7 +140,7 @@ end of buffer"))
(with-slots (from length) this
(+ from length)))
;; Call next method
- (t (call-next-method)))
+ (t (cl-call-next-method)))
)
@@ -151,7 +152,7 @@ end of buffer"))
()
"Objects of this class represent deletion operations.")
-(defmethod rudel-apply ((this rudel-delete-op) object)
+(cl-defmethod rudel-apply ((this rudel-delete-op) object)
"Apply THIS to OBJECT by deleting the associated region."
(with-slots (from length) this
(rudel-delete object from length)))
@@ -164,7 +165,7 @@ end of buffer"))
()
"Objects of this class represent cursor movements.")
-(defmethod rudel-apply ((this rudel-move-cursor-op) object)
+(cl-defmethod rudel-apply ((this rudel-move-cursor-op) object)
"Apply THIS to OBJECT by changing the position of one user's cursor."
(with-slots (from) this
(rudel-move-cursor object from)))
@@ -178,7 +179,7 @@ end of buffer"))
"Objects of this class represent changes of users'
selections.")
-(defmethod rudel-apply ((this rudel-move-selection-op) object)
+(cl-defmethod rudel-apply ((this rudel-move-selection-op) object)
"Apply THIS to OBJECT by changing one user's selection."
(with-slots (from to) this
(rudel-move-selection object from to)))
diff --git a/rudel-operators.el b/rudel-operators.el
index 8bc3c17..8e75d57 100644
--- a/rudel-operators.el
+++ b/rudel-operators.el
@@ -46,6 +46,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'eieio)
(require 'rudel-overlay)
@@ -62,12 +63,12 @@
applied."))
"Provides operation methods which modify an associated document.")
-(defmethod rudel-insert ((this rudel-document-operators) position data)
+(cl-defmethod rudel-insert ((this rudel-document-operators) position data)
"Insert DATA at POSITION into the document attached to THIS."
(with-slots (document) this
(rudel-insert document position data)))
-(defmethod rudel-delete ((this rudel-document-operators) position length)
+(cl-defmethod rudel-delete ((this rudel-document-operators) position length)
"Delete a region of LENGTH characters at POSITION from the document attached
to THIS."
(with-slots (document) this
(rudel-delete document position length)))
@@ -89,12 +90,12 @@ performed.")
"Provides operation methods which affect an associated
connection.")
-(defmethod rudel-insert ((this rudel-connection-operators) position data)
+(cl-defmethod rudel-insert ((this rudel-connection-operators) position data)
"Notify the connection associated to THIS of the insertion of DATA at
POSITION."
(with-slots (connection document) this
(rudel-local-insert connection document position data)))
-(defmethod rudel-delete ((this rudel-connection-operators) position length)
+(cl-defmethod rudel-delete ((this rudel-connection-operators) position length)
"Notify the connection associated to THIS of a deletion of LENGTH at
POSITION."
(with-slots (connection document) this
(rudel-local-delete connection document position length)))
@@ -116,7 +117,7 @@ operations are applied")
"Provides operation methods which affect the overlays of a
buffer.")
-(defmethod rudel-insert ((this rudel-overlay-operators) position data)
+(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
(with-slots (buffer) document
@@ -133,7 +134,7 @@ buffer.")
buffer (+ position 1) (length data) user)))
)
-(defmethod rudel-delete ((this rudel-overlay-operators) position length)
+(cl-defmethod rudel-delete ((this rudel-overlay-operators) position length)
"Update the overlays associated to THIS to incorporate a deletion of LENGTH
at POSITION."
(with-slots (document user) this
(with-slots (buffer) document
@@ -156,13 +157,13 @@ buffer.")
"Provides operation methods which cause corresponding hooks to
be called.")
-(defmethod rudel-insert ((this rudel-hook-operators) position data)
+(cl-defmethod rudel-insert ((this rudel-hook-operators) position data)
"Call insert hook associated to THIS with POSITION and DATA."
(with-slots (document user) this
(with-slots (buffer) document
(run-hook-with-args 'rudel-insert-hook buffer user position data))))
-(defmethod rudel-delete ((this rudel-hook-operators) position length)
+(cl-defmethod rudel-delete ((this rudel-hook-operators) position length)
"Call delete hook associated to THIS with POSITION and LENGTH."
(with-slots (document user) this
(with-slots (buffer) document
diff --git a/rudel-protocol.el b/rudel-protocol.el
index 78ae225..967df6e 100644
--- a/rudel-protocol.el
+++ b/rudel-protocol.el
@@ -45,6 +45,7 @@
;;; Code:
;;
+(require 'cl-generic)
(require 'eieio)
(require 'rudel-backend)
@@ -58,13 +59,13 @@
"Interface implemented by protocol backends."
:abstract t)
-(defgeneric rudel-ask-connect-info ((this rudel-protocol-backend)
+(cl-defgeneric rudel-ask-connect-info ((this rudel-protocol-backend)
&optional info)
"Retrieve information for joining a session from user.
When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
-(defgeneric rudel-connect ((this rudel-protocol-backend) transport
+(cl-defgeneric rudel-connect ((this rudel-protocol-backend) transport
info info-callback
&optional progress-callback)
"Create a new connection through TRANSPORT according to the data in INFO.
@@ -81,13 +82,13 @@ Implementations can rely on the fact that the property
:session
in INFO contains the `rudel-session' object to which the new
connection will be associated.")
-(defgeneric rudel-ask-host-info ((this rudel-protocol-backend)
+(cl-defgeneric rudel-ask-host-info ((this rudel-protocol-backend)
&optional info)
"Retrieve information for hosting a session from user.
When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
-(defgeneric rudel-host ((this rudel-protocol-backend) backend
+(cl-defgeneric rudel-host ((this rudel-protocol-backend) backend
info)
"Create a new session according to the property list INFO.
BACKEND has to be an object of a class derived from
@@ -95,7 +96,7 @@ BACKEND has to be an object of a class derived from
capability.
The created session object is returned.")
-(defgeneric rudel-make-document ((this rudel-protocol-backend)
+(cl-defgeneric rudel-make-document ((this rudel-protocol-backend)
name session)
"Create a new document object named NAME for SESSION.")
diff --git a/rudel-session-initiation.el b/rudel-session-initiation.el
index 6301dd5..de2bd68 100644
--- a/rudel-session-initiation.el
+++ b/rudel-session-initiation.el
@@ -56,6 +56,7 @@
(require 'cl-lib)
+(require 'cl-generic)
(require 'eieio)
(require 'rudel-backend)
@@ -156,7 +157,7 @@ implemented by this backend. Has to be either 'primary or
"Interface implemented by session initiation backends."
:abstract t)
-(defgeneric rudel-discover ((this rudel-session-initiation-backend))
+(cl-defgeneric rudel-discover ((this rudel-session-initiation-backend))
"Return a list of discovered sessions.
Each list element is a connect info property list. See
`rudel-join-session' for a description of the format of this
@@ -165,7 +166,7 @@ list.
The presence of an implementation of this generic function should
be indicated by the presence of the 'discover' capability.")
-(defgeneric rudel-advertise ((this rudel-session-initiation-backend) info)
+(cl-defgeneric rudel-advertise ((this rudel-session-initiation-backend) info)
"Advertise session described by INFO.
INFO is a connect info property list. See `rudel-host-session'
for a description of the format of this list.
@@ -264,15 +265,14 @@ advertise the session."
user select a suitable backend and asking for connect information
required by the chosen backend.")
-(defmethod initialize-instance ((this rudel-ask-protocol-backend)
+(cl-defmethod initialize-instance ((this rudel-ask-protocol-backend)
_slots)
"Set backend version."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-ask-protocol-version))
-(defmethod rudel-discover ((_this rudel-ask-protocol-backend))
+(cl-defmethod rudel-discover ((_this rudel-ask-protocol-backend))
"\"Discover\" sessions by asking the user about the backend to use and the
connect info."
(let ((protocol-backend (rudel-backend-choose
'protocol
@@ -311,15 +311,14 @@ required by the chosen backend.")
"This fallback backend can \"discover\" sessions the user has
configured using customization.")
-(defmethod initialize-instance ((this rudel-configured-sessions-backend)
+(cl-defmethod initialize-instance ((this rudel-configured-sessions-backend)
_slots)
"Set backend version."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-configured-sessions-version))
-(defmethod rudel-discover ((_this rudel-configured-sessions-backend))
+(cl-defmethod rudel-discover ((_this rudel-configured-sessions-backend))
"\"Discover\" sessions the has configured."
;; Iterate over all configured sessions in order to make
;; adjustments.
diff --git a/rudel-socket.el b/rudel-socket.el
index f19c97d..756bea5 100644
--- a/rudel-socket.el
+++ b/rudel-socket.el
@@ -78,7 +78,7 @@ directly installed into the underlying process and therefore
has
to be stored separately."))
"Objects of this class use sockets to transport data.")
-(defmethod initialize-instance :after ((this rudel-socket-transport) _slots)
+(cl-defmethod initialize-instance :after ((this rudel-socket-transport) _slots)
"Install process filter and sentinel for THIS."
(with-slots (socket) this
(set-process-filter
@@ -102,17 +102,17 @@ to be stored separately."))
((or `closed `failed `exit `finished)
(funcall sentinel 'close)))))))))
-(defmethod rudel-send ((this rudel-socket-transport) data)
+(cl-defmethod rudel-send ((this rudel-socket-transport) data)
"Send DATA through THIS."
(with-slots (socket) this
(process-send-string socket data)))
-(defmethod rudel-close ((this rudel-socket-transport))
+(cl-defmethod rudel-close ((this rudel-socket-transport))
"Close THIS."
(with-slots (socket) this
(delete-process socket)))
-(defmethod rudel-start ((this rudel-socket-transport))
+(cl-defmethod rudel-start ((this rudel-socket-transport))
"Start THIS after it has been suspended."
(with-slots (socket) this
(continue-process socket)))
@@ -137,12 +137,12 @@ The dispatch function has to accept a single argument
which will
be a transport object representing the incoming connection."))
"")
-(defmethod rudel-close ((this rudel-socket-listener))
+(cl-defmethod rudel-close ((this rudel-socket-listener))
"Make THIS stop listening for incoming connections."
(with-slots (socket) this
(delete-process socket)))
-(defmethod rudel-handle-connect ((this rudel-socket-listener) socket)
+(cl-defmethod rudel-handle-connect ((this rudel-socket-listener) socket)
"Handle incoming connection SOCKET."
(with-slots (dispatch) this
(when dispatch
@@ -167,10 +167,9 @@ be a transport object representing the incoming
connection."))
"TCP transport backend.
The transport backend is a factory for TCP transport objects.")
-(defmethod initialize-instance ((this rudel-tcp-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-tcp-backend) _slots)
"Initialize slots and set version of THIS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-tcp-version))
@@ -180,7 +179,7 @@ The transport backend is a factory for TCP transport
objects.")
(defvar rudel-tcp-ask-connect-info-port-last nil
"Last port read by TCP backend's `rudel-ask-connect-info'.")
-(defmethod rudel-ask-connect-info ((_this rudel-tcp-backend)
+(cl-defmethod rudel-ask-connect-info ((_this rudel-tcp-backend)
&optional info)
"Augment INFO by read a hostname and a port number."
;; Read server host and port.
@@ -203,7 +202,7 @@ The transport backend is a factory for TCP transport
objects.")
:port port)
info)))
-(defmethod rudel-make-connection ((this rudel-tcp-backend)
+(cl-defmethod rudel-make-connection ((this rudel-tcp-backend)
info info-callback
&optional _progress-callback)
"Connect to a TCP server using the information in INFO.
@@ -229,7 +228,7 @@ and :port."
:socket socket))
)
-(defmethod rudel-wait-for-connections ((this rudel-tcp-backend)
+(cl-defmethod rudel-wait-for-connections ((this rudel-tcp-backend)
info info-callback)
"Create TCP server according to INFO.
INFO has to be a property list containing the key :port."
diff --git a/rudel-speedbar.el b/rudel-speedbar.el
index 3a03ffe..39292e0 100644
--- a/rudel-speedbar.el
+++ b/rudel-speedbar.el
@@ -41,11 +41,11 @@
;;; Class rudel-user methods
;;
-(defmethod eieio-speedbar-description ((this rudel-user))
+(cl-defmethod eieio-speedbar-description ((this rudel-user))
"Provide a speedbar description for OBJ."
(format "User %s" (object-name-string this)))
-(defmethod eieio-speedbar-object-buttonname ((this rudel-user))
+(cl-defmethod eieio-speedbar-object-buttonname ((this rudel-user))
"Return a string to use as a speedbar button for OBJECT."
(format "%s" (object-name-string this)))
@@ -53,11 +53,11 @@
;;; Class rudel-document methods
;;
-(defmethod eieio-speedbar-description ((this rudel-document))
+(cl-defmethod eieio-speedbar-description ((this rudel-document))
"Construct a description for from the name of document object THIS."
(format "Document %s" (object-name-string this)))
-(defmethod eieio-speedbar-object-buttonname ((this rudel-document))
+(cl-defmethod eieio-speedbar-object-buttonname ((this rudel-document))
"Return a string to use as a speedbar button for OBJECT."
(rudel-unique-name this))
diff --git a/rudel-state-machine.el b/rudel-state-machine.el
index 0b36b0d..eb169cd 100644
--- a/rudel-state-machine.el
+++ b/rudel-state-machine.el
@@ -43,6 +43,7 @@
(require 'cl-lib)
+(require 'cl-generic)
(require 'eieio)
(require 'rudel-errors)
@@ -105,13 +106,13 @@
"A state that can be used in state machines."
:abstract t)
-(defgeneric rudel-accept ((this rudel-state) &rest arguments)
+(cl-defgeneric rudel-accept ((this rudel-state) &rest arguments)
"Executed when the machine receives an event while in state THIS.")
-(defgeneric rudel-enter ((this rudel-state) &rest arguments)
+(cl-defgeneric rudel-enter ((this rudel-state) &rest arguments)
"Executed when the machine switches to state THIS.")
-(defgeneric rudel-leave ((this rudel-state))
+(cl-defgeneric rudel-leave ((this rudel-state))
"Executed when the machine leaves state THIS.")
@@ -132,14 +133,13 @@ and STATE is an object of a class derived from
rudel-state.")
"The current state of the machine."))
"A finite state machine.")
-(defmethod initialize-instance ((this rudel-state-machine) slots)
+(cl-defmethod initialize-instance ((this rudel-state-machine) slots)
"Initialize slots of THIS skipping :start initarg."
;; Call the next method, passing only non-virtual initargs.
- (when (next-method-p)
- (call-next-method
- this (rudel-state-machine-strip-initargs slots))))
+ (cl-call-next-method
+ this (rudel-state-machine-strip-initargs slots)))
-(defmethod initialize-instance :after ((this rudel-state-machine) slots)
+(cl-defmethod initialize-instance :after ((this rudel-state-machine) slots)
"Set current state of THIS to a proper initial value.
If a start state is specified using the :start init argument to
the constructor, that state is used. If there is no such state,
@@ -174,16 +174,16 @@ that fails as well, the first state in the state list is
used."
this start (apply #'rudel-enter start args))))
)
-(defmethod rudel-find-state ((this rudel-state-machine) name)
+(cl-defmethod rudel-find-state ((this rudel-state-machine) name)
"Return state object for symbol NAME."
(with-slots (states) this
(cdr (assoc name states))))
-(defmethod rudel-register-state ((this rudel-state-machine) name state)
+(cl-defmethod rudel-register-state ((this rudel-state-machine) name state)
"Register STATE and its NAME with THIS state machine."
(object-add-to-list this :states (cons name state) t))
-(defmethod rudel-register-states ((this rudel-state-machine) states)
+(cl-defmethod rudel-register-states ((this rudel-state-machine) states)
"Register STATES with THIS state machine.
STATES is a list of cons cells whose car is a symbol - the name
of the state - and whose cdr is a class."
@@ -193,7 +193,7 @@ of the state - and whose cdr is a class."
this name (make-instance class (symbol-name name)))))
)
-(defmethod rudel-current-state ((this rudel-state-machine) &optional object)
+(cl-defmethod rudel-current-state ((this rudel-state-machine) &optional object)
"Return name and, optionally, state object of the current state of THIS.
If OBJECT is non-nil, (NAME . OBJECT) is returned. Otherwise,
just NAME."
@@ -204,7 +204,7 @@ just NAME."
state-symbol)))
)
-(defmethod rudel-accept ((this rudel-state-machine) &rest arguments)
+(cl-defmethod rudel-accept ((this rudel-state-machine) &rest arguments)
"Process an event described by ARGUMENTS."
(with-slots (state) this
;; Let the current state decide which state is next.
@@ -225,7 +225,7 @@ just NAME."
(signal 'wrong-type-argument (list (type-of next)))))))
)
-(defmethod rudel-switch ((this rudel-state-machine) next
+(cl-defmethod rudel-switch ((this rudel-state-machine) next
&rest arguments)
"Leave current state and switch to state NEXT.
ARGUMENTS are passed to the `rudel-enter' method of the successor
@@ -272,7 +272,7 @@ state."
this state (apply #'rudel-enter state arguments))))
)
-(defmethod rudel--switch-to-return-value ((this rudel-state-machine)
+(cl-defmethod rudel--switch-to-return-value ((this rudel-state-machine)
state next)
"Switch from STATE to the next state indicated by NEXT.
STATE is the current state.
@@ -290,7 +290,7 @@ NEXT can nil, a list or a `rudel-state' object."
(rudel-switch this next)))
)
-(defmethod object-print ((this rudel-state-machine) &rest strings)
+(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
@@ -299,7 +299,7 @@ NEXT can nil, a list or a `rudel-state' object."
(format " state: %s"
(object-name-string state))
strings))
- (call-next-method this " state: #start" strings))
+ (cl-call-next-method this " state: #start" strings))
)
@@ -330,17 +330,17 @@ between states."))
"State machine objects of this class run hooks when they accept
arguments and when they switch states.")
-(defmethod rudel-accept :before ((this rudel-hook-state-machine)
+(cl-defmethod rudel-accept :before ((this rudel-hook-state-machine)
&rest arguments)
"This method runs 'accept-hook' before ARGUMENTS are processed."
(apply #'object-run-hook-with-args this 'accept-hook arguments))
-(defmethod rudel-switch :before ((this rudel-hook-state-machine) _next
+(cl-defmethod rudel-switch :before ((this rudel-hook-state-machine) _next
&rest arguments)
"This method stores ARGUMENTS for later processing."
(oset this :last-args arguments))
-(defmethod rudel-set-state :before ((this rudel-hook-state-machine) next
+(cl-defmethod rudel-set-state :before ((this rudel-hook-state-machine) next
&rest _arguments)
"This method runs 'switch-hook' when switching states."
(with-slots (last-args) this
diff --git a/rudel-telepathy.el b/rudel-telepathy.el
index 72e1e31..6c09b85 100644
--- a/rudel-telepathy.el
+++ b/rudel-telepathy.el
@@ -58,10 +58,9 @@
((capabilities :initform '()))
"Class rudel-telepathy-backend ")
-(defmethod initialize-instance ((this rudel-telepathy-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-telepathy-backend) _slots)
"Initialize slots of THIS according to SLOTS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-telepathy-version))
diff --git a/rudel-tls.el b/rudel-tls.el
index cf1269a..6ef9502 100644
--- a/rudel-tls.el
+++ b/rudel-tls.el
@@ -225,7 +225,7 @@ This only works if PROCESS has been created by
"Objects of this class provide socket transports with START TLS
capability.")
-(defmethod initialize-instance :after
+(cl-defmethod initialize-instance :after
((this rudel-start-tls-transport) _slots)
"Repair filter of the process owned by THIS."
;; The superclass `rudel-socket-transport' installs its filter
@@ -236,7 +236,7 @@ capability.")
(process-put socket :old-filter (process-filter socket))
(set-process-filter socket #'rudel-tls-wait-init)))
-(defmethod rudel-enable-encryption ((this rudel-start-tls-transport))
+(cl-defmethod rudel-enable-encryption ((this rudel-start-tls-transport))
"Try to enable TLS encryption on THIS transport."
(with-slots (socket) this
(rudel-tls-start-tls socket)))
@@ -252,10 +252,9 @@ capability.")
The transport backend is a factory for transport objects that
support STARTTLS behavior.")
-(defmethod initialize-instance ((this rudel-start-tls-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-start-tls-backend) _slots)
"Initialize slots and set version of THIS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-tls-version)
@@ -268,7 +267,7 @@ support STARTTLS behavior.")
(defvar rudel-tls-ask-connect-info-port-last nil
"Last port read by TLS backend's `rudel-ask-connect-info'.")
-(defmethod rudel-ask-connect-info ((_this rudel-start-tls-backend)
+(cl-defmethod rudel-ask-connect-info ((_this rudel-start-tls-backend)
&optional info)
"Augment INFO by read a hostname and a port number."
;; Read server host and port.
@@ -291,7 +290,7 @@ support STARTTLS behavior.")
:port port)
info)))
-(defmethod rudel-make-connection ((this rudel-start-tls-backend)
+(cl-defmethod rudel-make-connection ((this rudel-start-tls-backend)
info info-callback
&optional _progress-callback)
"Connect to a START-TLS server using the information in INFO.
diff --git a/rudel-transport-util.el b/rudel-transport-util.el
index b667b3a..cc105ea 100644
--- a/rudel-transport-util.el
+++ b/rudel-transport-util.el
@@ -98,7 +98,7 @@ transport changes."))
transform a bidirectional data stream as it passes through them."
:abstract t)
-(defmethod slot-missing ((this rudel-transport-filter)
+(cl-defmethod slot-missing ((this rudel-transport-filter)
slot-name operation &optional new-value)
"Make slots of underlying transport available as virtual slots of THIS."
(cond
@@ -117,7 +117,7 @@ transform a bidirectional data stream as it passes through
them."
(set-slot-value (oref this :transport) slot-name new-value)))
)
-(defmethod no-applicable-method ((this rudel-transport-filter)
+(cl-defmethod no-applicable-method ((this rudel-transport-filter)
method &rest args)
"Make methods of underlying transport callable as virtual methods of THIS."
(apply method (oref this :transport) (cdr args)))
@@ -152,12 +152,11 @@ are sent unmodified."))
"Objects of this class assemble received message fragments into
complete messages by calling an assembly function.")
-(defmethod initialize-instance ((this rudel-assembling-transport-filter)
+(cl-defmethod initialize-instance ((this rudel-assembling-transport-filter)
_slots)
"Initialize THIS using SLOTS and install suitable handlers."
;; Initialize slots.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(with-slots (transport) this
;; Install a handler for received data that assembles messages
@@ -183,7 +182,7 @@ complete messages by calling an assembly function.")
(when sentinel
(funcall sentinel event)))))))
-(defmethod rudel-send ((this rudel-assembling-transport-filter) data)
+(cl-defmethod rudel-send ((this rudel-assembling-transport-filter) data)
"Send DATA using the transport of THIS."
(with-slots (transport fragment-function) this
(if fragment-function
@@ -219,11 +218,10 @@ object to transform it into a string representation."))
string representations and structured representations by calling
a pair of one parse and one generate function.")
-(defmethod initialize-instance ((this rudel-parsing-transport-filter) _slots)
+(cl-defmethod initialize-instance ((this rudel-parsing-transport-filter)
_slots)
"Initialize THIS using SLOTS and install suitable handlers."
;; Initialize slots.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(with-slots (transport) this
;; Install a handler for received data that parses messages into
@@ -245,7 +243,7 @@ a pair of one parse and one generate function.")
(when sentinel
(funcall sentinel event)))))))
-(defmethod rudel-send ((this rudel-parsing-transport-filter) message)
+(cl-defmethod rudel-send ((this rudel-parsing-transport-filter) message)
"Apply generate function to MESSAGE, pass result to transport of THIS."
(with-slots (transport generate-function) this
(rudel-send transport (funcall generate-function message))))
@@ -260,7 +258,7 @@ a pair of one parse and one generate function.")
receive their data from underlying transports. Instead data is
injected by calling `rudel-inject'.")
-(defmethod rudel-inject ((this rudel-injecting-transport-filter) data)
+(cl-defmethod rudel-inject ((this rudel-injecting-transport-filter) data)
"Inject DATA as if it was received from an underlying transport."
(with-slots (filter) this
(when filter
@@ -292,12 +290,11 @@ stopped."))
"Objects of this class are transport filters that can queue
incoming and outgoing data and process it later.")
-(defmethod initialize-instance ((this rudel-buffering-transport-filter)
+(cl-defmethod initialize-instance ((this rudel-buffering-transport-filter)
_slots)
"Initialize slots of THIS and install filter in underlying transport."
;; Initialize slots.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(with-slots (transport) this
;; Install `rudel-handle' as filter in underlying transport.
@@ -311,7 +308,7 @@ incoming and outgoing data and process it later.")
(when sentinel
(funcall sentinel event)))))))
-(defmethod rudel-send ((this rudel-buffering-transport-filter) data)
+(cl-defmethod rudel-send ((this rudel-buffering-transport-filter) data)
"Send DATA through THIS, queueing when necessary."
(with-slots (transport stopped queue-out) this
(if stopped
@@ -320,7 +317,7 @@ incoming and outgoing data and process it later.")
;; Otherwise send DATA right away.
(rudel-send transport data))))
-(defmethod rudel-stop ((this rudel-buffering-transport-filter))
+(cl-defmethod rudel-stop ((this rudel-buffering-transport-filter))
"Stop THIS, queue incoming and out going data."
(with-slots (stopped) this
;; The filter cannot be stopped if it already is stopped.
@@ -331,7 +328,7 @@ incoming and outgoing data and process it later.")
(setq stopped t))
)
-(defmethod rudel-start ((this rudel-buffering-transport-filter))
+(cl-defmethod rudel-start ((this rudel-buffering-transport-filter))
"Start THIS, process queued incoming and outgoing data."
(with-slots (stopped queue-in queue-out filter) this
;; Send queued outgoing data.
@@ -347,7 +344,7 @@ incoming and outgoing data and process it later.")
queue-out nil
stopped nil)))
-(defmethod rudel-handle ((this rudel-buffering-transport-filter) data)
+(cl-defmethod rudel-handle ((this rudel-buffering-transport-filter) data)
"Handle DATA."
(with-slots (stopped queue-in filter) this
(if stopped
@@ -396,12 +393,11 @@ queued data even if it is smaller than a complete
chunk."))
sent through them until certain amounts of data are available for
transmission.")
-(defmethod initialize-instance ((this rudel-collecting-transport-filter)
+(cl-defmethod initialize-instance ((this rudel-collecting-transport-filter)
_slots)
"Initialize slots of THIS and setup filter of underlying transport."
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(with-slots (transport) this
;; Install a filter in the underlying transport.
@@ -417,7 +413,7 @@ transmission.")
(when sentinel
(funcall sentinel event)))))))
-(defmethod rudel-send ((this rudel-collecting-transport-filter) data)
+(cl-defmethod rudel-send ((this rudel-collecting-transport-filter) data)
"Send or enqueue DATA."
(with-slots (transport queue queued-size flush-size) this
;; Enqueue new data.
@@ -432,14 +428,14 @@ transmission.")
(rudel-flush this)))
)
-(defmethod rudel-flush ((this rudel-collecting-transport-filter))
+(cl-defmethod rudel-flush ((this rudel-collecting-transport-filter))
"Transmit all data queued in THIS immediately."
(with-slots (transport queue queued-size) this
(rudel-send transport (mapconcat #'identity (nreverse queue) ""))
(setq queue nil
queued-size 0)))
-(defmethod rudel-maybe-start-timer
+(cl-defmethod rudel-maybe-start-timer
((this rudel-collecting-transport-filter))
"Start timer that runs `rudel-flush' when it expires."
;; If necessary, create a timer that runs `rudel-flush' when it
@@ -452,7 +448,7 @@ transmission.")
(rudel-flush this)
(oset this :timer nil)))))))
-(defmethod rudel-maybe-cancel-timer
+(cl-defmethod rudel-maybe-cancel-timer
((this rudel-collecting-transport-filter))
"Cancel the flush timer of this."
(with-slots (timer) this
@@ -478,11 +474,10 @@ multiple chunks.")
"TODO"))
"TODO")
-(defmethod initialize-instance
+(cl-defmethod initialize-instance
((this rudel-progress-reporting-transport-filter) _slots)
"TODO"
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(with-slots (reporter) this
(setq reporter (make-progress-reporter "Sending data " 0.0 1.0)))
@@ -494,7 +489,7 @@ multiple chunks.")
(when filter
(funcall filter data)))))))
-(defmethod rudel-send ((this rudel-progress-reporting-transport-filter)
+(cl-defmethod rudel-send ((this rudel-progress-reporting-transport-filter)
data)
"TODO"
(with-slots (transport reporter) this
diff --git a/rudel-transport.el b/rudel-transport.el
index fc0028d..0abe8fe 100644
--- a/rudel-transport.el
+++ b/rudel-transport.el
@@ -40,6 +40,7 @@
(require 'eieio)
+(require 'cl-generic)
(require 'rudel-errors) ;; for `rudel-error'
(require 'rudel-backend)
@@ -66,21 +67,21 @@
()
"Interface for transport objects.")
-(defgeneric rudel-set-filter ((this rudel-transport) handler)
+(cl-defgeneric rudel-set-filter ((this rudel-transport) handler)
"Install HANDLER as dispatcher for messages received by THIS.")
-(defgeneric rudel-set-sentinel ((this rudel-transport) handler)
+(cl-defgeneric rudel-set-sentinel ((this rudel-transport) handler)
"Install HANDLER as dispatcher for state changes of THIS.")
-(defgeneric rudel-send ((this rudel-transport) data)
+(cl-defgeneric rudel-send ((this rudel-transport) data)
"Send DATA through THIS transport object.")
-(defgeneric rudel-close ((this rudel-transport))
+(cl-defgeneric rudel-close ((this rudel-transport))
"Close THIS.")
;; TODO we could get rid of this if we required implementations to
;; queue messages until a handler is installed
-(defgeneric rudel-start ((this rudel-transport))
+(cl-defgeneric rudel-start ((this rudel-transport))
"Start THIS.")
@@ -94,12 +95,12 @@ Listener objects wait for incoming connections and create
transport objects representing such connections."
:abstract t)
-(defgeneric rudel-set-dispatcher ((this rudel-listener) handler)
+(cl-defgeneric rudel-set-dispatcher ((this rudel-listener) handler)
"Install HANDLER as dispatch function for incoming connections.
HANDLER has to accept a single argument which will be a transport
object representing the incoming connection.")
-(defgeneric rudel-close ((this rudel-listener))
+(cl-defgeneric rudel-close ((this rudel-listener))
"Cause THIS to stop listening for incoming connections.")
@@ -111,13 +112,13 @@ object representing the incoming connection.")
"Interface implemented by transport backends."
:abstract t)
-(defgeneric rudel-ask-connect-info ((this rudel-transport-backend)
+(cl-defgeneric rudel-ask-connect-info ((this rudel-transport-backend)
&optional info)
"Retrieve information for making a new connection.
When INFO is non-nil, augment INFO to produce new list.
Return a property list that contains the collected information.")
-(defgeneric rudel-make-connection ((this rudel-transport-backend)
+(cl-defgeneric rudel-make-connection ((this rudel-transport-backend)
info info-callback
&optional progress-callback)
"Create a transport object according to INFO.
@@ -138,7 +139,7 @@ The returned transport object has to be in a stopped state
in the
sense that it does not attempt to dispatch any data to the filter
function before `rudel-start' has been called.")
-(defgeneric rudel-wait-for-connections ((this rudel-transport-backend)
+(cl-defgeneric rudel-wait-for-connections ((this rudel-transport-backend)
info info-callback)
"Create and return listener object according to INFO.
INFO has to be a property list specifying desired properties of
diff --git a/rudel-util.el b/rudel-util.el
index 5cac3cf..64e3a52 100644
--- a/rudel-util.el
+++ b/rudel-util.el
@@ -44,6 +44,7 @@
;;
(require 'cl-lib)
+(require 'cl-generic)
(require 'eieio)
@@ -74,25 +75,25 @@ event/subscription, but for Emacs, the notion of hooks
seems more
appropriate."
:abstract t)
-(defmethod object-add-hook ((this rudel-hook-object)
+(cl-defmethod object-add-hook ((this rudel-hook-object)
hook function &optional append)
"Add FUNCTION to HOOK for THIS.
If APPEND is non-nil FUNCTION becomes the last element in the
list of hooks."
(let ((value (slot-value this hook)))
(unless (member function value)
- (set-slot-value this hook
- (if append (append value (list function))
- (cons function value)))))
+ (setf (slot-value this hook)
+ (if append (append value (list function))
+ (cons function value)))))
)
-(defmethod object-remove-hook ((this rudel-hook-object)
+(cl-defmethod object-remove-hook ((this rudel-hook-object)
hook function)
"Remove FUNCTION from HOOK for THIS."
- (set-slot-value this hook
- (remove function (slot-value this hook))))
+ (setf (slot-value this hook)
+ (remove function (slot-value this hook))))
-(defmethod object-run-hook-with-args ((this rudel-hook-object)
+(cl-defmethod object-run-hook-with-args ((this rudel-hook-object)
hook &rest arguments)
"Run HOOK of THIS with arguments ARGUMENTS."
(mapc (lambda (f) (apply f this arguments)) (slot-value this hook)))
@@ -111,22 +112,19 @@ the slot that holds the reference to the target object."))
the slots of some other object as if they were their own slots."
:abstract t)
-(defmethod slot-missing ((this rudel-impersonator)
- slot-name operation &optional new-value)
+(cl-defmethod slot-missing ((this rudel-impersonator)
+ slot-name operation &optional new-value)
"Look up SLOT-NAME in the state machine associated to THIS."
(let ((target (slot-value this (oref this impersonation-target-slot))))
- (condition-case error
+ (condition-case nil
(pcase operation
(`oref
(slot-value target slot-name))
(`oset
- (set-slot-value target slot-name new-value)))
+ (setf (slot-value target slot-name) new-value)))
(invalid-slot-name
- (if (next-method-p)
- (call-next-method)
- (apply #'signal error)))))
- )
+ (cl-call-next-method)))))
;;; Class rudel-delegator
@@ -143,11 +141,11 @@ call methods of some other object as if they were their
own
methods."
:abstract t)
-(defmethod no-applicable-method ((this rudel-delegator)
- method &rest args)
+(cl-defmethod cl-no-applicable-method (method (this rudel-delegator)
+ &rest args)
"Call METHOD on the target object instead of THIS."
(let ((target (slot-value this (oref this delegation-target-slot))))
- (apply method target (cdr args))))
+ (cl-generic-apply method (cons target args))))
;;; Fragmentation and assembling functions.
diff --git a/rudel-wave.el b/rudel-wave.el
index 344c20a..8c72edb 100644
--- a/rudel-wave.el
+++ b/rudel-wave.el
@@ -58,10 +58,9 @@
"Main class of the Rudel Wave backend. Creates wave client
connections.")
-(defmethod initialize-instance ((this rudel-wave-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-wave-backend) _slots)
"Initialize slots of THIS with SLOTS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-wave-version))
diff --git a/rudel-xmpp-debug.el b/rudel-xmpp-debug.el
index 615bf29..c088af6 100644
--- a/rudel-xmpp-debug.el
+++ b/rudel-xmpp-debug.el
@@ -52,7 +52,7 @@
;;; All XMPP states
;;
-(defmethod rudel-debug-target ((this rudel-xmpp-state))
+(cl-defmethod rudel-debug-target ((this rudel-xmpp-state))
"Return debug target of the transport as debug target for THIS."
(with-slots (transport) this
(rudel-debug-target transport)))
@@ -61,7 +61,7 @@
;;; Handle base64 encoded data in SASL steps
;;
-(defmethod rudel-send ((this rudel-xmpp-state-sasl-mechanism-step)
+(cl-defmethod rudel-send ((this rudel-xmpp-state-sasl-mechanism-step)
&rest args)
"Delegate sending ARGS to the transport associated with THIS."
;; We need this primary method in order for the :after method below
@@ -70,7 +70,7 @@
(with-slots (transport) this
(apply #'rudel-send transport args)))
-(defmethod rudel-send :after
+(cl-defmethod rudel-send :after
((this rudel-xmpp-state-sasl-mechanism-step) xml)
"Show base64-decoded version of XML."
(when (and (eq (xml-node-name xml) 'response)
@@ -89,7 +89,7 @@
",")))
)
-(defmethod rudel-accept :before
+(cl-defmethod rudel-accept :before
((this rudel-xmpp-state-sasl-mechanism-step) xml)
"Show base64-decoded version of XML."
(when (and (eq (xml-node-name xml) 'challenge)
diff --git a/rudel-xmpp-sasl.el b/rudel-xmpp-sasl.el
index 48bfe1d..eab022e 100644
--- a/rudel-xmpp-sasl.el
+++ b/rudel-xmpp-sasl.el
@@ -52,7 +52,7 @@
()
"Start state of the SASL negotiation.")
-(defmethod rudel-enter ((_this rudel-xmpp-state-sasl-start)
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-sasl-start)
name server features)
"Extract the list of supported mechanisms from FEATURES.
Then switch to the try one state to try them in order."
@@ -87,7 +87,7 @@ Then switch to the try one state to try them in order."
"State that selects a mechanism and switches to the mechanism
start state for that mechanism.")
-(defmethod rudel-enter ((_this rudel-xmpp-state-sasl-try-one)
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-sasl-try-one)
name server mechanisms)
"If Emacs support the first mechanism in MECHANISMS, try it, otherwise skip
it.
Mechanism are tried by switching to the mechanism start state.
@@ -124,7 +124,7 @@ When no mechanisms are left, switch to the authentication
failed state."
""))
"Start state of the negotiation for the selected mechanism.")
-(defmethod rudel-enter ((this rudel-xmpp-state-sasl-mechanism-start)
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-sasl-mechanism-start)
name1 server1 schema1 mechanism1 rest1)
""
(with-slots (schema mechanism rest) this
@@ -186,7 +186,7 @@ When no mechanisms are left, switch to the authentication
failed state."
"Intermediate step of the negotiation for the selected
mechanism.")
-(defmethod rudel-enter ((this rudel-xmpp-state-sasl-mechanism-step)
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-sasl-mechanism-step)
name1 server1 schema1 client1 step1 rest1)
"Store SCHEMA1, CLIENT1, STEP1 and REST1 for later use."
(with-slots (name server schema client step rest) this
@@ -198,7 +198,7 @@ mechanism.")
rest rest1))
nil)
-(defmethod rudel-accept ((this rudel-xmpp-state-sasl-mechanism-step) xml)
+(cl-defmethod rudel-accept ((this rudel-xmpp-state-sasl-mechanism-step) xml)
"Interpret XML to decide how to proceed with the authentication mechanism."
(pcase (xml-node-name xml)
;; Authentication mechanism failed.
@@ -277,7 +277,7 @@ mechanism.")
nil)) ;; TODO send error or call-next-method?
)
-(defmethod rudel-obtain-sasl-password
+(cl-defmethod rudel-obtain-sasl-password
((this rudel-xmpp-state-sasl-mechanism-step) prompt)
"Replaces prompt function of the sasl library.
This function adds all available context information to the
diff --git a/rudel-xmpp-state.el b/rudel-xmpp-state.el
index 8eeeec7..8d3b9cc 100644
--- a/rudel-xmpp-state.el
+++ b/rudel-xmpp-state.el
@@ -61,19 +61,19 @@
machine of which uses the state object."))
"Base class for XMPP state classes.")
-(defmethod rudel-enter ((_this rudel-xmpp-state) &rest _args)
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state) &rest _args)
"Default behavior is to stay in the newly entered state."
nil)
-(defmethod rudel-leave ((_this rudel-xmpp-state))
+(cl-defmethod rudel-leave ((_this rudel-xmpp-state))
"Default behavior is to do nothing when leaving a state.")
;; TODO choose one
-(defmethod rudel-accept ((_this rudel-xmpp-state) _xml)
+(cl-defmethod rudel-accept ((_this rudel-xmpp-state) _xml)
"Default behavior is to accept XML without taking action."
nil)
-(defmethod rudel-accept ((_this rudel-xmpp-state) xml)
+(cl-defmethod rudel-accept ((_this rudel-xmpp-state) xml)
""
(let ((name (xml-node-name xml)))
(pcase name
diff --git a/rudel-xmpp-tls.el b/rudel-xmpp-tls.el
index 8717a5e..9f40317 100644
--- a/rudel-xmpp-tls.el
+++ b/rudel-xmpp-tls.el
@@ -46,7 +46,7 @@
()
"State used to enable TLS encryption for a connection.")
-(defmethod rudel-enter ((_this rudel-xmpp-state-tls-start))
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-tls-start))
"Enable TLS encryption for the connection associated with THIS."
(require 'rudel-tls)
;; something like this: (rudel-tls-start-tls transport)
diff --git a/rudel-xmpp-tunnel.el b/rudel-xmpp-tunnel.el
index bfad4f4..968a663 100644
--- a/rudel-xmpp-tunnel.el
+++ b/rudel-xmpp-tunnel.el
@@ -48,12 +48,12 @@
"Transport backend that tunnels any kind of data (not
necessarily XML) through an XMPP connection.")
-(defmethod rudel-send ((this rudel-xmpp-tunnel-transport) data)
+(cl-defmethod rudel-send ((this rudel-xmpp-tunnel-transport) data)
""
(let ((encoded (base64-encode-string data)))
(rudel-send this `(("data") ,encoded))))
-(defmethod rudel-message ((this rudel-xmpp-tunnel-transport) xml)
+(cl-defmethod rudel-message ((this rudel-xmpp-tunnel-transport) xml)
""
(with-tag-attrs (data) xml
(let ((decoded (base64-decode-string data)))
diff --git a/rudel-xmpp.el b/rudel-xmpp.el
index ba9cea3..b2d2927 100644
--- a/rudel-xmpp.el
+++ b/rudel-xmpp.el
@@ -70,14 +70,13 @@
"Transport backend works by transporting XMPP messages through
XMPP connections.")
-(defmethod initialize-instance ((this rudel-xmpp-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-xmpp-backend) _slots)
"Initialize slots and set version of THIS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-xmpp-transport-version))
-(defmethod rudel-ask-connect-info ((_this rudel-xmpp-backend)
+(cl-defmethod rudel-ask-connect-info ((_this rudel-xmpp-backend)
&optional info)
"Augment INFO by reading a hostname and a port number."
;; Read server host and port.
@@ -92,7 +91,7 @@ XMPP connections.")
:jid jid)
info)))
-(defmethod rudel-make-connection ((this rudel-xmpp-backend)
+(cl-defmethod rudel-make-connection ((this rudel-xmpp-backend)
info info-callback
&optional progress-callback)
"Connect to an XMPP server using the information in INFO.
@@ -146,7 +145,7 @@ called repeatedly to report progress."
()
"Initial state of new XMPP connections.")
-(defmethod rudel-enter ((_this rudel-xmpp-state-new) to jid)
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-new) to jid)
"Switch to \"negotiate-stream\" state."
(list 'negotiate-stream to jid (list 'sasl-start jid to)))
@@ -162,7 +161,7 @@ called repeatedly to report progress."
negotiation."))
"Stream negotiation state.")
-(defmethod rudel-enter ((this rudel-xmpp-state-negotiate-stream)
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-negotiate-stream)
to jid success-state)
"Send opening stream tag constructed with TO and JID."
;; Store the name of the successor state in case of successful
@@ -198,7 +197,7 @@ id=\"%s\">"
jid))
nil)
-(defmethod rudel-leave ((this rudel-xmpp-state-negotiate-stream))
+(cl-defmethod rudel-leave ((this rudel-xmpp-state-negotiate-stream))
"Stop assembling based on opening stream tag."
;; One the stream is negotiated, assemble data based on complete XML
;; trees rather than the opening stream tag.
@@ -206,7 +205,7 @@ id=\"%s\">"
(rudel-set-assembly-function transport #'rudel-xml-assemble-tags)
(rudel-set-generate-function transport #'xml->string)))
-(defmethod rudel-accept ((this rudel-xmpp-state-negotiate-stream) xml)
+(cl-defmethod rudel-accept ((this rudel-xmpp-state-negotiate-stream) xml)
""
(cond
;; Stream negotiation error.
@@ -234,7 +233,7 @@ id=\"%s\">"
()
"")
-(defmethod rudel-enter ((_this rudel-xmpp-state-authenticated))
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-authenticated))
""
;; Switch to negotiate-stream telling it to switch to established in
;; case the negotiation succeeds.
@@ -249,7 +248,7 @@ id=\"%s\">"
()
"")
-(defmethod rudel-enter ((_this rudel-xmpp-state-authentication-failed))
+(cl-defmethod rudel-enter ((_this rudel-xmpp-state-authentication-failed))
""
'we-finalize)
@@ -263,7 +262,7 @@ id=\"%s\">"
negotiation and the negotiation of the actual stream are
complete.")
-(defmethod rudel-accept ((this rudel-xmpp-state-established) xml)
+(cl-defmethod rudel-accept ((this rudel-xmpp-state-established) xml)
"Store XML in buffer of THIS for later processing."
(with-slots (shelve-buffer) this
(push xml shelve-buffer))
@@ -279,7 +278,7 @@ complete.")
negotiation and the negotiation of the actual stream are
complete.")
-(defmethod rudel-enter ((this rudel-xmpp-state-idle))
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-idle))
"Process data previously shelved in (the transport owning) THIS."
(with-slots (filter shelve-buffer) this
(when filter
@@ -288,7 +287,7 @@ complete.")
(setq shelve-buffer nil))
nil)
-(defmethod rudel-accept ((this rudel-xmpp-state-idle) xml)
+(cl-defmethod rudel-accept ((this rudel-xmpp-state-idle) xml)
""
(with-slots (filter) this
(when filter
@@ -303,7 +302,7 @@ complete.")
()
"")
-(defmethod rudel-enter ((this rudel-xmpp-state-we-finalize))
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-we-finalize))
""
;; We send the closing tag, </stream:stream>, of the stream
;; document. This has be processed as string, not XML.
@@ -323,7 +322,7 @@ complete.")
()
"")
-(defmethod rudel-enter ((this rudel-xmpp-state-they-finalize))
+(cl-defmethod rudel-enter ((this rudel-xmpp-state-they-finalize))
""
(rudel-close this)
nil)
@@ -368,11 +367,10 @@ Authentication mechanisms can add more states to this
list.")
the current for processing in a successor state."))
"")
-(defmethod initialize-instance ((this rudel-xmpp-transport) _slots)
+(cl-defmethod initialize-instance ((this rudel-xmpp-transport) _slots)
"Initialize THIS and register states."
;; Initialize slots of THIS.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
;; Register states.
(rudel-register-states this rudel-xmpp-states)
@@ -385,24 +383,23 @@ Authentication mechanisms can add more states to this
list.")
(lambda (data)
(rudel-accept this data)))))
-(defmethod rudel-register-state ((this rudel-xmpp-transport)
+(cl-defmethod rudel-register-state ((this rudel-xmpp-transport)
_symbol state)
"Associate THIS to STATE before registering STATE."
;; Associate THIS connection to STATE.
(oset state :transport this)
;; Register the modified STATE.
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
)
-(defmethod rudel-start ((this rudel-xmpp-transport))
+(cl-defmethod rudel-start ((this rudel-xmpp-transport))
"Start processing by THIS.
Starting the transport can lead to immediate processing of
previously shelved data"
(rudel-switch this 'idle))
-(defmethod rudel-close ((this rudel-xmpp-transport))
+(cl-defmethod rudel-close ((this rudel-xmpp-transport))
"Close the XMPP connection used by THIS."
(unless (member (rudel-current-state this)
'(we-finalize they-finalize disconnected))
@@ -410,8 +407,8 @@ previously shelved data"
(rudel-state-wait this '(disconnected))
- (when (next-method-p)
- (call-next-method)) ;; TODO does this call rudel-close again?
+ (when (cl-next-method-p)
+ (cl-call-next-method)) ;; TODO does this call rudel-close again?
)
diff --git a/rudel-zeroconf.el b/rudel-zeroconf.el
index c7284ad..c4c18ef 100644
--- a/rudel-zeroconf.el
+++ b/rudel-zeroconf.el
@@ -114,14 +114,13 @@ service type TYPE."
(priority :initform primary))
"")
-(defmethod initialize-instance ((this rudel-zeroconf-backend) _slots)
+(cl-defmethod initialize-instance ((this rudel-zeroconf-backend) _slots)
"Initialize slots of THIS with SLOTS."
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
(oset this :version rudel-zeroconf-version))
-(defmethod rudel-discover ((_this rudel-zeroconf-backend))
+(cl-defmethod rudel-discover ((_this rudel-zeroconf-backend))
"Return a list of session information property lists for Zeroconf-advertised
sessions."
(mapcar
#'rudel-zeroconf-service->plist
@@ -136,7 +135,7 @@ service type TYPE."
rudel-zeroconf-service-types)))))
)
-(defmethod rudel-advertise ((_this rudel-session-initiation-backend) info)
+(cl-defmethod rudel-advertise ((_this rudel-session-initiation-backend) info)
"Use Zeroconf to advertise the session described by INFO to other users."
(let ((name (plist-get info :name))
(transport-backend (plist-get info :transport-backend))
@@ -149,7 +148,7 @@ service type TYPE."
transport-backend protocol-backend name host port data)))
t)
-(defmethod rudel-withdraw ((_this rudel-session-initiation-backend))
+(cl-defmethod rudel-withdraw ((_this rudel-session-initiation-backend))
"Withdraw Zeroconf record."
(error "Not implemented, yet"))
diff --git a/rudel.el b/rudel.el
index fe1a13f..ecef2d1 100644
--- a/rudel.el
+++ b/rudel.el
@@ -6,7 +6,7 @@
;; Keywords: rudel, collaboration
;; Version: 0.3
;; URL: http://rudel.sourceforge.net/
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
+;; Package-Requires: ((emacs "24") (cl-lib "0.5") (cl-generic "0.3"))
;; X-RCS: $Id:$
;;
;; This file is part of Rudel.
@@ -57,6 +57,7 @@
(require 'cl-lib)
+(require 'cl-generic)
(require 'eieio)
(require 'eieio-base)
@@ -195,12 +196,12 @@ rudel-server-session. Consequently, it consists of slots
common
to client and server sessions."
:abstract t)
-(defmethod rudel-end ((this rudel-session))
+(cl-defmethod rudel-end ((this rudel-session))
"Terminate THIS session performing all necessary cleanup."
;; Run the hook.
(object-run-hook-with-args this 'end-hook))
-(defmethod rudel-add-user ((this rudel-session) user)
+(cl-defmethod rudel-add-user ((this rudel-session) user)
"Add USER to the user list of THIS session.
Runs object hook (see `rudel-hook-object') `add-user-hook' with
@@ -211,7 +212,7 @@ arguments THIS and USER."
;; Run the hook.
(object-run-hook-with-args this 'add-user-hook user))
-(defmethod rudel-remove-user ((this rudel-session) user)
+(cl-defmethod rudel-remove-user ((this rudel-session) user)
"Remove USER from the user list of THIS session.
Runs object hook (see `rudel-hook-object') `remove-user-hook'
@@ -222,7 +223,7 @@ with arguments THIS and USER."
;; Run the hook.
(object-run-hook-with-args this 'remove-user-hook user))
-(defmethod rudel-find-user ((this rudel-session)
+(cl-defmethod rudel-find-user ((this rudel-session)
which &optional test key)
"Find user WHICH in the user list.
WHICH is compared to the result of KEY using TEST."
@@ -231,7 +232,7 @@ WHICH is compared to the result of KEY using TEST."
:key (or key #'object-name-string)
:test (or test #'string=))))
-(defmethod rudel-add-document ((this rudel-session) document)
+(cl-defmethod rudel-add-document ((this rudel-session) document)
""
(unless (slot-boundp document :session)
(oset document :session this))
@@ -242,7 +243,7 @@ WHICH is compared to the result of KEY using TEST."
;; Run the hook.
(object-run-hook-with-args this 'add-document-hook document))
-(defmethod rudel-remove-document ((this rudel-session) document)
+(cl-defmethod rudel-remove-document ((this rudel-session) document)
"Remove DOCUMENT from THIS session, detaching it if necessary."
;; Detach document from its buffer when necessary.
(rudel-maybe-detach-from-buffer document)
@@ -253,7 +254,7 @@ WHICH is compared to the result of KEY using TEST."
;; Run the hook.
(object-run-hook-with-args this 'remove-document-hook document))
-(defmethod rudel-find-document ((this rudel-session)
+(cl-defmethod rudel-find-document ((this rudel-session)
which &optional test key)
"Find document WHICH in the document list.
WHICH is compared to the result of KEY using TEST."
@@ -283,7 +284,7 @@ the local user"))
"Objects represent a collaborative editing session from a
client perspective.")
-(defmethod rudel-end ((this rudel-client-session))
+(cl-defmethod rudel-end ((this rudel-client-session))
;; Clean everything up
(with-slots (connection users documents) this
;; Make sure all documents are detached from their buffers
@@ -296,11 +297,10 @@ client perspective.")
(error nil))))
;;
- (when (next-method-p)
- (call-next-method))
+ (cl-call-next-method)
)
-(defmethod rudel-unsubscribed-documents ((this rudel-client-session))
+(cl-defmethod rudel-unsubscribed-documents ((this rudel-client-session))
"Return documents in THIS to which the self user is not subscribed."
(with-slots (documents self) this
(unless self
@@ -336,31 +336,31 @@ client perspective.")
client protocols have to obey."
:abstract t)
-(defgeneric rudel-disconnect ((this rudel-connection))
+(cl-defgeneric rudel-disconnect ((this rudel-connection))
"Close the connection.")
-(defgeneric rudel-change-color- ((this rudel-connection) color) ;; TODO name
+(cl-defgeneric rudel-change-color- ((this rudel-connection) color) ;; TODO name
"")
-(defgeneric rudel-publish ((this rudel-connection) document)
+(cl-defgeneric rudel-publish ((this rudel-connection) document)
"")
-(defgeneric rudel-subscribe-to ((this rudel-connection) document)
+(cl-defgeneric rudel-subscribe-to ((this rudel-connection) document)
"")
-(defgeneric rudel-unsubscribe-from ((this rudel-connection) document) ; TODO
name should be rudel-unsubscribe
+(cl-defgeneric rudel-unsubscribe-from ((this rudel-connection) document) ;
TODO name should be rudel-unsubscribe
"")
-(defgeneric rudel-local-insert ((this rudel-connection))
+(cl-defgeneric rudel-local-insert ((this rudel-connection))
"")
-(defgeneric rudel-local-delete ((this rudel-connection))
+(cl-defgeneric rudel-local-delete ((this rudel-connection))
"")
-(defgeneric rudel-remote-insert ((this rudel-connection))
+(cl-defgeneric rudel-remote-insert ((this rudel-connection))
"")
-(defgeneric rudel-remote-delete ((this rudel-connection))
+(cl-defgeneric rudel-remote-delete ((this rudel-connection))
"")
@@ -389,7 +389,7 @@ collaborative editing session. Note that a participating
user
does not have to be connected to the session at any given time."
:abstract t)
-(defmethod rudel-change-notify ((this rudel-user))
+(cl-defmethod rudel-change-notify ((this rudel-user))
"Run change hook of THIS after slot values have changed."
(object-run-hook-with-args this 'change-hook))
@@ -443,19 +443,19 @@ is detached from this document object."))
collaborative editing session can subscribe to."
:abstract t)
-(defmethod rudel-unique-name ((this rudel-document))
+(cl-defmethod rudel-unique-name ((this rudel-document))
"Returns a suggested name for the buffer attached to THIS document."
(object-name-string this))
-(defmethod rudel-suggested-buffer-name ((this rudel-document))
+(cl-defmethod rudel-suggested-buffer-name ((this rudel-document))
"Returns a suggested name for the buffer attached to THIS document."
(rudel-unique-name this))
-(defmethod rudel-attached-p ((this rudel-document))
+(cl-defmethod rudel-attached-p ((this rudel-document))
(with-slots (buffer) this
buffer))
-(defmethod rudel-attach-to-buffer ((this rudel-document) buffer)
+(cl-defmethod rudel-attach-to-buffer ((this rudel-document) buffer)
"Attach THIS document to BUFFER"
(with-slots ((doc-buffer buffer)) this
;; Set buffer slot of THIS to BUFFER and associated THIS with
@@ -492,7 +492,7 @@ collaborative editing session can subscribe to."
(object-run-hook-with-args this 'attach-hook doc-buffer))
)
-(defmethod rudel-detach-from-buffer ((this rudel-document))
+(cl-defmethod rudel-detach-from-buffer ((this rudel-document))
"Detach document THIS from its buffer.
Do nothing, if THIS is not attached to any buffer."
(with-slots (buffer) this
@@ -531,7 +531,7 @@ Do nothing, if THIS is not attached to any buffer."
(object-run-hook-with-args this 'detach-hook buffer-save)))
)
-(defmethod rudel-maybe-detach-from-buffer ((this rudel-document))
+(cl-defmethod rudel-maybe-detach-from-buffer ((this rudel-document))
""
;; Only try to detach from BUFFER, if it is non-nil. BUFFER can be
;; nil, if the user did not subscribe to the document, or
@@ -539,7 +539,7 @@ Do nothing, if THIS is not attached to any buffer."
(when (rudel-attached-p this)
(rudel-detach-from-buffer this)))
-(defmethod rudel-add-user ((this rudel-document) user)
+(cl-defmethod rudel-add-user ((this rudel-document) user)
"Add USER to the list of subscribed users of THIS.
Runs object hook (see `rudel-hook-object') `subscribe-hook' with
@@ -550,7 +550,7 @@ arguments THIS and USER."
;; Run the hook.
(object-run-hook-with-args this 'subscribe-hook user))
-(defmethod rudel-remove-user ((this rudel-document) user)
+(cl-defmethod rudel-remove-user ((this rudel-document) user)
"Remove USER from the list of subscribed users of THIS.
Runs object hook (see `rudel-hook-object') `unsubscribe-hook'
@@ -561,11 +561,11 @@ with arguments THIS and USER."
;; Run the hook.
(object-run-hook-with-args this 'unsubscribe-hook user))
-(defmethod rudel-clear-users ((this rudel-document))
+(cl-defmethod rudel-clear-users ((this rudel-document))
"Clear list of users subscribed to THIS."
(oset this :subscribed nil))
-(defmethod rudel-find-user ((this rudel-document)
+(cl-defmethod rudel-find-user ((this rudel-document)
which &optional test key)
"Find user WHICH in the list of subscribed users.
WHICH is compared to the result of KEY using TEST."
@@ -574,7 +574,7 @@ WHICH is compared to the result of KEY using TEST."
:key (or key #'object-name-string)
:test (or test #'string=))))
-(defmethod rudel-insert ((this rudel-document) position data)
+(cl-defmethod rudel-insert ((this rudel-document) position data)
"Insert DATA at POSITION into the buffer attached to THIS.
When POSITION is nil `point-max' is used to determine the
insertion position.
@@ -591,7 +591,7 @@ Modification hooks are disabled during the insertion."
(insert data)))))
)
-(defmethod rudel-delete ((this rudel-document) position length)
+(cl-defmethod rudel-delete ((this rudel-document) position length)
"Delete a region of LENGTH character at POSITION from the buffer attached to
THIS.
Modification hooks are disabled during the insertion."
(with-slots (buffer) this
@@ -601,7 +601,7 @@ Modification hooks are disabled during the insertion."
(delete-region (+ position 1) (+ position length 1))))))
)
-(defmethod rudel-local-operation ((this rudel-document) operation)
+(cl-defmethod rudel-local-operation ((this rudel-document) operation)
"Apply the local operation OPERATION to THIS."
(with-slots (session buffer) this
(with-slots (connection (user self)) session
@@ -623,7 +623,7 @@ Modification hooks are disabled during the insertion."
(rudel-apply operation operators))))
)
-(defmethod rudel-remote-operation ((this rudel-document) user operation)
+(cl-defmethod rudel-remote-operation ((this rudel-document) user operation)
"Apply the remote operation OPERATION performed by USER to THIS."
(dolist (operators (append
@@ -643,7 +643,7 @@ Modification hooks are disabled during the insertion."
(rudel-apply operation operators))
)
-(defmethod rudel-chunks ((this rudel-document))
+(cl-defmethod rudel-chunks ((this rudel-document))
"Return a list of text chunks of the associated buffer.
Each element in the chunk is a list structured like this (START
END AUTHOR). START and END are numbers, AUTHOR is of type (or
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/rudel 243d132: Use cl-generic,
Stefan Monnier <=