Commit e41c1dc9 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/net/imap.el: Use lexical-binding and cl-lib

Require packages instead of autoloading their functions.
(imap-send-command): Remove unused vars 'stream' and 'eol'.
(imap-parse-response): Use pcase.
(imap-parse-fetch): Remove unused arg 'response'.

* lisp/format-spec.el: Don't require CL.
parent 5ed5f548
......@@ -24,8 +24,6 @@
;;; Code:
(eval-when-compile (require 'cl))
(defun format-spec (format specification)
"Return a string based on FORMAT and SPECIFICATION.
FORMAT is a string containing `format'-like specs like \"bash %u %k\",
......
;;; imap.el --- imap library
;;; imap.el --- imap library -*- lexical-binding:t -*-
;; Copyright (C) 1998-2018 Free Software Foundation, Inc.
......@@ -135,20 +135,16 @@
;;; Code:
(eval-when-compile (require 'cl))
(eval-and-compile
;; For Emacs <22.2 and XEmacs.
(unless (fboundp 'declare-function) (defmacro declare-function (&rest _r)))
(autoload 'sasl-find-mechanism "sasl")
(autoload 'digest-md5-parse-digest-challenge "digest-md5")
(autoload 'digest-md5-digest-response "digest-md5")
(autoload 'digest-md5-digest-uri "digest-md5")
(autoload 'digest-md5-challenge "digest-md5")
(autoload 'rfc2104-hash "rfc2104")
(autoload 'utf7-encode "utf7")
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
(autoload 'format-spec-make "format-spec"))
(eval-when-compile (require 'cl-lib))
(require 'format-spec)
(require 'utf7)
(require 'rfc2104)
;; Hmm... digest-md5 is not part of Emacs.
;; FIXME: Should/can we use sasl-digest.el instead?
(declare-function digest-md5-parse-digest-challenge "digest-md5")
(declare-function digest-md5-digest-response "digest-md5")
(declare-function digest-md5-digest-uri "digest-md5")
(declare-function digest-md5-challenge "digest-md5")
;; User variables.
......@@ -1900,9 +1896,7 @@ on failure."
(setq cmdstr nil)
(if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
(setq command nil) ;; abort command if no cont-req
(let ((process imap-process)
(stream imap-stream)
(eol imap-client-eol))
(let ((process imap-process))
(with-current-buffer cmd
(imap-log cmd)
(process-send-region process (point-min)
......@@ -1956,7 +1950,7 @@ on failure."
'INCOMPLETE
'OK))))))
(defun imap-sentinel (process string)
(defun imap-sentinel (process _string)
(delete-process process))
(defun imap-find-next-line ()
......@@ -2145,7 +2139,7 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse addresses)))
;; With assert, the code might not be eval'd.
;; (assert (imap-parse-nil) t "In imap-parse-address-list")
;; (cl-assert (imap-parse-nil) t "In imap-parse-address-list")
(imap-parse-nil)))
;; mailbox = "INBOX" / astring
......@@ -2218,72 +2212,72 @@ Return nil if no complete line has arrived."
(defun imap-parse-response ()
"Parse an IMAP command response."
(let (token)
(case (setq token (read (current-buffer)))
(+ (setq imap-continuation
(or (buffer-substring (min (point-max) (1+ (point)))
(point-max))
t)))
(* (case (prog1 (setq token (read (current-buffer)))
(imap-forward))
(OK (imap-parse-resp-text))
(NO (imap-parse-resp-text))
(BAD (imap-parse-resp-text))
(BYE (imap-parse-resp-text))
(FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list)))
(LIST (imap-parse-data-list 'list))
(LSUB (imap-parse-data-list 'lsub))
(SEARCH (imap-mailbox-put
'search
(read (concat "(" (buffer-substring (point) (point-max)) ")"))))
(STATUS (imap-parse-status))
(CAPABILITY (setq imap-capability
(pcase (setq token (read (current-buffer)))
('+ (setq imap-continuation
(or (buffer-substring (min (point-max) (1+ (point)))
(point-max))
t)))
('* (pcase (prog1 (setq token (read (current-buffer)))
(imap-forward))
('OK (imap-parse-resp-text))
('NO (imap-parse-resp-text))
('BAD (imap-parse-resp-text))
('BYE (imap-parse-resp-text))
('FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list)))
('LIST (imap-parse-data-list 'list))
('LSUB (imap-parse-data-list 'lsub))
('SEARCH (imap-mailbox-put
'search
(read (concat "(" (buffer-substring (point) (point-max)) ")"))))
('STATUS (imap-parse-status))
('CAPABILITY (setq imap-capability
(read (concat "(" (upcase (buffer-substring
(point) (point-max)))
")"))))
(ID (setq imap-id (read (buffer-substring (point)
(point-max)))))
(ACL (imap-parse-acl))
(t (case (prog1 (read (current-buffer))
(imap-forward))
(EXISTS (imap-mailbox-put 'exists token))
(RECENT (imap-mailbox-put 'recent token))
(EXPUNGE t)
(FETCH (imap-parse-fetch token))
(t (message "Garbage: %s" (buffer-string)))))))
(t (let (status)
('ID (setq imap-id (read (buffer-substring (point)
(point-max)))))
('ACL (imap-parse-acl))
(_ (pcase (prog1 (read (current-buffer))
(imap-forward))
('EXISTS (imap-mailbox-put 'exists token))
('RECENT (imap-mailbox-put 'recent token))
('EXPUNGE t)
('FETCH (imap-parse-fetch))
(_ (message "Garbage: %s" (buffer-string)))))))
(_ (let (status)
(if (not (integerp token))
(message "Garbage: %s" (buffer-string))
(case (prog1 (setq status (read (current-buffer)))
(imap-forward))
(OK (progn
(setq imap-reached-tag (max imap-reached-tag token))
(imap-parse-resp-text)))
(NO (progn
(setq imap-reached-tag (max imap-reached-tag token))
(save-excursion
(imap-parse-resp-text))
(let (code text)
(when (eq (char-after) ?\[)
(setq code (buffer-substring (point)
(search-forward "]")))
(imap-forward))
(setq text (buffer-substring (point) (point-max)))
(push (list token status code text)
imap-failed-tags))))
(BAD (progn
(setq imap-reached-tag (max imap-reached-tag token))
(save-excursion
(imap-parse-resp-text))
(let (code text)
(when (eq (char-after) ?\[)
(setq code (buffer-substring (point)
(search-forward "]")))
(imap-forward))
(setq text (buffer-substring (point) (point-max)))
(push (list token status code text) imap-failed-tags)
(error "Internal error, tag %s status %s code %s text %s"
token status code text))))
(t (message "Garbage: %s" (buffer-string))))
(pcase (prog1 (setq status (read (current-buffer)))
(imap-forward))
('OK (progn
(setq imap-reached-tag (max imap-reached-tag token))
(imap-parse-resp-text)))
('NO (progn
(setq imap-reached-tag (max imap-reached-tag token))
(save-excursion
(imap-parse-resp-text))
(let (code text)
(when (eq (char-after) ?\[)
(setq code (buffer-substring (point)
(search-forward "]")))
(imap-forward))
(setq text (buffer-substring (point) (point-max)))
(push (list token status code text)
imap-failed-tags))))
('BAD (progn
(setq imap-reached-tag (max imap-reached-tag token))
(save-excursion
(imap-parse-resp-text))
(let (code text)
(when (eq (char-after) ?\[)
(setq code (buffer-substring (point)
(search-forward "]")))
(imap-forward))
(setq text (buffer-substring (point) (point-max)))
(push (list token status code text) imap-failed-tags)
(error "Internal error, tag %s status %s code %s text %s"
token status code text))))
(_ (message "Garbage: %s" (buffer-string))))
(when (assq token imap-callbacks)
(funcall (cdr (assq token imap-callbacks)) token status)
(setq imap-callbacks
......@@ -2459,7 +2453,7 @@ Return nil if no complete line has arrived."
(search-forward "]" nil t))
section)))
(defun imap-parse-fetch (response)
(defun imap-parse-fetch ()
(when (eq (char-after) ?\()
(let (uid flags envelope internaldate rfc822 rfc822header rfc822text
rfc822size body bodydetail bodystructure flags-empty)
......@@ -2593,7 +2587,7 @@ Return nil if no complete line has arrived."
(defun imap-parse-flag-list ()
(let (flag-list start)
(assert (eq (char-after) ?\() nil "In imap-parse-flag-list 1")
(cl-assert (eq (char-after) ?\() nil "In imap-parse-flag-list 1")
(while (and (not (eq (char-after) ?\)))
(setq start (progn
(imap-forward)
......@@ -2602,7 +2596,7 @@ Return nil if no complete line has arrived."
(point)))
(> (skip-chars-forward "^ )" (point-at-eol)) 0))
(push (buffer-substring start (point)) flag-list))
(assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2")
(cl-assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2")
(imap-forward)
(nreverse flag-list)))
......@@ -2687,7 +2681,7 @@ Return nil if no complete line has arrived."
(while (eq (char-after) ?\ )
(imap-forward)
(push (imap-parse-body-extension) b-e))
(assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
(cl-assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
(imap-forward)
(nreverse b-e))
(or (imap-parse-number)
......@@ -2716,7 +2710,7 @@ Return nil if no complete line has arrived."
(push (imap-parse-string-list) dsp)
(imap-forward))
;; With assert, the code might not be eval'd.
;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
;; (cl-assert (imap-parse-nil) t "In imap-parse-body-ext")
(imap-parse-nil))
(push (nreverse dsp) ext))
(when (eq (char-after) ?\ ) ;; body-fld-lang
......@@ -2813,7 +2807,7 @@ Return nil if no complete line has arrived."
(push (and (imap-parse-nil) nil) body))
(setq body
(append (imap-parse-body-ext) body))) ;; body-ext-...
(assert (eq (char-after) ?\)) nil "In imap-parse-body")
(cl-assert (eq (char-after) ?\)) nil "In imap-parse-body")
(imap-forward)
(nreverse body))
......@@ -2879,7 +2873,7 @@ Return nil if no complete line has arrived."
(push (imap-parse-nstring) body) ;; body-fld-md5
(setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
(assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
(cl-assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
(imap-forward)
(nreverse body)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment