aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2018-01-23 14:42:43 -0500
committerStefan Monnier2018-01-23 14:42:43 -0500
commit18139139c90574ddc8dcb4d91ffbc48a536c1fe1 (patch)
tree2d70c229847cf4479b443e54fffd9a64a7bcc422
parente41c1dc99e631886fafc5595d4f4c048f294af33 (diff)
downloademacs-18139139c90574ddc8dcb4d91ffbc48a536c1fe1.tar.gz
emacs-18139139c90574ddc8dcb4d91ffbc48a536c1fe1.zip
Remove final uses of 'cl' in lisp/net
* lisp/net/pop3.el: Use lexical-binding and cl-lib. (pop3-write-to-file): Remove unused var 'start'. (pop3-make-date): Remove unused var 'sign'. * lisp/net/rfc2104.el: Use lexical-binding and cl-lib. * lisp/net/shr-color.el: Use lexical-binding and cl-lib. * lisp/net/sieve-manage.el: Use lexical-binding and cl-lib.
-rw-r--r--lisp/net/pop3.el26
-rw-r--r--lisp/net/rfc2104.el10
-rw-r--r--lisp/net/shr-color.el11
-rw-r--r--lisp/net/sieve-manage.el38
4 files changed, 40 insertions, 45 deletions
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index c2385f7f7e5..2a6807e1aca 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -1,4 +1,4 @@
1;;; pop3.el --- Post Office Protocol (RFC 1460) interface 1;;; pop3.el --- Post Office Protocol (RFC 1460) interface -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1996-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1996-2018 Free Software Foundation, Inc.
4 4
@@ -32,7 +32,7 @@
32 32
33;;; Code: 33;;; Code:
34 34
35(eval-when-compile (require 'cl)) 35(eval-when-compile (require 'cl-lib))
36 36
37(require 'mail-utils) 37(require 'mail-utils)
38(defvar parse-time-months) 38(defvar parse-time-months)
@@ -237,8 +237,8 @@ Use streaming commands."
237 (setq start-point 237 (setq start-point
238 (pop3-wait-for-messages process pop3-stream-length 238 (pop3-wait-for-messages process pop3-stream-length
239 total-size start-point)) 239 total-size start-point))
240 (incf waited-for pop3-stream-length)) 240 (cl-incf waited-for pop3-stream-length))
241 (incf i)) 241 (cl-incf i))
242 (pop3-wait-for-messages process (- count waited-for) 242 (pop3-wait-for-messages process (- count waited-for)
243 total-size start-point))) 243 total-size start-point)))
244 244
@@ -249,7 +249,7 @@ Use streaming commands."
249 (or (not total-size) 249 (or (not total-size)
250 (re-search-forward "^\\.\r?\n" nil t))) 250 (re-search-forward "^\\.\r?\n" nil t)))
251 (re-search-forward "^-ERR " nil t)) 251 (re-search-forward "^-ERR " nil t))
252 (decf count) 252 (cl-decf count)
253 (setq start-point (point))) 253 (setq start-point (point)))
254 (unless (memq (process-status process) '(open run)) 254 (unless (memq (process-status process) '(open run))
255 (error "pop3 process died")) 255 (error "pop3 process died"))
@@ -269,7 +269,6 @@ Use streaming commands."
269 269
270(defun pop3-write-to-file (file messages) 270(defun pop3-write-to-file (file messages)
271 (let ((pop-buffer (current-buffer)) 271 (let ((pop-buffer (current-buffer))
272 (start (point-min))
273 beg end 272 beg end
274 temp-buffer) 273 temp-buffer)
275 (with-temp-buffer 274 (with-temp-buffer
@@ -280,7 +279,6 @@ Use streaming commands."
280 (forward-line 1) 279 (forward-line 1)
281 (setq beg (point)) 280 (setq beg (point))
282 (when (re-search-forward "^\\.\r?\n" nil t) 281 (when (re-search-forward "^\\.\r?\n" nil t)
283 (setq start (point))
284 (forward-line -1) 282 (forward-line -1)
285 (setq end (point))) 283 (setq end (point)))
286 (with-current-buffer temp-buffer 284 (with-current-buffer temp-buffer
@@ -369,7 +367,7 @@ Use streaming commands."
369 (while (> i 0) 367 (while (> i 0)
370 (unless (member (nth (1- i) pop3-uidl) saved) 368 (unless (member (nth (1- i) pop3-uidl) saved)
371 (push i messages)) 369 (push i messages))
372 (decf i))) 370 (cl-decf i)))
373 (when messages 371 (when messages
374 (setq list (pop3-list process) 372 (setq list (pop3-list process)
375 size 0) 373 size 0)
@@ -399,7 +397,7 @@ Return non-nil if it is necessary to update the local UIDL file."
399 (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved)) 397 (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved))
400 (push ctime new) 398 (push ctime new)
401 (push uidl new)) 399 (push uidl new))
402 (decf i))) 400 (cl-decf i)))
403 (pop3-uidl 401 (pop3-uidl
404 (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl)))) 402 (setq new (mapcan (lambda (elt) (list elt ctime)) pop3-uidl))))
405 (when new (setq mod t)) 403 (when new (setq mod t))
@@ -424,7 +422,7 @@ Return non-nil if it is necessary to update the local UIDL file."
424 (push uidl new))) 422 (push uidl new)))
425 ;; Mails having been deleted in the server. 423 ;; Mails having been deleted in the server.
426 (setq mod t)) 424 (setq mod t))
427 (decf i 2)) 425 (cl-decf i 2))
428 (cond (saved 426 (cond (saved
429 (setcdr saved new)) 427 (setcdr saved new))
430 (srvr 428 (srvr
@@ -440,7 +438,7 @@ Return non-nil if it is necessary to update the local UIDL file."
440 (while (> i 0) 438 (while (> i 0)
441 (when (member (nth (1- i) pop3-uidl) dele) 439 (when (member (nth (1- i) pop3-uidl) dele)
442 (push i uidl)) 440 (push i uidl))
443 (decf i)) 441 (cl-decf i))
444 (when uidl 442 (when uidl
445 (pop3-send-streaming-command process "DELE" uidl nil))) 443 (pop3-send-streaming-command process "DELE" uidl nil)))
446 mod)) 444 mod))
@@ -620,10 +618,8 @@ Return the response string if optional second argument is non-nil."
620If NOW, use that time instead." 618If NOW, use that time instead."
621 (require 'parse-time) 619 (require 'parse-time)
622 (let* ((now (or now (current-time))) 620 (let* ((now (or now (current-time)))
623 (zone (nth 8 (decode-time now))) 621 (zone (nth 8 (decode-time now))))
624 (sign "+"))
625 (when (< zone 0) 622 (when (< zone 0)
626 (setq sign "-")
627 (setq zone (- zone))) 623 (setq zone (- zone)))
628 (concat 624 (concat
629 (format-time-string "%d" now) 625 (format-time-string "%d" now)
@@ -785,7 +781,7 @@ Otherwise, return the size of the message-id MSG"
785 (pop3-send-command process (format "DELE %s" msg)) 781 (pop3-send-command process (format "DELE %s" msg))
786 (pop3-read-response process)) 782 (pop3-read-response process))
787 783
788(defun pop3-noop (process msg) 784(defun pop3-noop (process _msg)
789 "No-operation." 785 "No-operation."
790 (pop3-send-command process "NOOP") 786 (pop3-send-command process "NOOP")
791 (pop3-read-response process)) 787 (pop3-read-response process))
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index d974ab6a772..57bca2e8788 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -1,4 +1,4 @@
1;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes 1;;; rfc2104.el --- RFC2104 Hashed Message Authentication Codes -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1998-2018 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
4 4
@@ -55,7 +55,7 @@
55 55
56;;; Code: 56;;; Code:
57 57
58(eval-when-compile (require 'cl)) 58(eval-when-compile (require 'cl-lib))
59 59
60;; Magic character for inner HMAC round. 0x36 == 54 == '6' 60;; Magic character for inner HMAC round. 0x36 == 54 == '6'
61(defconst rfc2104-ipad ?\x36) 61(defconst rfc2104-ipad ?\x36)
@@ -101,7 +101,7 @@ In XEmacs return just STRING."
101 (opad (make-string (+ block-length hash-length) rfc2104-opad)) 101 (opad (make-string (+ block-length hash-length) rfc2104-opad))
102 c partial) 102 c partial)
103 ;; Prefix *pad with key, appropriately XORed. 103 ;; Prefix *pad with key, appropriately XORed.
104 (do ((i 0 (1+ i))) 104 (cl-do ((i 0 (1+ i)))
105 ((= len i)) 105 ((= len i))
106 (setq c (aref key i)) 106 (setq c (aref key i))
107 (aset ipad i (logxor rfc2104-ipad c)) 107 (aset ipad i (logxor rfc2104-ipad c))
@@ -110,8 +110,8 @@ In XEmacs return just STRING."
110 (setq partial (rfc2104-string-make-unibyte 110 (setq partial (rfc2104-string-make-unibyte
111 (funcall hash (concat ipad text)))) 111 (funcall hash (concat ipad text))))
112 ;; Pack latter part of opad. 112 ;; Pack latter part of opad.
113 (do ((r 0 (+ 2 r)) 113 (cl-do ((r 0 (+ 2 r))
114 (w block-length (1+ w))) 114 (w block-length (1+ w)))
115 ((= (* 2 hash-length) r)) 115 ((= (* 2 hash-length) r))
116 (aset opad w 116 (aset opad w
117 (+ (* 16 (aref rfc2104-nybbles (aref partial r))) 117 (+ (* 16 (aref rfc2104-nybbles (aref partial r)))
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index 60d44b3cd66..31f3d46ed66 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -1,4 +1,4 @@
1;;; shr-color.el --- Simple HTML Renderer color management 1;;; shr-color.el --- Simple HTML Renderer color management -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2010-2018 Free Software Foundation, Inc. 3;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
4 4
@@ -27,7 +27,7 @@
27;;; Code: 27;;; Code:
28 28
29(require 'color) 29(require 'color)
30(eval-when-compile (require 'cl)) 30(eval-when-compile (require 'cl-lib))
31 31
32(defgroup shr-color nil 32(defgroup shr-color nil
33 "Simple HTML Renderer colors" 33 "Simple HTML Renderer colors"
@@ -209,8 +209,8 @@ This will convert \"80 %\" to 204, \"100 %\" to 255 but \"123\" to \"123\"."
209 209
210(defun shr-color-hue-to-rgb (x y h) 210(defun shr-color-hue-to-rgb (x y h)
211 "Convert X Y H to RGB value." 211 "Convert X Y H to RGB value."
212 (when (< h 0) (incf h)) 212 (when (< h 0) (cl-incf h))
213 (when (> h 1) (decf h)) 213 (when (> h 1) (cl-decf h))
214 (cond ((< h (/ 6.0)) (+ x (* (- y x) h 6))) 214 (cond ((< h (/ 6.0)) (+ x (* (- y x) h 6)))
215 ((< h 0.5) y) 215 ((< h 0.5) y)
216 ((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6))) 216 ((< h (/ 2.0 3.0)) (+ x (* (- y x) (- (/ 2.0 3.0) h) 6)))
@@ -258,8 +258,7 @@ Like rgb() or hsl()."
258 (let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0)) 258 (let ((h (/ (string-to-number (match-string-no-properties 1 color)) 360.0))
259 (s (/ (string-to-number (match-string-no-properties 2 color)) 100.0)) 259 (s (/ (string-to-number (match-string-no-properties 2 color)) 100.0))
260 (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0))) 260 (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0)))
261 (destructuring-bind (r g b) 261 (pcase-let ((`(,r ,g ,b) (shr-color-hsl-to-rgb-fractions h s l)))
262 (shr-color-hsl-to-rgb-fractions h s l)
263 (color-rgb-to-hex r g b 2)))) 262 (color-rgb-to-hex r g b 2))))
264 ;; Color names 263 ;; Color names
265 ((cdr (assoc-string color shr-color-html-colors-alist t))) 264 ((cdr (assoc-string color shr-color-html-colors-alist t)))
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index e6a1e8401d2..cd403072389 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -1,4 +1,4 @@
1;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp 1;;; sieve-manage.el --- Implementation of the managesieve protocol in elisp -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 2001-2018 Free Software Foundation, Inc. 3;; Copyright (C) 2001-2018 Free Software Foundation, Inc.
4 4
@@ -75,7 +75,7 @@
75 (require 'password-cache) 75 (require 'password-cache)
76 (require 'password)) 76 (require 'password))
77 77
78(eval-when-compile (require 'cl)) 78(eval-when-compile (require 'cl-lib))
79(require 'sasl) 79(require 'sasl)
80(require 'starttls) 80(require 'starttls)
81(autoload 'sasl-find-mechanism "sasl") 81(autoload 'sasl-find-mechanism "sasl")
@@ -182,7 +182,7 @@ Valid states are `closed', `initial', `nonauth', and `auth'.")
182 (generate-new-buffer (format " *sieve %s:%s*" 182 (generate-new-buffer (format " *sieve %s:%s*"
183 sieve-manage-server 183 sieve-manage-server
184 sieve-manage-port)) 184 sieve-manage-port))
185 (mapc 'make-local-variable sieve-manage-local-variables) 185 (mapc #'make-local-variable sieve-manage-local-variables)
186 (mm-enable-multibyte) 186 (mm-enable-multibyte)
187 (buffer-disable-undo) 187 (buffer-disable-undo)
188 (current-buffer))) 188 (current-buffer)))
@@ -206,19 +206,19 @@ Return the buffer associated with the connection."
206 (with-current-buffer buffer 206 (with-current-buffer buffer
207 (sieve-manage-erase) 207 (sieve-manage-erase)
208 (setq sieve-manage-state 'initial) 208 (setq sieve-manage-state 'initial)
209 (destructuring-bind (proc . props) 209 (pcase-let ((`(,proc . ,props)
210 (open-network-stream 210 (open-network-stream
211 "SIEVE" buffer server port 211 "SIEVE" buffer server port
212 :type stream 212 :type stream
213 :capability-command "CAPABILITY\r\n" 213 :capability-command "CAPABILITY\r\n"
214 :end-of-command "^\\(OK\\|NO\\).*\n" 214 :end-of-command "^\\(OK\\|NO\\).*\n"
215 :success "^OK.*\n" 215 :success "^OK.*\n"
216 :return-list t 216 :return-list t
217 :starttls-function 217 :starttls-function
218 (lambda (capabilities) 218 (lambda (capabilities)
219 (when (and (not sieve-manage-ignore-starttls) 219 (when (and (not sieve-manage-ignore-starttls)
220 (string-match "\\bSTARTTLS\\b" capabilities)) 220 (string-match "\\bSTARTTLS\\b" capabilities))
221 "STARTTLS\r\n"))) 221 "STARTTLS\r\n")))))
222 (setq sieve-manage-process proc) 222 (setq sieve-manage-process proc)
223 (setq sieve-manage-capability 223 (setq sieve-manage-capability
224 (sieve-manage-parse-capability (plist-get props :capabilities))) 224 (sieve-manage-parse-capability (plist-get props :capabilities)))
@@ -250,7 +250,7 @@ Return the buffer associated with the connection."
250 ;; somehow. 250 ;; somehow.
251 `(lambda (prompt) ,(copy-sequence user-password))) 251 `(lambda (prompt) ,(copy-sequence user-password)))
252 (step (sasl-next-step client nil)) 252 (step (sasl-next-step client nil))
253 (tag (sieve-manage-send 253 (_tag (sieve-manage-send
254 (concat 254 (concat
255 "AUTHENTICATE \"" 255 "AUTHENTICATE \""
256 mech 256 mech
@@ -373,11 +373,11 @@ to work in."
373 ;; Choose authenticator 373 ;; Choose authenticator
374 (when (and (null sieve-manage-auth) 374 (when (and (null sieve-manage-auth)
375 (not (eq sieve-manage-state 'auth))) 375 (not (eq sieve-manage-state 'auth)))
376 (dolist (auth sieve-manage-authenticators) 376 (cl-dolist (auth sieve-manage-authenticators)
377 (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) 377 (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist))
378 buffer) 378 buffer)
379 (setq sieve-manage-auth auth) 379 (setq sieve-manage-auth auth)
380 (return))) 380 (cl-return)))
381 (unless sieve-manage-auth 381 (unless sieve-manage-auth
382 (error "Couldn't figure out authenticator for server"))) 382 (error "Couldn't figure out authenticator for server")))
383 (sieve-manage-erase) 383 (sieve-manage-erase)