[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 74b097b: * lisp/mh-e: Use cl-lib
|
From: |
Stefan Monnier |
|
Subject: |
[Emacs-diffs] master 74b097b: * lisp/mh-e: Use cl-lib |
|
Date: |
Tue, 6 Aug 2019 03:56:56 -0400 (EDT) |
branch: master
commit 74b097b61c5201405ad7bc5bb76f1ca0e794184b
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>
* lisp/mh-e: Use cl-lib
Also, use underscore prefixes and defvar in preparation for lexical binding
* lisp/mh-e/mh-acros.el: Require cl-lib instead of cl.
Rename all cl.el uses by adding `cl-` prefix.
(mh-require-cl): Remove. Not needed any more. Remove all calls.
(mh-defstruct): Remove. Replace all uses with cl-defstruct.
(mh-dlet*): New macro.
* lisp/mh-e/mh-comp.el (mh-user-agent-compose): Fold all ignored
optional args into the &rest arg.
* lisp/mh-e/mh-e.el: Require cl-lib instead of using mh-require-cl.
(mh-variants): Don't add-to-list on a local var.
* lisp/mh-e/mh-folder.el (mh-restore-desktop-buffer): Use shorter arg
names that don't collide with global vars.
* lisp/mh-e/mh-mime.el (mh-insert-mime-button):
(mh-insert-mime-security-button): Use mh-dlet*.
* lisp/mh-e/mh-search.el (mh-swish-next-result, mh-grep-next-result)
(mh-namazu-next-result): Use `or`.
* lisp/mh-e/mh-thread.el (mh-thread-generate)
(mh-thread-prune-containers): Use underscore rather than declare+ignore.
* lisp/mh-e/mh-tool-bar.el (mh-tool-bar-define): Use mh-dlet*.
(mh-tool-bar-define): Prefer the more precise \`...\' regexp ops.
Prefer Elisp's `eval-and-compile` over `cl-eval-when`.
* lisp/mh-e/mh-xface.el (mh-picon-get-image): Don't use
mh-funcall-if-exists for ietf-drums-parse-address.
Avoid the use of `cl-return` and hence use plain `defun`.
Replace some `cl-loop` with `dolist`.
---
lisp/mh-e/mh-acros.el | 80 +++-----------
lisp/mh-e/mh-alias.el | 4 +-
lisp/mh-e/mh-comp.el | 22 ++--
lisp/mh-e/mh-compat.el | 12 +--
lisp/mh-e/mh-e.el | 103 +++++++++---------
lisp/mh-e/mh-folder.el | 57 +++++-----
lisp/mh-e/mh-funcs.el | 2 +-
lisp/mh-e/mh-gnus.el | 8 +-
lisp/mh-e/mh-identity.el | 6 +-
lisp/mh-e/mh-inc.el | 15 ++-
lisp/mh-e/mh-junk.el | 1 -
lisp/mh-e/mh-limit.el | 27 +++--
lisp/mh-e/mh-mime.el | 129 ++++++++++++-----------
lisp/mh-e/mh-search.el | 266 +++++++++++++++++++++++------------------------
lisp/mh-e/mh-seq.el | 21 ++--
lisp/mh-e/mh-show.el | 2 +-
lisp/mh-e/mh-speed.el | 11 +-
lisp/mh-e/mh-thread.el | 76 +++++++-------
lisp/mh-e/mh-tool-bar.el | 97 ++++++++---------
lisp/mh-e/mh-utils.el | 79 +++++++-------
lisp/mh-e/mh-xface.el | 133 ++++++++++++------------
21 files changed, 549 insertions(+), 602 deletions(-)
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 3bbf509..c017419 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -40,30 +40,12 @@
;;; Code:
-(require 'cl)
+(require 'cl-lib)
;;; Compatibility
-;; TODO: Replace `cl' with `cl-lib'.
-;; `cl' is deprecated in Emacs 24.3. Use `cl-lib' instead. However,
-;; we'll likely have to insert `cl-' before each use of a Common Lisp
-;; function.
-;;;###mh-autoload
-(defmacro mh-require-cl ()
- "Macro to load \"cl\" if needed.
-
-Emacs coding conventions require that the \"cl\" package not be
-required at runtime. However, the \"cl\" package in Emacs 21.4
-and earlier left \"cl\" routines in their macro expansions. In
-particular, the expansion of (setf (gethash ...) ...) used
-functions in \"cl\" at run time. This macro recognizes that and
-loads \"cl\" appropriately."
- (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
- '(require 'cl)
- '(eval-when-compile (require 'cl))))
-
;;;###mh-autoload
(defmacro mh-do-in-gnu-emacs (&rest body)
"Execute BODY if in GNU Emacs."
@@ -81,6 +63,9 @@ loads \"cl\" appropriately."
;;;###mh-autoload
(defmacro mh-funcall-if-exists (function &rest args)
"Call FUNCTION with ARGS as parameters if it exists."
+ ;; FIXME: Not clear when this should be used. If the function happens
+ ;; not to exist at compile-time (e.g. because the corresponding package
+ ;; wasn't loaded), then it won't ever be used :-(
(when (fboundp function)
`(when (fboundp ',function)
(funcall ',function ,@args))))
@@ -135,53 +120,6 @@ check if variable `transient-mark-mode' is active."
'(and (boundp 'transient-mark-mode) transient-mark-mode
(boundp 'mark-active) mark-active))))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar struct)
- (defvar x)
- (defvar y))
-
-;;;###mh-autoload
-(defmacro mh-defstruct (name-spec &rest fields)
- ;; FIXME: Use `cl-defstruct' instead: shouldn't emit warnings any
- ;; more nor depend on run-time CL functions.
- "Replacement for `defstruct' from the \"cl\" package.
-The `defstruct' in the \"cl\" library produces compiler warnings,
-and generates code that uses functions present in \"cl\" at
-run-time. This is a partial replacement, that avoids these
-issues.
-
-NAME-SPEC declares the name of the structure, while FIELDS
-describes the various structure fields. Lookup `defstruct' for
-more details."
- (let* ((struct-name (if (atom name-spec) name-spec (car name-spec)))
- (conc-name (or (and (consp name-spec)
- (cadr (assoc :conc-name (cdr name-spec))))
- (format "%s-" struct-name)))
- (predicate (intern (format "%s-p" struct-name)))
- (constructor (or (and (consp name-spec)
- (cadr (assoc :constructor (cdr name-spec))))
- (intern (format "make-%s" struct-name))))
- (fields (mapcar (lambda (x)
- (if (atom x)
- (list x nil)
- (list (car x) (cadr x))))
- fields))
- (field-names (mapcar #'car fields))
- (struct (gensym "S"))
- (x (gensym "X"))
- (y (gensym "Y")))
- `(progn
- (defun* ,constructor (&key ,@fields)
- (list (quote ,struct-name) ,@field-names))
- (defun ,predicate (arg)
- (and (consp arg) (eq (car arg) (quote ,struct-name))))
- ,@(loop for x from 1
- for y in field-names
- collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z)
- (list 'nth ,x z)))
- (quote ,struct-name))))
-
;;;###mh-autoload
(defmacro with-mh-folder-updating (save-modification-flag &rest body)
"Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
@@ -327,6 +265,16 @@ MH-E functions."
,@body))))))))
(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
+(defmacro mh-dlet* (binders &rest body)
+ "Like `let*' but always dynamically scoped."
+ (declare (debug let) (indent 1))
+ ;; Works in both lexical and non-lexical mode.
+ `(progn
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders)
+ (let* ,binders ,@body)))
+
(provide 'mh-acros)
;; Local Variables:
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index c6cdfc4..2ff8801 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -30,8 +30,6 @@
(require 'mh-e)
-(mh-require-cl)
-
(require 'goto-addr)
(defvar mh-alias-alist 'not-read
@@ -308,7 +306,7 @@ Blind aliases or users from /etc/passwd are not expanded."
(if (not mh-alias-expand-aliases-flag)
mh-alias-alist
(lambda (string pred action)
- (case action
+ (cl-case action
((nil)
(let ((res (try-completion string mh-alias-alist pred)))
(if (or (eq res t)
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index a5614f5..1ffe56a 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -217,7 +217,7 @@ TO, CC, and SUBJECT arguments are used."
(defvar mh-error-if-no-draft nil) ;raise error over using old draft
;;;###autoload
-(defun mh-smail-batch (&optional to subject other-headers &rest ignored)
+(defun mh-smail-batch (&optional to subject _other-headers &rest _ignored)
"Compose a message with the MH mail system.
This function does not prompt the user for any header fields, and
@@ -239,10 +239,7 @@ applications should use `mh-user-agent-compose'."
'mh-before-send-letter-hook)
;;;###autoload
-(defun mh-user-agent-compose (&optional to subject other-headers continue
- switch-function yank-action
- send-actions return-action
- &rest ignored)
+(defun mh-user-agent-compose (&optional to subject other-headers &rest
_ignored)
"Set up mail composition draft with the MH mail system.
This is the `mail-user-agent' entry point to MH-E. This function
conforms to the contract specified by `define-mail-user-agent'
@@ -256,8 +253,7 @@ OTHER-HEADERS is an alist specifying additional header
fields.
Elements look like (HEADER . VALUE) where both HEADER and VALUE
are strings.
-CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and
-RETURN-ACTION and any additional arguments are IGNORED."
+Any additional arguments are IGNORED."
(mh-find-path)
(let ((mh-error-if-no-draft t))
(mh-send to "" subject)
@@ -266,9 +262,7 @@ RETURN-ACTION and any additional arguments are IGNORED."
(cdr (car other-headers)))
(setq other-headers (cdr other-headers)))))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar sendmail-coding-system))
+(defvar sendmail-coding-system)
;;;###autoload
(defun mh-send-letter (&optional arg)
@@ -1297,10 +1291,10 @@ discarded."
"Check if current buffer is entirely composed of ASCII.
The function doesn't work for XEmacs since `find-charset-region'
doesn't exist there."
- (loop for charset in (mh-funcall-if-exists
- find-charset-region (point-min) (point-max))
- unless (eq charset 'ascii) return nil
- finally return t))
+ (cl-loop for charset in (mh-funcall-if-exists
+ find-charset-region (point-min) (point-max))
+ unless (eq charset 'ascii) return nil
+ finally return t))
(provide 'mh-comp)
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index a459d27..7c5bd3a 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -143,7 +143,7 @@ introduced in Emacs 22."
`(face-background ,face ,frame ,inherit)))
(defun-mh mh-font-lock-add-keywords font-lock-add-keywords
- (mode keywords &optional how)
+ (_mode _keywords &optional _how)
"XEmacs does not have `font-lock-add-keywords'.
This function returns nil on that system.")
@@ -243,7 +243,7 @@ compatibility with versions of Emacs that lack the variable
(delete image-directory (copy-sequence (or path load-path))))))
(defun-mh mh-image-search-load-path
- image-search-load-path (file &optional path)
+ image-search-load-path (_file &optional _path)
"Emacs 21 and XEmacs don't have `image-search-load-path'.
This function returns nil on those systems."
nil)
@@ -292,7 +292,7 @@ introduced in Emacs 24."
`(make-obsolete-variable ,obsolete-name ,current-name ,when
,access-type))))
(defun-mh mh-match-string-no-properties
- match-string-no-properties (num &optional string)
+ match-string-no-properties (num &optional _string)
"Return string of text matched by last search, without text properties.
This function is used by XEmacs that lacks `match-string-no-properties'.
The function `buffer-substring-no-properties' is used instead.
@@ -301,7 +301,7 @@ The argument STRING is ignored."
(match-beginning num) (match-end num)))
(defun-mh mh-replace-regexp-in-string replace-regexp-in-string
- (regexp rep string &optional fixedcase literal subexp start)
+ (regexp rep string &optional _fixedcase literal _subexp _start)
"Replace REGEXP with REP everywhere in STRING and return result.
This function is used by XEmacs that lacks `replace-regexp-in-string'.
The function `replace-in-string' is used instead.
@@ -311,7 +311,7 @@ The arguments FIXEDCASE, SUBEXP, and START, used by
(replace-in-string string regexp rep literal)))
(defun-mh mh-test-completion
- test-completion (string collection &optional predicate)
+ test-completion (_string _collection &optional _predicate)
"Return non-nil if STRING is a valid completion.
XEmacs does not have `test-completion'. This function returns nil
on that system." nil)
@@ -352,7 +352,7 @@ The arguments RETURN-TO and EXIT-ACTION are ignored."
(view-mode 1))
(defun-mh mh-window-full-height-p
- window-full-height-p (&optional WINDOW)
+ window-full-height-p (&optional _window)
"Return non-nil if WINDOW is not the result of a vertical split.
This function is defined in XEmacs as it lacks
`window-full-height-p'. The values of the functions
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index c70e11e..7644f6e 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -91,7 +91,7 @@
;; for if it does it will introduce a require loop.
(require 'mh-loaddefs)
-(mh-require-cl)
+(require 'cl-lib)
(require 'mh-buffers)
(require 'mh-compat)
@@ -496,7 +496,7 @@ all the strings have been used."
(push (buffer-substring-no-properties (point)
(mh-line-end-position))
arg-list)
- (incf count)
+ (cl-incf count)
(forward-line))
(apply #'call-process cmd nil (list out nil) nil
(nreverse arg-list))))
@@ -509,8 +509,8 @@ all the strings have been used."
Adds double-quotes around entire string and quotes the characters
\\, `, and $ with a backslash."
(concat "\""
- (loop for x across string
- concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
+ (cl-loop for x across string
+ concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
"\""))
(defun mh-exec-cmd (command &rest args)
@@ -527,7 +527,7 @@ parsed by MH-E."
(save-excursion
(goto-char start)
(insert "Errors when executing: " command)
- (loop for arg in args do (insert " " arg))
+ (cl-loop for arg in args do (insert " " arg))
(insert "\n"))
(save-window-excursion
(switch-to-buffer-other-window mh-log-buffer)
@@ -583,7 +583,7 @@ ARGS are passed to COMMAND as command line arguments."
(push elem process-environment))
(apply #'mh-exec-cmd-daemon command filter args)))
-(defun mh-process-daemon (process output)
+(defun mh-process-daemon (_process output)
"PROCESS daemon that puts OUTPUT into a temporary buffer.
Any output from the process is displayed in an asynchronous
pop-up window."
@@ -683,11 +683,11 @@ ARGS is returned unchanged."
`(if (boundp 'customize-package-emacs-version-alist)
,args
(let (seen)
- (loop for keyword in ,args
- if (cond ((eq keyword ':package-version) (setq seen t) nil)
- (seen (setq seen nil) nil)
- (t t))
- collect keyword))))
+ (cl-loop for keyword in ,args
+ if (cond ((eq keyword ':package-version) (setq seen t) nil)
+ (seen (setq seen nil) nil)
+ (t t))
+ collect keyword))))
(defmacro defgroup-mh (symbol members doc &rest args)
"Declare SYMBOL as a customization group containing MEMBERS.
@@ -740,14 +740,14 @@ is described by the variable `mh-variants'."
(let ((list-unique))
;; Make a unique list of directories, keeping the given order.
;; We don't want the same MH variant to be listed multiple times.
- (loop for dir in (append mh-path mh-sys-path exec-path) do
- (setq dir (file-chase-links (directory-file-name dir)))
- (add-to-list 'list-unique dir))
- (loop for dir in (nreverse list-unique) do
- (when (and dir (file-accessible-directory-p dir))
- (let ((variant (mh-variant-info dir)))
- (if variant
- (add-to-list 'mh-variants variant)))))
+ (cl-loop for dir in (append mh-path mh-sys-path exec-path) do
+ (setq dir (file-chase-links (directory-file-name dir)))
+ (cl-pushnew dir list-unique :test #'equal))
+ (cl-loop for dir in (nreverse list-unique) do
+ (when (and dir (file-accessible-directory-p dir))
+ (let ((variant (mh-variant-info dir)))
+ (if variant
+ (add-to-list 'mh-variants variant)))))
mh-variants)))
(defun mh-variant-info (dir)
@@ -858,22 +858,22 @@ variant."
mh-progs progs
mh-variant-in-use variant))))
((symbolp variant) ;e.g. 'nmh (pick the first match)
- (loop for variant-list in (mh-variants)
- when (eq variant (cadr (assoc 'variant (cdr variant-list))))
- return (let* ((version (car variant-list))
- (alist (cdr variant-list))
- (lib-progs (cadr (assoc 'mh-lib-progs alist)))
- (lib (cadr (assoc 'mh-lib alist)))
- (progs (cadr (assoc 'mh-progs alist)))
- (flists (cadr (assoc 'flists alist))))
- ;;(set-default mh-variant flavor)
- (setq mh-x-mailer-string nil
- mh-flists-present-flag flists
- mh-lib-progs lib-progs
- mh-lib lib
- mh-progs progs
- mh-variant-in-use version)
- t)))))
+ (cl-loop for variant-list in (mh-variants)
+ when (eq variant (cadr (assoc 'variant (cdr variant-list))))
+ return (let* ((version (car variant-list))
+ (alist (cdr variant-list))
+ (lib-progs (cadr (assoc 'mh-lib-progs alist)))
+ (lib (cadr (assoc 'mh-lib alist)))
+ (progs (cadr (assoc 'mh-progs alist)))
+ (flists (cadr (assoc 'flists alist))))
+ ;;(set-default mh-variant flavor)
+ (setq mh-x-mailer-string nil
+ mh-flists-present-flag flists
+ mh-lib-progs lib-progs
+ mh-lib lib
+ mh-progs progs
+ mh-variant-in-use version)
+ t)))))
(defun mh-variant-p (&rest variants)
"Return t if variant is any of VARIANTS.
@@ -1706,9 +1706,9 @@ The function is always called with SYMBOL bound to
(set symbol value) ;XXX shouldn't this be set-default?
(setq mh-junk-choice
(or value
- (loop for element in mh-junk-function-alist
- until (executable-find (symbol-name (car element)))
- finally return (car element)))))
+ (cl-loop for element in mh-junk-function-alist
+ until (executable-find (symbol-name (car element)))
+ finally return (car element)))))
(defcustom-mh mh-junk-background nil
"If on, spam programs are run in background.
@@ -2885,9 +2885,9 @@ removed and entries from `mh-invisible-header-fields' are
added."
(when mh-invisible-header-fields-default
;; Remove entries from `mh-invisible-header-fields-default'
(setq fields
- (loop for x in fields
- unless (member x mh-invisible-header-fields-default)
- collect x)))
+ (cl-loop for x in fields
+ unless (member x mh-invisible-header-fields-default)
+ collect x)))
(when (and (boundp 'mh-invisible-header-fields)
mh-invisible-header-fields)
(dolist (x mh-invisible-header-fields)
@@ -3605,16 +3605,17 @@ specified colors."
new-spec)
;; Remove entries with min-colors, or delete them if we have
;; fewer colors than they specify.
- (loop for entry in (reverse spec) do
- (let ((requirement (if (eq (car entry) t)
- nil
- (assq 'min-colors (car entry)))))
- (if requirement
- (when (>= cells (nth 1 requirement))
- (setq new-spec (cons (cons (delq requirement (car entry))
- (cdr entry))
- new-spec)))
- (setq new-spec (cons entry new-spec)))))
+ (cl-loop
+ for entry in (reverse spec) do
+ (let ((requirement (if (eq (car entry) t)
+ nil
+ (assq 'min-colors (car entry)))))
+ (if requirement
+ (when (>= cells (nth 1 requirement))
+ (setq new-spec (cons (cons (delq requirement (car entry))
+ (cdr entry))
+ new-spec)))
+ (setq new-spec (cons entry new-spec)))))
new-spec))))
(defface-mh mh-folder-address
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 5b4c34f..7e7918e 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -31,7 +31,6 @@
(require 'mh-e)
(require 'mh-scan)
-(mh-require-cl)
;; Dynamically-created functions not found in mh-loaddefs.el.
(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
@@ -80,16 +79,14 @@ the MH mail system."
(add-to-list 'desktop-buffer-mode-handlers
'(mh-folder-mode . mh-restore-desktop-buffer)))
-(defun mh-restore-desktop-buffer (desktop-buffer-file-name
- desktop-buffer-name
- desktop-buffer-misc)
+(defun mh-restore-desktop-buffer (_file-name name _misc)
"Restore an MH folder buffer specified in a desktop file.
-When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the
-file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer
-name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info
+When desktop creates a buffer, FILE-NAME holds the
+file name to visit, NAME holds the desired buffer
+name, and MISC holds a list of miscellaneous info
used by the `desktop-buffer-mode-handlers' functions."
(mh-find-path)
- (mh-visit-folder desktop-buffer-name)
+ (mh-visit-folder name)
(current-buffer))
@@ -932,9 +929,9 @@ many unread messages to skip."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
- (t (loop for msg in unread-sequence
- when (mh-goto-msg msg t) return nil
- finally (message "No more unread messages"))))))
+ (t (cl-loop for msg in unread-sequence
+ when (mh-goto-msg msg t) return nil
+ finally (message "No more unread messages"))))))
;;;###mh-autoload
(defun mh-page-msg (&optional lines)
@@ -1030,9 +1027,9 @@ many unread messages to skip."
(setq count (1- count)))
(not (car unread-sequence)))
(message "No more unread messages"))
- (t (loop for msg in unread-sequence
- when (mh-goto-msg msg t) return nil
- finally (message "No more unread messages"))))))
+ (t (cl-loop for msg in unread-sequence
+ when (mh-goto-msg msg t) return nil
+ finally (message "No more unread messages"))))))
;;;###mh-autoload
(defun mh-quit ()
@@ -1503,7 +1500,7 @@ function doesn't recenter the folder buffer."
(let ((lines-from-end 2))
(save-excursion
(while (> (point-max) (progn (forward-line) (point)))
- (incf lines-from-end)))
+ (cl-incf lines-from-end)))
(recenter (- lines-from-end))))
;; '(4) is the same as C-u prefix argument.
(t (recenter (or arg '(4))))))
@@ -1587,10 +1584,11 @@ after the commands are processed."
;; Preserve sequences in destination folder...
(when mh-refile-preserves-sequences-flag
(clrhash dest-map)
- (loop for i from (1+ (or last 0))
- for msg in (sort (copy-sequence msgs) #'<)
- do (loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name dest-map))))
+ (cl-loop
+ for i from (1+ (or last 0))
+ for msg in (sort (copy-sequence msgs) #'<)
+ do (cl-loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name dest-map))))
(maphash
#'(lambda (seq msgs)
;; Can't be run in the background, since the
@@ -1639,10 +1637,10 @@ after the commands are processed."
(mh-delete-scan-msgs mh-whitelist)
(when mh-whitelist-preserves-sequences-flag
(clrhash white-map)
- (loop for i from (1+ (or last 0))
- for msg in (sort (copy-sequence mh-whitelist) #'<)
- do (loop for seq-name in (gethash msg seq-map)
- do (push i (gethash seq-name white-map))))
+ (cl-loop for i from (1+ (or last 0))
+ for msg in (sort (copy-sequence mh-whitelist) #'<)
+ do (cl-loop for seq-name in (gethash msg seq-map)
+ do (push i (gethash seq-name white-map))))
(maphash
#'(lambda (seq msgs)
;; Can't be run in background, since the current
@@ -1922,10 +1920,11 @@ exist."
(from (or (message-fetch-field "from") ""))
folder-name)
(setq folder-name
- (loop for list in mh-default-folder-list
- when (string-match (nth 0 list) (if (nth 2 list) to/cc from))
- return (nth 1 list)
- finally return nil))
+ (cl-loop for list in mh-default-folder-list
+ when (string-match (nth 0 list)
+ (if (nth 2 list) to/cc from))
+ return (nth 1 list)
+ finally return nil))
;; Make sure a result from `mh-default-folder-list' begins with "+"
;; since 'mh-expand-file-name below depends on it
@@ -2026,8 +2025,8 @@ If MSG is nil then act on the message at point"
(t
(dolist (folder-msg-list mh-refile-list)
(setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
- (setq mh-refile-list (loop for x in mh-refile-list
- unless (null (cdr x)) collect x))))
+ (setq mh-refile-list (cl-loop for x in mh-refile-list
+ unless (null (cdr x)) collect x))))
(mh-notate nil ? mh-cmd-note)))
;;;###mh-autoload
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 9f603c0..1b3883d 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -123,7 +123,7 @@ folder. This is useful for folders that are easily
regenerated."
(message "Folder %s removed" folder))
(message "Folder not removed")))
-(defun mh-rmf-daemon (process output)
+(defun mh-rmf-daemon (_process output)
"The rmf PROCESS puts OUTPUT in temporary buffer.
Display the results only if something went wrong."
(set-buffer (get-buffer-create mh-temp-buffer))
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 61d531f..1ca90d9 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -79,7 +79,7 @@
;; Function from mm-decode.el used in PGP messages. Just define it with older
;; Gnus to avoid compiler warning.
(defun-mh mh-mm-possibly-verify-or-decrypt
- mm-possibly-verify-or-decrypt (parts ctl)
+ mm-possibly-verify-or-decrypt (_parts _ctl)
nil)
;; Copy of macro in mm-decode.el.
@@ -110,16 +110,16 @@
(and (> (current-column) length)
(current-column))))
-(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle)
+(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (_handle)
;; Released Gnus doesn't keep handles associated with externally displayed
;; MIME parts. So this will always return nil.
nil)
-(defun-mh mh-mm-destroy-parts mm-destroy-parts (list)
+(defun-mh mh-mm-destroy-parts mm-destroy-parts (_list)
"Older versions of Emacs don't have this function."
nil)
-(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles)
+(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (_handles)
"Emacs 21 and XEmacs don't have this function."
nil)
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 1d929e8..0b69839 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -205,7 +205,7 @@ See `mh-identity-list'."
(setq mh-identity-local identity))))
;;;###mh-autoload
-(defun mh-identity-handler-gpg-identity (field action &optional value)
+(defun mh-identity-handler-gpg-identity (_field action &optional value)
"Process header FIELD \":pgg-default-user-id\".
The ACTION is one of `remove' or `add'. If `add', the VALUE is added.
The buffer-local variable `mh-identity-pgg-default-user-id' is set to
@@ -219,7 +219,7 @@ VALUE when action `add' is selected."
(setq mh-identity-pgg-default-user-id value))))
;;;###mh-autoload
-(defun mh-identity-handler-signature (field action &optional value)
+(defun mh-identity-handler-signature (_field action &optional value)
"Process header FIELD \":signature\".
The ACTION is one of `remove' or `add'. If `add', the VALUE is
added."
@@ -250,7 +250,7 @@ added."
"Marker for the end of the attribution verb.")
;;;###mh-autoload
-(defun mh-identity-handler-attribution-verb (field action &optional value)
+(defun mh-identity-handler-attribution-verb (_field action &optional value)
"Process header FIELD \":attribution-verb\".
The ACTION is one of `remove' or `add'. If `add', the VALUE is
added."
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 21034bc..9d7b719 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -33,7 +33,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(defvar mh-inc-spool-map-help nil
"Help text for `mh-inc-spool-map'.")
@@ -51,13 +50,13 @@
"Make all commands and defines keys for contents of `mh-inc-spool-list'."
(setq mh-inc-spool-map-help nil)
(when mh-inc-spool-list
- (loop for elem in mh-inc-spool-list
- do (let ((spool (nth 0 elem))
- (folder (nth 1 elem))
- (key (nth 2 elem)))
- (progn
- (mh-inc-spool-generator folder spool)
- (mh-inc-spool-def-key key folder))))))
+ (cl-loop for elem in mh-inc-spool-list
+ do (let ((spool (nth 0 elem))
+ (folder (nth 1 elem))
+ (key (nth 2 elem)))
+ (progn
+ (mh-inc-spool-generator folder spool)
+ (mh-inc-spool-def-key key folder))))))
(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make)
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index db80f90..f3ae919 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -32,7 +32,6 @@
(require 'mh-e)
(require 'mh-scan)
-(mh-require-cl)
;;;###mh-autoload
(defun mh-junk-blacklist (range)
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index ee6fa83..8d1e542 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -30,7 +30,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(require 'mh-scan)
(autoload 'message-fetch-field "message")
@@ -126,8 +125,8 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this
command."
(mh-quote-pick-expr (mh-current-message-header-field 'subject)))))
(setq pick-expr
(let ((case-fold-search t))
- (loop for s in pick-expr
- collect (mh-replace-regexp-in-string "re: *" "" s))))
+ (cl-loop for s in pick-expr
+ collect (mh-replace-regexp-in-string "re: *" "" s))))
(mh-narrow-to-header-field 'subject pick-expr))
;;;###mh-autoload
@@ -249,7 +248,7 @@ Return number of messages put in the sequence:
(defun mh-edit-pick-expr (default)
"With prefix arg edit a pick expression.
If no prefix arg is given, then return DEFAULT."
- (let ((default-string (loop for x in default concat (format " %s" x))))
+ (let ((default-string (cl-loop for x in default concat (format " %s" x))))
(if (or current-prefix-arg (equal default-string ""))
(mh-pick-args-list (read-string "Pick expression: "
default-string))
@@ -291,18 +290,18 @@ For example, the string \"-subject a b c -from Joe User
(let* ((field (or (message-fetch-field (format "%s" header-field))
""))
(field-option (format "-%s" header-field))
- (patterns (loop for x in (split-string field "[ ]*,[ ]*")
- unless (equal x "")
- collect (if (string-match "<\\(.*@.*\\)>" x)
- (match-string 1 x)
- x))))
+ (patterns (cl-loop for x in (split-string field "[ ]*,[ ]*")
+ unless (equal x "")
+ collect (if (string-match "<\\(.*@.*\\)>"
x)
+ (match-string 1 x)
+ x))))
(when patterns
- (loop with accum = `(,field-option ,(car patterns))
- for e in (cdr patterns)
- do (setq accum `(,field-option ,e "-or" ,@accum))
- finally return accum))))))))
+ (cl-loop with accum = `(,field-option ,(car patterns))
+ for e in (cdr patterns)
+ do (setq accum `(,field-option ,e "-or" ,@accum))
+ finally return accum))))))))
-(defun mh-narrow-to-header-field (header-field pick-expr)
+(defun mh-narrow-to-header-field (_header-field pick-expr)
"Limit to messages whose HEADER-FIELD match PICK-EXPR.
The MH command pick is used to do the match."
(let ((folder mh-current-folder)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 6f12696..d74e79f 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -77,7 +77,7 @@
'(gethash (current-buffer) mh-globals-hash))
;; Structure to keep track of MIME handles on a per buffer basis.
-(mh-defstruct (mh-buffer-data (:conc-name mh-mime-)
+(cl-defstruct (mh-buffer-data (:conc-name mh-mime-)
(:constructor mh-make-buffer-data))
(handles ()) ; List of MIME handles
(handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of
@@ -611,7 +611,7 @@ If message has been encoded for transfer take that into
account."
"Choose among the alternatives, HANDLES the part that will be displayed.
If no part is preferred then all the parts are displayed."
(let* ((preferred (mm-preferred-alternative handles))
- (others (loop for x in handles unless (eq x preferred) collect x)))
+ (others (cl-loop for x in handles unless (eq x preferred) collect x)))
(cond ((and preferred
(stringp (car preferred)))
(mh-mime-display-part preferred)
@@ -770,7 +770,7 @@ buttons need to be displayed multiple times (for instance
when
nested messages are opened)."
(or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
(setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
- (incf (mh-mime-parts-count (mh-buffer-data))))))
+ (cl-incf (mh-mime-parts-count (mh-buffer-data))))))
(defun mh-small-image-p (handle)
"Decide whether HANDLE is a \"small\" image that can be displayed inline.
@@ -839,9 +839,7 @@ being used to highlight the signature in a MIME part."
;; Shush compiler.
(mh-do-in-xemacs
- (defvar dots)
- (defvar type)
- (defvar ov))
+ (defvar ov))
(defun mh-insert-mime-button (handle index displayed)
"Insert MIME button for HANDLE.
@@ -857,23 +855,27 @@ by commands like \"K v\" which operate on individual MIME
parts."
(mail-content-type-get (mm-handle-type handle) 'url)
""))
(type (mm-handle-media-type handle))
- (description (mail-decode-encoded-word-string
- (or (mm-handle-description handle) "")))
- (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
- long-type begin end)
+ begin end)
(if (string-match ".*/" name) (setq name (substring name (match-end 0))))
- (setq long-type (concat type (and (not (equal name ""))
- (concat "; " name))))
- (unless (equal description "")
- (setq long-type (concat " --- " long-type)))
- (unless (bolp) (insert "\n"))
- (setq begin (point))
- (gnus-eval-format
- mh-mime-button-line-format mh-mime-button-line-format-alist
- `(,@(mh-gnus-local-map-property mh-mime-button-map)
+ ;; These vars are passed by dynamic-scoping to
+ ;; mh-mime-button-line-format-alist via gnus-eval-format.
+ (mh-dlet* ((index index)
+ (description (mail-decode-encoded-word-string
+ (or (mm-handle-description handle) "")))
+ (dots (if (or displayed (mm-handle-displayed-p handle))
+ " " "..."))
+ (long-type (concat type (and (not (equal name ""))
+ (concat "; " name)))))
+ (unless (equal description "")
+ (setq long-type (concat " --- " long-type)))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-button-line-format mh-mime-button-line-format-alist
+ `(,@(mh-gnus-local-map-property mh-mime-button-map)
mh-callback mh-mm-display-part
mh-part ,index
- mh-data ,handle))
+ mh-data ,handle)))
(setq end (point))
(widget-convert-button
'link begin end
@@ -888,8 +890,6 @@ by commands like \"K v\" which operate on individual MIME
parts."
;; Shush compiler.
(defvar mm-verify-function-alist) ; < Emacs 22
(defvar mm-decrypt-function-alist) ; < Emacs 22
-(mh-do-in-xemacs
- (defvar pressed-details))
(defun mh-insert-mime-security-button (handle)
"Display buttons for PGP message, HANDLE."
@@ -897,42 +897,47 @@ by commands like \"K v\" which operate on individual MIME
parts."
(crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
(nth 2 (assoc protocol mm-decrypt-function-alist))
"Unknown"))
- (type (concat crypto-type
- (if (equal (car handle) "multipart/signed")
- " Signed" " Encrypted")
- " Part"))
- (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info)
- "Undecided"))
- (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details))
- pressed-details begin end face)
- (setq details (if details (concat "\n" details) ""))
- (setq pressed-details (if mh-mime-security-button-pressed details ""))
- (setq face (mh-mime-security-button-face info))
- (unless (bolp) (insert "\n"))
- (setq begin (point))
- (gnus-eval-format
- mh-mime-security-button-line-format
- mh-mime-security-button-line-format-alist
- `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
+ begin end face)
+ ;; These vars are passed by dynamic-scoping to
+ ;; mh-mime-security-button-line-format-alist via gnus-eval-format.
+ (mh-dlet* ((type (concat crypto-type
+ (if (equal (car handle) "multipart/signed")
+ " Signed" " Encrypted")
+ " Part"))
+ (info (or (mh-mm-handle-multipart-ctl-parameter
+ handle 'gnus-info)
+ "Undecided"))
+ (details (mh-mm-handle-multipart-ctl-parameter
+ handle 'gnus-details))
+ pressed-details)
+ (setq details (if details (concat "\n" details) ""))
+ (setq pressed-details (if mh-mime-security-button-pressed details ""))
+ (setq face (mh-mime-security-button-face info))
+ (unless (bolp) (insert "\n"))
+ (setq begin (point))
+ (gnus-eval-format
+ mh-mime-security-button-line-format
+ mh-mime-security-button-line-format-alist
+ `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
mh-button-pressed ,mh-mime-security-button-pressed
mh-callback mh-mime-security-press-button
mh-line-format ,mh-mime-security-button-line-format
mh-data ,handle))
- (setq end (point))
- (widget-convert-button 'link begin end
- :mime-handle handle
- :action 'mh-widget-press-button
- :button-keymap mh-mime-security-button-map
- :button-face face
- :help-echo "Mouse-2 click or press RET (in show
buffer) to see security details.")
- (dolist (ov (mh-funcall-if-exists overlays-in begin end))
- (mh-funcall-if-exists overlay-put ov 'evaporate t))
- (when (equal info "Failed")
- (let* ((type (if (equal (car handle) "multipart/signed")
- "verification" "decryption"))
- (warning (if (equal type "decryption")
- "(passphrase may be incorrect)" "")))
- (message "%s %s failed %s" crypto-type type warning)))))
+ (setq end (point))
+ (widget-convert-button 'link begin end
+ :mime-handle handle
+ :action 'mh-widget-press-button
+ :button-keymap mh-mime-security-button-map
+ :button-face face
+ :help-echo "Mouse-2 click or press RET (in show
buffer) to see security details.")
+ (dolist (ov (mh-funcall-if-exists overlays-in begin end))
+ (mh-funcall-if-exists overlay-put ov 'evaporate t))
+ (when (equal info "Failed")
+ (let* ((type (if (equal (car handle) "multipart/signed")
+ "verification" "decryption"))
+ (warning (if (equal type "decryption")
+ "(passphrase may be incorrect)" "")))
+ (message "%s %s failed %s" crypto-type type warning))))))
(defun mh-mime-security-button-face (info)
"Return the button face to use for encrypted/signed mail based on INFO."
@@ -995,7 +1000,7 @@ If CRITERION is a function or a symbol which has a
function binding
then that function must return non-nil at the button we stop."
(unless (or (and (symbolp criterion) (fboundp criterion))
(functionp criterion))
- (setq criterion (lambda (x) t)))
+ (setq criterion (lambda (_) t)))
;; Move to the next button in the buffer satisfying criterion
(goto-char (or (save-excursion
(beginning-of-line)
@@ -1015,7 +1020,7 @@ then that function must return non-nil at the button we
stop."
(not (if backward-flag (bobp) (eobp))))
(forward-line (if backward-flag -1 1)))
;; Stop at next MIME button if any exists.
- (block loop
+ (cl-block loop
(while (/= (progn
(unless (= (forward-line
(if backward-flag -1 1))
@@ -1028,11 +1033,11 @@ then that function must return non-nil at the button we
stop."
point-before-current-button)
(when (and (get-text-property (point) 'mh-data)
(funcall criterion (point)))
- (return-from loop (point))))
+ (cl-return-from loop (point))))
nil)))
(point))))
-(defun mh-widget-press-button (widget el)
+(defun mh-widget-press-button (widget _el)
"Callback for widget, WIDGET.
Parameter EL is unused."
(goto-char (widget-get widget :from))
@@ -1596,7 +1601,7 @@ the possible security methods (see
`mh-mml-method-default')."
nil t nil 'mh-mml-cryptographic-method-history def))
mh-mml-method-default))
-(defun mh-secure-message (method mode &optional identity)
+(defun mh-secure-message (method mode &optional _identity)
"Add tag to encrypt or sign message.
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
@@ -1697,19 +1702,19 @@ buffer, while END defaults to the end of the buffer."
(unless begin (setq begin (point-min)))
(unless end (setq end (point-max)))
(save-excursion
- (block search-for-mh-directive
+ (cl-block search-for-mh-directive
(goto-char begin)
(while (re-search-forward "^#" end t)
(let ((s (buffer-substring-no-properties
(point) (mh-line-end-position))))
(cond ((equal s ""))
((string-match "^forw[ \t\n]+" s)
- (return-from search-for-mh-directive t))
+ (cl-return-from search-for-mh-directive t))
(t (let ((first-token (car (split-string s "[ \t;@]"))))
(when (and first-token
(string-match mh-media-type-regexp
first-token))
- (return-from search-for-mh-directive t)))))))
+ (cl-return-from search-for-mh-directive t)))))))
nil)))
(defun mh-minibuffer-read-type (filename &optional default)
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index ca74b2e..596f009 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -44,7 +44,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(require 'gnus-util)
(require 'imenu)
@@ -227,17 +226,17 @@ folder containing the index search results."
mh-search-regexp-builder)
(current-window-configuration)
nil)))
- (block mh-search
+ (cl-block mh-search
;; Redoing a sequence search?
(when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
(not mh-flists-called-flag))
(let ((mh-flists-called-flag t))
(apply #'mh-index-sequenced-messages mh-index-previous-search))
- (return-from mh-search))
+ (cl-return-from mh-search))
;; We have fancy query parsing.
(when (symbolp search-regexp)
(mh-search-folder folder window-config)
- (return-from mh-search))
+ (cl-return-from mh-search))
;; Begin search proper.
(mh-checksum-choose)
(let ((result-count 0)
@@ -264,21 +263,22 @@ folder containing the index search results."
;; Parse searcher output.
(message "Processing %s output... " mh-searcher)
(goto-char (point-min))
- (loop for next-result = (funcall mh-search-next-result-function)
- while next-result
- do (unless (eq next-result 'error)
- (unless (gethash (car next-result) folder-results-map)
- (setf (gethash (car next-result) folder-results-map)
- (make-hash-table :test #'equal)))
- (setf (gethash (cadr next-result)
- (gethash (car next-result)
folder-results-map))
- t)))
+ (cl-loop for next-result = (funcall mh-search-next-result-function)
+ while next-result
+ do (unless (eq next-result 'error)
+ (unless (gethash (car next-result) folder-results-map)
+ (setf (gethash (car next-result) folder-results-map)
+ (make-hash-table :test #'equal)))
+ (setf (gethash (cadr next-result)
+ (gethash (car next-result)
folder-results-map))
+ t)))
;; Copy the search results over.
(maphash #'(lambda (folder msgs)
(let ((cur (car (mh-translate-range folder "cur")))
- (msgs (sort (loop for msg being the hash-keys of
msgs
- collect msg)
+ (msgs (sort (cl-loop
+ for msg being the hash-keys of msgs
+ collect msg)
#'<)))
(mh-exec-cmd "refile" msgs "-src" folder
"-link" index-folder)
@@ -287,10 +287,10 @@ folder containing the index search results."
(mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
"-sequence"
"cur" (format "%s" cur)))
- (loop for msg in msgs
- do (incf result-count)
- (setf (gethash result-count origin-map)
- (cons folder msg)))))
+ (cl-loop for msg in msgs
+ do (cl-incf result-count)
+ (setf (gethash result-count origin-map)
+ (cons folder msg)))))
folder-results-map)
;; Vist the results folder.
@@ -315,14 +315,14 @@ folder containing the index search results."
(message "%s found %s matches in %s folders"
(upcase-initials (symbol-name mh-searcher))
- (loop for msg-hash being the hash-values of mh-index-data
- sum (hash-table-count msg-hash))
- (loop for msg-hash being the hash-values of mh-index-data
- count (> (hash-table-count msg-hash) 0)))))))
+ (cl-loop for msg-hash being the hash-values of mh-index-data
+ sum (hash-table-count msg-hash))
+ (cl-loop for msg-hash being the hash-values of mh-index-data
+ count (> (hash-table-count msg-hash) 0)))))))
;; Shush compiler.
(mh-do-in-xemacs
- (defvar pick-folder))
+ (defvar pick-folder)) ;FIXME: Why?
(defun mh-search-folder (folder window-config)
"Search FOLDER for messages matching a pattern.
@@ -331,6 +331,7 @@ In a program, argument WINDOW-CONFIG is the current window
configuration and is used when the search folder is dismissed."
(interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil
t)
(current-window-configuration)))
+ ;; FIXME: `pick-folder' is unused!
(let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
(switch-to-buffer-other-window "search-pattern")
(if (or (zerop (buffer-size))
@@ -401,10 +402,8 @@ or nothing to search all folders."
mh-ticked-messages-folders)))
(mh-index-sequenced-messages folders mh-tick-seq))
-;; Shush compiler.
-(mh-do-in-xemacs
- (defvar mh-mairix-folder)
- (defvar mh-flists-search-folders))
+(defvar mh-mairix-folder)
+(defvar mh-flists-search-folders)
;;;###mh-autoload
(defun mh-index-sequenced-messages (folders sequence)
@@ -471,9 +470,9 @@ recursively. All arguments are IGNORED."
(mh-quote-for-shell mh-inbox))
((eq mh-flists-search-folders nil) "")
((listp mh-flists-search-folders)
- (loop for folder in mh-flists-search-folders
- concat
- (concat " " (mh-quote-for-shell folder)))))
+ (cl-loop for folder in mh-flists-search-folders
+ concat
+ (concat " " (mh-quote-for-shell folder)))))
(if mh-recursive-folders-flag " -recurse" "")
" -sequence " seq " -noshowzero -fast` ; do\n"
(expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
@@ -536,8 +535,9 @@ group of results."
(when (or (not (get-buffer folder))
(y-or-n-p (format "Reuse buffer displaying %s? " folder)))
(mh-visit-folder
- folder (loop for x being the hash-keys of (gethash folder mh-index-data)
- when (mh-msg-exists-p x folder) collect x)))))
+ folder (cl-loop
+ for x being the hash-keys of (gethash folder mh-index-data)
+ when (mh-msg-exists-p x folder) collect x)))))
@@ -716,7 +716,7 @@ parsed."
((equal token "or") (push 'or op-stack))
((equal token "and") (push 'and op-stack))
((equal token ")")
- (multiple-value-setq (op-stack operand-stack)
+ (cl-multiple-value-setq (op-stack operand-stack)
(cl-values-list (mh-index-evaluate op-stack operand-stack)))
(when (eq (car op-stack) 'not)
(setq op-stack (cdr op-stack))
@@ -762,12 +762,12 @@ parsed."
(defun mh-index-evaluate (op-stack operand-stack)
"Read expression till starting paren based on OP-STACK and OPERAND-STACK."
- (block mh-index-evaluate
+ (cl-block mh-index-evaluate
(let (op oper1)
(while op-stack
(setq op (pop op-stack))
(cond ((eq op 'paren)
- (return-from mh-index-evaluate (list op-stack operand-stack)))
+ (cl-return-from mh-index-evaluate (list op-stack
operand-stack)))
((eq op 'not)
(push `(not ,(pop operand-stack)) operand-stack))
((or (eq op 'and) (eq op 'or))
@@ -806,7 +806,7 @@ The side-effects of this function are that the variables
searcher in `mh-search-choices' present on the system. If
optional argument SEARCHER is present, use it instead of
`mh-search-program'."
- (block nil
+ (cl-block nil
(let ((program-alist (cond (searcher
(list (assoc searcher mh-search-choices)))
(mh-search-program
@@ -821,7 +821,7 @@ optional argument SEARCHER is present, use it instead of
(setq mh-search-function (nth 2 current))
(setq mh-search-next-result-function (nth 3 current))
(setq mh-search-regexp-builder (nth 4 current))
- (return mh-searcher))))
+ (cl-return mh-searcher))))
nil)))
;;; Swish++
@@ -974,31 +974,31 @@ is used to search."
(defun mh-swish-next-result ()
"Get the next result from swish output."
(prog1
- (block nil
+ (cl-block nil
(when (or (eobp) (equal (char-after (point)) ?.))
- (return nil))
+ (cl-return nil))
(when (equal (char-after (point)) ?#)
- (return 'error))
+ (cl-return 'error))
(let* ((start (search-forward " " (mh-line-end-position) t))
(end (search-forward " " (mh-line-end-position) t)))
(unless (and start end)
- (return 'error))
+ (cl-return 'error))
(setq end (1- end))
(unless (file-exists-p (buffer-substring-no-properties start end))
- (return 'error))
+ (cl-return 'error))
(unless (search-backward "/" start t)
- (return 'error))
+ (cl-return 'error))
(list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
(unless (string-match mh-swish-folder s)
- (return 'error))
+ (cl-return 'error))
(if (and (string-match mh-user-path s)
(< (match-end 0) (1- (length s))))
(format "+%s"
(substring s (match-end 0) (1- (length s))))
- (return 'error)))
+ (cl-return 'error)))
(let* ((s (buffer-substring-no-properties (1+ (point)) end))
(n (ignore-errors (string-to-number s))))
- (if n n (return 'error)))
+ (or n (cl-return 'error)))
nil)))
(forward-line)))
@@ -1051,26 +1051,26 @@ SEARCH-REGEXP-LIST is used to search."
(defun mh-mairix-next-result ()
"Return next result from mairix output."
(prog1
- (block nil
+ (cl-block nil
(when (or (eobp) (and (bolp) (eolp)))
- (return nil))
+ (cl-return nil))
(unless (eq (char-after) ?/)
- (return 'error))
+ (cl-return 'error))
(let ((start (point))
end msg-start)
(setq end (mh-line-end-position))
(unless (search-forward mh-mairix-folder end t)
- (return 'error))
+ (cl-return 'error))
(goto-char (match-beginning 0))
(unless (equal (point) start)
- (return 'error))
+ (cl-return 'error))
(goto-char end)
(unless (search-backward "/" start t)
- (return 'error))
+ (cl-return 'error))
(setq msg-start (1+ (point)))
(goto-char start)
(unless (search-forward mh-user-path end t)
- (return 'error))
+ (cl-return 'error))
(list (format "+%s" (buffer-substring-no-properties
(point) (1- msg-start)))
(string-to-number
@@ -1119,8 +1119,8 @@ REGEXP-LIST is an alist of fields and values."
(cond ((atom expr) `(or (and ,expr)))
((eq (car expr) 'or)
(cons 'or
- (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr))
- append (cdr e))))
+ (cl-loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr
expr))
+ append (cdr e))))
((eq (car expr) 'and)
(let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr)))
result next-factor)
@@ -1196,22 +1196,22 @@ is used to search."
(defun mh-namazu-next-result ()
"Get the next result from namazu output."
(prog1
- (block nil
- (when (eobp) (return nil))
+ (cl-block nil
+ (when (eobp) (cl-return nil))
(let ((file-name (buffer-substring-no-properties
(point) (mh-line-end-position))))
(unless (equal (string-match mh-namazu-folder file-name) 0)
- (return 'error))
+ (cl-return 'error))
(unless (file-exists-p file-name)
- (return 'error))
+ (cl-return 'error))
(string-match mh-user-path file-name)
(let* ((folder/msg (substring file-name (match-end 0)))
(mark (mh-search-from-end ?/ folder/msg)))
- (unless mark (return 'error))
+ (unless mark (cl-return 'error))
(list (format "+%s" (substring folder/msg 0 mark))
(let ((n (ignore-errors (string-to-number
(substring folder/msg (1+ mark))))))
- (if n n (return 'error)))
+ (or n (cl-return 'error)))
nil))))
(forward-line)))
@@ -1235,25 +1235,25 @@ is used to search."
(erase-buffer)
(let ((folders
(mh-folder-list (substring folder-path (length mh-user-path)))))
- (loop for folder in folders do
- (setq folder (concat "+" folder))
- (insert folder "\n")
- (apply #'call-process (expand-file-name "pick" mh-progs)
- nil '(t nil) nil folder "-list" search-regexp)))
+ (cl-loop for folder in folders do
+ (setq folder (concat "+" folder))
+ (insert folder "\n")
+ (apply #'call-process (expand-file-name "pick" mh-progs)
+ nil '(t nil) nil folder "-list" search-regexp)))
(goto-char (point-min)))
(defun mh-pick-next-result ()
"Return the next pick search result."
(prog1
- (block nil
- (when (eobp) (return nil))
+ (cl-block nil
+ (when (eobp) (cl-return nil))
(when (search-forward-regexp "^\\+" (mh-line-end-position) t)
(setq mh-index-pick-folder
(buffer-substring-no-properties (mh-line-beginning-position)
(mh-line-end-position)))
- (return 'error))
+ (cl-return 'error))
(unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position)
t)
- (return 'error))
+ (cl-return 'error))
(list mh-index-pick-folder
(string-to-number
(buffer-substring-no-properties (mh-line-beginning-position)
@@ -1331,29 +1331,29 @@ Parse it and return the message folder, message index
and the
match. If no other matches left then return nil. If the current
record is invalid return 'error."
(prog1
- (block nil
+ (cl-block nil
(when (eobp)
- (return nil))
+ (cl-return nil))
(let ((eol-pos (mh-line-end-position))
(bol-pos (mh-line-beginning-position))
folder-start msg-end)
(goto-char bol-pos)
(unless (search-forward mh-user-path eol-pos t)
- (return 'error))
+ (cl-return 'error))
(setq folder-start (point))
(unless (search-forward ":" eol-pos t)
- (return 'error))
+ (cl-return 'error))
(let ((match (buffer-substring-no-properties (point) eol-pos)))
(forward-char -1)
(setq msg-end (point))
(unless (search-backward "/" folder-start t)
- (return 'error))
+ (cl-return 'error))
(list (format "+%s" (buffer-substring-no-properties
folder-start (point)))
(let ((n (ignore-errors (string-to-number
(buffer-substring-no-properties
(1+ (point)) msg-end)))))
- (if n n (return 'error)))
+ (or n (cl-return 'error)))
match))))
(forward-line)))
@@ -1369,13 +1369,14 @@ being the list of messages originally from that folder."
(save-excursion
(goto-char (point-min))
(let ((result-table (make-hash-table :test #'equal)))
- (loop for msg being the hash-keys of mh-index-msg-checksum-map
- do (push msg (gethash (car (gethash
- (gethash msg mh-index-msg-checksum-map)
- mh-index-checksum-origin-map))
- result-table)))
- (loop for x being the hash-keys of result-table
- collect (cons x (nreverse (gethash x result-table)))))))
+ (cl-loop for msg being the hash-keys of mh-index-msg-checksum-map
+ do (push msg (gethash (car (gethash
+ (gethash msg
+ mh-index-msg-checksum-map)
+ mh-index-checksum-origin-map))
+ result-table)))
+ (cl-loop for x being the hash-keys of result-table
+ collect (cons x (nreverse (gethash x result-table)))))))
;;;###mh-autoload
(defun mh-index-insert-folder-headers ()
@@ -1443,9 +1444,7 @@ being the list of messages originally from that folder."
"Non-nil means that this folder was generated by searching."
mh-index-data)
-;; Shush compiler
-(mh-do-in-xemacs
- (defvar mh-speed-flists-inhibit-flag))
+(defvar mh-speed-flists-inhibit-flag)
;;;###mh-autoload
(defun mh-index-execute-commands ()
@@ -1478,23 +1477,24 @@ buffer."
(setq mh-refile-list
(mapcar (lambda (x)
(cons (car x)
- (loop for y in (cdr x)
- unless (memq y msgs) collect y)))
+ (cl-loop for y in (cdr x)
+ unless (memq y msgs)
+ collect y)))
old-refile-list)
mh-delete-list
- (loop for x in old-delete-list
- unless (memq x msgs) collect x)
+ (cl-loop for x in old-delete-list
+ unless (memq x msgs) collect x)
mh-blacklist
- (loop for x in old-blacklist
- unless (memq x msgs) collect x)
+ (cl-loop for x in old-blacklist
+ unless (memq x msgs) collect x)
mh-whitelist
- (loop for x in old-whitelist
- unless (memq x msgs) collect x))
+ (cl-loop for x in old-whitelist
+ unless (memq x msgs) collect x))
(mh-set-folder-modified-p (mh-outstanding-commands-p))
(when (mh-outstanding-commands-p)
(mh-notate-deleted-and-refiled)))))))
- (mh-index-matching-source-msgs (append (loop for x in mh-refile-list
- append (cdr x))
+ (mh-index-matching-source-msgs (append (cl-loop for x in mh-refile-list
+ append (cdr x))
mh-delete-list
mh-blacklist
mh-whitelist)
@@ -1565,12 +1565,12 @@ If the folder returned doesn't exist then it is
created."
(unless (mh-folder-name-p name)
(error "The argument should be a valid MH folder name"))
(let ((chosen-name
- (loop for i from 1
- for candidate = (if (equal i 1) name (format "%s-%s" name i))
- when (or (not (mh-folder-exists-p candidate))
- (equal (mh-index-folder-search-regexp candidate)
- search-regexp))
- return candidate)))
+ (cl-loop for i from 1
+ for candidate = (if (equal i 1) name (format "%s-%s" name i))
+ when (or (not (mh-folder-exists-p candidate))
+ (equal (mh-index-folder-search-regexp candidate)
+ search-regexp))
+ return candidate)))
;; Do pending refiles/deletes...
(when (get-buffer chosen-name)
(mh-process-or-undo-commands chosen-name))
@@ -1603,37 +1603,37 @@ garbled."
"Mirror sequences present in source folders in index folder."
(let ((seq-hash (make-hash-table :test #'equal))
(seq-list ()))
- (loop for folder being the hash-keys of mh-index-data
- do (setf (gethash folder seq-hash)
- (mh-create-sequence-map
- (mh-read-folder-sequences folder nil))))
+ (cl-loop for folder being the hash-keys of mh-index-data
+ do (setf (gethash folder seq-hash)
+ (mh-create-sequence-map
+ (mh-read-folder-sequences folder nil))))
(dolist (msg (mh-translate-range mh-current-folder "all"))
(let* ((checksum (gethash msg mh-index-msg-checksum-map))
(pair (gethash checksum mh-index-checksum-origin-map))
(ofolder (car pair))
(omsg (cdr pair)))
- (loop for seq in (ignore-errors
- (gethash omsg (gethash ofolder seq-hash)))
- do (if (assoc seq seq-list)
- (push msg (cdr (assoc seq seq-list)))
- (push (list seq msg) seq-list)))))
- (loop for seq in seq-list
- do (apply #'mh-exec-cmd "mark" mh-current-folder
- "-sequence" (symbol-name (car seq)) "-add"
- (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
+ (cl-loop for seq in (ignore-errors
+ (gethash omsg (gethash ofolder seq-hash)))
+ do (if (assoc seq seq-list)
+ (push msg (cdr (assoc seq seq-list)))
+ (push (list seq msg) seq-list)))))
+ (cl-loop for seq in seq-list
+ do (apply #'mh-exec-cmd "mark" mh-current-folder
+ "-sequence" (symbol-name (car seq)) "-add"
+ (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
;;;###mh-autoload
(defun mh-create-sequence-map (seq-list)
"Return a map from msg number to list of sequences in which it is present.
SEQ-LIST is an assoc list whose keys are sequence names and whose
cdr is the list of messages in that sequence."
- (loop with map = (make-hash-table)
- for seq in seq-list
- when (and (not (memq (car seq) (mh-unpropagated-sequences)))
- (mh-valid-seq-p (car seq)))
- do (loop for msg in (cdr seq)
- do (push (car seq) (gethash msg map)))
- finally return map))
+ (cl-loop with map = (make-hash-table)
+ for seq in seq-list
+ when (and (not (memq (car seq) (mh-unpropagated-sequences)))
+ (mh-valid-seq-p (car seq)))
+ do (cl-loop for msg in (cdr seq)
+ do (push (car seq) (gethash msg map)))
+ finally return map))
;;;###mh-autoload
(defun mh-index-add-to-sequence (seq msgs)
@@ -1741,7 +1741,7 @@ folder, is removed from `mh-index-data'."
(print-level nil))
(with-temp-file outfile
(mh-index-write-hashtable
- data (lambda (x) (loop for y being the hash-keys of x collect y)))
+ data (lambda (x) (cl-loop for y being the hash-keys of x collect y)))
(mh-index-write-hashtable msg-checksum-map #'identity)
(mh-index-write-hashtable checksum-origin-map #'identity)
(pp previous-search (current-buffer)) (insert "\n")
@@ -1751,8 +1751,8 @@ folder, is removed from `mh-index-data'."
"Write TABLE to `current-buffer'.
PROC is used to serialize the values corresponding to the hash
table keys."
- (pp (loop for x being the hash-keys of table
- collect (cons x (funcall proc (gethash x table))))
+ (pp (cl-loop for x being the hash-keys of table
+ collect (cons x (funcall proc (gethash x table))))
(current-buffer))
(insert "\n"))
@@ -1769,9 +1769,9 @@ table keys."
(goto-char (point-min))
(setq t1 (mh-index-read-hashtable
(lambda (data)
- (loop with table = (make-hash-table :test #'equal)
- for x in data do (setf (gethash x table) t)
- finally return table)))
+ (cl-loop with table = (make-hash-table :test #'equal)
+ for x in data do (setf (gethash x table) t)
+ finally return table)))
t2 (mh-index-read-hashtable #'identity)
t3 (mh-index-read-hashtable #'identity)
t4 (read (current-buffer))
@@ -1785,10 +1785,10 @@ table keys."
(defun mh-index-read-hashtable (proc)
"From BUFFER read a hash table serialized as a list.
PROC is used to convert the value to actual data."
- (loop with table = (make-hash-table :test #'equal)
- for pair in (read (current-buffer))
- do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
- finally return table))
+ (cl-loop with table = (make-hash-table :test #'equal)
+ for pair in (read (current-buffer))
+ do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
+ finally return table))
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 9989dc9..818a6ce 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -31,7 +31,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(require 'mh-scan)
(require 'font-lock)
@@ -183,9 +182,9 @@ MESSAGE appears."
(interactive "P")
(if (not message)
(setq message (mh-get-msg-num t)))
- (let* ((dest-folder (loop for seq in mh-refile-list
- when (member message (cdr seq)) return (car seq)
- finally return nil))
+ (let* ((dest-folder (cl-loop for seq in mh-refile-list
+ when (member message (cdr seq)) return (car seq)
+ finally return nil))
(deleted-flag (unless dest-folder (member message mh-delete-list))))
(message "Message %d%s is in sequences: %s"
message
@@ -721,9 +720,9 @@ completion is over."
((eq flag t)
(all-completions last-word candidates predicate))
((eq flag 'lambda)
- (loop for x in candidates
- when (equal x last-word) return t
- finally return nil)))))
+ (cl-loop for x in candidates
+ when (equal x last-word) return t
+ finally return nil)))))
(defun mh-seq-names (seq-list)
"Return an alist containing the names of the SEQ-LIST."
@@ -742,8 +741,8 @@ completion is over."
(call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
"-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
(goto-char (point-min))
- (multiple-value-bind (folder unseen total)
- (values-list
+ (cl-multiple-value-bind (folder unseen total)
+ (cl-values-list
(mh-parse-flist-output-line
(buffer-substring (point) (mh-line-end-position))))
(list total unseen folder))))
@@ -934,8 +933,8 @@ notated."
(dolist (msg (mh-seq-msgs seq))
(push (car seq) (gethash msg msg-hash))))
(mh-iterate-on-range msg range
- (loop for seq in (gethash msg msg-hash)
- do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
+ (cl-loop for seq in (gethash msg msg-hash)
+ do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
(defun mh-add-sequence-notation (msg internal-seq-flag)
"Add sequence notation to the MSG on the current line.
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index 4f70681..1761139 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -900,7 +900,7 @@ See also `mh-folder-mode'.
;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
;; style?
(mh-flet
- ((gnus-article-add-button (&rest args) nil))
+ ((gnus-article-add-button (&rest _args) nil))
(let* ((modified (buffer-modified-p))
(gnus-article-buffer (buffer-name))
(gnus-cite-face-list `(,@(cdr gnus-cite-face-list)
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index fc661c8..c615ba6 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -31,7 +31,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(require 'gnus-util)
(require 'speedbar)
@@ -184,7 +183,7 @@ The optional arguments from speedbar are IGNORED."
;;; Support Routines
;;;###mh-autoload
-(defun mh-folder-speedbar-buttons (buffer)
+(defun mh-folder-speedbar-buttons (_buffer)
"Interface function to create MH-E speedbar buffer.
BUFFER is the MH-E buffer for which the speedbar buffer is to be
created."
@@ -438,7 +437,7 @@ flists is run only for that one folder."
;; Copied from mh-make-folder-list-filter...
;; XXX Refactor to use mh-make-folder-list-filer?
-(defun mh-speed-parse-flists-output (process output)
+(defun mh-speed-parse-flists-output (_process output)
"Parse the incremental results from flists.
PROCESS is the flists process and OUTPUT is the results that must
be handled next."
@@ -451,7 +450,7 @@ be handled next."
mh-speed-partial-line
(substring output position line-end))
mh-speed-partial-line "")
- (multiple-value-setq (folder unseen total)
+ (cl-multiple-value-setq (folder unseen total)
(cl-values-list
(mh-parse-flist-output-line line mh-speed-current-folder)))
(when (and folder unseen total
@@ -555,12 +554,12 @@ The function invalidates the latest ancestor that is
present."
(last-slash (mh-search-from-end ?/ folder))
(ancestor folder)
(ancestor-pos nil))
- (block while-loop
+ (cl-block while-loop
(while last-slash
(setq ancestor (substring ancestor 0 last-slash))
(setq ancestor-pos (gethash ancestor mh-speed-folder-map))
(when ancestor-pos
- (return-from while-loop))
+ (cl-return-from while-loop))
(setq last-slash (mh-search-from-end ?/ ancestor))))
(unless ancestor-pos (setq ancestor nil))
(goto-char (or ancestor-pos (gethash nil mh-speed-folder-map)))
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index 0fc560b..0f6f9f8 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -76,14 +76,14 @@
(require 'mh-e)
(require 'mh-scan)
-(mh-defstruct (mh-thread-message (:conc-name mh-message-)
+(cl-defstruct (mh-thread-message (:conc-name mh-message-)
(:constructor mh-thread-make-message))
(id nil)
(references ())
(subject "")
(subject-re-p nil))
-(mh-defstruct (mh-thread-container (:conc-name mh-container-)
+(cl-defstruct (mh-thread-container (:conc-name mh-container-)
(:constructor mh-thread-make-container))
message parent children
(real-child-p t))
@@ -258,7 +258,7 @@ sibling."
(beginning-of-line)
(forward-char address-start-offset)
(while (char-equal (char-after) ? )
- (incf level)
+ (cl-incf level)
(forward-char))
level)))
@@ -292,7 +292,7 @@ at the end."
(setq begin (point))
(setq spaces (format (format "%%%ss" (1+ level)) ""))
(forward-line)
- (block nil
+ (cl-block nil
(while (not (eobp))
(forward-char address-start-offset)
(unless (equal (string-match spaces (buffer-substring-no-properties
@@ -300,7 +300,7 @@ at the end."
0)
(beginning-of-line)
(backward-char)
- (return))
+ (cl-return))
(forward-line)))
(list begin (point)))))
@@ -388,8 +388,8 @@ the id-table is updated."
(parent-container (mh-container-parent child-container)))
(when parent-container
(setf (mh-container-children parent-container)
- (loop for elem in (mh-container-children parent-container)
- unless (eq child-container elem) collect elem))
+ (cl-loop for elem in (mh-container-children parent-container)
+ unless (eq child-container elem) collect elem))
(setf (mh-container-parent child-container) nil))))
(defsubst mh-thread-add-link (parent child &optional at-end-p)
@@ -442,9 +442,9 @@ added to the end of the children list of PARENT."
"Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
In the limit, the function returns t if ANCESTOR and SUCCESSOR
are the same containers."
- (block nil
+ (cl-block nil
(while successor
- (when (eq ancestor successor) (return t))
+ (when (eq ancestor successor) (cl-return t))
(setq successor (mh-container-parent successor)))
nil))
@@ -525,12 +525,12 @@ children."
(cond ((and (mh-container-message container)
(mh-message-id (mh-container-message container)))
(mh-message-subject (mh-container-message container)))
- (t (block nil
+ (t (cl-block nil
(dolist (kid (mh-container-children container))
(when (and (mh-container-message kid)
(mh-message-id (mh-container-message kid)))
(let ((kid-message (mh-container-message kid)))
- (return (mh-message-subject kid-message)))))
+ (cl-return (mh-message-subject kid-message)))))
(error "This can't happen")))))
(defsubst mh-thread-update-id-index-maps (id index)
@@ -595,9 +595,9 @@ Only information about messages in MSG-LIST are added to
the tree."
(goto-char (point-min))
(let ((roots ())
(case-fold-search t))
- (block nil
+ (cl-block nil
(while (not (eobp))
- (block process-message
+ (cl-block process-message
(let* ((index-line
(prog1 (buffer-substring (point) (mh-line-end-position))
(forward-line)))
@@ -616,26 +616,26 @@ Only information about messages in MSG-LIST are added to
the tree."
(forward-line)))
(subject-re-p nil))
(unless (gethash index mh-thread-scan-line-map)
- (return-from process-message))
- (unless (integerp index) (return)) ;Error message here
- (multiple-value-setq (subject subject-re-p)
- (values-list (mh-thread-prune-subject subject)))
+ (cl-return-from process-message))
+ (unless (integerp index) (cl-return)) ;Error message here
+ (cl-multiple-value-setq (subject subject-re-p)
+ (cl-values-list (mh-thread-prune-subject subject)))
(setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
- (setq refs (loop for x in (append (split-string refs)
in-reply-to)
- when (string-match mh-message-id-regexp x)
- collect x))
+ (setq refs
+ (cl-loop for x in (append (split-string refs) in-reply-to)
+ when (string-match mh-message-id-regexp x)
+ collect x))
(setq id (mh-thread-canonicalize-id id))
(mh-thread-update-id-index-maps id index)
(setq refs (mapcar #'mh-thread-canonicalize-id refs))
(mh-thread-get-message id subject-re-p subject refs)
- (do ((ancestors refs (cdr ancestors)))
+ (cl-do ((ancestors refs (cdr ancestors)))
((null (cdr ancestors))
(when (car ancestors)
(mh-thread-remove-parent-link id)
(mh-thread-add-link (car ancestors) id)))
(mh-thread-add-link (car ancestors) (cadr ancestors)))))))
- (maphash #'(lambda (k v)
- (declare (ignore k))
+ (maphash #'(lambda (_k v)
(when (null (mh-container-parent v))
(push v roots)))
mh-thread-id-table)
@@ -720,8 +720,7 @@ For now it will take the last string inside angles."
mh-thread-history)
(mh-thread-remove-parent-link node)))))
(let ((results ()))
- (maphash #'(lambda (k v)
- (declare (ignore k))
+ (maphash #'(lambda (_k v)
(when (and (null (mh-container-parent v))
(gethash (mh-message-id (mh-container-message v))
mh-thread-id-index-map))
@@ -751,17 +750,18 @@ For now it will take the last string inside angles."
(mh-thread-last-ancestor nil))
(if (null mh-index-data)
(mh-thread-generate-scan-lines thread-tree -2)
- (loop for x in (mh-index-group-by-folder)
- do (let* ((old-map mh-thread-scan-line-map)
- (mh-thread-scan-line-map (make-hash-table)))
- (setq mh-thread-last-ancestor nil)
- (loop for msg in (cdr x)
- do (let ((v (gethash msg old-map)))
- (when v
- (setf (gethash msg mh-thread-scan-line-map) v))))
- (when (> (hash-table-count mh-thread-scan-line-map) 0)
- (insert (if (bobp) "" "\n") (car x) "\n")
- (mh-thread-generate-scan-lines thread-tree -2))))
+ (cl-loop for x in (mh-index-group-by-folder)
+ do (let* ((old-map mh-thread-scan-line-map)
+ (mh-thread-scan-line-map (make-hash-table)))
+ (setq mh-thread-last-ancestor nil)
+ (cl-loop for msg in (cdr x)
+ do (let ((v (gethash msg old-map)))
+ (when v
+ (setf (gethash msg mh-thread-scan-line-map)
+ v))))
+ (when (> (hash-table-count mh-thread-scan-line-map) 0)
+ (insert (if (bobp) "" "\n") (car x) "\n")
+ (mh-thread-generate-scan-lines thread-tree -2))))
(mh-index-create-imenu-index))))
(defun mh-thread-generate-scan-lines (tree level)
@@ -826,8 +826,8 @@ MSG is the message being notated with NOTATION at OFFSET."
(let* ((msg (or msg (mh-get-msg-num nil)))
(cur-scan-line (and mh-thread-scan-line-map
(gethash msg mh-thread-scan-line-map)))
- (old-scan-lines (loop for map in mh-thread-scan-line-map-stack
- collect (and map (gethash msg map)))))
+ (old-scan-lines (cl-loop for map in mh-thread-scan-line-map-stack
+ collect (and map (gethash msg map)))))
(when cur-scan-line
(setf (aref (car cur-scan-line) offset) notation))
(dolist (line old-scan-lines)
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 41610b2..de7a519 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -36,7 +36,7 @@
;;; Tool Bar Commands
-(defun mh-tool-bar-search (&optional arg)
+(defun mh-tool-bar-search (&optional _arg)
"Interactively call `mh-tool-bar-search-function'.
Optional argument ARG is not used."
(interactive "P")
@@ -131,11 +131,12 @@ where,
active. If it isn't present then the button is always active."
;; The following variable names have been carefully chosen to make code
;; generation easier. Modifying the names should be done carefully.
- (let (folder-buttons folder-docs folder-button-setter sequence-button-setter
- show-buttons show-button-setter show-seq-button-setter
- letter-buttons letter-docs letter-button-setter
- folder-defaults letter-defaults
- folder-vectors show-vectors letter-vectors)
+ (mh-dlet* (folder-buttons
+ folder-docs folder-button-setter sequence-button-setter
+ show-buttons show-button-setter show-seq-button-setter
+ letter-buttons letter-docs letter-button-setter
+ folder-defaults letter-defaults
+ folder-vectors show-vectors letter-vectors)
(dolist (x defaults)
(cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
((eq (car x) :letter) (setq letter-defaults (cdr x)))))
@@ -161,14 +162,14 @@ where,
(append `(,(if (memq 'folder modes) :folder :sequence) ,name)
functions))
(setq show-sym
- (if (string-match "^mh-\\(.*\\)$" name-str)
+ (if (string-match "\\`mh-\\(.*\\)\\'" name-str)
(intern (concat "mh-show-" (match-string 1 name-str)))
name))
(setq functions
(append `(,(if (memq 'folder modes) :show :show-seq)
,(if (fboundp show-sym) show-sym name))
functions)))
- (do ((functions functions (cddr functions)))
+ (cl-do ((functions functions (cddr functions)))
((null functions))
(let* ((type (car functions))
(function (cadr functions))
@@ -209,15 +210,15 @@ where,
(dolist (x letter-defaults)
(unless (memq x letter-buttons)
(error "Letter defaults contains unknown button %s" x)))
- `(eval-when (compile load eval)
+ `(eval-and-compile
;; GNU Emacs tool bar specific code
(mh-do-in-gnu-emacs
(defun mh-buffer-exists-p (mode)
"Test whether a buffer with major mode MODE is present."
- (loop for buf in (buffer-list)
- when (with-current-buffer buf
- (eq major-mode mode))
- return t))
+ (cl-loop for buf in (buffer-list)
+ when (with-current-buffer buf
+ (eq major-mode mode))
+ return t))
;; Tool bar initialization functions
(defun mh-tool-bar-folder-buttons-init ()
(when (mh-buffer-exists-p 'mh-folder-mode)
@@ -257,18 +258,18 @@ where,
(defun mh-tool-bar-update (mode default-map sequence-map)
"Update `tool-bar-map' in all buffers of MODE.
Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
- (loop for buf in (buffer-list)
- do (with-current-buffer buf
- (if (eq mode major-mode)
- (let ((map (if mh-folder-view-stack
- sequence-map
- default-map)))
- ;; Yes, make-local-variable is necessary since we
- ;; get here during initialization when loading
- ;; mh-e.el, after the +inbox buffer has been
- ;; created, but before mh-folder-mode has run and
- ;; created the local map.
- (set (make-local-variable 'tool-bar-map) map))))))
+ (cl-loop for buf in (buffer-list)
+ do (with-current-buffer buf
+ (when (eq mode major-mode) ;FIXME: derived-mode-p?
+ (let ((map (if mh-folder-view-stack
+ sequence-map
+ default-map)))
+ ;; Yes, make-local-variable is necessary since we
+ ;; get here during initialization when loading
+ ;; mh-e.el, after the +inbox buffer has been
+ ;; created, but before mh-folder-mode has run and
+ ;; created the local map.
+ (set (make-local-variable 'tool-bar-map) map))))))
(defun mh-tool-bar-folder-buttons-set (symbol value)
"Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
(set-default symbol value)
@@ -286,17 +287,17 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP
otherwise."
;; XEmacs specific code
(mh-do-in-xemacs
(defvar mh-tool-bar-folder-vector-map
- (list ,@(loop for button in folder-buttons
- for vector in folder-vectors
- collect `(cons ',button ,vector))))
+ (list ,@(cl-loop for button in folder-buttons
+ for vector in folder-vectors
+ collect `(cons ',button ,vector))))
(defvar mh-tool-bar-show-vector-map
- (list ,@(loop for button in show-buttons
- for vector in show-vectors
- collect `(cons ',button ,vector))))
+ (list ,@(cl-loop for button in show-buttons
+ for vector in show-vectors
+ collect `(cons ',button ,vector))))
(defvar mh-tool-bar-letter-vector-map
- (list ,@(loop for button in letter-buttons
- for vector in letter-vectors
- collect `(cons ',button ,vector))))
+ (list ,@(cl-loop for button in letter-buttons
+ for vector in letter-vectors
+ collect `(cons ',button ,vector))))
(defvar mh-tool-bar-folder-buttons)
(defvar mh-tool-bar-show-buttons)
(defvar mh-tool-bar-letter-buttons)
@@ -305,18 +306,20 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP
otherwise."
(set-default symbol value)
(when mh-xemacs-has-tool-bar-flag
(setq mh-tool-bar-letter-buttons
- (loop for b in value
- collect (cdr
- (assoc b mh-tool-bar-letter-vector-map))))))
+ (cl-loop
+ for b in value
+ collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
(defun mh-tool-bar-folder-buttons-set (symbol value)
(set-default symbol value)
(when mh-xemacs-has-tool-bar-flag
(setq mh-tool-bar-folder-buttons
- (loop for b in value
- collect (cdr (assoc b
mh-tool-bar-folder-vector-map))))
+ (cl-loop
+ for b in value
+ collect (cdr (assoc b mh-tool-bar-folder-vector-map))))
(setq mh-tool-bar-show-buttons
- (loop for b in value
- collect (cdr (assoc b
mh-tool-bar-show-vector-map))))))
+ (cl-loop
+ for b in value
+ collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
(defun mh-tool-bar-init (mode)
"Install tool bar in MODE."
(when mh-xemacs-use-tool-bar-flag
@@ -354,9 +357,9 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP
otherwise."
"List of buttons to include in MH-Folder tool bar."
:group 'mh-tool-bar
:set 'mh-tool-bar-folder-buttons-set
- :type '(set ,@(loop for x in folder-buttons
- for y in folder-docs
- collect `(const :tag ,y ,x)))
+ :type '(set ,@(cl-loop for x in folder-buttons
+ for y in folder-docs
+ collect `(const :tag ,y ,x)))
;;:package-version '(MH-E "7.1")
)
(custom-declare-variable
@@ -365,9 +368,9 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP
otherwise."
"List of buttons to include in MH-Letter tool bar."
:group 'mh-tool-bar
:set 'mh-tool-bar-letter-buttons-set
- :type '(set ,@(loop for x in letter-buttons
- for y in letter-docs
- collect `(const :tag ,y ,x)))
+ :type '(set ,@(cl-loop for x in letter-buttons
+ for y in letter-docs
+ collect `(const :tag ,y ,x)))
;;:package-version '(MH-E "7.1")
))))
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 0938729..9f39c1b 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -29,7 +29,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(require 'font-lock)
@@ -40,9 +39,9 @@
"Return the position of last occurrence of CHAR in STRING.
If CHAR is not present in STRING then return nil. The function is
used in lieu of `search' in the CL package."
- (loop for index from (1- (length string)) downto 0
- when (equal (aref string index) char) return index
- finally return nil))
+ (cl-loop for index from (1- (length string)) downto 0
+ when (equal (aref string index) char) return index
+ finally return nil))
@@ -103,9 +102,9 @@ PICK-EXPR is a list of strings. Return nil if PICK-EXPR is
nil."
(dolist (string pick-expr)
(when (and string
(not (string-equal string "")))
- (loop for i from 0 to (1- (length mh-pick-regexp-chars)) do
- (let ((s (string ?\\ (aref mh-pick-regexp-chars i))))
- (setq string (mh-replace-regexp-in-string s s string t t))))
+ (cl-loop for i from 0 to (1- (length mh-pick-regexp-chars)) do
+ (let ((s (string ?\\ (aref mh-pick-regexp-chars i))))
+ (setq string (mh-replace-regexp-in-string s s string t t))))
(setq quoted-pick-expr (append quoted-pick-expr (list string)))))
quoted-pick-expr))
@@ -374,7 +373,7 @@ the cursor is not pointing to a message."
(mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter
"-recurse" "-fast"))))
-(defun mh-collect-folder-names-filter (process output)
+(defun mh-collect-folder-names-filter (_process output)
"Read folder names.
PROCESS is the flists process that was run to collect folder
names and the function is called when OUTPUT is available."
@@ -402,15 +401,15 @@ names and the function is called when OUTPUT is
available."
(child2 (and parent (substring parent (1+ (or parent-slash 0)))))
(grand-parent (and parent-slash (substring parent 0 parent-slash)))
(cache-entry (gethash parent mh-sub-folders-cache)))
- (unless (loop for x in cache-entry when (equal (car x) child1) return t
- finally return nil)
+ (unless (cl-loop for x in cache-entry when (equal (car x) child1) return t
+ finally return nil)
(push (list child1) cache-entry)
(setf (gethash parent mh-sub-folders-cache)
(sort cache-entry (lambda (x y) (string< (car x) (car y)))))
(when parent
- (loop for x in (gethash grand-parent mh-sub-folders-cache)
- when (equal (car x) child2)
- do (progn (setf (cdr x) t) (return)))))))
+ (cl-loop for x in (gethash grand-parent mh-sub-folders-cache)
+ when (equal (car x) child2)
+ do (progn (setf (cdr x) t) (cl-return)))))))
(defun mh-normalize-folder-name (folder &optional empty-string-okay
dont-remove-trailing-slash
@@ -522,12 +521,12 @@ they will not be returned."
(unless (null folder)
(setq folder-list (list folder))
(setq folder (concat folder "/")))
- (loop for f in (mh-sub-folders folder) do
- (setq folder-list
- (append folder-list
- (if (mh-children-p f)
- (mh-folder-list (concat folder (car f)))
- (list (concat folder (car f)))))))
+ (cl-loop for f in (mh-sub-folders folder) do
+ (setq folder-list
+ (append folder-list
+ (if (mh-children-p f)
+ (mh-folder-list (concat folder (car f)))
+ (list (concat folder (car f)))))))
folder-list))
;;;###mh-autoload
@@ -583,10 +582,10 @@ Expects FOLDER to have already been normalized with
(mh-line-beginning-position) t)))
(when (integerp has-pos)
(while (equal (char-after has-pos) ? )
- (decf has-pos))
- (incf has-pos)
+ (cl-decf has-pos))
+ (cl-incf has-pos)
(while (equal (char-after start-pos) ? )
- (incf start-pos))
+ (cl-incf start-pos))
(let* ((name (buffer-substring start-pos has-pos))
(first-char (aref name 0))
(last-char (aref name (1- (length name)))))
@@ -621,7 +620,7 @@ Here we will need to invalidate the cached sub-folders of
+foo,
otherwise completion on +foo won't tell us about the option
+foo/bar!"
(remhash folder mh-sub-folders-cache)
- (block ancestor-found
+ (cl-block ancestor-found
(let ((parent folder)
(one-ancestor-found nil)
last-slash)
@@ -630,7 +629,7 @@ otherwise completion on +foo won't tell us about the option
(unless (eq (gethash parent mh-sub-folders-cache 'none) 'none)
(remhash parent mh-sub-folders-cache)
(if one-ancestor-found
- (return-from ancestor-found)
+ (cl-return-from ancestor-found)
(setq one-ancestor-found t))))
(remhash nil mh-sub-folders-cache))))
@@ -702,11 +701,11 @@ See Info node `(elisp) Programmed Completion' for
details."
(name (substring name 1))
(t ""))))
(cond ((eq (car-safe flag) 'boundaries)
- (list* 'boundaries
- (let ((slash (mh-search-from-end ?/ orig-name)))
- (if slash (1+ slash)
- (if (string-match "\\`\\+" orig-name) 1 0)))
- (if (cdr flag) (string-match "/" (cdr flag)))))
+ (cl-list* 'boundaries
+ (let ((slash (mh-search-from-end ?/ orig-name)))
+ (if slash (1+ slash)
+ (if (string-match "\\`\\+" orig-name) 1 0)))
+ (if (cdr flag) (string-match "/" (cdr flag)))))
((eq flag nil)
(let ((try-res
(try-completion
@@ -721,6 +720,8 @@ See Info node `(elisp) Programmed Completion' for details."
(all-completions
remainder (mh-sub-folders last-complete t) predicate))
((eq flag 'lambda)
+ ;; FIXME: if name starts with "/", `path' will end
+ ;; being a relative name without a leading + nor / !? --Stef
(let ((path (concat (unless (and (> (length name) 1)
(eq (aref name 1) ?/))
mh-user-path)
@@ -738,7 +739,7 @@ See Info node `(elisp) Programmed Completion' for details."
If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be
a folder name corresponding to `mh-user-path'."
(mh-normalize-folder-name
- (let ((completion-root-regexp "^[+/]")
+ (let ((completion-root-regexp "^[+/]") ;FIXME: Who/what uses that?
(minibuffer-local-completion-map mh-folder-completion-map)
(mh-allow-root-folder-flag allow-root-folder-flag))
(completing-read prompt 'mh-folder-completion-function nil nil nil
@@ -876,12 +877,12 @@ in this situation."
;; In this situation, rfc822-goto-eoh doesn't go to the end of the
;; header. The replacement allows From_ lines in the mail header.
(goto-char (point-min))
- (loop for p = (re-search-forward
- "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
- do (cond ((null p) (return))
- (t (goto-char (match-beginning 0))
- (unless (looking-at "From ") (return))
- (goto-char p))))
+ (cl-loop for p = (re-search-forward
+ "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
+ do (cond ((null p) (cl-return))
+ (t (goto-char (match-beginning 0))
+ (unless (looking-at "From ") (cl-return))
+ (goto-char p))))
(point)))
;;;###mh-autoload
@@ -918,9 +919,9 @@ Handle RFC 822 (or later) continuation lines."
(defun mh-letter-skipped-header-field-p (field)
"Check if FIELD is to be skipped."
(let ((field (downcase field)))
- (loop for x in mh-compose-skipped-header-fields
- when (equal (downcase x) field) return t
- finally return nil)))
+ (cl-loop for x in mh-compose-skipped-header-fields
+ when (equal (downcase x) field) return t
+ finally return nil)))
(defvar mh-hidden-header-keymap
(let ((map (make-sparse-keymap)))
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 4ff84a6..5ffcfe5 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -28,7 +28,6 @@
;;; Code:
(require 'mh-e)
-(mh-require-cl)
(autoload 'message-fetch-field "message")
@@ -74,8 +73,8 @@ in this order is used."
(x-face (setq raw (mh-uncompface x-face)
type 'pbm))
(url (setq type 'url))
- (t (multiple-value-setq (type raw)
- (values-list (mh-picon-get-image)))))
+ (t (cl-multiple-value-setq (type raw)
+ (cl-values-list (mh-picon-get-image)))))
(when type
(goto-char (point-min))
(when (re-search-forward "^from:" (point-max) t)
@@ -177,93 +176,97 @@ The directories are searched for in the order they appear
in the list.")
(defvar mh-picon-cache (make-hash-table :test #'equal))
(defvar mh-picon-image-types
- (loop for type in '(xpm xbm gif)
- when (or (mh-do-in-gnu-emacs
- (ignore-errors
- (mh-funcall-if-exists image-type-available-p type)))
- (mh-do-in-xemacs (featurep type)))
- collect type))
+ (cl-loop for type in '(xpm xbm gif)
+ when (or (mh-do-in-gnu-emacs
+ (ignore-errors
+ (mh-funcall-if-exists image-type-available-p type)))
+ (mh-do-in-xemacs (featurep type)))
+ collect type))
(autoload 'message-tokenize-header "sendmail")
-(defun* mh-picon-get-image ()
+(defun mh-picon-get-image ()
"Find the best possible match and return contents."
(mh-picon-set-directory-list)
(save-restriction
(let* ((from-field (ignore-errors (car (message-tokenize-header
(mh-get-header-field "from:")))))
(from (car (ignore-errors
- (mh-funcall-if-exists ietf-drums-parse-address
- from-field))))
+ ;; Don't use mh-funcall-if-exists because
+ ;; ietf-drums-parse-address might exist at run-time but
+ ;; not at compile-time.
+ (when (fboundp 'ietf-drums-parse-address)
+ (ietf-drums-parse-address from-field)))))
(host (and from
(string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from)
(downcase (match-string 3 from))))
(user (and host (downcase (match-string 1 from))))
(canonical-address (format "%s@%s" user host))
(cached-value (gethash canonical-address mh-picon-cache))
- (host-list (and host (delete "" (split-string host "\\."))))
- (match nil))
- (cond (cached-value (return-from mh-picon-get-image cached-value))
- ((not host-list) (return-from mh-picon-get-image nil)))
- (setq match
- (block loop
- ;; u@h search
- (loop for dir in mh-picon-existing-directory-list
- do (loop for type in mh-picon-image-types
- ;; [path]user@host
- for file1 = (format "%s/%s.%s"
- dir canonical-address type)
- when (file-exists-p file1)
- do (return-from loop file1)
- ;; [path]user
- for file2 = (format "%s/%s.%s" dir user type)
- when (file-exists-p file2)
- do (return-from loop file2)
- ;; [path]host
- for file3 = (format "%s/%s.%s" dir host type)
- when (file-exists-p file3)
- do (return-from loop file3)))
- ;; facedb search
- ;; Search order for address@hidden:
- ;; [path]net/foo/user
- ;; [path]net/foo/user/face
- ;; [path]net/user
- ;; [path]net/user/face
- ;; [path]net/foo/unknown
- ;; [path]net/foo/unknown/face
- ;; [path]net/unknown
- ;; [path]net/unknown/face
- (loop for u in (list user "unknown")
- do (loop for dir in mh-picon-existing-directory-list
- do (loop for x on host-list by #'cdr
- for y = (mh-picon-generate-path x u dir)
- do (loop for type in mh-picon-image-types
- for z1 = (format "%s.%s" y type)
- when (file-exists-p z1)
- do (return-from loop z1)
- for z2 = (format "%s/face.%s"
- y type)
- when (file-exists-p z2)
- do (return-from loop z2)))))))
- (setf (gethash canonical-address mh-picon-cache)
- (mh-picon-file-contents match)))))
+ (host-list (and host (delete "" (split-string host "\\.")))))
+ (cond
+ (cached-value cached-value)
+ ((not host-list) nil)
+ (t
+ (let ((match
+ (cl-block loop
+ ;; u@h search
+ (dolist (dir mh-picon-existing-directory-list)
+ (cl-loop for type in mh-picon-image-types
+ ;; [path]user@host
+ for file1 = (format "%s/%s.%s"
+ dir canonical-address type)
+ when (file-exists-p file1)
+ do (cl-return-from loop file1)
+ ;; [path]user
+ for file2 = (format "%s/%s.%s" dir user type)
+ when (file-exists-p file2)
+ do (cl-return-from loop file2)
+ ;; [path]host
+ for file3 = (format "%s/%s.%s" dir host type)
+ when (file-exists-p file3)
+ do (cl-return-from loop file3)))
+ ;; facedb search
+ ;; Search order for address@hidden:
+ ;; [path]net/foo/user
+ ;; [path]net/foo/user/face
+ ;; [path]net/user
+ ;; [path]net/user/face
+ ;; [path]net/foo/unknown
+ ;; [path]net/foo/unknown/face
+ ;; [path]net/unknown
+ ;; [path]net/unknown/face
+ (dolist (u (list user "unknown"))
+ (dolist (dir mh-picon-existing-directory-list)
+ (cl-loop for x on host-list by #'cdr
+ for y = (mh-picon-generate-path x u dir)
+ do (cl-loop for type in mh-picon-image-types
+ for z1 = (format "%s.%s" y type)
+ when (file-exists-p z1)
+ do (cl-return-from loop z1)
+ for z2 = (format "%s/face.%s"
+ y type)
+ when (file-exists-p z2)
+ do (cl-return-from loop z2))))))))
+ (setf (gethash canonical-address mh-picon-cache)
+ (mh-picon-file-contents match))))))))
(defun mh-picon-set-directory-list ()
"Update `mh-picon-existing-directory-list' if needed."
(when (eq mh-picon-existing-directory-list 'unset)
(setq mh-picon-existing-directory-list
- (loop for x in mh-picon-directory-list
- when (file-directory-p x) collect x))))
+ (cl-loop for x in mh-picon-directory-list
+ when (file-directory-p x) collect x))))
(defun mh-picon-generate-path (host-list user directory)
"Generate the image file path.
HOST-LIST is the parsed host address of the email address, USER
the username and DIRECTORY is the directory relative to which the
path is generated."
- (loop with acc = ""
- for elem in host-list
- do (setq acc (format "%s/%s" elem acc))
- finally return (format "%s/%s%s" directory acc user)))
+ (cl-loop with acc = ""
+ for elem in host-list
+ do (setq acc (format "%s/%s" elem acc))
+ finally return (format "%s/%s%s" directory acc user)))
(defun mh-picon-file-contents (file)
"Return details about FILE.
@@ -437,7 +440,7 @@ actual display is carried out by the SENTINEL function."
;; Temporary failure
(mh-x-image-set-download-state cache-file 'try-again)))
-(defun mh-x-image-scale-and-display (process change)
+(defun mh-x-image-scale-and-display (process _change)
"When the wget PROCESS terminates scale and display image.
The argument CHANGE is ignored."
(when (eq (process-status process) 'exit)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 74b097b: * lisp/mh-e: Use cl-lib,
Stefan Monnier <=