[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/rudel 71a7e74: Use cl-lib instead of cl
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] externals/rudel 71a7e74: Use cl-lib instead of cl |
|
Date: |
Mon, 11 Jul 2016 20:55:31 +0000 (UTC) |
branch: externals/rudel
commit 71a7e746a03610f8dd20117c750988bb97e0eab0
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
Use cl-lib instead of cl
---
adopted-compound.el | 7 ++--
adopted-delete.el | 15 ++++----
adopted-insert.el | 11 +++---
jupiter-compound.el | 9 ++---
jupiter-delete.el | 15 ++++----
jupiter-insert.el | 11 +++---
jupiter.el | 9 ++---
rudel-backend.el | 4 +-
rudel-color.el | 19 +++++----
rudel-infinote-client.el | 60 ++++++++++++++---------------
rudel-infinote-display.el | 12 +++---
rudel-infinote-group-directory.el | 5 ++-
rudel-infinote-group-document.el | 9 +++--
rudel-infinote-group-text-document.el | 5 ++-
rudel-infinote-group.el | 11 +++---
rudel-infinote-util.el | 5 +--
rudel-interactive.el | 8 ++--
rudel-mode.el | 13 ++-----
rudel-obby-client.el | 68 +++++++++++++++++----------------
rudel-obby-server.el | 22 +++++------
rudel-obby-util.el | 29 +++++++-------
rudel-obby.el | 28 +++++++-------
rudel-overlay.el | 10 ++---
rudel-session-initiation.el | 44 ++++++++++-----------
rudel-socket.el | 16 ++++----
rudel-state-machine.el | 16 ++++----
rudel-tls.el | 5 ++-
rudel-transport-util.el | 18 ++++-----
rudel-util.el | 26 +++++--------
rudel-xml.el | 66 ++++++++++++++++----------------
rudel-xmpp-debug.el | 7 ++--
rudel-xmpp-sasl.el | 27 ++++++-------
rudel-xmpp-state.el | 9 +++--
rudel-xmpp-util.el | 25 ++++++------
rudel-xmpp.el | 5 ++-
rudel-zeroconf.el | 27 +++++++------
rudel.el | 14 +++----
37 files changed, 338 insertions(+), 352 deletions(-)
diff --git a/adopted-compound.el b/adopted-compound.el
index e710076..9668d12 100644
--- a/adopted-compound.el
+++ b/adopted-compound.el
@@ -57,8 +57,8 @@ number of child operation.")
(defmethod rudel-apply ((this adopted-compound) object)
"Apply THIS to BUFFER by applying the child operation."
(with-slots (children) this
- (let ((child (first children))
- (rest (rest children)))
+ (let ((child (car children))
+ (rest (cdr children)))
;; Apply all child operations
(while child
(rudel-apply child object)
@@ -67,8 +67,7 @@ number of child operation.")
(dolist (next rest)
(setf next (adopted-transform child next)))
;; Advance to next child operation.
- (setq child (first rest)
- rest (rest rest)))))
+ (setq child (pop rest)))))
)
(defmethod adopted-transform ((this adopted-compound) other)
diff --git a/adopted-delete.el b/adopted-delete.el
index 74732b3..1c092f6 100644
--- a/adopted-delete.el
+++ b/adopted-delete.el
@@ -1,6 +1,6 @@
;;; adopted-delete.el --- Adopted delete operation
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, adopted, algorithm, operation, delete
@@ -36,6 +36,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'eieio)
(require 'rudel-operations)
@@ -73,7 +74,7 @@ OTHER is destructively modified or replaced."
;; <other>
;; <this>
((> other-from this-to)
- (decf other-from this-length))
+ (cl-decf other-from this-length))
;; <other>
;; < this >
@@ -96,8 +97,8 @@ OTHER is destructively modified or replaced."
;; THIS. Therefore OTHER has to be shifted by the length of
;; the deleted region.
((> other-from this-to)
- (decf other-from this-length)
- (decf other-to this-length))
+ (cl-decf other-from this-length)
+ (cl-decf other-to this-length))
;; <other>
;; <this>
@@ -108,12 +109,12 @@ OTHER is destructively modified or replaced."
;; < other >
;; <this>
((and (>= other-from this-from) (>= other-to this-to))
- (decf other-to this-length))
+ (cl-decf other-to this-length))
;; <other>
;; <this>
((and (< other-from this-from) (< other-to this-to))
- (decf other-to (- other-to this-to)))
+ (cl-decf other-to (- other-to this-to)))
;; <other>
;; <this>
@@ -125,7 +126,7 @@ OTHER is destructively modified or replaced."
;; overlap.
((and (< other-from this-to) (> other-to this-to))
(setq other-from this-from)
- (incf other-to (+ other-from (- other-to this-to))))
+ (cl-incf other-to (+ other-from (- other-to this-to))))
;; (setq other-to (this-to - other-from))
;; <other>
diff --git a/adopted-insert.el b/adopted-insert.el
index ba1f781..dbccd65 100644
--- a/adopted-insert.el
+++ b/adopted-insert.el
@@ -1,6 +1,6 @@
;;; adopted-insert.el --- Adopted insert operation
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, adopted, algorithm, operation, insert
@@ -36,6 +36,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'eieio)
(require 'rudel-operations)
@@ -74,7 +75,7 @@
;; <this>
;;
((> other-from this-from)
- (incf other-from this-length))
+ (cl-incf other-from this-length))
;;
;; <other>
@@ -85,7 +86,7 @@
;; ordering.
((= other-from this-from)
(when (string< this-data other-data)
- (incf other-from this-length)))))))
+ (cl-incf other-from this-length)))))))
;;
;; Transform a delete operation
@@ -104,8 +105,8 @@
;; <other> and <other> and <other>
;; <this> <this> <this>
((>= other-from this-from)
- (incf other-from this-length)
- (incf other-to this-length))
+ (cl-incf other-from this-length)
+ (cl-incf other-to this-length))
;;
;; < other >
diff --git a/jupiter-compound.el b/jupiter-compound.el
index a64ec33..13b823c 100644
--- a/jupiter-compound.el
+++ b/jupiter-compound.el
@@ -1,6 +1,6 @@
;;; jupiter-compound.el --- Jupiter compound operation
;;
-;; Copyright (C) 2009, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: jupiter, operation, compound
@@ -57,8 +57,8 @@ number of child operation.")
(defmethod rudel-apply ((this jupiter-compound) object)
"Apply THIS to BUFFER by applying the child operation."
(with-slots (children) this
- (let ((child (first children))
- (rest (rest children)))
+ (let ((child (car children))
+ (rest (cdr children)))
;; Apply all child operations
(while child
(rudel-apply child object)
@@ -67,8 +67,7 @@ number of child operation.")
(dolist (next rest)
(setf next (jupiter-transform child next)))
;; Advance to next child operation.
- (setq child (first rest)
- rest (rest rest)))))
+ (setq child (pop rest)))))
)
(defmethod jupiter-transform ((this jupiter-compound) other)
diff --git a/jupiter-delete.el b/jupiter-delete.el
index 48a5649..1587e1b 100644
--- a/jupiter-delete.el
+++ b/jupiter-delete.el
@@ -1,6 +1,6 @@
;;; jupiter-delete.el --- Jupiter delete operation
;;
-;; Copyright (C) 2009, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: jupiter, operation, delete
@@ -36,6 +36,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'eieio)
(require 'rudel-operations)
@@ -77,7 +78,7 @@ OTHER is destructively modified or replaced."
;; <other>
;; <this>
((> other-from this-to)
- (decf other-from this-length))
+ (cl-decf other-from this-length))
;; <other>
;; < this >
@@ -104,8 +105,8 @@ OTHER is destructively modified or replaced."
;; THIS. Therefore OTHER has to be shifted by the length of
;; the deleted region.
((> other-from this-to)
- (decf other-from this-length)
- (decf other-to this-length))
+ (cl-decf other-from this-length)
+ (cl-decf other-to this-length))
;; <other>
;; <this>
@@ -116,12 +117,12 @@ OTHER is destructively modified or replaced."
;; < other >
;; <this>
((and (>= other-from this-from) (>= other-to this-to))
- (decf other-to this-length))
+ (cl-decf other-to this-length))
;; <other>
;; <this>
((and (< other-from this-from) (< other-to this-to))
- (decf other-to (- other-to this-to)))
+ (cl-decf other-to (- other-to this-to)))
;; <other>
;; <this>
@@ -133,7 +134,7 @@ OTHER is destructively modified or replaced."
;; overlap.
((and (< other-from this-to) (> other-to this-to))
(setq other-from this-from)
- (incf other-to (+ other-from (- other-to this-to))))
+ (cl-incf other-to (+ other-from (- other-to this-to))))
;; <other>
;; < this >
diff --git a/jupiter-insert.el b/jupiter-insert.el
index 67b274d..55679af 100644
--- a/jupiter-insert.el
+++ b/jupiter-insert.el
@@ -1,6 +1,6 @@
;;; jupiter-insert.el --- Jupiter insert operation
;;
-;; Copyright (C) 2009, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: jupiter, operation, insert
@@ -36,6 +36,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'eieio)
(require 'rudel-operations)
@@ -79,7 +80,7 @@
;; <this>
;;
((> other-from this-from)
- (incf other-from this-length))
+ (cl-incf other-from this-length))
;;
;; <other>
@@ -90,7 +91,7 @@
;; ordering.
((= other-from this-from)
(when (string< this-data other-data)
- (incf other-from this-length)))))))
+ (cl-incf other-from this-length)))))))
;;
;; Transform a delete operation
@@ -113,8 +114,8 @@
;; <other> and <other> and <other>
;; <this> <this> <this>
((>= other-from this-from)
- (incf other-from this-length)
- (incf other-to this-length))
+ (cl-incf other-from this-length)
+ (cl-incf other-to this-length))
;;
;; < other >
diff --git a/jupiter.el b/jupiter.el
index 8a5abfa..e543b39 100644
--- a/jupiter.el
+++ b/jupiter.el
@@ -41,8 +41,7 @@
;;; Code:
;;
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'eieio)
@@ -81,7 +80,7 @@ jupiter algorithm.")
"Store OPERATION in the operation log of THIS and increase local revision
count."
(with-slots (local-revision local-log) this
(push (cons local-revision operation) local-log)
- (incf local-revision)))
+ (cl-incf local-revision)))
(defmethod jupiter-remote-operation ((this jupiter-context)
local-revision remote-revision
@@ -95,7 +94,7 @@ site is referring to."
;; Discard stored local operations which are older than the
;; local revision to which the remote site refers.
- (setq local-log (delete-if
+ (setq local-log (cl-delete-if
(lambda (revision) (< revision local-revision))
local-log
:key 'car))
@@ -117,7 +116,7 @@ site is referring to."
(reverse local-log))
;; Increase remote revision
- (incf this-remote-revision))
+ (cl-incf this-remote-revision))
;; The transformed operation is the result of the computation.
transformed-operation)
)
diff --git a/rudel-backend.el b/rudel-backend.el
index 6ef1d41..2072939 100644
--- a/rudel-backend.el
+++ b/rudel-backend.el
@@ -46,7 +46,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'warnings)
@@ -177,7 +177,7 @@ Backends are loaded, if necessary."
;; Retrieve and return all backends, filtering the list using
;; PREDICATE. Backends that could not be loaded, are ignored.
(if predicate
- (remove-if-not
+ (cl-remove-if-not
(lambda (cell)
(funcall predicate (cdr cell)))
(rudel-all-backends this t))
diff --git a/rudel-color.el b/rudel-color.el
index 862d887..182f66a 100644
--- a/rudel-color.el
+++ b/rudel-color.el
@@ -1,6 +1,6 @@
;;; rudel-color.el --- Color manipulation functions for Rudel
;;
-;; Copyright (C) 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, color, color space
@@ -46,7 +46,6 @@
;;; Code:
;;
-(eval-when-compile (require 'cl))
;;; RGV <-> HSV conversion
;;
@@ -84,7 +83,7 @@ http://www.emacswiki.org/emacs/hexrgb.el";
(+ 4.0 (/ (- red green) delta)))))
(setq hue (/ hue 6.0))
(when (<= hue 0.0)
- (incf hue))))
+ (cl-incf hue))))
(list hue saturation value))
)
@@ -107,18 +106,18 @@ http://www.emacswiki.org/emacs/hexrgb.el";
(pp (* value (- 1 saturation)))
(qq (* value (- 1 (* saturation fract))))
(ww (* value (- 1 (* saturation (- 1 (- hue int-hue)))))))
- (case int-hue
- ((0 6)
+ (pcase int-hue
+ ((or `0 `6)
(list value ww pp))
- (1
+ (`1
(list qq value pp))
- (2
+ (`2
(list pp value ww))
- (3
+ (`3
(list pp qq value))
- (4
+ (`4
(list ww pp value))
- (otherwise
+ (_
(list value pp qq)))))
)
diff --git a/rudel-infinote-client.el b/rudel-infinote-client.el
index eb011cf..6affdf5 100644
--- a/rudel-infinote-client.el
+++ b/rudel-infinote-client.el
@@ -36,7 +36,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'warnings)
@@ -190,7 +190,7 @@ which case it is the name of a group."
"Find node WHICH in the node list of THIS.
WHICH is compared to the result of KEY using TEST."
(with-slots (nodes) this
- (find which nodes
+ (cl-find which nodes
:key (or key #'rudel-id)
:test (or test #'=))))
@@ -215,31 +215,31 @@ WHICH is compared to the result of KEY using TEST."
;; Create the new node. Distinguish document and directory nodes
;; based on TYPE.
- (destructuring-bind (node . is-document)
- (cond
- ;; This is a special kind of node. Nodes of this kind are
- ;; inner nodes in the node tree.
- ((string= type "InfSubdirectory")
- (cons (rudel-infinote-node-directory
- name
- :id id
- :parent parent
- :group (rudel-get-group this "InfDirectory"))
- nil))
-
- ;; Other special kinds of nodes would go here
-
- ;; Ordinary document nodes.
- ;; TODO the backend should construct the appropriate document
- ;; object based on TYPE
- ((string= type "InfText")
- (cons (rudel-infinote-text-document
- name
- :id id
- :parent parent)
- t)))
-
- ;; Integrate the document object into the hierarchy.
+ (pcase-let ((`(,node . ,is-document)
+ (cond
+ ;; This is a special kind of node. Nodes of this kind are
+ ;; inner nodes in the node tree.
+ ((string= type "InfSubdirectory")
+ (cons (rudel-infinote-node-directory
+ name
+ :id id
+ :parent parent
+ :group (rudel-get-group this "InfDirectory"))
+ nil))
+
+ ;; Other special kinds of nodes would go here
+
+ ;; Ordinary document nodes.
+ ;; TODO the backend should construct the appropriate
+ ;; document object based on TYPE
+ ((string= type "InfText")
+ (cons (rudel-infinote-text-document
+ name
+ :id id
+ :parent parent)
+ t)))))
+
+ ;; Integrate the document object into the hierarchy.
(when parent
(rudel-add-child parent node))
(rudel-add-node this node)
@@ -254,9 +254,9 @@ WHICH is compared to the result of KEY using TEST."
(defmethod rudel-receive ((this rudel-infinote-client-connection) xml)
""
- (case (xml-node-name xml)
+ (pcase (xml-node-name xml)
;;
- (group
+ (`group
(let* ((name (xml-get-attribute xml 'name))
(xml (xml-node-children xml))
(group (rudel-get-group this name)))
@@ -274,7 +274,7 @@ WHICH is compared to the result of KEY using TEST."
nil)
;;
- (t
+ (_
(when (next-method-p)
(call-next-method)))) ;; TODO what is actually called here?
)
diff --git a/rudel-infinote-display.el b/rudel-infinote-display.el
index 2e59adf..5ded0ab 100644
--- a/rudel-infinote-display.el
+++ b/rudel-infinote-display.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-display.el --- Display functions for infinote users
;;
-;; Copyright (C) 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, user interface
@@ -47,29 +47,29 @@
(concat
(call-next-method)
- (case status
- (active
+ (pcase status
+ (`active
(propertize
"a"
'display rudel-icon-connected
'help-echo (format "%s is connected"
name)))
- (inactive
+ (`inactive
(propertize
"i"
'display rudel-icon-connected
'help-echo (format "%s is connected, but inactive"
name)))
- (unavailable
+ (`unavailable
(propertize
"-"
'display rudel-icon-disconnected
'help-ehco (format "%s is not connected"
name)))
- (t
+ (_
"?"))))
)
diff --git a/rudel-infinote-group-directory.el
b/rudel-infinote-group-directory.el
index 7ca4d5f..a2f0115 100644
--- a/rudel-infinote-group-directory.el
+++ b/rudel-infinote-group-directory.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-directory.el --- Infinote directory group
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, group, communication
@@ -38,6 +38,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'warnings)
(require 'eieio)
@@ -171,7 +172,7 @@ explored.")
name
type) xml
(rudel-add-node group id parent name type))
- (decf remaining-messages))
+ (cl-decf remaining-messages))
nil)
(defmethod rudel-infinote/explore-end
diff --git a/rudel-infinote-group-document.el b/rudel-infinote-group-document.el
index 1f20d6e..192e58b 100644
--- a/rudel-infinote-group-document.el
+++ b/rudel-infinote-group-document.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-document.el --- Infinote document group
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, group, communication
@@ -36,6 +36,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'warnings)
(require 'eieio)
@@ -255,7 +256,7 @@
(rudel-add-user document user)))
;; Expect one less synchronization item.
- (decf remaining-items))
+ (cl-decf remaining-items))
;; Stay in this state.
nil)
@@ -267,7 +268,7 @@
) ;; TODO
;; Expect one less synchronization item.
- (decf remaining-items))
+ (cl-decf remaining-items))
;; Stay in this state.
nil)
@@ -279,7 +280,7 @@
) ;; TODO
;; Expect one less synchronization item.
- (decf remaining-items))
+ (cl-decf remaining-items))
;; Stay in this state.
nil)
diff --git a/rudel-infinote-group-text-document.el
b/rudel-infinote-group-text-document.el
index 0331599..f47394a 100644
--- a/rudel-infinote-group-text-document.el
+++ b/rudel-infinote-group-text-document.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group-text-document.el --- Communication group used by text
documents
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, communication, group, text, document
@@ -35,6 +35,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'rudel-xml)
(require 'rudel-operations)
@@ -204,7 +205,7 @@
:data (or text "\n")))))
;; Expect one less synchronization item.
- (decf remaining-items)))
+ (cl-decf remaining-items)))
nil)
(defmethod rudel-infinote/request/delete
diff --git a/rudel-infinote-group.el b/rudel-infinote-group.el
index 51cfc4c..c7ae505 100644
--- a/rudel-infinote-group.el
+++ b/rudel-infinote-group.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-group.el --- Common aspects of infinote communication groups
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, group, communication
@@ -49,6 +49,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'warnings)
(require 'eieio)
@@ -77,9 +78,9 @@
(defmethod rudel-accept ((this rudel-infinote-group-state) xml)
"Dispatch XML to appropriate handler method based on content."
(let ((type (xml-node-name xml)))
- (case type
+ (pcase type
;; Handle request-failed messages.
- (request-failed
+ (`request-failed
;; TODO handle the problem
;; TODO there can be a description:
;; <request-failed><text>Bla</text></request-failed>
@@ -96,7 +97,7 @@ domain: `%s', code: `%s'"
;; Dispatch all normal message to appropriate methods
;; automatically.
- (t
+ (_
(let ((name (symbol-name type)))
(condition-case error
;; Try to dispatch on the message type.
@@ -213,7 +214,7 @@ and do not increment the sequence number counter."
(cons `(seq . ,(number-to-string seq-num))
attributes))
children)))
- (incf seq-num)))
+ (cl-incf seq-num)))
)
diff --git a/rudel-infinote-util.el b/rudel-infinote-util.el
index 142e322..37b40bd 100644
--- a/rudel-infinote-util.el
+++ b/rudel-infinote-util.el
@@ -1,6 +1,6 @@
;;; rudel-infinote-util.el --- Miscellaneous functions for infinote backend
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, infinote, miscellaneous, utility
@@ -35,9 +35,6 @@
;;; Code:
;;
-(eval-when-compile
- (require 'cl))
-
(require 'rudel-util)
(require 'rudel-xml)
diff --git a/rudel-interactive.el b/rudel-interactive.el
index 782e9c1..3af7cf5 100644
--- a/rudel-interactive.el
+++ b/rudel-interactive.el
@@ -38,8 +38,6 @@
;;; Code:
;;
-(require 'cl)
-
(require 'rudel-backend) ;; for `rudel-backend-cons-p'
@@ -92,7 +90,7 @@ the name as string."
nil t)))
(cond
((eq return 'object)
- (find session-name sessions
+ (cl-find session-name sessions
:key to-string :test #'string=))
(t session-name))))
)
@@ -141,7 +139,7 @@ the name as string."
(user-name (completing-read prompt user-names nil t)))
(cond
((eq return 'object)
- (find user-name users
+ (cl-find user-name users
:test 'string= :key 'object-name-string))
(t user-name)))
)
@@ -165,7 +163,7 @@ return the name as string."
(document-name (completing-read prompt document-names nil t)))
(cond
((eq return 'object)
- (find document-name documents
+ (cl-find document-name documents
:test #'string= :key #'rudel-unique-name))
(t document-name)))
)
diff --git a/rudel-mode.el b/rudel-mode.el
index c54c7f5..7468423 100644
--- a/rudel-mode.el
+++ b/rudel-mode.el
@@ -48,7 +48,6 @@
;;; Code:
;;
-(require 'cl)
(require 'easy-mmode)
(require 'easymenu)
@@ -370,10 +369,8 @@ of the buffer.")
(defun rudel-mode-line-publish-state--add-indicator-to-mode-line ()
"Add Rudel publish state indicator to mode line."
- (let* ((new-format (copy-list mode-line-format))
- (format-rest (nthcdr
- (position 'mode-line-modified mode-line-format)
- new-format))
+ (let* ((new-format (copy-sequence mode-line-format))
+ (format-rest (memq 'mode-line-modified new-format))
(format-rest-cdr (cdr format-rest)))
(setcdr format-rest (cons 'rudel-mode-line-publish-state-string
format-rest-cdr))
@@ -382,11 +379,9 @@ of the buffer.")
(defun rudel-mode-line-publish-state--remove-indicator-from-mode-line ()
"Remove Rudel publish state indicator from mode line."
- (let ((format-rest (nthcdr
- (position 'mode-line-remote mode-line-format)
- mode-line-format)))
+ (let ((format-rest (memq 'mode-line-remote mode-line-format)))
;; Only change the mode line if our indicator is present.
- (when (eq (second format-rest) 'rudel-mode-line-publish-state-string)
+ (when (eq (cadr format-rest) 'rudel-mode-line-publish-state-string)
(setcdr format-rest (cddr format-rest))
(force-mode-line-update))))
diff --git a/rudel-obby-client.el b/rudel-obby-client.el
index 7903557..95dcae2 100644
--- a/rudel-obby-client.el
+++ b/rudel-obby-client.el
@@ -39,6 +39,7 @@
;;; Code:
;;
+(eval-when-compile (require 'cl-lib))
(require 'warnings)
(require 'eieio)
@@ -591,7 +592,7 @@ a 'self' user object."))
have-self t)))))
;; Decrease number of not yet received synchronization items.
- (decf remaining-items)))
+ (cl-decf remaining-items)))
nil)
(defmethod rudel-obby/obby_sync_usertable_user
@@ -608,7 +609,7 @@ a 'self' user object."))
:color color)))
;; Decrease number of not yet received synchronization items.
- (decf remaining-items)))
+ (cl-decf remaining-items)))
nil)
(defmethod rudel-obby/obby_sync_doclist_document
@@ -638,7 +639,7 @@ a 'self' user object."))
:suffix suffix))))
;; Decrease number of not yet received synchronization items.
- (decf remaining-items)))
+ (cl-decf remaining-items)))
nil)
(defmethod rudel-obby/obby_sync_final
@@ -743,7 +744,7 @@ a 'self' user object."))
(rudel-remote-operation document user operation)))
;; After all bytes are transferred, go back to idle state.
- (decf remaining-bytes (string-bytes data))
+ (cl-decf remaining-bytes (string-bytes data))
(if (zerop remaining-bytes)
'idle
nil)))
@@ -889,8 +890,8 @@ documents."))
;; receiving a 'close' event.
(rudel-set-sentinel transport
(lambda (event)
- (case event
- (close
+ (pcase event
+ (`close
(rudel-close this)))))))
(defmethod rudel-register-state ((this rudel-obby-connection)
@@ -989,33 +990,34 @@ documents."))
(with-slots (self) session
(rudel-switch this 'subscribing self document)))
- (let ((reporter (make-progress-reporter "Subscribing " 0.0 1.0)))
- (flet ((display-progress (state)
- (cond
- ;; Syncing document content, we can provide detailed progress.
- ((and (consp state)
- (eq (car state) 'document-synching))
- (with-slots (all-bytes remaining-bytes) (cdr state)
- (progress-reporter-force-update
- reporter
- (- 1.0 (/ (float remaining-bytes) (float all-bytes)))
- (format "Subscribing (%s) " (car state)))))
-
- ;; For other states, we just spin.
- ((consp state)
- (progress-reporter-force-update
- reporter 0.5
- (format "Subscribing (%s) " (car state))))
-
- ;; Done
- (t
- (progress-reporter-force-update reporter 1.0 "Subscribing ")
- (progress-reporter-done reporter)))))
- (rudel-state-wait
- this
- '(idle)
- '(we-finalized they-finalized disconnected)
- #'display-progress)))
+ (let* ((reporter (make-progress-reporter "Subscribing " 0.0 1.0))
+ (display-progress
+ (lambda (state)
+ (cond
+ ;; Syncing document content, we can provide detailed progress.
+ ((and (consp state)
+ (eq (car state) 'document-synching))
+ (with-slots (all-bytes remaining-bytes) (cdr state)
+ (progress-reporter-force-update
+ reporter
+ (- 1.0 (/ (float remaining-bytes) (float all-bytes)))
+ (format "Subscribing (%s) " (car state)))))
+
+ ;; For other states, we just spin.
+ ((consp state)
+ (progress-reporter-force-update
+ reporter 0.5
+ (format "Subscribing (%s) " (car state))))
+
+ ;; Done
+ (t
+ (progress-reporter-force-update reporter 1.0 "Subscribing ")
+ (progress-reporter-done reporter))))))
+ (rudel-state-wait
+ this
+ '(idle)
+ '(we-finalized they-finalized disconnected)
+ display-progress))
;; We receive a notification of our own subscription from the
;; server. Consequently we do not add SELF to the list of subscribed
diff --git a/rudel-obby-server.el b/rudel-obby-server.el
index 6da3f91..f7c1a34 100644
--- a/rudel-obby-server.el
+++ b/rudel-obby-server.el
@@ -48,7 +48,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'warnings)
@@ -193,7 +193,7 @@ failed encryption negotiation."
(rudel-obby-format-color color))))))
;; Transmit list of disconnected users.
- (let ((offline-users (remove-if #'rudel-connected users)))
+ (let ((offline-users (cl-remove-if #'rudel-connected users)))
(dolist (user offline-users)
(with-slots ((name :object-name) user-id color) user
(rudel-send this
@@ -297,7 +297,7 @@ of her color to COLOR."
name
(format "%s<%d>" name suffix))
#'string= #'rudel-unique-name)
- (incf suffix))
+ (cl-incf suffix))
;; Add the document to the server's document list
(rudel-add-document server document)
@@ -352,7 +352,7 @@ of her color to COLOR."
;; Send buffer chunks with author ids
(dolist (chunk (rudel-chunks document))
- (multiple-value-bind (from to author) chunk
+ (pcase-let ((`(,from ,to ,author) chunk))
(let ((string (buffer-substring (+ from 1) (+ to 1))))
(rudel-send this
"obby_document"
@@ -531,8 +531,8 @@ handled by the server.")
;; receiving a 'close' event.
(rudel-set-sentinel transport
(lambda (event)
- (case event
- (close
+ (pcase event
+ (`close
(rudel-close this)))))))
(defmethod rudel-register-state ((this rudel-obby-client) _symbol state)
@@ -622,7 +622,7 @@ handled by the server.")
"Return a list of clients subscribed to DOCUMENT excluding THIS."
(with-slots (clients) (oref this :server)
(with-slots (subscribed) document
- (remove-if
+ (cl-remove-if
(lambda (client)
(with-slots (user) client
(or (eq client this)
@@ -709,8 +709,8 @@ such objects derived from rudel-obby-client."
((and (listp receivers)
(eq (car receivers) 'exclude))
(with-slots (clients) this
- (set-difference clients (cdr receivers)
- :key #'rudel-id)))
+ (cl-set-difference clients (cdr receivers)
+ :key #'rudel-id)))
;; If RECEIVERS is a single rudel-obby-client (or derived)
;; object, send the message to that client.
((rudel-obby-client-child-p receivers)
@@ -733,7 +733,7 @@ such objects derived from rudel-obby-client."
:user-id next-user-id
:connected t
:encryption encryption)))
- (incf next-user-id)
+ (cl-incf next-user-id)
user))
)
@@ -776,7 +776,7 @@ user. COLOR has to be sufficiently different from used
colors."
:id next-client-id
:encryption nil)))
(push client clients))
- (incf next-client-id))
+ (cl-incf next-client-id))
)
(defmethod rudel-remove-client ((this rudel-obby-server)
diff --git a/rudel-obby-util.el b/rudel-obby-util.el
index ffc0d44..7e04250 100644
--- a/rudel-obby-util.el
+++ b/rudel-obby-util.el
@@ -40,9 +40,7 @@
;;; Code:
;;
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'eieio)
(require 'jupiter)
@@ -109,14 +107,13 @@ construction of the name of the new operation. "
;; Compound operation
((string= type "split")
(let* ((rest (cdr message))
- (offset (position-if
+ (offset (cl-position-if
(lambda (item)
- (member* item '("ins" "del" "nop")
- :test #'string=))
+ (member item '("ins" "del" "nop")))
rest
:start 1))
- (first (subseq rest 0 offset))
- (second (subseq rest offset)))
+ (first (cl-subseq rest 0 offset))
+ (second (cl-subseq rest offset)))
(jupiter-compound
(format "compound-%d-%d"
remote-revision local-revision)
@@ -155,8 +152,8 @@ construction of the name of the new operation. "
(let ((old-from (+ from 1))
(old-to (+ to 1)))
(with-current-buffer buffer
- (destructuring-bind (change-from change-to string)
- rudel-buffer-change-workaround-data
+ (pcase-let ((`(,change-from ,change-to string)
+ rudel-buffer-change-workaround-data))
(setq from (- (position-bytes old-from) 1)
length (string-bytes
(substring string
@@ -237,23 +234,23 @@ coding-system."
(let ((bindings
(mapcar
(lambda (spec)
- (destructuring-bind (var type) spec
+ (pcase-let ((`(,var ,type) spec))
(list var
- (case type
+ (pcase type
;; Number
- (number
+ (`number
`(string-to-number ,var 16))
;; Color
- (color
+ (`color
`(rudel-obby-parse-color ,var))
;; Document Id
- (document-id
+ (`document-id
`(mapcar
(lambda (string)
(string-to-number string 16))
(split-string ,var " " t)))
;; Coding System
- (coding-system
+ (`coding-system
`(coding-system-from-name (downcase ,var)))))))
specs)))
`(let (,@bindings)
diff --git a/rudel-obby.el b/rudel-obby.el
index c13abcc..e86d008 100644
--- a/rudel-obby.el
+++ b/rudel-obby.el
@@ -41,9 +41,7 @@
;;; Code:
;;
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'eieio)
(require 'rudel)
@@ -182,44 +180,44 @@ Return the connection object."
;; Connection entered error state
(rudel-entered-error-state
- (destructuring-bind (symbol . state) (cdr error-data)
+ (pcase-let ((`(,symbol . ,state) (cdr error-data)))
(if (eq (rudel-find-state connection 'join-failed) state)
;; For the join-failed state, we can extract
;; details and react accordingly.
- (case symbol
+ (pcase symbol
;; Error state is 'join-failed'
- (join-failed
+ (`join-failed
(with-slots (error-symbol error-data) state
(message "Login error: %s %s."
error-symbol error-data)
(sleep-for 2)
- (case error-symbol
+ (pcase error-symbol
;; Invalid username; reset it.
- (rudel-obby-invalid-username
+ (`rudel-obby-invalid-username
(setq info (plist-put info :username nil)
switch-to (list 'joining info)))
;; Username already in use; reset it.
- (rudel-obby-username-in-use
+ (`rudel-obby-username-in-use
(setq info (plist-put info :username nil)
switch-to (list 'joining info)))
;; Invalid color; reset it.
- (rudel-obby-invalid-color
+ (`rudel-obby-invalid-color
(setq info (plist-put info :color nil)
switch-to (list 'joining info)))
;; Color already in use; reset it.
- (rudel-obby-color-in-use
+ (`rudel-obby-color-in-use
(setq info (plist-put info :color nil)
switch-to (list 'joining info)))
;; Unknown error TODO should we signal?
- (t nil))))
+ (_ nil))))
;; Error state is one of {we, they}-finalize
- ((we-finalized they-finalized)
+ ((or `we-finalized `they-finalized)
(with-slots (reason) state
(signal 'rudel-join-error (list reason)))))
@@ -275,7 +273,7 @@ Return the new document."
(let* ((used-ids (with-slots (documents) session
(mapcar 'rudel-id documents)))
(test-ids (number-sequence 0 (length used-ids))))
- (car (sort (set-difference test-ids used-ids) '<)))
+ (car (sort (cl-set-difference test-ids used-ids) #'<)))
)
@@ -414,7 +412,7 @@ whose cdr is the replacement for the pattern."
(defun rudel-obby-format-color (color)
"Format the Emacs color COLOR as obby color string."
- (multiple-value-bind (red green blue) (color-values color)
+ (pcase-let ((`(,red ,green ,blue) (color-values color)))
(format "%02x%02x%02x" (lsh red -8) (lsh green -8) (lsh blue -8))))
(defun rudel-obby-assemble-message (name &rest arguments)
diff --git a/rudel-overlay.el b/rudel-overlay.el
index a4f0663..00fb237 100644
--- a/rudel-overlay.el
+++ b/rudel-overlay.el
@@ -1,6 +1,6 @@
;;; rudel-overlay.el --- Overlay functions for Rudel
;;
-;; Copyright (C) 2008-2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, overlay
@@ -36,7 +36,7 @@
(require 'custom)
-(require 'cl)
+(require 'cl-lib)
(require 'eieio)
@@ -89,7 +89,7 @@ Otherwise all Rudel-related overlays are returned."
(let* ((overlay-lists (overlay-lists))
(overlays (append (car overlay-lists)
(cdr overlay-lists))))
- (remove-if-not predicate overlays))
+ (cl-remove-if-not predicate overlays))
)
(defun rudel-overlays-at (position &optional predicate)
@@ -98,7 +98,7 @@ If PREDICATE is non-nil returned overlays satisfy PREDICATES;
Otherwise all Rudel-related overlays are returned."
(unless predicate
(setq predicate #'rudel-overlay-p))
- (remove-if-not predicate (overlays-at position)))
+ (cl-remove-if-not predicate (overlays-at position)))
(defun rudel-overlays-in (start end &optional predicate)
"Return a list of Rudel-related overlays in the range START to END.
@@ -106,7 +106,7 @@ If PREDICATE is non-nil returned overlays satisfy
PREDICATES;
Otherwise all Rudel-related overlays are returned."
(unless predicate
(setq predicate #'rudel-overlay-p))
- (remove-if-not predicate (overlays-in start end)))
+ (cl-remove-if-not predicate (overlays-in start end)))
(defun rudel-overlays-remove-all ()
"Remove all Rudel overlays from the current buffer."
diff --git a/rudel-session-initiation.el b/rudel-session-initiation.el
index bf2b2a7..ad3a1fc 100644
--- a/rudel-session-initiation.el
+++ b/rudel-session-initiation.el
@@ -1,6 +1,6 @@
;;; rudel-session-initiation.el --- Session discovery and advertising functions
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: Rudel, session, initiation, service, discovery, advertising
@@ -54,7 +54,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'eieio)
@@ -188,12 +188,12 @@ priority."
(lambda (backend)
(rudel-capable-of-p backend capability))))
;; Select primary backends
- (primary-backends (remove*
+ (primary-backends (cl-remove
'fallback suitable-backends
:key (lambda (backend)
(rudel-priority (cdr backend)))))
;; Select fallback backends
- (fallback-backends (remove*
+ (fallback-backends (cl-remove
'primary suitable-backends
:key (lambda (backend)
(rudel-priority (cdr backend))))))
@@ -209,20 +209,21 @@ The returned list is of the form (INFO-1 ... INFO-N
FALLBACK-1
... FALLBACK-M) where INFO-I are connect info property lists (see
`rudel-join-session') and FALLBACK-I are conses of the form (NAME
. CLASS-OR-OBJECT) that specify fallback backends."
- (multiple-value-bind (primary-backends fallback-backends)
- (rudel-session-initiation-suitable-backends 'discover)
+ (pcase-let ((`(,primary-backends ,fallback-backends)
+ (rudel-session-initiation-suitable-backends 'discover)))
;; Retrieve session list from primary backend and fall back to
;; fallback backends if the list is empty.
(if backend-name
- (let ((backend (or (find backend-name primary-backends :key #'car)
- (find backend-name fallback-backends :key #'car))))
+ (let ((backend
+ (or (cl-find backend-name primary-backends :key #'car)
+ (cl-find backend-name fallback-backends :key #'car))))
(when backend
(rudel-discover (cdr backend))))
(let ((primary-results
- (remove-if #'null
- (apply #'append
- (mapcar #'rudel-discover
- (mapcar #'cdr primary-backends))))))
+ (cl-remove-if #'null
+ (apply #'append
+ (mapcar #'rudel-discover
+ (mapcar #'cdr primary-backends))))))
(append primary-results fallback-backends))))
)
@@ -236,20 +237,17 @@ backends are tried.
The result is non-nil if at least one backend was able to
advertise the session."
- (multiple-value-bind (primary-backends fallback-backends)
- (rudel-session-initiation-suitable-backends 'advertise)
+ (pcase-let ((`(,primary-backends ,fallback-backends)
+ (rudel-session-initiation-suitable-backends 'advertise)))
(or ;; Try to advertise the session using primary backends.
- (some #'identity
- (mapcar (lambda (backend)
- (rudel-advertise backend info))
- (mapcar #'cdr primary-backends)))
+ (cl-some (lambda (backend)
+ (rudel-advertise (cdr backend) info))
+ primary-backends)
;; When the primary backends fail, try to advertise the
;; session using fallback backends
- (some #'identity
- (mapcar (lambda (backend)
- (rudel-advertise backend info))
- (mapcar #'cdr fallback-backends)))))
- )
+ (cl-some (lambda (backend)
+ (rudel-advertise (cdr backend) info))
+ fallback-backends))))
;;; Class rudel-ask-protocol-backend
diff --git a/rudel-socket.el b/rudel-socket.el
index a0b884e..f19c97d 100644
--- a/rudel-socket.el
+++ b/rudel-socket.el
@@ -37,7 +37,7 @@
;;; Code:
;;
-(require 'cl) ;; for `every'
+(require 'cl-lib) ;; for `cl-every'
(require 'rudel-backend)
(require 'rudel-transport)
@@ -91,15 +91,15 @@ to be stored separately."))
socket (lambda (process _message)
(with-slots (sentinel) this
(when sentinel
- (case (process-status process)
+ (pcase (process-status process)
;; Nothing to do here.
- (run
+ (`run
nil)
;; Dispatch events which indicate the
;; termination of the connection to the
;; sentinel.
- ((closed failed exit finished)
+ ((or `closed `failed `exit `finished)
(funcall sentinel 'close)))))))))
(defmethod rudel-send ((this rudel-socket-transport) data)
@@ -210,8 +210,8 @@ The transport backend is a factory for TCP transport
objects.")
INFO has to be a property list containing the keys :host
and :port."
;; Ensure that INFO contains all necessary information.
- (unless (every (lambda (keyword) (member keyword info))
- '(:host :port))
+ (unless (cl-every (lambda (keyword) (member keyword info))
+ '(:host :port))
(setq info (funcall info-callback this info)))
;; Extract information from INFO and create the socket.
@@ -234,8 +234,8 @@ and :port."
"Create TCP server according to INFO.
INFO has to be a property list containing the key :port."
;; Ensure that INFO contains all necessary information.
- (unless (every (lambda (keyword) (member keyword info))
- '(:port))
+ (unless (cl-every (lambda (keyword) (member keyword info))
+ '(:port))
(setq info (funcall info-callback this info)))
;; Extract information from INFO and create the socket.
diff --git a/rudel-state-machine.el b/rudel-state-machine.el
index 7879983..b15a17e 100644
--- a/rudel-state-machine.el
+++ b/rudel-state-machine.el
@@ -1,6 +1,6 @@
;;; rudel-state-machine.el --- A simple state machine for Rudel
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, fsm
@@ -41,7 +41,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'eieio)
@@ -188,7 +188,7 @@ that fails as well, the first state in the state list is
used."
STATES is a list of cons cells whose car is a symbol - the name
of the state - and whose cdr is a class."
(dolist (symbol-and-state states)
- (destructuring-bind (name . class) symbol-and-state
+ (pcase-let ((`(,name . ,class) symbol-and-state))
(rudel-register-state
this name (make-instance class (symbol-name name)))))
)
@@ -198,7 +198,7 @@ of the state - and whose cdr is a class."
If OBJECT is non-nil, (NAME . OBJECT) is returned. Otherwise,
just NAME."
(with-slots (states state) this
- (let ((state-symbol (car (find state states :key #'cdr :test #'eq))))
+ (let ((state-symbol (car (cl-find state states :key #'cdr :test #'eq))))
(if object
(cons state-symbol state)
state-symbol)))
@@ -358,8 +358,8 @@ arguments and when they switch states.")
;; Remove :start initarg
(while rest
(unless (eq (car rest) :start)
- (push (first rest) replacement-args)
- (push (second rest) replacement-args))
+ (push (nth 0 rest) replacement-args)
+ (push (nth 1 rest) replacement-args))
(setq rest (cddr rest)))
;; Return remaining initargs.
@@ -388,8 +388,8 @@ symbol of the current state and STATE is the state object."
(catch 'state-wait
(while t
;; Retrieve current state.
- (destructuring-bind (symbol . state)
- (rudel-current-state machine t)
+ (pcase-let ((`(,symbol . ,state)
+ (rudel-current-state machine t)))
;; Check against success and error states.
(when (memq symbol success-states)
diff --git a/rudel-tls.el b/rudel-tls.el
index c6da7e7..c339a00 100644
--- a/rudel-tls.el
+++ b/rudel-tls.el
@@ -1,6 +1,6 @@
;;; rudel-tls.el --- Start TLS protocol.
;;
-;; Copyright (C) 2008, 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: Rudel, TLS, encryption, starttls, gnutls
@@ -39,6 +39,7 @@
;;; Code:
;;
+(require 'cl-lib)
(require 'format-spec)
(require 'rudel)
@@ -297,7 +298,7 @@ support STARTTLS behavior.")
INFO has to be a property list containing the keys :host
and :port."
;; Ensure that INFO contains all necessary information.
- (unless (every (lambda (keyword) (member keyword info))
+ (unless (cl-every (lambda (keyword) (member keyword info))
'(:host :port))
(setq info (funcall info-callback this info)))
diff --git a/rudel-transport-util.el b/rudel-transport-util.el
index 1f67fe3..b667b3a 100644
--- a/rudel-transport-util.el
+++ b/rudel-transport-util.el
@@ -48,7 +48,7 @@
;;; Code:
;;
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'eieio)
(eval-when-compile (require 'rudel-util))
(require 'rudel-errors) ;; for `rudel-error'
@@ -120,7 +120,7 @@ transform a bidirectional data stream as it passes through
them."
(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) (rest args)))
+ (apply method (oref this :transport) (cdr args)))
;;; Class rudel-assembling-transport-filter
@@ -422,7 +422,7 @@ transmission.")
(with-slots (transport queue queued-size flush-size) this
;; Enqueue new data.
(push data queue)
- (incf queued-size (length data))
+ (cl-incf queued-size (length data))
;; Transmit data immediately if necessary, otherwise ensure the
;; timer is running.
@@ -508,7 +508,7 @@ multiple chunks.")
(rudel-loop-chunks data chunk rudel-long-message-chunk-size
(progress-reporter-update reporter (/ (float current) total))
(rudel-send transport chunk)
- (incf current))
+ (cl-incf current))
(progress-reporter-done reporter))
;; Send small messages in one chunk
@@ -534,11 +534,11 @@ The returned value is the \"top\" of the constructed
stack (BASE
being the \"bottom\")."
(let ((current base))
(dolist (spec specs)
- (destructuring-bind (class &rest args) spec
- (setq current (apply #'make-instance
- class
- :transport current
- args))))
+ (pcase-let ((`(,class . ,args) spec))
+ (setq current (apply #'make-instance
+ class
+ :transport current
+ args))))
current))
(provide 'rudel-transport-util)
diff --git a/rudel-util.el b/rudel-util.el
index 30b943f..5cac3cf 100644
--- a/rudel-util.el
+++ b/rudel-util.el
@@ -43,7 +43,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'eieio)
@@ -53,10 +53,6 @@
;;; Errors
;;
-;; rudel-dispatch-error
-
-(intern "rudel-dispatch-error")
-
(put 'rudel-dispatch-error 'error-conditions
'(error
rudel-error rudel-dispatch-error))
@@ -120,11 +116,11 @@ the slots of some other object as if they were their own
slots."
"Look up SLOT-NAME in the state machine associated to THIS."
(let ((target (slot-value this (oref this impersonation-target-slot))))
(condition-case error
- (case operation
- (oref
+ (pcase operation
+ (`oref
(slot-value target slot-name))
- (oset
+ (`oset
(set-slot-value target slot-name new-value)))
(invalid-slot-name
(if (next-method-p)
@@ -151,7 +147,7 @@ methods."
method &rest args)
"Call METHOD on the target object instead of THIS."
(let ((target (slot-value this (oref this delegation-target-slot))))
- (apply method target (rest args))))
+ (apply method target (cdr args))))
;;; Fragmentation and assembling functions.
@@ -165,15 +161,13 @@ processing.
FUNCTION is called to identify complete and partial fragments in
the data."
(declare (debug (symbolp symbolp form)))
- (let ((complete (make-symbol "complete"))
- (partial (make-symbol "partial")))
+ (let ((x (make-symbol "x")))
;; Ask FUNCTION to find complete and partial fragments in the
;; combined data DATA and STORAGE. Store the results in DATA
;; STORAGE.
- `(multiple-value-bind (,complete ,partial)
- (funcall ,function ,data ,storage)
- (setq ,storage ,partial
- ,data ,complete)))
+ `(let ((,x (funcall ,function ,data ,storage)))
+ (setq ,storage (cadr ,x)
+ ,data (car ,x))))
)
(defun rudel-assemble-lines (data storage)
@@ -186,7 +180,7 @@ where complete COMPLETE is a list of complete lines and
INCOMPLETE is a list of string fragments of not yet complete
lines."
;; Try to find a line break in data.
- (let ((index (position ?\n data :from-end t)))
+ (let ((index (cl-position ?\n data :from-end t)))
(list
;; Complete lines
(when index
diff --git a/rudel-xml.el b/rudel-xml.el
index 0689808..c0ce737 100644
--- a/rudel-xml.el
+++ b/rudel-xml.el
@@ -1,6 +1,6 @@
;;; rudel-xml.el --- XML processing functions used by Rudel
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, xml
@@ -45,7 +45,7 @@
;;; Code:
;;
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'xml)
@@ -75,15 +75,15 @@ PRETTY-PRINT is currently ignored."
"Generate code for accessing the NAME component of NODE-VAR.
The optional argument TYPE is used when name is :child
or :children to specify the element name of the child."
- (case name
+ (pcase name
;; Retrieve child text node of NODE-VAR.
- (:text
+ (`:text
(list
`(car (xml-node-children ,node-var))
nil))
;; Retrieve a single child named TYPE of NODE-VAR.
- (:child
+ (`:child
(unless type
(signal 'wrong-number-of-arguments
(list 'rudel-xml--node-component name 2)))
@@ -92,7 +92,7 @@ or :children to specify the element name of the child."
t))
;; Retrieve a list of children, optionally filtering by NAME.
- (:children
+ (`:children
(if type
(list
`(xml-get-children ,node-var (quote ,type))
@@ -102,7 +102,7 @@ or :children to specify the element name of the child."
nil)))
;; Retrieve an attribute value.
- (t
+ (_
(list
`(xml-get-attribute ,node-var (quote ,name))
nil)))
@@ -111,18 +111,18 @@ or :children to specify the element name of the child."
(defun rudel-xml--parse-value (value-var type)
"Generate code to parse the value of VALUE-VAR as TYPE.
Currently, TYPE can be one of 'string and 'number."
- (case type
+ (pcase type
;; String; no conversion
- (string
+ (`string
value-var)
;; Convert to number
- (number
+ (`number
`(when ,value-var
(string-to-number ,value-var)))
;; For other types, signal an error.
- (t
+ (_
(signal 'wrong-type-argument (list 'type type))))
)
@@ -139,35 +139,33 @@ tag name. TYPE can be 'number."
(bindings
(mapcar
(lambda (attr)
- (cond
+ (pcase attr
;; Simple form
- ((symbolp attr)
+ ((pred symbolp)
`(,attr ,(car (rudel-xml--node-component
node-var attr))))
;; Variable name and attribute name
- ((= (length attr) 2)
- (destructuring-bind (attr-var name) attr
- (let ((value (car (rudel-xml--node-component
- node-var name))))
- `(,attr-var ,value))))
+ (`(,attr-var ,name)
+ (let ((value (car (rudel-xml--node-component
+ node-var name))))
+ `(,attr-var ,value)))
;; Variable name, attribute name and type
- ((= (length attr) 3)
- (destructuring-bind (attr-var name type) attr
- (destructuring-bind (value type-consumed)
- (rudel-xml--node-component
- node-var name type)
- (if type-consumed
- `(,attr-var ,value)
- (let ((string (make-symbol "value-string")))
- `(,attr-var (let ((,string ,value))
- ,(rudel-xml--parse-value
- string type))))))))
+ (`(,attr-var ,name ,type)
+ (pcase-let ((`(,value ,type-consumed)
+ (rudel-xml--node-component
+ node-var name type)))
+ (if type-consumed
+ `(,attr-var ,value)
+ (let ((string (make-symbol "value-string")))
+ `(,attr-var (let ((,string ,value))
+ ,(rudel-xml--parse-value
+ string type)))))))
;; Invalid form
- (t
+ (_
;; TODO define a proper condition or use signal?
(error "Invalid tag clause: %s" attr))))
attrs)))
@@ -218,8 +216,8 @@ start position and an end position."
(unless (or (= (aref string (- index 1)) ?/)
(= (aref string (- index 1)) ??))
(if tag-opening
- (incf depth)
- (decf depth)))
+ (cl-incf depth)
+ (cl-decf depth)))
(when (= depth 0)
(push (cons start (+ index 1)) tags)))))
@@ -249,8 +247,8 @@ The returned value is a list of the following form
\(COMPLETE INCOMPLETE\)
where complete COMPLETE is a list of complete tags and INCOMPLETE
is a string containing not yet complete tags."
- (destructuring-bind (tags buffer)
- (rudel-xml-toplevel-tags (concat storage data))
+ (pcase-let ((`(,tags ,buffer)
+ (rudel-xml-toplevel-tags (concat storage data))))
(list tags buffer)))
diff --git a/rudel-xmpp-debug.el b/rudel-xmpp-debug.el
index 2502351..e2798b7 100644
--- a/rudel-xmpp-debug.el
+++ b/rudel-xmpp-debug.el
@@ -1,6 +1,6 @@
;;; rudel-xmpp-debug.el --- Debugging functions for the Rudel XMPP backend
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, xmpp, debug
@@ -37,6 +37,7 @@
;;; Code:
;;
+(require 'cl-lib)
(require 'eieio)
(require 'rudel-xml)
@@ -80,7 +81,7 @@
this
:sent
"RESPDATA"
- (if (find ?= pair)
+ (if (cl-find ?= pair)
(apply #'format "%-16s: %s" (split-string pair "="))
pair)))
(split-string
@@ -99,7 +100,7 @@
this
:received
"CHALDATA"
- (if (find ?= pair)
+ (if (cl-find ?= pair)
(apply #'format "%-16s: %s" (split-string pair "="))
pair)))
(split-string
diff --git a/rudel-xmpp-sasl.el b/rudel-xmpp-sasl.el
index 2bec169..48bfe1d 100644
--- a/rudel-xmpp-sasl.el
+++ b/rudel-xmpp-sasl.el
@@ -36,6 +36,7 @@
;;; Code:
;;
+(require 'cl-lib)
(require 'xml)
(require 'sasl)
@@ -56,9 +57,9 @@
"Extract the list of supported mechanisms from FEATURES.
Then switch to the try one state to try them in order."
;; Find mechanism tags
- (let* ((mechanism-tags (remove* 'mechanisms features
- :test-not #'eq
- :key #'xml-node-name))
+ (let* ((mechanism-tags (cl-remove 'mechanisms features
+ :test-not #'eq
+ :key #'xml-node-name))
;; XML -> alist
(mechanisms
(apply #'append
@@ -93,7 +94,7 @@ Mechanism are tried by switching to the mechanism start state.
When no mechanisms are left, switch to the authentication failed state."
;; If there are mechanism on the list, try them, otherwise fail.
(if mechanisms
- (destructuring-bind (schema mechanism-name) (car mechanisms)
+ (pcase-let ((`(,schema ,mechanism-name) (car mechanisms)))
;; If Emacs supports the head of the mechanism list, try it,
;; otherwise go with the tail.
(let ((mechanism (sasl-find-mechanism (list mechanism-name))))
@@ -199,21 +200,21 @@ mechanism.")
(defmethod rudel-accept ((this rudel-xmpp-state-sasl-mechanism-step) xml)
"Interpret XML to decide how to proceed with the authentication mechanism."
- (case (xml-node-name xml)
+ (pcase (xml-node-name xml)
;; Authentication mechanism failed.
- (failure
+ (`failure
(let ((child (car-safe (xml-node-children xml))))
- (case (xml-node-name child)
+ (pcase (xml-node-name child)
;; The id chosen for identification was not accepted (example:
;; incorrectly formatted user id).
- (invalid-authzid
+ (`invalid-authzid
(with-slots (name server rest) this
(list 'sasl-try-one name server rest))) ;; TODO how do we react?
;; The not-authorized failure means that the credentials we
;; provided were wrong.
- ('not-authorized
+ (`not-authorized
(with-slots (name server rest) this
(list 'sasl-try-one name server rest))) ;; TODO how do we react?
@@ -222,19 +223,19 @@ mechanism.")
;; Not handled explicitly: <aborted/>, <incorrect-encoding/>,
;; <invalid-mechanism/>, <mechanism-too-weak/>,
;; <temporary-auth-failure/>
- (t
+ (_
(with-slots (name server rest) this
(list 'sasl-try-one name server rest))))))
;; Authentication mechanism succeeded. Switch to authenticated
;; state.
- (success
+ (`success
'authenticated)
;; Authentication mechanism requires a challenge-response
;; step. The Emacs SASL implementation does the heavy lifting for
;; us.
- (challenge
+ (`challenge
;; TODO is the challenge data always there?
(with-slots (name server schema client step rest) this
;; TODO assert string= schema (xml-node-attr xml "xmlns")
@@ -272,7 +273,7 @@ mechanism.")
(list 'sasl-try-one name server rest)))))
;; Unknown message.
- (t
+ (_
nil)) ;; TODO send error or call-next-method?
)
diff --git a/rudel-xmpp-state.el b/rudel-xmpp-state.el
index 862c30f..68f761a 100644
--- a/rudel-xmpp-state.el
+++ b/rudel-xmpp-state.el
@@ -1,6 +1,6 @@
;;; rudel-xmpp-state.el --- Base class for states used in XMPP connections
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, xmpp, state machine
@@ -36,6 +36,7 @@
;;; Code:
;;
+(require 'xml)
(require 'rudel-util)
(require 'rudel-state-machine)
@@ -75,17 +76,17 @@ machine of which uses the state object."))
(defmethod rudel-accept ((this rudel-xmpp-state) xml)
""
(let ((name (xml-node-name xml)))
- (case name
+ (pcase name
;;
;; TODO example
;; <stream:error>
;; <not-authorized xmlns="urn:ietf:params:xml:ns:xmpp-streams"/>
;; </stream:error>
- ('stream:error ;; TODO is this qualified
+ (`stream:error ;; TODO is this qualified
'they-finalize)
;; we do not accept unexpected messages.
- (t
+ (_
'we-finalize)))
)
diff --git a/rudel-xmpp-util.el b/rudel-xmpp-util.el
index 2bf2be4..f23703a 100644
--- a/rudel-xmpp-util.el
+++ b/rudel-xmpp-util.el
@@ -1,6 +1,6 @@
;;; rudel-xmpp-util.el --- Miscellaneous functions for the Rudel XMPP backend
;;
-;; Copyright (C) 2009, 2010, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009, 2010, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, xmpp, backend, miscellaneous
@@ -38,6 +38,7 @@
;;; Code:
;;
+(require 'cl-lib)
(require 'rudel-xml)
(require 'rudel-transport-util)
@@ -57,8 +58,8 @@ does not contains any incomplete stanzas."
;; Form a string by concatenating STORAGE and DATA. Form the stream
;; header, find the end of stream:features.
(let* ((string (concat storage data))
- (end (or (search "</stream:features>" string)
- (search "<stream:features/>" string)))
+ (end (or (cl-search "</stream:features>" string)
+ (cl-search "<stream:features/>" string)))
(end (when end
(+ end 18))))
;; If the end of stream:features has been found, artificially
@@ -68,17 +69,17 @@ does not contains any incomplete stanzas."
(list nil string)
;; Otherwise find top-level tags. This can still leave
;; incomplete tags.
- (destructuring-bind (tags buffer)
- (rudel-xml-toplevel-tags
- (concat (substring string 0 end)
- "</stream:stream>"
- (replace-regexp-in-string
- "</stream:stream>"
- ""
- (substring string end))))
+ (pcase-let ((`(,tags ,buffer)
+ (rudel-xml-toplevel-tags
+ (concat (substring string 0 end)
+ "</stream:stream>"
+ (replace-regexp-in-string
+ "</stream:stream>"
+ ""
+ (substring string end))))))
(list
;; Remove processing instructions.
- (remove-if
+ (cl-remove-if
(lambda (tag)
(= (aref tag 1) ??))
tags)
diff --git a/rudel-xmpp.el b/rudel-xmpp.el
index ee980ff..ba9cea3 100644
--- a/rudel-xmpp.el
+++ b/rudel-xmpp.el
@@ -37,6 +37,7 @@
;;; Code:
;;
+(require 'cl-lib)
(require 'rudel-state-machine)
(require 'rudel-backend)
@@ -103,8 +104,8 @@ keys
If non-nil, PROGRESS-CALLBACK has to be a function which is
called repeatedly to report progress."
;; Ensure that INFO contains all necessary information.
- (unless (every (lambda (keyword) (member keyword info))
- '(:host :jid))
+ (unless (cl-every (lambda (keyword) (member keyword info))
+ '(:host :jid))
(setq info (funcall info-callback this info)))
;; Extract information from INFO and connect.
diff --git a/rudel-zeroconf.el b/rudel-zeroconf.el
index 80f47a9..09eedf8 100644
--- a/rudel-zeroconf.el
+++ b/rudel-zeroconf.el
@@ -1,6 +1,6 @@
;;; rudel-zeroconf.el --- Zeroconf support for Rudel
;;
-;; Copyright (C) 2008, 2009, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009, 2014, 2016 Free Software Foundation, Inc.
;;
;; Author: Jan Moringen <address@hidden>
;; Keywords: rudel, service, discovery, advertising, zeroconf,
@@ -48,8 +48,7 @@
;;; Code:
;;
-(eval-when-compile
- (require 'cl)) ;; first, second, third
+(require 'cl-lib)
(require 'zeroconf)
@@ -72,20 +71,20 @@ Each element is of the form
;;; Accessors and manipulators for the service list
;;
-(defalias 'rudel-zeroconf-service-type 'first
+(defalias 'rudel-zeroconf-service-type #'car
"Return type of service.")
-(defalias 'rudel-zeroconf-transport-backend 'second
+(defalias 'rudel-zeroconf-transport-backend #'cadr
"Return transport backend associated with service type.")
-(defalias 'rudel-zeroconf-protocol-backend 'third
+(defalias 'rudel-zeroconf-protocol-backend #'cl-third
"Return protocol backend associated with service type.")
(defun rudel-zeroconf-service (key which)
"Return the Zeroconf service type used by BACKEND."
- (find which rudel-zeroconf-service-types
- :key key :test (if (eq key 'rudel-zeroconf-service-type)
- #'string= #'eq)))
+ (cl-find which rudel-zeroconf-service-types
+ :key key :test (if (eq key 'rudel-zeroconf-service-type)
+ #'string= #'eq)))
;;;###rudel-autoload
(defun rudel-zeroconf-register-service
@@ -126,7 +125,7 @@ service type TYPE."
"Return a list of session information property lists for Zeroconf-advertised
sessions."
(mapcar
#'rudel-zeroconf-service->plist
- (remove-if
+ (cl-remove-if
#'null
(mapcar
#'zeroconf-resolve-service
@@ -226,7 +225,7 @@ service type TYPE."
(apply #'append
(mapcar
(lambda (entry)
- (multiple-value-bind (key value) (split-string entry "=")
+ (pcase-let ((`(,key ,value) (split-string entry "=")))
(list (intern (concat ":" key))
value)))
record))
@@ -246,9 +245,9 @@ service type TYPE."
(mapcar #'zeroconf-service-name services)
nil t))
;; Retrieve and resolve the selected service object.
- (service (find service-name services
- :key #'zeroconf-service-name
- :test #'string=))
+ (service (cl-find service-name services
+ :key #'zeroconf-service-name
+ :test #'string=))
(service-resolved (zeroconf-resolve-service service)))
;; Return host and port
(list (zeroconf-service-host service-resolved)
diff --git a/rudel.el b/rudel.el
index 5d11105..0219530 100644
--- a/rudel.el
+++ b/rudel.el
@@ -55,7 +55,7 @@
;;; Code:
;;
-(require 'cl)
+(require 'cl-lib)
(require 'eieio)
(require 'eieio-base)
@@ -227,7 +227,7 @@ with arguments THIS and USER."
"Find user WHICH in the user list.
WHICH is compared to the result of KEY using TEST."
(with-slots (users) this
- (find which users
+ (cl-find which users
:key (or key #'object-name-string)
:test (or test #'string=))))
@@ -258,7 +258,7 @@ WHICH is compared to the result of KEY using TEST."
"Find document WHICH in the document list.
WHICH is compared to the result of KEY using TEST."
(with-slots (documents) this
- (find which documents
+ (cl-find which documents
:key (or key #'object-name-string)
:test (or test #'string=))))
@@ -306,7 +306,7 @@ client perspective.")
(unless self
(error "Cannot find unsubscribed documents without self user"))
- (remove-if
+ (cl-remove-if
(lambda (document)
(with-slots (subscribed) document
(memq self subscribed)))
@@ -569,7 +569,7 @@ with arguments THIS and USER."
"Find user WHICH in the list of subscribed users.
WHICH is compared to the result of KEY using TEST."
(with-slots (subscribed) this
- (find which subscribed
+ (cl-find which subscribed
:key (or key #'object-name-string)
:test (or test #'string=))))
@@ -657,7 +657,7 @@ null rudel-user-child)."
(list (- (overlay-start overlay) 1)
(- (overlay-end overlay) 1)
(rudel-overlay-user overlay)))
- (sort* (rudel-author-overlays)
+ (cl-sort (rudel-author-overlays)
#'< :key #'overlay-start)))
(last)
(augmented-chunks))
@@ -691,7 +691,7 @@ null rudel-user-child)."
augmented-chunks))
;; Sort chunks according to the start position.
- (sort* augmented-chunks #'< :key #'car))))
+ (cl-sort augmented-chunks #'< :key #'car))))
)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/rudel 71a7e74: Use cl-lib instead of cl,
Stefan Monnier <=