aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-08-06 03:56:51 -0400
committerStefan Monnier2019-08-06 03:56:51 -0400
commit74b097b61c5201405ad7bc5bb76f1ca0e794184b (patch)
tree9e616fd95c5cb01c7dac507c6d84a34637f14411
parentb06917a4912a60402025286d07d4a195749245c4 (diff)
downloademacs-74b097b61c5201405ad7bc5bb76f1ca0e794184b.tar.gz
emacs-74b097b61c5201405ad7bc5bb76f1ca0e794184b.zip
* 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`.
-rw-r--r--lisp/mh-e/mh-acros.el80
-rw-r--r--lisp/mh-e/mh-alias.el4
-rw-r--r--lisp/mh-e/mh-comp.el22
-rw-r--r--lisp/mh-e/mh-compat.el12
-rw-r--r--lisp/mh-e/mh-e.el103
-rw-r--r--lisp/mh-e/mh-folder.el57
-rw-r--r--lisp/mh-e/mh-funcs.el2
-rw-r--r--lisp/mh-e/mh-gnus.el8
-rw-r--r--lisp/mh-e/mh-identity.el6
-rw-r--r--lisp/mh-e/mh-inc.el15
-rw-r--r--lisp/mh-e/mh-junk.el1
-rw-r--r--lisp/mh-e/mh-limit.el27
-rw-r--r--lisp/mh-e/mh-mime.el129
-rw-r--r--lisp/mh-e/mh-search.el266
-rw-r--r--lisp/mh-e/mh-seq.el21
-rw-r--r--lisp/mh-e/mh-show.el2
-rw-r--r--lisp/mh-e/mh-speed.el11
-rw-r--r--lisp/mh-e/mh-thread.el76
-rw-r--r--lisp/mh-e/mh-tool-bar.el97
-rw-r--r--lisp/mh-e/mh-utils.el79
-rw-r--r--lisp/mh-e/mh-xface.el133
21 files changed, 549 insertions, 602 deletions
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index 3bbf509989d..c017419df2e 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -40,30 +40,12 @@
40 40
41;;; Code: 41;;; Code:
42 42
43(require 'cl) 43(require 'cl-lib)
44 44
45 45
46 46
47;;; Compatibility 47;;; Compatibility
48 48
49;; TODO: Replace `cl' with `cl-lib'.
50;; `cl' is deprecated in Emacs 24.3. Use `cl-lib' instead. However,
51;; we'll likely have to insert `cl-' before each use of a Common Lisp
52;; function.
53;;;###mh-autoload
54(defmacro mh-require-cl ()
55 "Macro to load \"cl\" if needed.
56
57Emacs coding conventions require that the \"cl\" package not be
58required at runtime. However, the \"cl\" package in Emacs 21.4
59and earlier left \"cl\" routines in their macro expansions. In
60particular, the expansion of (setf (gethash ...) ...) used
61functions in \"cl\" at run time. This macro recognizes that and
62loads \"cl\" appropriately."
63 (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash)
64 '(require 'cl)
65 '(eval-when-compile (require 'cl))))
66
67;;;###mh-autoload 49;;;###mh-autoload
68(defmacro mh-do-in-gnu-emacs (&rest body) 50(defmacro mh-do-in-gnu-emacs (&rest body)
69 "Execute BODY if in GNU Emacs." 51 "Execute BODY if in GNU Emacs."
@@ -81,6 +63,9 @@ loads \"cl\" appropriately."
81;;;###mh-autoload 63;;;###mh-autoload
82(defmacro mh-funcall-if-exists (function &rest args) 64(defmacro mh-funcall-if-exists (function &rest args)
83 "Call FUNCTION with ARGS as parameters if it exists." 65 "Call FUNCTION with ARGS as parameters if it exists."
66 ;; FIXME: Not clear when this should be used. If the function happens
67 ;; not to exist at compile-time (e.g. because the corresponding package
68 ;; wasn't loaded), then it won't ever be used :-(
84 (when (fboundp function) 69 (when (fboundp function)
85 `(when (fboundp ',function) 70 `(when (fboundp ',function)
86 (funcall ',function ,@args)))) 71 (funcall ',function ,@args))))
@@ -135,53 +120,6 @@ check if variable `transient-mark-mode' is active."
135 '(and (boundp 'transient-mark-mode) transient-mark-mode 120 '(and (boundp 'transient-mark-mode) transient-mark-mode
136 (boundp 'mark-active) mark-active)))) 121 (boundp 'mark-active) mark-active))))
137 122
138;; Shush compiler.
139(mh-do-in-xemacs
140 (defvar struct)
141 (defvar x)
142 (defvar y))
143
144;;;###mh-autoload
145(defmacro mh-defstruct (name-spec &rest fields)
146 ;; FIXME: Use `cl-defstruct' instead: shouldn't emit warnings any
147 ;; more nor depend on run-time CL functions.
148 "Replacement for `defstruct' from the \"cl\" package.
149The `defstruct' in the \"cl\" library produces compiler warnings,
150and generates code that uses functions present in \"cl\" at
151run-time. This is a partial replacement, that avoids these
152issues.
153
154NAME-SPEC declares the name of the structure, while FIELDS
155describes the various structure fields. Lookup `defstruct' for
156more details."
157 (let* ((struct-name (if (atom name-spec) name-spec (car name-spec)))
158 (conc-name (or (and (consp name-spec)
159 (cadr (assoc :conc-name (cdr name-spec))))
160 (format "%s-" struct-name)))
161 (predicate (intern (format "%s-p" struct-name)))
162 (constructor (or (and (consp name-spec)
163 (cadr (assoc :constructor (cdr name-spec))))
164 (intern (format "make-%s" struct-name))))
165 (fields (mapcar (lambda (x)
166 (if (atom x)
167 (list x nil)
168 (list (car x) (cadr x))))
169 fields))
170 (field-names (mapcar #'car fields))
171 (struct (gensym "S"))
172 (x (gensym "X"))
173 (y (gensym "Y")))
174 `(progn
175 (defun* ,constructor (&key ,@fields)
176 (list (quote ,struct-name) ,@field-names))
177 (defun ,predicate (arg)
178 (and (consp arg) (eq (car arg) (quote ,struct-name))))
179 ,@(loop for x from 1
180 for y in field-names
181 collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z)
182 (list 'nth ,x z)))
183 (quote ,struct-name))))
184
185;;;###mh-autoload 123;;;###mh-autoload
186(defmacro with-mh-folder-updating (save-modification-flag &rest body) 124(defmacro with-mh-folder-updating (save-modification-flag &rest body)
187 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY). 125 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY).
@@ -327,6 +265,16 @@ MH-E functions."
327 ,@body)))))))) 265 ,@body))))))))
328(put 'mh-iterate-on-range 'lisp-indent-hook 'defun) 266(put 'mh-iterate-on-range 'lisp-indent-hook 'defun)
329 267
268(defmacro mh-dlet* (binders &rest body)
269 "Like `let*' but always dynamically scoped."
270 (declare (debug let) (indent 1))
271 ;; Works in both lexical and non-lexical mode.
272 `(progn
273 ,@(mapcar (lambda (binder)
274 `(defvar ,(if (consp binder) (car binder) binder)))
275 binders)
276 (let* ,binders ,@body)))
277
330(provide 'mh-acros) 278(provide 'mh-acros)
331 279
332;; Local Variables: 280;; Local Variables:
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index c6cdfc40c94..2ff8801cd94 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -30,8 +30,6 @@
30 30
31(require 'mh-e) 31(require 'mh-e)
32 32
33(mh-require-cl)
34
35(require 'goto-addr) 33(require 'goto-addr)
36 34
37(defvar mh-alias-alist 'not-read 35(defvar mh-alias-alist 'not-read
@@ -308,7 +306,7 @@ Blind aliases or users from /etc/passwd are not expanded."
308 (if (not mh-alias-expand-aliases-flag) 306 (if (not mh-alias-expand-aliases-flag)
309 mh-alias-alist 307 mh-alias-alist
310 (lambda (string pred action) 308 (lambda (string pred action)
311 (case action 309 (cl-case action
312 ((nil) 310 ((nil)
313 (let ((res (try-completion string mh-alias-alist pred))) 311 (let ((res (try-completion string mh-alias-alist pred)))
314 (if (or (eq res t) 312 (if (or (eq res t)
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index a5614f52550..1ffe56a6dbe 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."
217(defvar mh-error-if-no-draft nil) ;raise error over using old draft 217(defvar mh-error-if-no-draft nil) ;raise error over using old draft
218 218
219;;;###autoload 219;;;###autoload
220(defun mh-smail-batch (&optional to subject other-headers &rest ignored) 220(defun mh-smail-batch (&optional to subject _other-headers &rest _ignored)
221 "Compose a message with the MH mail system. 221 "Compose a message with the MH mail system.
222 222
223This function does not prompt the user for any header fields, and 223This function does not prompt the user for any header fields, and
@@ -239,10 +239,7 @@ applications should use `mh-user-agent-compose'."
239 'mh-before-send-letter-hook) 239 'mh-before-send-letter-hook)
240 240
241;;;###autoload 241;;;###autoload
242(defun mh-user-agent-compose (&optional to subject other-headers continue 242(defun mh-user-agent-compose (&optional to subject other-headers &rest _ignored)
243 switch-function yank-action
244 send-actions return-action
245 &rest ignored)
246 "Set up mail composition draft with the MH mail system. 243 "Set up mail composition draft with the MH mail system.
247This is the `mail-user-agent' entry point to MH-E. This function 244This is the `mail-user-agent' entry point to MH-E. This function
248conforms to the contract specified by `define-mail-user-agent' 245conforms to the contract specified by `define-mail-user-agent'
@@ -256,8 +253,7 @@ OTHER-HEADERS is an alist specifying additional header fields.
256Elements look like (HEADER . VALUE) where both HEADER and VALUE 253Elements look like (HEADER . VALUE) where both HEADER and VALUE
257are strings. 254are strings.
258 255
259CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and 256Any additional arguments are IGNORED."
260RETURN-ACTION and any additional arguments are IGNORED."
261 (mh-find-path) 257 (mh-find-path)
262 (let ((mh-error-if-no-draft t)) 258 (let ((mh-error-if-no-draft t))
263 (mh-send to "" subject) 259 (mh-send to "" subject)
@@ -266,9 +262,7 @@ RETURN-ACTION and any additional arguments are IGNORED."
266 (cdr (car other-headers))) 262 (cdr (car other-headers)))
267 (setq other-headers (cdr other-headers))))) 263 (setq other-headers (cdr other-headers)))))
268 264
269;; Shush compiler. 265(defvar sendmail-coding-system)
270(mh-do-in-xemacs
271 (defvar sendmail-coding-system))
272 266
273;;;###autoload 267;;;###autoload
274(defun mh-send-letter (&optional arg) 268(defun mh-send-letter (&optional arg)
@@ -1297,10 +1291,10 @@ discarded."
1297 "Check if current buffer is entirely composed of ASCII. 1291 "Check if current buffer is entirely composed of ASCII.
1298The function doesn't work for XEmacs since `find-charset-region' 1292The function doesn't work for XEmacs since `find-charset-region'
1299doesn't exist there." 1293doesn't exist there."
1300 (loop for charset in (mh-funcall-if-exists 1294 (cl-loop for charset in (mh-funcall-if-exists
1301 find-charset-region (point-min) (point-max)) 1295 find-charset-region (point-min) (point-max))
1302 unless (eq charset 'ascii) return nil 1296 unless (eq charset 'ascii) return nil
1303 finally return t)) 1297 finally return t))
1304 1298
1305(provide 'mh-comp) 1299(provide 'mh-comp)
1306 1300
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index a459d27ee2d..7c5bd3a987e 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -143,7 +143,7 @@ introduced in Emacs 22."
143 `(face-background ,face ,frame ,inherit))) 143 `(face-background ,face ,frame ,inherit)))
144 144
145(defun-mh mh-font-lock-add-keywords font-lock-add-keywords 145(defun-mh mh-font-lock-add-keywords font-lock-add-keywords
146 (mode keywords &optional how) 146 (_mode _keywords &optional _how)
147 "XEmacs does not have `font-lock-add-keywords'. 147 "XEmacs does not have `font-lock-add-keywords'.
148This function returns nil on that system.") 148This function returns nil on that system.")
149 149
@@ -243,7 +243,7 @@ compatibility with versions of Emacs that lack the variable
243 (delete image-directory (copy-sequence (or path load-path)))))) 243 (delete image-directory (copy-sequence (or path load-path))))))
244 244
245(defun-mh mh-image-search-load-path 245(defun-mh mh-image-search-load-path
246 image-search-load-path (file &optional path) 246 image-search-load-path (_file &optional _path)
247 "Emacs 21 and XEmacs don't have `image-search-load-path'. 247 "Emacs 21 and XEmacs don't have `image-search-load-path'.
248This function returns nil on those systems." 248This function returns nil on those systems."
249 nil) 249 nil)
@@ -292,7 +292,7 @@ introduced in Emacs 24."
292 `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type)))) 292 `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))))
293 293
294(defun-mh mh-match-string-no-properties 294(defun-mh mh-match-string-no-properties
295 match-string-no-properties (num &optional string) 295 match-string-no-properties (num &optional _string)
296 "Return string of text matched by last search, without text properties. 296 "Return string of text matched by last search, without text properties.
297This function is used by XEmacs that lacks `match-string-no-properties'. 297This function is used by XEmacs that lacks `match-string-no-properties'.
298The function `buffer-substring-no-properties' is used instead. 298The function `buffer-substring-no-properties' is used instead.
@@ -301,7 +301,7 @@ The argument STRING is ignored."
301 (match-beginning num) (match-end num))) 301 (match-beginning num) (match-end num)))
302 302
303(defun-mh mh-replace-regexp-in-string replace-regexp-in-string 303(defun-mh mh-replace-regexp-in-string replace-regexp-in-string
304 (regexp rep string &optional fixedcase literal subexp start) 304 (regexp rep string &optional _fixedcase literal _subexp _start)
305 "Replace REGEXP with REP everywhere in STRING and return result. 305 "Replace REGEXP with REP everywhere in STRING and return result.
306This function is used by XEmacs that lacks `replace-regexp-in-string'. 306This function is used by XEmacs that lacks `replace-regexp-in-string'.
307The function `replace-in-string' is used instead. 307The function `replace-in-string' is used instead.
@@ -311,7 +311,7 @@ The arguments FIXEDCASE, SUBEXP, and START, used by
311 (replace-in-string string regexp rep literal))) 311 (replace-in-string string regexp rep literal)))
312 312
313(defun-mh mh-test-completion 313(defun-mh mh-test-completion
314 test-completion (string collection &optional predicate) 314 test-completion (_string _collection &optional _predicate)
315 "Return non-nil if STRING is a valid completion. 315 "Return non-nil if STRING is a valid completion.
316XEmacs does not have `test-completion'. This function returns nil 316XEmacs does not have `test-completion'. This function returns nil
317on that system." nil) 317on that system." nil)
@@ -352,7 +352,7 @@ The arguments RETURN-TO and EXIT-ACTION are ignored."
352 (view-mode 1)) 352 (view-mode 1))
353 353
354(defun-mh mh-window-full-height-p 354(defun-mh mh-window-full-height-p
355 window-full-height-p (&optional WINDOW) 355 window-full-height-p (&optional _window)
356 "Return non-nil if WINDOW is not the result of a vertical split. 356 "Return non-nil if WINDOW is not the result of a vertical split.
357This function is defined in XEmacs as it lacks 357This function is defined in XEmacs as it lacks
358`window-full-height-p'. The values of the functions 358`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 c70e11e773a..7644f6e961c 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -91,7 +91,7 @@
91;; for if it does it will introduce a require loop. 91;; for if it does it will introduce a require loop.
92(require 'mh-loaddefs) 92(require 'mh-loaddefs)
93 93
94(mh-require-cl) 94(require 'cl-lib)
95 95
96(require 'mh-buffers) 96(require 'mh-buffers)
97(require 'mh-compat) 97(require 'mh-compat)
@@ -496,7 +496,7 @@ all the strings have been used."
496 (push (buffer-substring-no-properties (point) 496 (push (buffer-substring-no-properties (point)
497 (mh-line-end-position)) 497 (mh-line-end-position))
498 arg-list) 498 arg-list)
499 (incf count) 499 (cl-incf count)
500 (forward-line)) 500 (forward-line))
501 (apply #'call-process cmd nil (list out nil) nil 501 (apply #'call-process cmd nil (list out nil) nil
502 (nreverse arg-list)))) 502 (nreverse arg-list))))
@@ -509,8 +509,8 @@ all the strings have been used."
509Adds double-quotes around entire string and quotes the characters 509Adds double-quotes around entire string and quotes the characters
510\\, `, and $ with a backslash." 510\\, `, and $ with a backslash."
511 (concat "\"" 511 (concat "\""
512 (loop for x across string 512 (cl-loop for x across string
513 concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x)) 513 concat (format (if (memq x '(?\\ ?` ?$)) "\\%c" "%c") x))
514 "\"")) 514 "\""))
515 515
516(defun mh-exec-cmd (command &rest args) 516(defun mh-exec-cmd (command &rest args)
@@ -527,7 +527,7 @@ parsed by MH-E."
527 (save-excursion 527 (save-excursion
528 (goto-char start) 528 (goto-char start)
529 (insert "Errors when executing: " command) 529 (insert "Errors when executing: " command)
530 (loop for arg in args do (insert " " arg)) 530 (cl-loop for arg in args do (insert " " arg))
531 (insert "\n")) 531 (insert "\n"))
532 (save-window-excursion 532 (save-window-excursion
533 (switch-to-buffer-other-window mh-log-buffer) 533 (switch-to-buffer-other-window mh-log-buffer)
@@ -583,7 +583,7 @@ ARGS are passed to COMMAND as command line arguments."
583 (push elem process-environment)) 583 (push elem process-environment))
584 (apply #'mh-exec-cmd-daemon command filter args))) 584 (apply #'mh-exec-cmd-daemon command filter args)))
585 585
586(defun mh-process-daemon (process output) 586(defun mh-process-daemon (_process output)
587 "PROCESS daemon that puts OUTPUT into a temporary buffer. 587 "PROCESS daemon that puts OUTPUT into a temporary buffer.
588Any output from the process is displayed in an asynchronous 588Any output from the process is displayed in an asynchronous
589pop-up window." 589pop-up window."
@@ -683,11 +683,11 @@ ARGS is returned unchanged."
683 `(if (boundp 'customize-package-emacs-version-alist) 683 `(if (boundp 'customize-package-emacs-version-alist)
684 ,args 684 ,args
685 (let (seen) 685 (let (seen)
686 (loop for keyword in ,args 686 (cl-loop for keyword in ,args
687 if (cond ((eq keyword ':package-version) (setq seen t) nil) 687 if (cond ((eq keyword ':package-version) (setq seen t) nil)
688 (seen (setq seen nil) nil) 688 (seen (setq seen nil) nil)
689 (t t)) 689 (t t))
690 collect keyword)))) 690 collect keyword))))
691 691
692(defmacro defgroup-mh (symbol members doc &rest args) 692(defmacro defgroup-mh (symbol members doc &rest args)
693 "Declare SYMBOL as a customization group containing MEMBERS. 693 "Declare SYMBOL as a customization group containing MEMBERS.
@@ -740,14 +740,14 @@ is described by the variable `mh-variants'."
740 (let ((list-unique)) 740 (let ((list-unique))
741 ;; Make a unique list of directories, keeping the given order. 741 ;; Make a unique list of directories, keeping the given order.
742 ;; We don't want the same MH variant to be listed multiple times. 742 ;; We don't want the same MH variant to be listed multiple times.
743 (loop for dir in (append mh-path mh-sys-path exec-path) do 743 (cl-loop for dir in (append mh-path mh-sys-path exec-path) do
744 (setq dir (file-chase-links (directory-file-name dir))) 744 (setq dir (file-chase-links (directory-file-name dir)))
745 (add-to-list 'list-unique dir)) 745 (cl-pushnew dir list-unique :test #'equal))
746 (loop for dir in (nreverse list-unique) do 746 (cl-loop for dir in (nreverse list-unique) do
747 (when (and dir (file-accessible-directory-p dir)) 747 (when (and dir (file-accessible-directory-p dir))
748 (let ((variant (mh-variant-info dir))) 748 (let ((variant (mh-variant-info dir)))
749 (if variant 749 (if variant
750 (add-to-list 'mh-variants variant))))) 750 (add-to-list 'mh-variants variant)))))
751 mh-variants))) 751 mh-variants)))
752 752
753(defun mh-variant-info (dir) 753(defun mh-variant-info (dir)
@@ -858,22 +858,22 @@ variant."
858 mh-progs progs 858 mh-progs progs
859 mh-variant-in-use variant)))) 859 mh-variant-in-use variant))))
860 ((symbolp variant) ;e.g. 'nmh (pick the first match) 860 ((symbolp variant) ;e.g. 'nmh (pick the first match)
861 (loop for variant-list in (mh-variants) 861 (cl-loop for variant-list in (mh-variants)
862 when (eq variant (cadr (assoc 'variant (cdr variant-list)))) 862 when (eq variant (cadr (assoc 'variant (cdr variant-list))))
863 return (let* ((version (car variant-list)) 863 return (let* ((version (car variant-list))
864 (alist (cdr variant-list)) 864 (alist (cdr variant-list))
865 (lib-progs (cadr (assoc 'mh-lib-progs alist))) 865 (lib-progs (cadr (assoc 'mh-lib-progs alist)))
866 (lib (cadr (assoc 'mh-lib alist))) 866 (lib (cadr (assoc 'mh-lib alist)))
867 (progs (cadr (assoc 'mh-progs alist))) 867 (progs (cadr (assoc 'mh-progs alist)))
868 (flists (cadr (assoc 'flists alist)))) 868 (flists (cadr (assoc 'flists alist))))
869 ;;(set-default mh-variant flavor) 869 ;;(set-default mh-variant flavor)
870 (setq mh-x-mailer-string nil 870 (setq mh-x-mailer-string nil
871 mh-flists-present-flag flists 871 mh-flists-present-flag flists
872 mh-lib-progs lib-progs 872 mh-lib-progs lib-progs
873 mh-lib lib 873 mh-lib lib
874 mh-progs progs 874 mh-progs progs
875 mh-variant-in-use version) 875 mh-variant-in-use version)
876 t))))) 876 t)))))
877 877
878(defun mh-variant-p (&rest variants) 878(defun mh-variant-p (&rest variants)
879 "Return t if variant is any of VARIANTS. 879 "Return t if variant is any of VARIANTS.
@@ -1706,9 +1706,9 @@ The function is always called with SYMBOL bound to
1706 (set symbol value) ;XXX shouldn't this be set-default? 1706 (set symbol value) ;XXX shouldn't this be set-default?
1707 (setq mh-junk-choice 1707 (setq mh-junk-choice
1708 (or value 1708 (or value
1709 (loop for element in mh-junk-function-alist 1709 (cl-loop for element in mh-junk-function-alist
1710 until (executable-find (symbol-name (car element))) 1710 until (executable-find (symbol-name (car element)))
1711 finally return (car element))))) 1711 finally return (car element)))))
1712 1712
1713(defcustom-mh mh-junk-background nil 1713(defcustom-mh mh-junk-background nil
1714 "If on, spam programs are run in background. 1714 "If on, spam programs are run in background.
@@ -2885,9 +2885,9 @@ removed and entries from `mh-invisible-header-fields' are added."
2885 (when mh-invisible-header-fields-default 2885 (when mh-invisible-header-fields-default
2886 ;; Remove entries from `mh-invisible-header-fields-default' 2886 ;; Remove entries from `mh-invisible-header-fields-default'
2887 (setq fields 2887 (setq fields
2888 (loop for x in fields 2888 (cl-loop for x in fields
2889 unless (member x mh-invisible-header-fields-default) 2889 unless (member x mh-invisible-header-fields-default)
2890 collect x))) 2890 collect x)))
2891 (when (and (boundp 'mh-invisible-header-fields) 2891 (when (and (boundp 'mh-invisible-header-fields)
2892 mh-invisible-header-fields) 2892 mh-invisible-header-fields)
2893 (dolist (x mh-invisible-header-fields) 2893 (dolist (x mh-invisible-header-fields)
@@ -3605,16 +3605,17 @@ specified colors."
3605 new-spec) 3605 new-spec)
3606 ;; Remove entries with min-colors, or delete them if we have 3606 ;; Remove entries with min-colors, or delete them if we have
3607 ;; fewer colors than they specify. 3607 ;; fewer colors than they specify.
3608 (loop for entry in (reverse spec) do 3608 (cl-loop
3609 (let ((requirement (if (eq (car entry) t) 3609 for entry in (reverse spec) do
3610 nil 3610 (let ((requirement (if (eq (car entry) t)
3611 (assq 'min-colors (car entry))))) 3611 nil
3612 (if requirement 3612 (assq 'min-colors (car entry)))))
3613 (when (>= cells (nth 1 requirement)) 3613 (if requirement
3614 (setq new-spec (cons (cons (delq requirement (car entry)) 3614 (when (>= cells (nth 1 requirement))
3615 (cdr entry)) 3615 (setq new-spec (cons (cons (delq requirement (car entry))
3616 new-spec))) 3616 (cdr entry))
3617 (setq new-spec (cons entry new-spec))))) 3617 new-spec)))
3618 (setq new-spec (cons entry new-spec)))))
3618 new-spec)))) 3619 new-spec))))
3619 3620
3620(defface-mh mh-folder-address 3621(defface-mh mh-folder-address
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index 5b4c34fb6a8..7e7918e6c2e 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -31,7 +31,6 @@
31 31
32(require 'mh-e) 32(require 'mh-e)
33(require 'mh-scan) 33(require 'mh-scan)
34(mh-require-cl)
35 34
36;; Dynamically-created functions not found in mh-loaddefs.el. 35;; Dynamically-created functions not found in mh-loaddefs.el.
37(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar") 36(autoload 'mh-tool-bar-folder-buttons-init "mh-tool-bar")
@@ -80,16 +79,14 @@ the MH mail system."
80 (add-to-list 'desktop-buffer-mode-handlers 79 (add-to-list 'desktop-buffer-mode-handlers
81 '(mh-folder-mode . mh-restore-desktop-buffer))) 80 '(mh-folder-mode . mh-restore-desktop-buffer)))
82 81
83(defun mh-restore-desktop-buffer (desktop-buffer-file-name 82(defun mh-restore-desktop-buffer (_file-name name _misc)
84 desktop-buffer-name
85 desktop-buffer-misc)
86 "Restore an MH folder buffer specified in a desktop file. 83 "Restore an MH folder buffer specified in a desktop file.
87When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the 84When desktop creates a buffer, FILE-NAME holds the
88file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer 85file name to visit, NAME holds the desired buffer
89name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info 86name, and MISC holds a list of miscellaneous info
90used by the `desktop-buffer-mode-handlers' functions." 87used by the `desktop-buffer-mode-handlers' functions."
91 (mh-find-path) 88 (mh-find-path)
92 (mh-visit-folder desktop-buffer-name) 89 (mh-visit-folder name)
93 (current-buffer)) 90 (current-buffer))
94 91
95 92
@@ -932,9 +929,9 @@ many unread messages to skip."
932 (setq count (1- count))) 929 (setq count (1- count)))
933 (not (car unread-sequence))) 930 (not (car unread-sequence)))
934 (message "No more unread messages")) 931 (message "No more unread messages"))
935 (t (loop for msg in unread-sequence 932 (t (cl-loop for msg in unread-sequence
936 when (mh-goto-msg msg t) return nil 933 when (mh-goto-msg msg t) return nil
937 finally (message "No more unread messages")))))) 934 finally (message "No more unread messages"))))))
938 935
939;;;###mh-autoload 936;;;###mh-autoload
940(defun mh-page-msg (&optional lines) 937(defun mh-page-msg (&optional lines)
@@ -1030,9 +1027,9 @@ many unread messages to skip."
1030 (setq count (1- count))) 1027 (setq count (1- count)))
1031 (not (car unread-sequence))) 1028 (not (car unread-sequence)))
1032 (message "No more unread messages")) 1029 (message "No more unread messages"))
1033 (t (loop for msg in unread-sequence 1030 (t (cl-loop for msg in unread-sequence
1034 when (mh-goto-msg msg t) return nil 1031 when (mh-goto-msg msg t) return nil
1035 finally (message "No more unread messages")))))) 1032 finally (message "No more unread messages"))))))
1036 1033
1037;;;###mh-autoload 1034;;;###mh-autoload
1038(defun mh-quit () 1035(defun mh-quit ()
@@ -1503,7 +1500,7 @@ function doesn't recenter the folder buffer."
1503 (let ((lines-from-end 2)) 1500 (let ((lines-from-end 2))
1504 (save-excursion 1501 (save-excursion
1505 (while (> (point-max) (progn (forward-line) (point))) 1502 (while (> (point-max) (progn (forward-line) (point)))
1506 (incf lines-from-end))) 1503 (cl-incf lines-from-end)))
1507 (recenter (- lines-from-end)))) 1504 (recenter (- lines-from-end))))
1508 ;; '(4) is the same as C-u prefix argument. 1505 ;; '(4) is the same as C-u prefix argument.
1509 (t (recenter (or arg '(4)))))) 1506 (t (recenter (or arg '(4))))))
@@ -1587,10 +1584,11 @@ after the commands are processed."
1587 ;; Preserve sequences in destination folder... 1584 ;; Preserve sequences in destination folder...
1588 (when mh-refile-preserves-sequences-flag 1585 (when mh-refile-preserves-sequences-flag
1589 (clrhash dest-map) 1586 (clrhash dest-map)
1590 (loop for i from (1+ (or last 0)) 1587 (cl-loop
1591 for msg in (sort (copy-sequence msgs) #'<) 1588 for i from (1+ (or last 0))
1592 do (loop for seq-name in (gethash msg seq-map) 1589 for msg in (sort (copy-sequence msgs) #'<)
1593 do (push i (gethash seq-name dest-map)))) 1590 do (cl-loop for seq-name in (gethash msg seq-map)
1591 do (push i (gethash seq-name dest-map))))
1594 (maphash 1592 (maphash
1595 #'(lambda (seq msgs) 1593 #'(lambda (seq msgs)
1596 ;; Can't be run in the background, since the 1594 ;; Can't be run in the background, since the
@@ -1639,10 +1637,10 @@ after the commands are processed."
1639 (mh-delete-scan-msgs mh-whitelist) 1637 (mh-delete-scan-msgs mh-whitelist)
1640 (when mh-whitelist-preserves-sequences-flag 1638 (when mh-whitelist-preserves-sequences-flag
1641 (clrhash white-map) 1639 (clrhash white-map)
1642 (loop for i from (1+ (or last 0)) 1640 (cl-loop for i from (1+ (or last 0))
1643 for msg in (sort (copy-sequence mh-whitelist) #'<) 1641 for msg in (sort (copy-sequence mh-whitelist) #'<)
1644 do (loop for seq-name in (gethash msg seq-map) 1642 do (cl-loop for seq-name in (gethash msg seq-map)
1645 do (push i (gethash seq-name white-map)))) 1643 do (push i (gethash seq-name white-map))))
1646 (maphash 1644 (maphash
1647 #'(lambda (seq msgs) 1645 #'(lambda (seq msgs)
1648 ;; Can't be run in background, since the current 1646 ;; Can't be run in background, since the current
@@ -1922,10 +1920,11 @@ exist."
1922 (from (or (message-fetch-field "from") "")) 1920 (from (or (message-fetch-field "from") ""))
1923 folder-name) 1921 folder-name)
1924 (setq folder-name 1922 (setq folder-name
1925 (loop for list in mh-default-folder-list 1923 (cl-loop for list in mh-default-folder-list
1926 when (string-match (nth 0 list) (if (nth 2 list) to/cc from)) 1924 when (string-match (nth 0 list)
1927 return (nth 1 list) 1925 (if (nth 2 list) to/cc from))
1928 finally return nil)) 1926 return (nth 1 list)
1927 finally return nil))
1929 1928
1930 ;; Make sure a result from `mh-default-folder-list' begins with "+" 1929 ;; Make sure a result from `mh-default-folder-list' begins with "+"
1931 ;; since 'mh-expand-file-name below depends on it 1930 ;; since 'mh-expand-file-name below depends on it
@@ -2026,8 +2025,8 @@ If MSG is nil then act on the message at point"
2026 (t 2025 (t
2027 (dolist (folder-msg-list mh-refile-list) 2026 (dolist (folder-msg-list mh-refile-list)
2028 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) 2027 (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list))))
2029 (setq mh-refile-list (loop for x in mh-refile-list 2028 (setq mh-refile-list (cl-loop for x in mh-refile-list
2030 unless (null (cdr x)) collect x)))) 2029 unless (null (cdr x)) collect x))))
2031 (mh-notate nil ? mh-cmd-note))) 2030 (mh-notate nil ? mh-cmd-note)))
2032 2031
2033;;;###mh-autoload 2032;;;###mh-autoload
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 9f603c0c710..1b3883db522 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."
123 (message "Folder %s removed" folder)) 123 (message "Folder %s removed" folder))
124 (message "Folder not removed"))) 124 (message "Folder not removed")))
125 125
126(defun mh-rmf-daemon (process output) 126(defun mh-rmf-daemon (_process output)
127 "The rmf PROCESS puts OUTPUT in temporary buffer. 127 "The rmf PROCESS puts OUTPUT in temporary buffer.
128Display the results only if something went wrong." 128Display the results only if something went wrong."
129 (set-buffer (get-buffer-create mh-temp-buffer)) 129 (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 61d531fe995..1ca90d92a73 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -79,7 +79,7 @@
79;; Function from mm-decode.el used in PGP messages. Just define it with older 79;; Function from mm-decode.el used in PGP messages. Just define it with older
80;; Gnus to avoid compiler warning. 80;; Gnus to avoid compiler warning.
81(defun-mh mh-mm-possibly-verify-or-decrypt 81(defun-mh mh-mm-possibly-verify-or-decrypt
82 mm-possibly-verify-or-decrypt (parts ctl) 82 mm-possibly-verify-or-decrypt (_parts _ctl)
83 nil) 83 nil)
84 84
85;; Copy of macro in mm-decode.el. 85;; Copy of macro in mm-decode.el.
@@ -110,16 +110,16 @@
110 (and (> (current-column) length) 110 (and (> (current-column) length)
111 (current-column)))) 111 (current-column))))
112 112
113(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) 113(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (_handle)
114 ;; Released Gnus doesn't keep handles associated with externally displayed 114 ;; Released Gnus doesn't keep handles associated with externally displayed
115 ;; MIME parts. So this will always return nil. 115 ;; MIME parts. So this will always return nil.
116 nil) 116 nil)
117 117
118(defun-mh mh-mm-destroy-parts mm-destroy-parts (list) 118(defun-mh mh-mm-destroy-parts mm-destroy-parts (_list)
119 "Older versions of Emacs don't have this function." 119 "Older versions of Emacs don't have this function."
120 nil) 120 nil)
121 121
122(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) 122(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (_handles)
123 "Emacs 21 and XEmacs don't have this function." 123 "Emacs 21 and XEmacs don't have this function."
124 nil) 124 nil)
125 125
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index 1d929e8f990..0b698395756 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -205,7 +205,7 @@ See `mh-identity-list'."
205 (setq mh-identity-local identity)))) 205 (setq mh-identity-local identity))))
206 206
207;;;###mh-autoload 207;;;###mh-autoload
208(defun mh-identity-handler-gpg-identity (field action &optional value) 208(defun mh-identity-handler-gpg-identity (_field action &optional value)
209 "Process header FIELD \":pgg-default-user-id\". 209 "Process header FIELD \":pgg-default-user-id\".
210The ACTION is one of `remove' or `add'. If `add', the VALUE is added. 210The ACTION is one of `remove' or `add'. If `add', the VALUE is added.
211The buffer-local variable `mh-identity-pgg-default-user-id' is set to 211The buffer-local variable `mh-identity-pgg-default-user-id' is set to
@@ -219,7 +219,7 @@ VALUE when action `add' is selected."
219 (setq mh-identity-pgg-default-user-id value)))) 219 (setq mh-identity-pgg-default-user-id value))))
220 220
221;;;###mh-autoload 221;;;###mh-autoload
222(defun mh-identity-handler-signature (field action &optional value) 222(defun mh-identity-handler-signature (_field action &optional value)
223 "Process header FIELD \":signature\". 223 "Process header FIELD \":signature\".
224The ACTION is one of `remove' or `add'. If `add', the VALUE is 224The ACTION is one of `remove' or `add'. If `add', the VALUE is
225added." 225added."
@@ -250,7 +250,7 @@ added."
250 "Marker for the end of the attribution verb.") 250 "Marker for the end of the attribution verb.")
251 251
252;;;###mh-autoload 252;;;###mh-autoload
253(defun mh-identity-handler-attribution-verb (field action &optional value) 253(defun mh-identity-handler-attribution-verb (_field action &optional value)
254 "Process header FIELD \":attribution-verb\". 254 "Process header FIELD \":attribution-verb\".
255The ACTION is one of `remove' or `add'. If `add', the VALUE is 255The ACTION is one of `remove' or `add'. If `add', the VALUE is
256added." 256added."
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index 21034bc5501..9d7b719e09f 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -33,7 +33,6 @@
33;;; Code: 33;;; Code:
34 34
35(require 'mh-e) 35(require 'mh-e)
36(mh-require-cl)
37 36
38(defvar mh-inc-spool-map-help nil 37(defvar mh-inc-spool-map-help nil
39 "Help text for `mh-inc-spool-map'.") 38 "Help text for `mh-inc-spool-map'.")
@@ -51,13 +50,13 @@
51 "Make all commands and defines keys for contents of `mh-inc-spool-list'." 50 "Make all commands and defines keys for contents of `mh-inc-spool-list'."
52 (setq mh-inc-spool-map-help nil) 51 (setq mh-inc-spool-map-help nil)
53 (when mh-inc-spool-list 52 (when mh-inc-spool-list
54 (loop for elem in mh-inc-spool-list 53 (cl-loop for elem in mh-inc-spool-list
55 do (let ((spool (nth 0 elem)) 54 do (let ((spool (nth 0 elem))
56 (folder (nth 1 elem)) 55 (folder (nth 1 elem))
57 (key (nth 2 elem))) 56 (key (nth 2 elem)))
58 (progn 57 (progn
59 (mh-inc-spool-generator folder spool) 58 (mh-inc-spool-generator folder spool)
60 (mh-inc-spool-def-key key folder)))))) 59 (mh-inc-spool-def-key key folder))))))
61 60
62(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make) 61(defalias 'mh-inc-spool-make-no-autoload 'mh-inc-spool-make)
63 62
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index db80f90494e..f3ae91907bf 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -32,7 +32,6 @@
32 32
33(require 'mh-e) 33(require 'mh-e)
34(require 'mh-scan) 34(require 'mh-scan)
35(mh-require-cl)
36 35
37;;;###mh-autoload 36;;;###mh-autoload
38(defun mh-junk-blacklist (range) 37(defun mh-junk-blacklist (range)
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index ee6fa83abb6..8d1e5427623 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -30,7 +30,6 @@
30;;; Code: 30;;; Code:
31 31
32(require 'mh-e) 32(require 'mh-e)
33(mh-require-cl)
34(require 'mh-scan) 33(require 'mh-scan)
35 34
36(autoload 'message-fetch-field "message") 35(autoload 'message-fetch-field "message")
@@ -126,8 +125,8 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
126 (mh-quote-pick-expr (mh-current-message-header-field 'subject))))) 125 (mh-quote-pick-expr (mh-current-message-header-field 'subject)))))
127 (setq pick-expr 126 (setq pick-expr
128 (let ((case-fold-search t)) 127 (let ((case-fold-search t))
129 (loop for s in pick-expr 128 (cl-loop for s in pick-expr
130 collect (mh-replace-regexp-in-string "re: *" "" s)))) 129 collect (mh-replace-regexp-in-string "re: *" "" s))))
131 (mh-narrow-to-header-field 'subject pick-expr)) 130 (mh-narrow-to-header-field 'subject pick-expr))
132 131
133;;;###mh-autoload 132;;;###mh-autoload
@@ -249,7 +248,7 @@ Return number of messages put in the sequence:
249(defun mh-edit-pick-expr (default) 248(defun mh-edit-pick-expr (default)
250 "With prefix arg edit a pick expression. 249 "With prefix arg edit a pick expression.
251If no prefix arg is given, then return DEFAULT." 250If no prefix arg is given, then return DEFAULT."
252 (let ((default-string (loop for x in default concat (format " %s" x)))) 251 (let ((default-string (cl-loop for x in default concat (format " %s" x))))
253 (if (or current-prefix-arg (equal default-string "")) 252 (if (or current-prefix-arg (equal default-string ""))
254 (mh-pick-args-list (read-string "Pick expression: " 253 (mh-pick-args-list (read-string "Pick expression: "
255 default-string)) 254 default-string))
@@ -291,18 +290,18 @@ For example, the string \"-subject a b c -from Joe User
291 (let* ((field (or (message-fetch-field (format "%s" header-field)) 290 (let* ((field (or (message-fetch-field (format "%s" header-field))
292 "")) 291 ""))
293 (field-option (format "-%s" header-field)) 292 (field-option (format "-%s" header-field))
294 (patterns (loop for x in (split-string field "[ ]*,[ ]*") 293 (patterns (cl-loop for x in (split-string field "[ ]*,[ ]*")
295 unless (equal x "") 294 unless (equal x "")
296 collect (if (string-match "<\\(.*@.*\\)>" x) 295 collect (if (string-match "<\\(.*@.*\\)>" x)
297 (match-string 1 x) 296 (match-string 1 x)
298 x)))) 297 x))))
299 (when patterns 298 (when patterns
300 (loop with accum = `(,field-option ,(car patterns)) 299 (cl-loop with accum = `(,field-option ,(car patterns))
301 for e in (cdr patterns) 300 for e in (cdr patterns)
302 do (setq accum `(,field-option ,e "-or" ,@accum)) 301 do (setq accum `(,field-option ,e "-or" ,@accum))
303 finally return accum)))))))) 302 finally return accum))))))))
304 303
305(defun mh-narrow-to-header-field (header-field pick-expr) 304(defun mh-narrow-to-header-field (_header-field pick-expr)
306 "Limit to messages whose HEADER-FIELD match PICK-EXPR. 305 "Limit to messages whose HEADER-FIELD match PICK-EXPR.
307The MH command pick is used to do the match." 306The MH command pick is used to do the match."
308 (let ((folder mh-current-folder) 307 (let ((folder mh-current-folder)
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 6f126967fec..d74e79f1cb0 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -77,7 +77,7 @@
77 '(gethash (current-buffer) mh-globals-hash)) 77 '(gethash (current-buffer) mh-globals-hash))
78 78
79;; Structure to keep track of MIME handles on a per buffer basis. 79;; Structure to keep track of MIME handles on a per buffer basis.
80(mh-defstruct (mh-buffer-data (:conc-name mh-mime-) 80(cl-defstruct (mh-buffer-data (:conc-name mh-mime-)
81 (:constructor mh-make-buffer-data)) 81 (:constructor mh-make-buffer-data))
82 (handles ()) ; List of MIME handles 82 (handles ()) ; List of MIME handles
83 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of 83 (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."
611 "Choose among the alternatives, HANDLES the part that will be displayed. 611 "Choose among the alternatives, HANDLES the part that will be displayed.
612If no part is preferred then all the parts are displayed." 612If no part is preferred then all the parts are displayed."
613 (let* ((preferred (mm-preferred-alternative handles)) 613 (let* ((preferred (mm-preferred-alternative handles))
614 (others (loop for x in handles unless (eq x preferred) collect x))) 614 (others (cl-loop for x in handles unless (eq x preferred) collect x)))
615 (cond ((and preferred 615 (cond ((and preferred
616 (stringp (car preferred))) 616 (stringp (car preferred)))
617 (mh-mime-display-part preferred) 617 (mh-mime-display-part preferred)
@@ -770,7 +770,7 @@ buttons need to be displayed multiple times (for instance when
770nested messages are opened)." 770nested messages are opened)."
771 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) 771 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
772 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) 772 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data)))
773 (incf (mh-mime-parts-count (mh-buffer-data)))))) 773 (cl-incf (mh-mime-parts-count (mh-buffer-data))))))
774 774
775(defun mh-small-image-p (handle) 775(defun mh-small-image-p (handle)
776 "Decide whether HANDLE is a \"small\" image that can be displayed inline. 776 "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."
839 839
840;; Shush compiler. 840;; Shush compiler.
841(mh-do-in-xemacs 841(mh-do-in-xemacs
842 (defvar dots) 842 (defvar ov))
843 (defvar type)
844 (defvar ov))
845 843
846(defun mh-insert-mime-button (handle index displayed) 844(defun mh-insert-mime-button (handle index displayed)
847 "Insert MIME button for HANDLE. 845 "Insert MIME button for HANDLE.
@@ -857,23 +855,27 @@ by commands like \"K v\" which operate on individual MIME parts."
857 (mail-content-type-get (mm-handle-type handle) 'url) 855 (mail-content-type-get (mm-handle-type handle) 'url)
858 "")) 856 ""))
859 (type (mm-handle-media-type handle)) 857 (type (mm-handle-media-type handle))
860 (description (mail-decode-encoded-word-string 858 begin end)
861 (or (mm-handle-description handle) "")))
862 (dots (if (or displayed (mm-handle-displayed-p handle)) " " "..."))
863 long-type begin end)
864 (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) 859 (if (string-match ".*/" name) (setq name (substring name (match-end 0))))
865 (setq long-type (concat type (and (not (equal name "")) 860 ;; These vars are passed by dynamic-scoping to
866 (concat "; " name)))) 861 ;; mh-mime-button-line-format-alist via gnus-eval-format.
867 (unless (equal description "") 862 (mh-dlet* ((index index)
868 (setq long-type (concat " --- " long-type))) 863 (description (mail-decode-encoded-word-string
869 (unless (bolp) (insert "\n")) 864 (or (mm-handle-description handle) "")))
870 (setq begin (point)) 865 (dots (if (or displayed (mm-handle-displayed-p handle))
871 (gnus-eval-format 866 " " "..."))
872 mh-mime-button-line-format mh-mime-button-line-format-alist 867 (long-type (concat type (and (not (equal name ""))
873 `(,@(mh-gnus-local-map-property mh-mime-button-map) 868 (concat "; " name)))))
869 (unless (equal description "")
870 (setq long-type (concat " --- " long-type)))
871 (unless (bolp) (insert "\n"))
872 (setq begin (point))
873 (gnus-eval-format
874 mh-mime-button-line-format mh-mime-button-line-format-alist
875 `(,@(mh-gnus-local-map-property mh-mime-button-map)
874 mh-callback mh-mm-display-part 876 mh-callback mh-mm-display-part
875 mh-part ,index 877 mh-part ,index
876 mh-data ,handle)) 878 mh-data ,handle)))
877 (setq end (point)) 879 (setq end (point))
878 (widget-convert-button 880 (widget-convert-button
879 'link begin end 881 'link begin end
@@ -888,8 +890,6 @@ by commands like \"K v\" which operate on individual MIME parts."
888;; Shush compiler. 890;; Shush compiler.
889(defvar mm-verify-function-alist) ; < Emacs 22 891(defvar mm-verify-function-alist) ; < Emacs 22
890(defvar mm-decrypt-function-alist) ; < Emacs 22 892(defvar mm-decrypt-function-alist) ; < Emacs 22
891(mh-do-in-xemacs
892 (defvar pressed-details))
893 893
894(defun mh-insert-mime-security-button (handle) 894(defun mh-insert-mime-security-button (handle)
895 "Display buttons for PGP message, HANDLE." 895 "Display buttons for PGP message, HANDLE."
@@ -897,42 +897,47 @@ by commands like \"K v\" which operate on individual MIME parts."
897 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) 897 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist))
898 (nth 2 (assoc protocol mm-decrypt-function-alist)) 898 (nth 2 (assoc protocol mm-decrypt-function-alist))
899 "Unknown")) 899 "Unknown"))
900 (type (concat crypto-type 900 begin end face)
901 (if (equal (car handle) "multipart/signed") 901 ;; These vars are passed by dynamic-scoping to
902 " Signed" " Encrypted") 902 ;; mh-mime-security-button-line-format-alist via gnus-eval-format.
903 " Part")) 903 (mh-dlet* ((type (concat crypto-type
904 (info (or (mh-mm-handle-multipart-ctl-parameter handle 'gnus-info) 904 (if (equal (car handle) "multipart/signed")
905 "Undecided")) 905 " Signed" " Encrypted")
906 (details (mh-mm-handle-multipart-ctl-parameter handle 'gnus-details)) 906 " Part"))
907 pressed-details begin end face) 907 (info (or (mh-mm-handle-multipart-ctl-parameter
908 (setq details (if details (concat "\n" details) "")) 908 handle 'gnus-info)
909 (setq pressed-details (if mh-mime-security-button-pressed details "")) 909 "Undecided"))
910 (setq face (mh-mime-security-button-face info)) 910 (details (mh-mm-handle-multipart-ctl-parameter
911 (unless (bolp) (insert "\n")) 911 handle 'gnus-details))
912 (setq begin (point)) 912 pressed-details)
913 (gnus-eval-format 913 (setq details (if details (concat "\n" details) ""))
914 mh-mime-security-button-line-format 914 (setq pressed-details (if mh-mime-security-button-pressed details ""))
915 mh-mime-security-button-line-format-alist 915 (setq face (mh-mime-security-button-face info))
916 `(,@(mh-gnus-local-map-property mh-mime-security-button-map) 916 (unless (bolp) (insert "\n"))
917 (setq begin (point))
918 (gnus-eval-format
919 mh-mime-security-button-line-format
920 mh-mime-security-button-line-format-alist
921 `(,@(mh-gnus-local-map-property mh-mime-security-button-map)
917 mh-button-pressed ,mh-mime-security-button-pressed 922 mh-button-pressed ,mh-mime-security-button-pressed
918 mh-callback mh-mime-security-press-button 923 mh-callback mh-mime-security-press-button
919 mh-line-format ,mh-mime-security-button-line-format 924 mh-line-format ,mh-mime-security-button-line-format
920 mh-data ,handle)) 925 mh-data ,handle))
921 (setq end (point)) 926 (setq end (point))
922 (widget-convert-button 'link begin end 927 (widget-convert-button 'link begin end
923 :mime-handle handle 928 :mime-handle handle
924 :action 'mh-widget-press-button 929 :action 'mh-widget-press-button
925 :button-keymap mh-mime-security-button-map 930 :button-keymap mh-mime-security-button-map
926 :button-face face 931 :button-face face
927 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") 932 :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
928 (dolist (ov (mh-funcall-if-exists overlays-in begin end)) 933 (dolist (ov (mh-funcall-if-exists overlays-in begin end))
929 (mh-funcall-if-exists overlay-put ov 'evaporate t)) 934 (mh-funcall-if-exists overlay-put ov 'evaporate t))
930 (when (equal info "Failed") 935 (when (equal info "Failed")
931 (let* ((type (if (equal (car handle) "multipart/signed") 936 (let* ((type (if (equal (car handle) "multipart/signed")
932 "verification" "decryption")) 937 "verification" "decryption"))
933 (warning (if (equal type "decryption") 938 (warning (if (equal type "decryption")
934 "(passphrase may be incorrect)" ""))) 939 "(passphrase may be incorrect)" "")))
935 (message "%s %s failed %s" crypto-type type warning))))) 940 (message "%s %s failed %s" crypto-type type warning))))))
936 941
937(defun mh-mime-security-button-face (info) 942(defun mh-mime-security-button-face (info)
938 "Return the button face to use for encrypted/signed mail based on INFO." 943 "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
995then that function must return non-nil at the button we stop." 1000then that function must return non-nil at the button we stop."
996 (unless (or (and (symbolp criterion) (fboundp criterion)) 1001 (unless (or (and (symbolp criterion) (fboundp criterion))
997 (functionp criterion)) 1002 (functionp criterion))
998 (setq criterion (lambda (x) t))) 1003 (setq criterion (lambda (_) t)))
999 ;; Move to the next button in the buffer satisfying criterion 1004 ;; Move to the next button in the buffer satisfying criterion
1000 (goto-char (or (save-excursion 1005 (goto-char (or (save-excursion
1001 (beginning-of-line) 1006 (beginning-of-line)
@@ -1015,7 +1020,7 @@ then that function must return non-nil at the button we stop."
1015 (not (if backward-flag (bobp) (eobp)))) 1020 (not (if backward-flag (bobp) (eobp))))
1016 (forward-line (if backward-flag -1 1))) 1021 (forward-line (if backward-flag -1 1)))
1017 ;; Stop at next MIME button if any exists. 1022 ;; Stop at next MIME button if any exists.
1018 (block loop 1023 (cl-block loop
1019 (while (/= (progn 1024 (while (/= (progn
1020 (unless (= (forward-line 1025 (unless (= (forward-line
1021 (if backward-flag -1 1)) 1026 (if backward-flag -1 1))
@@ -1028,11 +1033,11 @@ then that function must return non-nil at the button we stop."
1028 point-before-current-button) 1033 point-before-current-button)
1029 (when (and (get-text-property (point) 'mh-data) 1034 (when (and (get-text-property (point) 'mh-data)
1030 (funcall criterion (point))) 1035 (funcall criterion (point)))
1031 (return-from loop (point)))) 1036 (cl-return-from loop (point))))
1032 nil))) 1037 nil)))
1033 (point)))) 1038 (point))))
1034 1039
1035(defun mh-widget-press-button (widget el) 1040(defun mh-widget-press-button (widget _el)
1036 "Callback for widget, WIDGET. 1041 "Callback for widget, WIDGET.
1037Parameter EL is unused." 1042Parameter EL is unused."
1038 (goto-char (widget-get widget :from)) 1043 (goto-char (widget-get widget :from))
@@ -1596,7 +1601,7 @@ the possible security methods (see `mh-mml-method-default')."
1596 nil t nil 'mh-mml-cryptographic-method-history def)) 1601 nil t nil 'mh-mml-cryptographic-method-history def))
1597 mh-mml-method-default)) 1602 mh-mml-method-default))
1598 1603
1599(defun mh-secure-message (method mode &optional identity) 1604(defun mh-secure-message (method mode &optional _identity)
1600 "Add tag to encrypt or sign message. 1605 "Add tag to encrypt or sign message.
1601 1606
1602METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". 1607METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
@@ -1697,19 +1702,19 @@ buffer, while END defaults to the end of the buffer."
1697 (unless begin (setq begin (point-min))) 1702 (unless begin (setq begin (point-min)))
1698 (unless end (setq end (point-max))) 1703 (unless end (setq end (point-max)))
1699 (save-excursion 1704 (save-excursion
1700 (block search-for-mh-directive 1705 (cl-block search-for-mh-directive
1701 (goto-char begin) 1706 (goto-char begin)
1702 (while (re-search-forward "^#" end t) 1707 (while (re-search-forward "^#" end t)
1703 (let ((s (buffer-substring-no-properties 1708 (let ((s (buffer-substring-no-properties
1704 (point) (mh-line-end-position)))) 1709 (point) (mh-line-end-position))))
1705 (cond ((equal s "")) 1710 (cond ((equal s ""))
1706 ((string-match "^forw[ \t\n]+" s) 1711 ((string-match "^forw[ \t\n]+" s)
1707 (return-from search-for-mh-directive t)) 1712 (cl-return-from search-for-mh-directive t))
1708 (t (let ((first-token (car (split-string s "[ \t;@]")))) 1713 (t (let ((first-token (car (split-string s "[ \t;@]"))))
1709 (when (and first-token 1714 (when (and first-token
1710 (string-match mh-media-type-regexp 1715 (string-match mh-media-type-regexp
1711 first-token)) 1716 first-token))
1712 (return-from search-for-mh-directive t))))))) 1717 (cl-return-from search-for-mh-directive t)))))))
1713 nil))) 1718 nil)))
1714 1719
1715(defun mh-minibuffer-read-type (filename &optional default) 1720(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 ca74b2e936e..596f00961b2 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -44,7 +44,6 @@
44;;; Code: 44;;; Code:
45 45
46(require 'mh-e) 46(require 'mh-e)
47(mh-require-cl)
48 47
49(require 'gnus-util) 48(require 'gnus-util)
50(require 'imenu) 49(require 'imenu)
@@ -227,17 +226,17 @@ folder containing the index search results."
227 mh-search-regexp-builder) 226 mh-search-regexp-builder)
228 (current-window-configuration) 227 (current-window-configuration)
229 nil))) 228 nil)))
230 (block mh-search 229 (cl-block mh-search
231 ;; Redoing a sequence search? 230 ;; Redoing a sequence search?
232 (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag 231 (when (and redo-search-flag mh-index-data mh-index-sequence-search-flag
233 (not mh-flists-called-flag)) 232 (not mh-flists-called-flag))
234 (let ((mh-flists-called-flag t)) 233 (let ((mh-flists-called-flag t))
235 (apply #'mh-index-sequenced-messages mh-index-previous-search)) 234 (apply #'mh-index-sequenced-messages mh-index-previous-search))
236 (return-from mh-search)) 235 (cl-return-from mh-search))
237 ;; We have fancy query parsing. 236 ;; We have fancy query parsing.
238 (when (symbolp search-regexp) 237 (when (symbolp search-regexp)
239 (mh-search-folder folder window-config) 238 (mh-search-folder folder window-config)
240 (return-from mh-search)) 239 (cl-return-from mh-search))
241 ;; Begin search proper. 240 ;; Begin search proper.
242 (mh-checksum-choose) 241 (mh-checksum-choose)
243 (let ((result-count 0) 242 (let ((result-count 0)
@@ -264,21 +263,22 @@ folder containing the index search results."
264 ;; Parse searcher output. 263 ;; Parse searcher output.
265 (message "Processing %s output... " mh-searcher) 264 (message "Processing %s output... " mh-searcher)
266 (goto-char (point-min)) 265 (goto-char (point-min))
267 (loop for next-result = (funcall mh-search-next-result-function) 266 (cl-loop for next-result = (funcall mh-search-next-result-function)
268 while next-result 267 while next-result
269 do (unless (eq next-result 'error) 268 do (unless (eq next-result 'error)
270 (unless (gethash (car next-result) folder-results-map) 269 (unless (gethash (car next-result) folder-results-map)
271 (setf (gethash (car next-result) folder-results-map) 270 (setf (gethash (car next-result) folder-results-map)
272 (make-hash-table :test #'equal))) 271 (make-hash-table :test #'equal)))
273 (setf (gethash (cadr next-result) 272 (setf (gethash (cadr next-result)
274 (gethash (car next-result) folder-results-map)) 273 (gethash (car next-result) folder-results-map))
275 t))) 274 t)))
276 275
277 ;; Copy the search results over. 276 ;; Copy the search results over.
278 (maphash #'(lambda (folder msgs) 277 (maphash #'(lambda (folder msgs)
279 (let ((cur (car (mh-translate-range folder "cur"))) 278 (let ((cur (car (mh-translate-range folder "cur")))
280 (msgs (sort (loop for msg being the hash-keys of msgs 279 (msgs (sort (cl-loop
281 collect msg) 280 for msg being the hash-keys of msgs
281 collect msg)
282 #'<))) 282 #'<)))
283 (mh-exec-cmd "refile" msgs "-src" folder 283 (mh-exec-cmd "refile" msgs "-src" folder
284 "-link" index-folder) 284 "-link" index-folder)
@@ -287,10 +287,10 @@ folder containing the index search results."
287 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" 287 (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero"
288 "-sequence" 288 "-sequence"
289 "cur" (format "%s" cur))) 289 "cur" (format "%s" cur)))
290 (loop for msg in msgs 290 (cl-loop for msg in msgs
291 do (incf result-count) 291 do (cl-incf result-count)
292 (setf (gethash result-count origin-map) 292 (setf (gethash result-count origin-map)
293 (cons folder msg))))) 293 (cons folder msg)))))
294 folder-results-map) 294 folder-results-map)
295 295
296 ;; Vist the results folder. 296 ;; Vist the results folder.
@@ -315,14 +315,14 @@ folder containing the index search results."
315 315
316 (message "%s found %s matches in %s folders" 316 (message "%s found %s matches in %s folders"
317 (upcase-initials (symbol-name mh-searcher)) 317 (upcase-initials (symbol-name mh-searcher))
318 (loop for msg-hash being the hash-values of mh-index-data 318 (cl-loop for msg-hash being the hash-values of mh-index-data
319 sum (hash-table-count msg-hash)) 319 sum (hash-table-count msg-hash))
320 (loop for msg-hash being the hash-values of mh-index-data 320 (cl-loop for msg-hash being the hash-values of mh-index-data
321 count (> (hash-table-count msg-hash) 0))))))) 321 count (> (hash-table-count msg-hash) 0)))))))
322 322
323;; Shush compiler. 323;; Shush compiler.
324(mh-do-in-xemacs 324(mh-do-in-xemacs
325 (defvar pick-folder)) 325 (defvar pick-folder)) ;FIXME: Why?
326 326
327(defun mh-search-folder (folder window-config) 327(defun mh-search-folder (folder window-config)
328 "Search FOLDER for messages matching a pattern. 328 "Search FOLDER for messages matching a pattern.
@@ -331,6 +331,7 @@ In a program, argument WINDOW-CONFIG is the current window
331configuration and is used when the search folder is dismissed." 331configuration and is used when the search folder is dismissed."
332 (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t) 332 (interactive (list (mh-prompt-for-folder "Search" mh-current-folder nil nil t)
333 (current-window-configuration))) 333 (current-window-configuration)))
334 ;; FIXME: `pick-folder' is unused!
334 (let ((pick-folder (if (equal folder "+") mh-current-folder folder))) 335 (let ((pick-folder (if (equal folder "+") mh-current-folder folder)))
335 (switch-to-buffer-other-window "search-pattern") 336 (switch-to-buffer-other-window "search-pattern")
336 (if (or (zerop (buffer-size)) 337 (if (or (zerop (buffer-size))
@@ -401,10 +402,8 @@ or nothing to search all folders."
401 mh-ticked-messages-folders))) 402 mh-ticked-messages-folders)))
402 (mh-index-sequenced-messages folders mh-tick-seq)) 403 (mh-index-sequenced-messages folders mh-tick-seq))
403 404
404;; Shush compiler. 405(defvar mh-mairix-folder)
405(mh-do-in-xemacs 406(defvar mh-flists-search-folders)
406 (defvar mh-mairix-folder)
407 (defvar mh-flists-search-folders))
408 407
409;;;###mh-autoload 408;;;###mh-autoload
410(defun mh-index-sequenced-messages (folders sequence) 409(defun mh-index-sequenced-messages (folders sequence)
@@ -471,9 +470,9 @@ recursively. All arguments are IGNORED."
471 (mh-quote-for-shell mh-inbox)) 470 (mh-quote-for-shell mh-inbox))
472 ((eq mh-flists-search-folders nil) "") 471 ((eq mh-flists-search-folders nil) "")
473 ((listp mh-flists-search-folders) 472 ((listp mh-flists-search-folders)
474 (loop for folder in mh-flists-search-folders 473 (cl-loop for folder in mh-flists-search-folders
475 concat 474 concat
476 (concat " " (mh-quote-for-shell folder))))) 475 (concat " " (mh-quote-for-shell folder)))))
477 (if mh-recursive-folders-flag " -recurse" "") 476 (if mh-recursive-folders-flag " -recurse" "")
478 " -sequence " seq " -noshowzero -fast` ; do\n" 477 " -sequence " seq " -noshowzero -fast` ; do\n"
479 (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n" 478 (expand-file-name "mhpath" mh-progs) " \"+$folder\" " seq "\n"
@@ -536,8 +535,9 @@ group of results."
536 (when (or (not (get-buffer folder)) 535 (when (or (not (get-buffer folder))
537 (y-or-n-p (format "Reuse buffer displaying %s? " folder))) 536 (y-or-n-p (format "Reuse buffer displaying %s? " folder)))
538 (mh-visit-folder 537 (mh-visit-folder
539 folder (loop for x being the hash-keys of (gethash folder mh-index-data) 538 folder (cl-loop
540 when (mh-msg-exists-p x folder) collect x))))) 539 for x being the hash-keys of (gethash folder mh-index-data)
540 when (mh-msg-exists-p x folder) collect x)))))
541 541
542 542
543 543
@@ -716,7 +716,7 @@ parsed."
716 ((equal token "or") (push 'or op-stack)) 716 ((equal token "or") (push 'or op-stack))
717 ((equal token "and") (push 'and op-stack)) 717 ((equal token "and") (push 'and op-stack))
718 ((equal token ")") 718 ((equal token ")")
719 (multiple-value-setq (op-stack operand-stack) 719 (cl-multiple-value-setq (op-stack operand-stack)
720 (cl-values-list (mh-index-evaluate op-stack operand-stack))) 720 (cl-values-list (mh-index-evaluate op-stack operand-stack)))
721 (when (eq (car op-stack) 'not) 721 (when (eq (car op-stack) 'not)
722 (setq op-stack (cdr op-stack)) 722 (setq op-stack (cdr op-stack))
@@ -762,12 +762,12 @@ parsed."
762 762
763(defun mh-index-evaluate (op-stack operand-stack) 763(defun mh-index-evaluate (op-stack operand-stack)
764 "Read expression till starting paren based on OP-STACK and OPERAND-STACK." 764 "Read expression till starting paren based on OP-STACK and OPERAND-STACK."
765 (block mh-index-evaluate 765 (cl-block mh-index-evaluate
766 (let (op oper1) 766 (let (op oper1)
767 (while op-stack 767 (while op-stack
768 (setq op (pop op-stack)) 768 (setq op (pop op-stack))
769 (cond ((eq op 'paren) 769 (cond ((eq op 'paren)
770 (return-from mh-index-evaluate (list op-stack operand-stack))) 770 (cl-return-from mh-index-evaluate (list op-stack operand-stack)))
771 ((eq op 'not) 771 ((eq op 'not)
772 (push `(not ,(pop operand-stack)) operand-stack)) 772 (push `(not ,(pop operand-stack)) operand-stack))
773 ((or (eq op 'and) (eq op 'or)) 773 ((or (eq op 'and) (eq op 'or))
@@ -806,7 +806,7 @@ The side-effects of this function are that the variables
806searcher in `mh-search-choices' present on the system. If 806searcher in `mh-search-choices' present on the system. If
807optional argument SEARCHER is present, use it instead of 807optional argument SEARCHER is present, use it instead of
808`mh-search-program'." 808`mh-search-program'."
809 (block nil 809 (cl-block nil
810 (let ((program-alist (cond (searcher 810 (let ((program-alist (cond (searcher
811 (list (assoc searcher mh-search-choices))) 811 (list (assoc searcher mh-search-choices)))
812 (mh-search-program 812 (mh-search-program
@@ -821,7 +821,7 @@ optional argument SEARCHER is present, use it instead of
821 (setq mh-search-function (nth 2 current)) 821 (setq mh-search-function (nth 2 current))
822 (setq mh-search-next-result-function (nth 3 current)) 822 (setq mh-search-next-result-function (nth 3 current))
823 (setq mh-search-regexp-builder (nth 4 current)) 823 (setq mh-search-regexp-builder (nth 4 current))
824 (return mh-searcher)))) 824 (cl-return mh-searcher))))
825 nil))) 825 nil)))
826 826
827;;; Swish++ 827;;; Swish++
@@ -974,31 +974,31 @@ is used to search."
974(defun mh-swish-next-result () 974(defun mh-swish-next-result ()
975 "Get the next result from swish output." 975 "Get the next result from swish output."
976 (prog1 976 (prog1
977 (block nil 977 (cl-block nil
978 (when (or (eobp) (equal (char-after (point)) ?.)) 978 (when (or (eobp) (equal (char-after (point)) ?.))
979 (return nil)) 979 (cl-return nil))
980 (when (equal (char-after (point)) ?#) 980 (when (equal (char-after (point)) ?#)
981 (return 'error)) 981 (cl-return 'error))
982 (let* ((start (search-forward " " (mh-line-end-position) t)) 982 (let* ((start (search-forward " " (mh-line-end-position) t))
983 (end (search-forward " " (mh-line-end-position) t))) 983 (end (search-forward " " (mh-line-end-position) t)))
984 (unless (and start end) 984 (unless (and start end)
985 (return 'error)) 985 (cl-return 'error))
986 (setq end (1- end)) 986 (setq end (1- end))
987 (unless (file-exists-p (buffer-substring-no-properties start end)) 987 (unless (file-exists-p (buffer-substring-no-properties start end))
988 (return 'error)) 988 (cl-return 'error))
989 (unless (search-backward "/" start t) 989 (unless (search-backward "/" start t)
990 (return 'error)) 990 (cl-return 'error))
991 (list (let* ((s (buffer-substring-no-properties start (1+ (point))))) 991 (list (let* ((s (buffer-substring-no-properties start (1+ (point)))))
992 (unless (string-match mh-swish-folder s) 992 (unless (string-match mh-swish-folder s)
993 (return 'error)) 993 (cl-return 'error))
994 (if (and (string-match mh-user-path s) 994 (if (and (string-match mh-user-path s)
995 (< (match-end 0) (1- (length s)))) 995 (< (match-end 0) (1- (length s))))
996 (format "+%s" 996 (format "+%s"
997 (substring s (match-end 0) (1- (length s)))) 997 (substring s (match-end 0) (1- (length s))))
998 (return 'error))) 998 (cl-return 'error)))
999 (let* ((s (buffer-substring-no-properties (1+ (point)) end)) 999 (let* ((s (buffer-substring-no-properties (1+ (point)) end))
1000 (n (ignore-errors (string-to-number s)))) 1000 (n (ignore-errors (string-to-number s))))
1001 (if n n (return 'error))) 1001 (or n (cl-return 'error)))
1002 nil))) 1002 nil)))
1003 (forward-line))) 1003 (forward-line)))
1004 1004
@@ -1051,26 +1051,26 @@ SEARCH-REGEXP-LIST is used to search."
1051(defun mh-mairix-next-result () 1051(defun mh-mairix-next-result ()
1052 "Return next result from mairix output." 1052 "Return next result from mairix output."
1053 (prog1 1053 (prog1
1054 (block nil 1054 (cl-block nil
1055 (when (or (eobp) (and (bolp) (eolp))) 1055 (when (or (eobp) (and (bolp) (eolp)))
1056 (return nil)) 1056 (cl-return nil))
1057 (unless (eq (char-after) ?/) 1057 (unless (eq (char-after) ?/)
1058 (return 'error)) 1058 (cl-return 'error))
1059 (let ((start (point)) 1059 (let ((start (point))
1060 end msg-start) 1060 end msg-start)
1061 (setq end (mh-line-end-position)) 1061 (setq end (mh-line-end-position))
1062 (unless (search-forward mh-mairix-folder end t) 1062 (unless (search-forward mh-mairix-folder end t)
1063 (return 'error)) 1063 (cl-return 'error))
1064 (goto-char (match-beginning 0)) 1064 (goto-char (match-beginning 0))
1065 (unless (equal (point) start) 1065 (unless (equal (point) start)
1066 (return 'error)) 1066 (cl-return 'error))
1067 (goto-char end) 1067 (goto-char end)
1068 (unless (search-backward "/" start t) 1068 (unless (search-backward "/" start t)
1069 (return 'error)) 1069 (cl-return 'error))
1070 (setq msg-start (1+ (point))) 1070 (setq msg-start (1+ (point)))
1071 (goto-char start) 1071 (goto-char start)
1072 (unless (search-forward mh-user-path end t) 1072 (unless (search-forward mh-user-path end t)
1073 (return 'error)) 1073 (cl-return 'error))
1074 (list (format "+%s" (buffer-substring-no-properties 1074 (list (format "+%s" (buffer-substring-no-properties
1075 (point) (1- msg-start))) 1075 (point) (1- msg-start)))
1076 (string-to-number 1076 (string-to-number
@@ -1119,8 +1119,8 @@ REGEXP-LIST is an alist of fields and values."
1119 (cond ((atom expr) `(or (and ,expr))) 1119 (cond ((atom expr) `(or (and ,expr)))
1120 ((eq (car expr) 'or) 1120 ((eq (car expr) 'or)
1121 (cons 'or 1121 (cons 'or
1122 (loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr)) 1122 (cl-loop for e in (mapcar #'mh-mairix-convert-to-sop* (cdr expr))
1123 append (cdr e)))) 1123 append (cdr e))))
1124 ((eq (car expr) 'and) 1124 ((eq (car expr) 'and)
1125 (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr))) 1125 (let ((conjuncts (mapcar #'mh-mairix-convert-to-sop* (cdr expr)))
1126 result next-factor) 1126 result next-factor)
@@ -1196,22 +1196,22 @@ is used to search."
1196(defun mh-namazu-next-result () 1196(defun mh-namazu-next-result ()
1197 "Get the next result from namazu output." 1197 "Get the next result from namazu output."
1198 (prog1 1198 (prog1
1199 (block nil 1199 (cl-block nil
1200 (when (eobp) (return nil)) 1200 (when (eobp) (cl-return nil))
1201 (let ((file-name (buffer-substring-no-properties 1201 (let ((file-name (buffer-substring-no-properties
1202 (point) (mh-line-end-position)))) 1202 (point) (mh-line-end-position))))
1203 (unless (equal (string-match mh-namazu-folder file-name) 0) 1203 (unless (equal (string-match mh-namazu-folder file-name) 0)
1204 (return 'error)) 1204 (cl-return 'error))
1205 (unless (file-exists-p file-name) 1205 (unless (file-exists-p file-name)
1206 (return 'error)) 1206 (cl-return 'error))
1207 (string-match mh-user-path file-name) 1207 (string-match mh-user-path file-name)
1208 (let* ((folder/msg (substring file-name (match-end 0))) 1208 (let* ((folder/msg (substring file-name (match-end 0)))
1209 (mark (mh-search-from-end ?/ folder/msg))) 1209 (mark (mh-search-from-end ?/ folder/msg)))
1210 (unless mark (return 'error)) 1210 (unless mark (cl-return 'error))
1211 (list (format "+%s" (substring folder/msg 0 mark)) 1211 (list (format "+%s" (substring folder/msg 0 mark))
1212 (let ((n (ignore-errors (string-to-number 1212 (let ((n (ignore-errors (string-to-number
1213 (substring folder/msg (1+ mark)))))) 1213 (substring folder/msg (1+ mark))))))
1214 (if n n (return 'error))) 1214 (or n (cl-return 'error)))
1215 nil)))) 1215 nil))))
1216 (forward-line))) 1216 (forward-line)))
1217 1217
@@ -1235,25 +1235,25 @@ is used to search."
1235 (erase-buffer) 1235 (erase-buffer)
1236 (let ((folders 1236 (let ((folders
1237 (mh-folder-list (substring folder-path (length mh-user-path))))) 1237 (mh-folder-list (substring folder-path (length mh-user-path)))))
1238 (loop for folder in folders do 1238 (cl-loop for folder in folders do
1239 (setq folder (concat "+" folder)) 1239 (setq folder (concat "+" folder))
1240 (insert folder "\n") 1240 (insert folder "\n")
1241 (apply #'call-process (expand-file-name "pick" mh-progs) 1241 (apply #'call-process (expand-file-name "pick" mh-progs)
1242 nil '(t nil) nil folder "-list" search-regexp))) 1242 nil '(t nil) nil folder "-list" search-regexp)))
1243 (goto-char (point-min))) 1243 (goto-char (point-min)))
1244 1244
1245(defun mh-pick-next-result () 1245(defun mh-pick-next-result ()
1246 "Return the next pick search result." 1246 "Return the next pick search result."
1247 (prog1 1247 (prog1
1248 (block nil 1248 (cl-block nil
1249 (when (eobp) (return nil)) 1249 (when (eobp) (cl-return nil))
1250 (when (search-forward-regexp "^\\+" (mh-line-end-position) t) 1250 (when (search-forward-regexp "^\\+" (mh-line-end-position) t)
1251 (setq mh-index-pick-folder 1251 (setq mh-index-pick-folder
1252 (buffer-substring-no-properties (mh-line-beginning-position) 1252 (buffer-substring-no-properties (mh-line-beginning-position)
1253 (mh-line-end-position))) 1253 (mh-line-end-position)))
1254 (return 'error)) 1254 (cl-return 'error))
1255 (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t) 1255 (unless (search-forward-regexp "^[1-9][0-9]*$" (mh-line-end-position) t)
1256 (return 'error)) 1256 (cl-return 'error))
1257 (list mh-index-pick-folder 1257 (list mh-index-pick-folder
1258 (string-to-number 1258 (string-to-number
1259 (buffer-substring-no-properties (mh-line-beginning-position) 1259 (buffer-substring-no-properties (mh-line-beginning-position)
@@ -1331,29 +1331,29 @@ Parse it and return the message folder, message index and the
1331match. If no other matches left then return nil. If the current 1331match. If no other matches left then return nil. If the current
1332record is invalid return 'error." 1332record is invalid return 'error."
1333 (prog1 1333 (prog1
1334 (block nil 1334 (cl-block nil
1335 (when (eobp) 1335 (when (eobp)
1336 (return nil)) 1336 (cl-return nil))
1337 (let ((eol-pos (mh-line-end-position)) 1337 (let ((eol-pos (mh-line-end-position))
1338 (bol-pos (mh-line-beginning-position)) 1338 (bol-pos (mh-line-beginning-position))
1339 folder-start msg-end) 1339 folder-start msg-end)
1340 (goto-char bol-pos) 1340 (goto-char bol-pos)
1341 (unless (search-forward mh-user-path eol-pos t) 1341 (unless (search-forward mh-user-path eol-pos t)
1342 (return 'error)) 1342 (cl-return 'error))
1343 (setq folder-start (point)) 1343 (setq folder-start (point))
1344 (unless (search-forward ":" eol-pos t) 1344 (unless (search-forward ":" eol-pos t)
1345 (return 'error)) 1345 (cl-return 'error))
1346 (let ((match (buffer-substring-no-properties (point) eol-pos))) 1346 (let ((match (buffer-substring-no-properties (point) eol-pos)))
1347 (forward-char -1) 1347 (forward-char -1)
1348 (setq msg-end (point)) 1348 (setq msg-end (point))
1349 (unless (search-backward "/" folder-start t) 1349 (unless (search-backward "/" folder-start t)
1350 (return 'error)) 1350 (cl-return 'error))
1351 (list (format "+%s" (buffer-substring-no-properties 1351 (list (format "+%s" (buffer-substring-no-properties
1352 folder-start (point))) 1352 folder-start (point)))
1353 (let ((n (ignore-errors (string-to-number 1353 (let ((n (ignore-errors (string-to-number
1354 (buffer-substring-no-properties 1354 (buffer-substring-no-properties
1355 (1+ (point)) msg-end))))) 1355 (1+ (point)) msg-end)))))
1356 (if n n (return 'error))) 1356 (or n (cl-return 'error)))
1357 match)))) 1357 match))))
1358 (forward-line))) 1358 (forward-line)))
1359 1359
@@ -1369,13 +1369,14 @@ being the list of messages originally from that folder."
1369 (save-excursion 1369 (save-excursion
1370 (goto-char (point-min)) 1370 (goto-char (point-min))
1371 (let ((result-table (make-hash-table :test #'equal))) 1371 (let ((result-table (make-hash-table :test #'equal)))
1372 (loop for msg being the hash-keys of mh-index-msg-checksum-map 1372 (cl-loop for msg being the hash-keys of mh-index-msg-checksum-map
1373 do (push msg (gethash (car (gethash 1373 do (push msg (gethash (car (gethash
1374 (gethash msg mh-index-msg-checksum-map) 1374 (gethash msg
1375 mh-index-checksum-origin-map)) 1375 mh-index-msg-checksum-map)
1376 result-table))) 1376 mh-index-checksum-origin-map))
1377 (loop for x being the hash-keys of result-table 1377 result-table)))
1378 collect (cons x (nreverse (gethash x result-table))))))) 1378 (cl-loop for x being the hash-keys of result-table
1379 collect (cons x (nreverse (gethash x result-table)))))))
1379 1380
1380;;;###mh-autoload 1381;;;###mh-autoload
1381(defun mh-index-insert-folder-headers () 1382(defun mh-index-insert-folder-headers ()
@@ -1443,9 +1444,7 @@ being the list of messages originally from that folder."
1443 "Non-nil means that this folder was generated by searching." 1444 "Non-nil means that this folder was generated by searching."
1444 mh-index-data) 1445 mh-index-data)
1445 1446
1446;; Shush compiler 1447(defvar mh-speed-flists-inhibit-flag)
1447(mh-do-in-xemacs
1448 (defvar mh-speed-flists-inhibit-flag))
1449 1448
1450;;;###mh-autoload 1449;;;###mh-autoload
1451(defun mh-index-execute-commands () 1450(defun mh-index-execute-commands ()
@@ -1478,23 +1477,24 @@ buffer."
1478 (setq mh-refile-list 1477 (setq mh-refile-list
1479 (mapcar (lambda (x) 1478 (mapcar (lambda (x)
1480 (cons (car x) 1479 (cons (car x)
1481 (loop for y in (cdr x) 1480 (cl-loop for y in (cdr x)
1482 unless (memq y msgs) collect y))) 1481 unless (memq y msgs)
1482 collect y)))
1483 old-refile-list) 1483 old-refile-list)
1484 mh-delete-list 1484 mh-delete-list
1485 (loop for x in old-delete-list 1485 (cl-loop for x in old-delete-list
1486 unless (memq x msgs) collect x) 1486 unless (memq x msgs) collect x)
1487 mh-blacklist 1487 mh-blacklist
1488 (loop for x in old-blacklist 1488 (cl-loop for x in old-blacklist
1489 unless (memq x msgs) collect x) 1489 unless (memq x msgs) collect x)
1490 mh-whitelist 1490 mh-whitelist
1491 (loop for x in old-whitelist 1491 (cl-loop for x in old-whitelist
1492 unless (memq x msgs) collect x)) 1492 unless (memq x msgs) collect x))
1493 (mh-set-folder-modified-p (mh-outstanding-commands-p)) 1493 (mh-set-folder-modified-p (mh-outstanding-commands-p))
1494 (when (mh-outstanding-commands-p) 1494 (when (mh-outstanding-commands-p)
1495 (mh-notate-deleted-and-refiled))))))) 1495 (mh-notate-deleted-and-refiled)))))))
1496 (mh-index-matching-source-msgs (append (loop for x in mh-refile-list 1496 (mh-index-matching-source-msgs (append (cl-loop for x in mh-refile-list
1497 append (cdr x)) 1497 append (cdr x))
1498 mh-delete-list 1498 mh-delete-list
1499 mh-blacklist 1499 mh-blacklist
1500 mh-whitelist) 1500 mh-whitelist)
@@ -1565,12 +1565,12 @@ If the folder returned doesn't exist then it is created."
1565 (unless (mh-folder-name-p name) 1565 (unless (mh-folder-name-p name)
1566 (error "The argument should be a valid MH folder name")) 1566 (error "The argument should be a valid MH folder name"))
1567 (let ((chosen-name 1567 (let ((chosen-name
1568 (loop for i from 1 1568 (cl-loop for i from 1
1569 for candidate = (if (equal i 1) name (format "%s-%s" name i)) 1569 for candidate = (if (equal i 1) name (format "%s-%s" name i))
1570 when (or (not (mh-folder-exists-p candidate)) 1570 when (or (not (mh-folder-exists-p candidate))
1571 (equal (mh-index-folder-search-regexp candidate) 1571 (equal (mh-index-folder-search-regexp candidate)
1572 search-regexp)) 1572 search-regexp))
1573 return candidate))) 1573 return candidate)))
1574 ;; Do pending refiles/deletes... 1574 ;; Do pending refiles/deletes...
1575 (when (get-buffer chosen-name) 1575 (when (get-buffer chosen-name)
1576 (mh-process-or-undo-commands chosen-name)) 1576 (mh-process-or-undo-commands chosen-name))
@@ -1603,37 +1603,37 @@ garbled."
1603 "Mirror sequences present in source folders in index folder." 1603 "Mirror sequences present in source folders in index folder."
1604 (let ((seq-hash (make-hash-table :test #'equal)) 1604 (let ((seq-hash (make-hash-table :test #'equal))
1605 (seq-list ())) 1605 (seq-list ()))
1606 (loop for folder being the hash-keys of mh-index-data 1606 (cl-loop for folder being the hash-keys of mh-index-data
1607 do (setf (gethash folder seq-hash) 1607 do (setf (gethash folder seq-hash)
1608 (mh-create-sequence-map 1608 (mh-create-sequence-map
1609 (mh-read-folder-sequences folder nil)))) 1609 (mh-read-folder-sequences folder nil))))
1610 (dolist (msg (mh-translate-range mh-current-folder "all")) 1610 (dolist (msg (mh-translate-range mh-current-folder "all"))
1611 (let* ((checksum (gethash msg mh-index-msg-checksum-map)) 1611 (let* ((checksum (gethash msg mh-index-msg-checksum-map))
1612 (pair (gethash checksum mh-index-checksum-origin-map)) 1612 (pair (gethash checksum mh-index-checksum-origin-map))
1613 (ofolder (car pair)) 1613 (ofolder (car pair))
1614 (omsg (cdr pair))) 1614 (omsg (cdr pair)))
1615 (loop for seq in (ignore-errors 1615 (cl-loop for seq in (ignore-errors
1616 (gethash omsg (gethash ofolder seq-hash))) 1616 (gethash omsg (gethash ofolder seq-hash)))
1617 do (if (assoc seq seq-list) 1617 do (if (assoc seq seq-list)
1618 (push msg (cdr (assoc seq seq-list))) 1618 (push msg (cdr (assoc seq seq-list)))
1619 (push (list seq msg) seq-list))))) 1619 (push (list seq msg) seq-list)))))
1620 (loop for seq in seq-list 1620 (cl-loop for seq in seq-list
1621 do (apply #'mh-exec-cmd "mark" mh-current-folder 1621 do (apply #'mh-exec-cmd "mark" mh-current-folder
1622 "-sequence" (symbol-name (car seq)) "-add" 1622 "-sequence" (symbol-name (car seq)) "-add"
1623 (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) 1623 (mapcar #'(lambda (x) (format "%s" x)) (cdr seq))))))
1624 1624
1625;;;###mh-autoload 1625;;;###mh-autoload
1626(defun mh-create-sequence-map (seq-list) 1626(defun mh-create-sequence-map (seq-list)
1627 "Return a map from msg number to list of sequences in which it is present. 1627 "Return a map from msg number to list of sequences in which it is present.
1628SEQ-LIST is an assoc list whose keys are sequence names and whose 1628SEQ-LIST is an assoc list whose keys are sequence names and whose
1629cdr is the list of messages in that sequence." 1629cdr is the list of messages in that sequence."
1630 (loop with map = (make-hash-table) 1630 (cl-loop with map = (make-hash-table)
1631 for seq in seq-list 1631 for seq in seq-list
1632 when (and (not (memq (car seq) (mh-unpropagated-sequences))) 1632 when (and (not (memq (car seq) (mh-unpropagated-sequences)))
1633 (mh-valid-seq-p (car seq))) 1633 (mh-valid-seq-p (car seq)))
1634 do (loop for msg in (cdr seq) 1634 do (cl-loop for msg in (cdr seq)
1635 do (push (car seq) (gethash msg map))) 1635 do (push (car seq) (gethash msg map)))
1636 finally return map)) 1636 finally return map))
1637 1637
1638;;;###mh-autoload 1638;;;###mh-autoload
1639(defun mh-index-add-to-sequence (seq msgs) 1639(defun mh-index-add-to-sequence (seq msgs)
@@ -1741,7 +1741,7 @@ folder, is removed from `mh-index-data'."
1741 (print-level nil)) 1741 (print-level nil))
1742 (with-temp-file outfile 1742 (with-temp-file outfile
1743 (mh-index-write-hashtable 1743 (mh-index-write-hashtable
1744 data (lambda (x) (loop for y being the hash-keys of x collect y))) 1744 data (lambda (x) (cl-loop for y being the hash-keys of x collect y)))
1745 (mh-index-write-hashtable msg-checksum-map #'identity) 1745 (mh-index-write-hashtable msg-checksum-map #'identity)
1746 (mh-index-write-hashtable checksum-origin-map #'identity) 1746 (mh-index-write-hashtable checksum-origin-map #'identity)
1747 (pp previous-search (current-buffer)) (insert "\n") 1747 (pp previous-search (current-buffer)) (insert "\n")
@@ -1751,8 +1751,8 @@ folder, is removed from `mh-index-data'."
1751 "Write TABLE to `current-buffer'. 1751 "Write TABLE to `current-buffer'.
1752PROC is used to serialize the values corresponding to the hash 1752PROC is used to serialize the values corresponding to the hash
1753table keys." 1753table keys."
1754 (pp (loop for x being the hash-keys of table 1754 (pp (cl-loop for x being the hash-keys of table
1755 collect (cons x (funcall proc (gethash x table)))) 1755 collect (cons x (funcall proc (gethash x table))))
1756 (current-buffer)) 1756 (current-buffer))
1757 (insert "\n")) 1757 (insert "\n"))
1758 1758
@@ -1769,9 +1769,9 @@ table keys."
1769 (goto-char (point-min)) 1769 (goto-char (point-min))
1770 (setq t1 (mh-index-read-hashtable 1770 (setq t1 (mh-index-read-hashtable
1771 (lambda (data) 1771 (lambda (data)
1772 (loop with table = (make-hash-table :test #'equal) 1772 (cl-loop with table = (make-hash-table :test #'equal)
1773 for x in data do (setf (gethash x table) t) 1773 for x in data do (setf (gethash x table) t)
1774 finally return table))) 1774 finally return table)))
1775 t2 (mh-index-read-hashtable #'identity) 1775 t2 (mh-index-read-hashtable #'identity)
1776 t3 (mh-index-read-hashtable #'identity) 1776 t3 (mh-index-read-hashtable #'identity)
1777 t4 (read (current-buffer)) 1777 t4 (read (current-buffer))
@@ -1785,10 +1785,10 @@ table keys."
1785(defun mh-index-read-hashtable (proc) 1785(defun mh-index-read-hashtable (proc)
1786 "From BUFFER read a hash table serialized as a list. 1786 "From BUFFER read a hash table serialized as a list.
1787PROC is used to convert the value to actual data." 1787PROC is used to convert the value to actual data."
1788 (loop with table = (make-hash-table :test #'equal) 1788 (cl-loop with table = (make-hash-table :test #'equal)
1789 for pair in (read (current-buffer)) 1789 for pair in (read (current-buffer))
1790 do (setf (gethash (car pair) table) (funcall proc (cdr pair))) 1790 do (setf (gethash (car pair) table) (funcall proc (cdr pair)))
1791 finally return table)) 1791 finally return table))
1792 1792
1793 1793
1794 1794
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 9989dc9f1c7..818a6ceb311 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -31,7 +31,6 @@
31;;; Code: 31;;; Code:
32 32
33(require 'mh-e) 33(require 'mh-e)
34(mh-require-cl)
35(require 'mh-scan) 34(require 'mh-scan)
36 35
37(require 'font-lock) 36(require 'font-lock)
@@ -183,9 +182,9 @@ MESSAGE appears."
183 (interactive "P") 182 (interactive "P")
184 (if (not message) 183 (if (not message)
185 (setq message (mh-get-msg-num t))) 184 (setq message (mh-get-msg-num t)))
186 (let* ((dest-folder (loop for seq in mh-refile-list 185 (let* ((dest-folder (cl-loop for seq in mh-refile-list
187 when (member message (cdr seq)) return (car seq) 186 when (member message (cdr seq)) return (car seq)
188 finally return nil)) 187 finally return nil))
189 (deleted-flag (unless dest-folder (member message mh-delete-list)))) 188 (deleted-flag (unless dest-folder (member message mh-delete-list))))
190 (message "Message %d%s is in sequences: %s" 189 (message "Message %d%s is in sequences: %s"
191 message 190 message
@@ -721,9 +720,9 @@ completion is over."
721 ((eq flag t) 720 ((eq flag t)
722 (all-completions last-word candidates predicate)) 721 (all-completions last-word candidates predicate))
723 ((eq flag 'lambda) 722 ((eq flag 'lambda)
724 (loop for x in candidates 723 (cl-loop for x in candidates
725 when (equal x last-word) return t 724 when (equal x last-word) return t
726 finally return nil))))) 725 finally return nil)))))
727 726
728(defun mh-seq-names (seq-list) 727(defun mh-seq-names (seq-list)
729 "Return an alist containing the names of the SEQ-LIST." 728 "Return an alist containing the names of the SEQ-LIST."
@@ -742,8 +741,8 @@ completion is over."
742 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero" 741 (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero"
743 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) 742 "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq))
744 (goto-char (point-min)) 743 (goto-char (point-min))
745 (multiple-value-bind (folder unseen total) 744 (cl-multiple-value-bind (folder unseen total)
746 (values-list 745 (cl-values-list
747 (mh-parse-flist-output-line 746 (mh-parse-flist-output-line
748 (buffer-substring (point) (mh-line-end-position)))) 747 (buffer-substring (point) (mh-line-end-position))))
749 (list total unseen folder)))) 748 (list total unseen folder))))
@@ -934,8 +933,8 @@ notated."
934 (dolist (msg (mh-seq-msgs seq)) 933 (dolist (msg (mh-seq-msgs seq))
935 (push (car seq) (gethash msg msg-hash)))) 934 (push (car seq) (gethash msg msg-hash))))
936 (mh-iterate-on-range msg range 935 (mh-iterate-on-range msg range
937 (loop for seq in (gethash msg msg-hash) 936 (cl-loop for seq in (gethash msg msg-hash)
938 do (mh-add-sequence-notation msg (mh-internal-seq seq)))))) 937 do (mh-add-sequence-notation msg (mh-internal-seq seq))))))
939 938
940(defun mh-add-sequence-notation (msg internal-seq-flag) 939(defun mh-add-sequence-notation (msg internal-seq-flag)
941 "Add sequence notation to the MSG on the current line. 940 "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 4f7068156ef..176113934d7 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -900,7 +900,7 @@ See also `mh-folder-mode'.
900 ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad 900 ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad
901 ;; style? 901 ;; style?
902 (mh-flet 902 (mh-flet
903 ((gnus-article-add-button (&rest args) nil)) 903 ((gnus-article-add-button (&rest _args) nil))
904 (let* ((modified (buffer-modified-p)) 904 (let* ((modified (buffer-modified-p))
905 (gnus-article-buffer (buffer-name)) 905 (gnus-article-buffer (buffer-name))
906 (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) 906 (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 fc661c882ee..c615ba6913d 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -31,7 +31,6 @@
31;;; Code: 31;;; Code:
32 32
33(require 'mh-e) 33(require 'mh-e)
34(mh-require-cl)
35 34
36(require 'gnus-util) 35(require 'gnus-util)
37(require 'speedbar) 36(require 'speedbar)
@@ -184,7 +183,7 @@ The optional arguments from speedbar are IGNORED."
184;;; Support Routines 183;;; Support Routines
185 184
186;;;###mh-autoload 185;;;###mh-autoload
187(defun mh-folder-speedbar-buttons (buffer) 186(defun mh-folder-speedbar-buttons (_buffer)
188 "Interface function to create MH-E speedbar buffer. 187 "Interface function to create MH-E speedbar buffer.
189BUFFER is the MH-E buffer for which the speedbar buffer is to be 188BUFFER is the MH-E buffer for which the speedbar buffer is to be
190created." 189created."
@@ -438,7 +437,7 @@ flists is run only for that one folder."
438 437
439;; Copied from mh-make-folder-list-filter... 438;; Copied from mh-make-folder-list-filter...
440;; XXX Refactor to use mh-make-folder-list-filer? 439;; XXX Refactor to use mh-make-folder-list-filer?
441(defun mh-speed-parse-flists-output (process output) 440(defun mh-speed-parse-flists-output (_process output)
442 "Parse the incremental results from flists. 441 "Parse the incremental results from flists.
443PROCESS is the flists process and OUTPUT is the results that must 442PROCESS is the flists process and OUTPUT is the results that must
444be handled next." 443be handled next."
@@ -451,7 +450,7 @@ be handled next."
451 mh-speed-partial-line 450 mh-speed-partial-line
452 (substring output position line-end)) 451 (substring output position line-end))
453 mh-speed-partial-line "") 452 mh-speed-partial-line "")
454 (multiple-value-setq (folder unseen total) 453 (cl-multiple-value-setq (folder unseen total)
455 (cl-values-list 454 (cl-values-list
456 (mh-parse-flist-output-line line mh-speed-current-folder))) 455 (mh-parse-flist-output-line line mh-speed-current-folder)))
457 (when (and folder unseen total 456 (when (and folder unseen total
@@ -555,12 +554,12 @@ The function invalidates the latest ancestor that is present."
555 (last-slash (mh-search-from-end ?/ folder)) 554 (last-slash (mh-search-from-end ?/ folder))
556 (ancestor folder) 555 (ancestor folder)
557 (ancestor-pos nil)) 556 (ancestor-pos nil))
558 (block while-loop 557 (cl-block while-loop
559 (while last-slash 558 (while last-slash
560 (setq ancestor (substring ancestor 0 last-slash)) 559 (setq ancestor (substring ancestor 0 last-slash))
561 (setq ancestor-pos (gethash ancestor mh-speed-folder-map)) 560 (setq ancestor-pos (gethash ancestor mh-speed-folder-map))
562 (when ancestor-pos 561 (when ancestor-pos
563 (return-from while-loop)) 562 (cl-return-from while-loop))
564 (setq last-slash (mh-search-from-end ?/ ancestor)))) 563 (setq last-slash (mh-search-from-end ?/ ancestor))))
565 (unless ancestor-pos (setq ancestor nil)) 564 (unless ancestor-pos (setq ancestor nil))
566 (goto-char (or ancestor-pos (gethash nil mh-speed-folder-map))) 565 (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 0fc560b90d0..0f6f9f80baa 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -76,14 +76,14 @@
76(require 'mh-e) 76(require 'mh-e)
77(require 'mh-scan) 77(require 'mh-scan)
78 78
79(mh-defstruct (mh-thread-message (:conc-name mh-message-) 79(cl-defstruct (mh-thread-message (:conc-name mh-message-)
80 (:constructor mh-thread-make-message)) 80 (:constructor mh-thread-make-message))
81 (id nil) 81 (id nil)
82 (references ()) 82 (references ())
83 (subject "") 83 (subject "")
84 (subject-re-p nil)) 84 (subject-re-p nil))
85 85
86(mh-defstruct (mh-thread-container (:conc-name mh-container-) 86(cl-defstruct (mh-thread-container (:conc-name mh-container-)
87 (:constructor mh-thread-make-container)) 87 (:constructor mh-thread-make-container))
88 message parent children 88 message parent children
89 (real-child-p t)) 89 (real-child-p t))
@@ -258,7 +258,7 @@ sibling."
258 (beginning-of-line) 258 (beginning-of-line)
259 (forward-char address-start-offset) 259 (forward-char address-start-offset)
260 (while (char-equal (char-after) ? ) 260 (while (char-equal (char-after) ? )
261 (incf level) 261 (cl-incf level)
262 (forward-char)) 262 (forward-char))
263 level))) 263 level)))
264 264
@@ -292,7 +292,7 @@ at the end."
292 (setq begin (point)) 292 (setq begin (point))
293 (setq spaces (format (format "%%%ss" (1+ level)) "")) 293 (setq spaces (format (format "%%%ss" (1+ level)) ""))
294 (forward-line) 294 (forward-line)
295 (block nil 295 (cl-block nil
296 (while (not (eobp)) 296 (while (not (eobp))
297 (forward-char address-start-offset) 297 (forward-char address-start-offset)
298 (unless (equal (string-match spaces (buffer-substring-no-properties 298 (unless (equal (string-match spaces (buffer-substring-no-properties
@@ -300,7 +300,7 @@ at the end."
300 0) 300 0)
301 (beginning-of-line) 301 (beginning-of-line)
302 (backward-char) 302 (backward-char)
303 (return)) 303 (cl-return))
304 (forward-line))) 304 (forward-line)))
305 (list begin (point))))) 305 (list begin (point)))))
306 306
@@ -388,8 +388,8 @@ the id-table is updated."
388 (parent-container (mh-container-parent child-container))) 388 (parent-container (mh-container-parent child-container)))
389 (when parent-container 389 (when parent-container
390 (setf (mh-container-children parent-container) 390 (setf (mh-container-children parent-container)
391 (loop for elem in (mh-container-children parent-container) 391 (cl-loop for elem in (mh-container-children parent-container)
392 unless (eq child-container elem) collect elem)) 392 unless (eq child-container elem) collect elem))
393 (setf (mh-container-parent child-container) nil)))) 393 (setf (mh-container-parent child-container) nil))))
394 394
395(defsubst mh-thread-add-link (parent child &optional at-end-p) 395(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."
442 "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise. 442 "Return t if ANCESTOR is really an ancestor of SUCCESSOR and nil otherwise.
443In the limit, the function returns t if ANCESTOR and SUCCESSOR 443In the limit, the function returns t if ANCESTOR and SUCCESSOR
444are the same containers." 444are the same containers."
445 (block nil 445 (cl-block nil
446 (while successor 446 (while successor
447 (when (eq ancestor successor) (return t)) 447 (when (eq ancestor successor) (cl-return t))
448 (setq successor (mh-container-parent successor))) 448 (setq successor (mh-container-parent successor)))
449 nil)) 449 nil))
450 450
@@ -525,12 +525,12 @@ children."
525 (cond ((and (mh-container-message container) 525 (cond ((and (mh-container-message container)
526 (mh-message-id (mh-container-message container))) 526 (mh-message-id (mh-container-message container)))
527 (mh-message-subject (mh-container-message container))) 527 (mh-message-subject (mh-container-message container)))
528 (t (block nil 528 (t (cl-block nil
529 (dolist (kid (mh-container-children container)) 529 (dolist (kid (mh-container-children container))
530 (when (and (mh-container-message kid) 530 (when (and (mh-container-message kid)
531 (mh-message-id (mh-container-message kid))) 531 (mh-message-id (mh-container-message kid)))
532 (let ((kid-message (mh-container-message kid))) 532 (let ((kid-message (mh-container-message kid)))
533 (return (mh-message-subject kid-message))))) 533 (cl-return (mh-message-subject kid-message)))))
534 (error "This can't happen"))))) 534 (error "This can't happen")))))
535 535
536(defsubst mh-thread-update-id-index-maps (id index) 536(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."
595 (goto-char (point-min)) 595 (goto-char (point-min))
596 (let ((roots ()) 596 (let ((roots ())
597 (case-fold-search t)) 597 (case-fold-search t))
598 (block nil 598 (cl-block nil
599 (while (not (eobp)) 599 (while (not (eobp))
600 (block process-message 600 (cl-block process-message
601 (let* ((index-line 601 (let* ((index-line
602 (prog1 (buffer-substring (point) (mh-line-end-position)) 602 (prog1 (buffer-substring (point) (mh-line-end-position))
603 (forward-line))) 603 (forward-line)))
@@ -616,26 +616,26 @@ Only information about messages in MSG-LIST are added to the tree."
616 (forward-line))) 616 (forward-line)))
617 (subject-re-p nil)) 617 (subject-re-p nil))
618 (unless (gethash index mh-thread-scan-line-map) 618 (unless (gethash index mh-thread-scan-line-map)
619 (return-from process-message)) 619 (cl-return-from process-message))
620 (unless (integerp index) (return)) ;Error message here 620 (unless (integerp index) (cl-return)) ;Error message here
621 (multiple-value-setq (subject subject-re-p) 621 (cl-multiple-value-setq (subject subject-re-p)
622 (values-list (mh-thread-prune-subject subject))) 622 (cl-values-list (mh-thread-prune-subject subject)))
623 (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to)) 623 (setq in-reply-to (mh-thread-process-in-reply-to in-reply-to))
624 (setq refs (loop for x in (append (split-string refs) in-reply-to) 624 (setq refs
625 when (string-match mh-message-id-regexp x) 625 (cl-loop for x in (append (split-string refs) in-reply-to)
626 collect x)) 626 when (string-match mh-message-id-regexp x)
627 collect x))
627 (setq id (mh-thread-canonicalize-id id)) 628 (setq id (mh-thread-canonicalize-id id))
628 (mh-thread-update-id-index-maps id index) 629 (mh-thread-update-id-index-maps id index)
629 (setq refs (mapcar #'mh-thread-canonicalize-id refs)) 630 (setq refs (mapcar #'mh-thread-canonicalize-id refs))
630 (mh-thread-get-message id subject-re-p subject refs) 631 (mh-thread-get-message id subject-re-p subject refs)
631 (do ((ancestors refs (cdr ancestors))) 632 (cl-do ((ancestors refs (cdr ancestors)))
632 ((null (cdr ancestors)) 633 ((null (cdr ancestors))
633 (when (car ancestors) 634 (when (car ancestors)
634 (mh-thread-remove-parent-link id) 635 (mh-thread-remove-parent-link id)
635 (mh-thread-add-link (car ancestors) id))) 636 (mh-thread-add-link (car ancestors) id)))
636 (mh-thread-add-link (car ancestors) (cadr ancestors))))))) 637 (mh-thread-add-link (car ancestors) (cadr ancestors)))))))
637 (maphash #'(lambda (k v) 638 (maphash #'(lambda (_k v)
638 (declare (ignore k))
639 (when (null (mh-container-parent v)) 639 (when (null (mh-container-parent v))
640 (push v roots))) 640 (push v roots)))
641 mh-thread-id-table) 641 mh-thread-id-table)
@@ -720,8 +720,7 @@ For now it will take the last string inside angles."
720 mh-thread-history) 720 mh-thread-history)
721 (mh-thread-remove-parent-link node))))) 721 (mh-thread-remove-parent-link node)))))
722 (let ((results ())) 722 (let ((results ()))
723 (maphash #'(lambda (k v) 723 (maphash #'(lambda (_k v)
724 (declare (ignore k))
725 (when (and (null (mh-container-parent v)) 724 (when (and (null (mh-container-parent v))
726 (gethash (mh-message-id (mh-container-message v)) 725 (gethash (mh-message-id (mh-container-message v))
727 mh-thread-id-index-map)) 726 mh-thread-id-index-map))
@@ -751,17 +750,18 @@ For now it will take the last string inside angles."
751 (mh-thread-last-ancestor nil)) 750 (mh-thread-last-ancestor nil))
752 (if (null mh-index-data) 751 (if (null mh-index-data)
753 (mh-thread-generate-scan-lines thread-tree -2) 752 (mh-thread-generate-scan-lines thread-tree -2)
754 (loop for x in (mh-index-group-by-folder) 753 (cl-loop for x in (mh-index-group-by-folder)
755 do (let* ((old-map mh-thread-scan-line-map) 754 do (let* ((old-map mh-thread-scan-line-map)
756 (mh-thread-scan-line-map (make-hash-table))) 755 (mh-thread-scan-line-map (make-hash-table)))
757 (setq mh-thread-last-ancestor nil) 756 (setq mh-thread-last-ancestor nil)
758 (loop for msg in (cdr x) 757 (cl-loop for msg in (cdr x)
759 do (let ((v (gethash msg old-map))) 758 do (let ((v (gethash msg old-map)))
760 (when v 759 (when v
761 (setf (gethash msg mh-thread-scan-line-map) v)))) 760 (setf (gethash msg mh-thread-scan-line-map)
762 (when (> (hash-table-count mh-thread-scan-line-map) 0) 761 v))))
763 (insert (if (bobp) "" "\n") (car x) "\n") 762 (when (> (hash-table-count mh-thread-scan-line-map) 0)
764 (mh-thread-generate-scan-lines thread-tree -2)))) 763 (insert (if (bobp) "" "\n") (car x) "\n")
764 (mh-thread-generate-scan-lines thread-tree -2))))
765 (mh-index-create-imenu-index)))) 765 (mh-index-create-imenu-index))))
766 766
767(defun mh-thread-generate-scan-lines (tree level) 767(defun mh-thread-generate-scan-lines (tree level)
@@ -826,8 +826,8 @@ MSG is the message being notated with NOTATION at OFFSET."
826 (let* ((msg (or msg (mh-get-msg-num nil))) 826 (let* ((msg (or msg (mh-get-msg-num nil)))
827 (cur-scan-line (and mh-thread-scan-line-map 827 (cur-scan-line (and mh-thread-scan-line-map
828 (gethash msg mh-thread-scan-line-map))) 828 (gethash msg mh-thread-scan-line-map)))
829 (old-scan-lines (loop for map in mh-thread-scan-line-map-stack 829 (old-scan-lines (cl-loop for map in mh-thread-scan-line-map-stack
830 collect (and map (gethash msg map))))) 830 collect (and map (gethash msg map)))))
831 (when cur-scan-line 831 (when cur-scan-line
832 (setf (aref (car cur-scan-line) offset) notation)) 832 (setf (aref (car cur-scan-line) offset) notation))
833 (dolist (line old-scan-lines) 833 (dolist (line old-scan-lines)
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 41610b253d7..de7a519852c 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -36,7 +36,7 @@
36 36
37;;; Tool Bar Commands 37;;; Tool Bar Commands
38 38
39(defun mh-tool-bar-search (&optional arg) 39(defun mh-tool-bar-search (&optional _arg)
40 "Interactively call `mh-tool-bar-search-function'. 40 "Interactively call `mh-tool-bar-search-function'.
41Optional argument ARG is not used." 41Optional argument ARG is not used."
42 (interactive "P") 42 (interactive "P")
@@ -131,11 +131,12 @@ where,
131 active. If it isn't present then the button is always active." 131 active. If it isn't present then the button is always active."
132 ;; The following variable names have been carefully chosen to make code 132 ;; The following variable names have been carefully chosen to make code
133 ;; generation easier. Modifying the names should be done carefully. 133 ;; generation easier. Modifying the names should be done carefully.
134 (let (folder-buttons folder-docs folder-button-setter sequence-button-setter 134 (mh-dlet* (folder-buttons
135 show-buttons show-button-setter show-seq-button-setter 135 folder-docs folder-button-setter sequence-button-setter
136 letter-buttons letter-docs letter-button-setter 136 show-buttons show-button-setter show-seq-button-setter
137 folder-defaults letter-defaults 137 letter-buttons letter-docs letter-button-setter
138 folder-vectors show-vectors letter-vectors) 138 folder-defaults letter-defaults
139 folder-vectors show-vectors letter-vectors)
139 (dolist (x defaults) 140 (dolist (x defaults)
140 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x))) 141 (cond ((eq (car x) :folder) (setq folder-defaults (cdr x)))
141 ((eq (car x) :letter) (setq letter-defaults (cdr x))))) 142 ((eq (car x) :letter) (setq letter-defaults (cdr x)))))
@@ -161,14 +162,14 @@ where,
161 (append `(,(if (memq 'folder modes) :folder :sequence) ,name) 162 (append `(,(if (memq 'folder modes) :folder :sequence) ,name)
162 functions)) 163 functions))
163 (setq show-sym 164 (setq show-sym
164 (if (string-match "^mh-\\(.*\\)$" name-str) 165 (if (string-match "\\`mh-\\(.*\\)\\'" name-str)
165 (intern (concat "mh-show-" (match-string 1 name-str))) 166 (intern (concat "mh-show-" (match-string 1 name-str)))
166 name)) 167 name))
167 (setq functions 168 (setq functions
168 (append `(,(if (memq 'folder modes) :show :show-seq) 169 (append `(,(if (memq 'folder modes) :show :show-seq)
169 ,(if (fboundp show-sym) show-sym name)) 170 ,(if (fboundp show-sym) show-sym name))
170 functions))) 171 functions)))
171 (do ((functions functions (cddr functions))) 172 (cl-do ((functions functions (cddr functions)))
172 ((null functions)) 173 ((null functions))
173 (let* ((type (car functions)) 174 (let* ((type (car functions))
174 (function (cadr functions)) 175 (function (cadr functions))
@@ -209,15 +210,15 @@ where,
209 (dolist (x letter-defaults) 210 (dolist (x letter-defaults)
210 (unless (memq x letter-buttons) 211 (unless (memq x letter-buttons)
211 (error "Letter defaults contains unknown button %s" x))) 212 (error "Letter defaults contains unknown button %s" x)))
212 `(eval-when (compile load eval) 213 `(eval-and-compile
213 ;; GNU Emacs tool bar specific code 214 ;; GNU Emacs tool bar specific code
214 (mh-do-in-gnu-emacs 215 (mh-do-in-gnu-emacs
215 (defun mh-buffer-exists-p (mode) 216 (defun mh-buffer-exists-p (mode)
216 "Test whether a buffer with major mode MODE is present." 217 "Test whether a buffer with major mode MODE is present."
217 (loop for buf in (buffer-list) 218 (cl-loop for buf in (buffer-list)
218 when (with-current-buffer buf 219 when (with-current-buffer buf
219 (eq major-mode mode)) 220 (eq major-mode mode))
220 return t)) 221 return t))
221 ;; Tool bar initialization functions 222 ;; Tool bar initialization functions
222 (defun mh-tool-bar-folder-buttons-init () 223 (defun mh-tool-bar-folder-buttons-init ()
223 (when (mh-buffer-exists-p 'mh-folder-mode) 224 (when (mh-buffer-exists-p 'mh-folder-mode)
@@ -257,18 +258,18 @@ where,
257 (defun mh-tool-bar-update (mode default-map sequence-map) 258 (defun mh-tool-bar-update (mode default-map sequence-map)
258 "Update `tool-bar-map' in all buffers of MODE. 259 "Update `tool-bar-map' in all buffers of MODE.
259Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." 260Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
260 (loop for buf in (buffer-list) 261 (cl-loop for buf in (buffer-list)
261 do (with-current-buffer buf 262 do (with-current-buffer buf
262 (if (eq mode major-mode) 263 (when (eq mode major-mode) ;FIXME: derived-mode-p?
263 (let ((map (if mh-folder-view-stack 264 (let ((map (if mh-folder-view-stack
264 sequence-map 265 sequence-map
265 default-map))) 266 default-map)))
266 ;; Yes, make-local-variable is necessary since we 267 ;; Yes, make-local-variable is necessary since we
267 ;; get here during initialization when loading 268 ;; get here during initialization when loading
268 ;; mh-e.el, after the +inbox buffer has been 269 ;; mh-e.el, after the +inbox buffer has been
269 ;; created, but before mh-folder-mode has run and 270 ;; created, but before mh-folder-mode has run and
270 ;; created the local map. 271 ;; created the local map.
271 (set (make-local-variable 'tool-bar-map) map)))))) 272 (set (make-local-variable 'tool-bar-map) map))))))
272 (defun mh-tool-bar-folder-buttons-set (symbol value) 273 (defun mh-tool-bar-folder-buttons-set (symbol value)
273 "Construct tool bar for `mh-folder-mode' and `mh-show-mode'." 274 "Construct tool bar for `mh-folder-mode' and `mh-show-mode'."
274 (set-default symbol value) 275 (set-default symbol value)
@@ -286,17 +287,17 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
286 ;; XEmacs specific code 287 ;; XEmacs specific code
287 (mh-do-in-xemacs 288 (mh-do-in-xemacs
288 (defvar mh-tool-bar-folder-vector-map 289 (defvar mh-tool-bar-folder-vector-map
289 (list ,@(loop for button in folder-buttons 290 (list ,@(cl-loop for button in folder-buttons
290 for vector in folder-vectors 291 for vector in folder-vectors
291 collect `(cons ',button ,vector)))) 292 collect `(cons ',button ,vector))))
292 (defvar mh-tool-bar-show-vector-map 293 (defvar mh-tool-bar-show-vector-map
293 (list ,@(loop for button in show-buttons 294 (list ,@(cl-loop for button in show-buttons
294 for vector in show-vectors 295 for vector in show-vectors
295 collect `(cons ',button ,vector)))) 296 collect `(cons ',button ,vector))))
296 (defvar mh-tool-bar-letter-vector-map 297 (defvar mh-tool-bar-letter-vector-map
297 (list ,@(loop for button in letter-buttons 298 (list ,@(cl-loop for button in letter-buttons
298 for vector in letter-vectors 299 for vector in letter-vectors
299 collect `(cons ',button ,vector)))) 300 collect `(cons ',button ,vector))))
300 (defvar mh-tool-bar-folder-buttons) 301 (defvar mh-tool-bar-folder-buttons)
301 (defvar mh-tool-bar-show-buttons) 302 (defvar mh-tool-bar-show-buttons)
302 (defvar mh-tool-bar-letter-buttons) 303 (defvar mh-tool-bar-letter-buttons)
@@ -305,18 +306,20 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
305 (set-default symbol value) 306 (set-default symbol value)
306 (when mh-xemacs-has-tool-bar-flag 307 (when mh-xemacs-has-tool-bar-flag
307 (setq mh-tool-bar-letter-buttons 308 (setq mh-tool-bar-letter-buttons
308 (loop for b in value 309 (cl-loop
309 collect (cdr 310 for b in value
310 (assoc b mh-tool-bar-letter-vector-map)))))) 311 collect (cdr (assoc b mh-tool-bar-letter-vector-map))))))
311 (defun mh-tool-bar-folder-buttons-set (symbol value) 312 (defun mh-tool-bar-folder-buttons-set (symbol value)
312 (set-default symbol value) 313 (set-default symbol value)
313 (when mh-xemacs-has-tool-bar-flag 314 (when mh-xemacs-has-tool-bar-flag
314 (setq mh-tool-bar-folder-buttons 315 (setq mh-tool-bar-folder-buttons
315 (loop for b in value 316 (cl-loop
316 collect (cdr (assoc b mh-tool-bar-folder-vector-map)))) 317 for b in value
318 collect (cdr (assoc b mh-tool-bar-folder-vector-map))))
317 (setq mh-tool-bar-show-buttons 319 (setq mh-tool-bar-show-buttons
318 (loop for b in value 320 (cl-loop
319 collect (cdr (assoc b mh-tool-bar-show-vector-map)))))) 321 for b in value
322 collect (cdr (assoc b mh-tool-bar-show-vector-map))))))
320 (defun mh-tool-bar-init (mode) 323 (defun mh-tool-bar-init (mode)
321 "Install tool bar in MODE." 324 "Install tool bar in MODE."
322 (when mh-xemacs-use-tool-bar-flag 325 (when mh-xemacs-use-tool-bar-flag
@@ -354,9 +357,9 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
354 "List of buttons to include in MH-Folder tool bar." 357 "List of buttons to include in MH-Folder tool bar."
355 :group 'mh-tool-bar 358 :group 'mh-tool-bar
356 :set 'mh-tool-bar-folder-buttons-set 359 :set 'mh-tool-bar-folder-buttons-set
357 :type '(set ,@(loop for x in folder-buttons 360 :type '(set ,@(cl-loop for x in folder-buttons
358 for y in folder-docs 361 for y in folder-docs
359 collect `(const :tag ,y ,x))) 362 collect `(const :tag ,y ,x)))
360 ;;:package-version '(MH-E "7.1") 363 ;;:package-version '(MH-E "7.1")
361 ) 364 )
362 (custom-declare-variable 365 (custom-declare-variable
@@ -365,9 +368,9 @@ Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise."
365 "List of buttons to include in MH-Letter tool bar." 368 "List of buttons to include in MH-Letter tool bar."
366 :group 'mh-tool-bar 369 :group 'mh-tool-bar
367 :set 'mh-tool-bar-letter-buttons-set 370 :set 'mh-tool-bar-letter-buttons-set
368 :type '(set ,@(loop for x in letter-buttons 371 :type '(set ,@(cl-loop for x in letter-buttons
369 for y in letter-docs 372 for y in letter-docs
370 collect `(const :tag ,y ,x))) 373 collect `(const :tag ,y ,x)))
371 ;;:package-version '(MH-E "7.1") 374 ;;:package-version '(MH-E "7.1")
372 )))) 375 ))))
373 376
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 0938729e788..9f39c1b9da1 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -29,7 +29,6 @@
29;;; Code: 29;;; Code:
30 30
31(require 'mh-e) 31(require 'mh-e)
32(mh-require-cl)
33 32
34(require 'font-lock) 33(require 'font-lock)
35 34
@@ -40,9 +39,9 @@
40 "Return the position of last occurrence of CHAR in STRING. 39 "Return the position of last occurrence of CHAR in STRING.
41If CHAR is not present in STRING then return nil. The function is 40If CHAR is not present in STRING then return nil. The function is
42used in lieu of `search' in the CL package." 41used in lieu of `search' in the CL package."
43 (loop for index from (1- (length string)) downto 0 42 (cl-loop for index from (1- (length string)) downto 0
44 when (equal (aref string index) char) return index 43 when (equal (aref string index) char) return index
45 finally return nil)) 44 finally return nil))
46 45
47 46
48 47
@@ -103,9 +102,9 @@ PICK-EXPR is a list of strings. Return nil if PICK-EXPR is nil."
103 (dolist (string pick-expr) 102 (dolist (string pick-expr)
104 (when (and string 103 (when (and string
105 (not (string-equal string ""))) 104 (not (string-equal string "")))
106 (loop for i from 0 to (1- (length mh-pick-regexp-chars)) do 105 (cl-loop for i from 0 to (1- (length mh-pick-regexp-chars)) do
107 (let ((s (string ?\\ (aref mh-pick-regexp-chars i)))) 106 (let ((s (string ?\\ (aref mh-pick-regexp-chars i))))
108 (setq string (mh-replace-regexp-in-string s s string t t)))) 107 (setq string (mh-replace-regexp-in-string s s string t t))))
109 (setq quoted-pick-expr (append quoted-pick-expr (list string))))) 108 (setq quoted-pick-expr (append quoted-pick-expr (list string)))))
110 quoted-pick-expr)) 109 quoted-pick-expr))
111 110
@@ -374,7 +373,7 @@ the cursor is not pointing to a message."
374 (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter 373 (mh-exec-cmd-daemon "folders" 'mh-collect-folder-names-filter
375 "-recurse" "-fast")))) 374 "-recurse" "-fast"))))
376 375
377(defun mh-collect-folder-names-filter (process output) 376(defun mh-collect-folder-names-filter (_process output)
378 "Read folder names. 377 "Read folder names.
379PROCESS is the flists process that was run to collect folder 378PROCESS is the flists process that was run to collect folder
380names and the function is called when OUTPUT is available." 379names and the function is called when OUTPUT is available."
@@ -402,15 +401,15 @@ names and the function is called when OUTPUT is available."
402 (child2 (and parent (substring parent (1+ (or parent-slash 0))))) 401 (child2 (and parent (substring parent (1+ (or parent-slash 0)))))
403 (grand-parent (and parent-slash (substring parent 0 parent-slash))) 402 (grand-parent (and parent-slash (substring parent 0 parent-slash)))
404 (cache-entry (gethash parent mh-sub-folders-cache))) 403 (cache-entry (gethash parent mh-sub-folders-cache)))
405 (unless (loop for x in cache-entry when (equal (car x) child1) return t 404 (unless (cl-loop for x in cache-entry when (equal (car x) child1) return t
406 finally return nil) 405 finally return nil)
407 (push (list child1) cache-entry) 406 (push (list child1) cache-entry)
408 (setf (gethash parent mh-sub-folders-cache) 407 (setf (gethash parent mh-sub-folders-cache)
409 (sort cache-entry (lambda (x y) (string< (car x) (car y))))) 408 (sort cache-entry (lambda (x y) (string< (car x) (car y)))))
410 (when parent 409 (when parent
411 (loop for x in (gethash grand-parent mh-sub-folders-cache) 410 (cl-loop for x in (gethash grand-parent mh-sub-folders-cache)
412 when (equal (car x) child2) 411 when (equal (car x) child2)
413 do (progn (setf (cdr x) t) (return))))))) 412 do (progn (setf (cdr x) t) (cl-return)))))))
414 413
415(defun mh-normalize-folder-name (folder &optional empty-string-okay 414(defun mh-normalize-folder-name (folder &optional empty-string-okay
416 dont-remove-trailing-slash 415 dont-remove-trailing-slash
@@ -522,12 +521,12 @@ they will not be returned."
522 (unless (null folder) 521 (unless (null folder)
523 (setq folder-list (list folder)) 522 (setq folder-list (list folder))
524 (setq folder (concat folder "/"))) 523 (setq folder (concat folder "/")))
525 (loop for f in (mh-sub-folders folder) do 524 (cl-loop for f in (mh-sub-folders folder) do
526 (setq folder-list 525 (setq folder-list
527 (append folder-list 526 (append folder-list
528 (if (mh-children-p f) 527 (if (mh-children-p f)
529 (mh-folder-list (concat folder (car f))) 528 (mh-folder-list (concat folder (car f)))
530 (list (concat folder (car f))))))) 529 (list (concat folder (car f)))))))
531 folder-list)) 530 folder-list))
532 531
533;;;###mh-autoload 532;;;###mh-autoload
@@ -583,10 +582,10 @@ Expects FOLDER to have already been normalized with
583 (mh-line-beginning-position) t))) 582 (mh-line-beginning-position) t)))
584 (when (integerp has-pos) 583 (when (integerp has-pos)
585 (while (equal (char-after has-pos) ? ) 584 (while (equal (char-after has-pos) ? )
586 (decf has-pos)) 585 (cl-decf has-pos))
587 (incf has-pos) 586 (cl-incf has-pos)
588 (while (equal (char-after start-pos) ? ) 587 (while (equal (char-after start-pos) ? )
589 (incf start-pos)) 588 (cl-incf start-pos))
590 (let* ((name (buffer-substring start-pos has-pos)) 589 (let* ((name (buffer-substring start-pos has-pos))
591 (first-char (aref name 0)) 590 (first-char (aref name 0))
592 (last-char (aref name (1- (length name))))) 591 (last-char (aref name (1- (length name)))))
@@ -621,7 +620,7 @@ Here we will need to invalidate the cached sub-folders of +foo,
621otherwise completion on +foo won't tell us about the option 620otherwise completion on +foo won't tell us about the option
622+foo/bar!" 621+foo/bar!"
623 (remhash folder mh-sub-folders-cache) 622 (remhash folder mh-sub-folders-cache)
624 (block ancestor-found 623 (cl-block ancestor-found
625 (let ((parent folder) 624 (let ((parent folder)
626 (one-ancestor-found nil) 625 (one-ancestor-found nil)
627 last-slash) 626 last-slash)
@@ -630,7 +629,7 @@ otherwise completion on +foo won't tell us about the option
630 (unless (eq (gethash parent mh-sub-folders-cache 'none) 'none) 629 (unless (eq (gethash parent mh-sub-folders-cache 'none) 'none)
631 (remhash parent mh-sub-folders-cache) 630 (remhash parent mh-sub-folders-cache)
632 (if one-ancestor-found 631 (if one-ancestor-found
633 (return-from ancestor-found) 632 (cl-return-from ancestor-found)
634 (setq one-ancestor-found t)))) 633 (setq one-ancestor-found t))))
635 (remhash nil mh-sub-folders-cache)))) 634 (remhash nil mh-sub-folders-cache))))
636 635
@@ -702,11 +701,11 @@ See Info node `(elisp) Programmed Completion' for details."
702 (name (substring name 1)) 701 (name (substring name 1))
703 (t "")))) 702 (t ""))))
704 (cond ((eq (car-safe flag) 'boundaries) 703 (cond ((eq (car-safe flag) 'boundaries)
705 (list* 'boundaries 704 (cl-list* 'boundaries
706 (let ((slash (mh-search-from-end ?/ orig-name))) 705 (let ((slash (mh-search-from-end ?/ orig-name)))
707 (if slash (1+ slash) 706 (if slash (1+ slash)
708 (if (string-match "\\`\\+" orig-name) 1 0))) 707 (if (string-match "\\`\\+" orig-name) 1 0)))
709 (if (cdr flag) (string-match "/" (cdr flag))))) 708 (if (cdr flag) (string-match "/" (cdr flag)))))
710 ((eq flag nil) 709 ((eq flag nil)
711 (let ((try-res 710 (let ((try-res
712 (try-completion 711 (try-completion
@@ -721,6 +720,8 @@ See Info node `(elisp) Programmed Completion' for details."
721 (all-completions 720 (all-completions
722 remainder (mh-sub-folders last-complete t) predicate)) 721 remainder (mh-sub-folders last-complete t) predicate))
723 ((eq flag 'lambda) 722 ((eq flag 'lambda)
723 ;; FIXME: if name starts with "/", `path' will end
724 ;; being a relative name without a leading + nor / !? --Stef
724 (let ((path (concat (unless (and (> (length name) 1) 725 (let ((path (concat (unless (and (> (length name) 1)
725 (eq (aref name 1) ?/)) 726 (eq (aref name 1) ?/))
726 mh-user-path) 727 mh-user-path)
@@ -738,7 +739,7 @@ See Info node `(elisp) Programmed Completion' for details."
738If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be 739If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be
739a folder name corresponding to `mh-user-path'." 740a folder name corresponding to `mh-user-path'."
740 (mh-normalize-folder-name 741 (mh-normalize-folder-name
741 (let ((completion-root-regexp "^[+/]") 742 (let ((completion-root-regexp "^[+/]") ;FIXME: Who/what uses that?
742 (minibuffer-local-completion-map mh-folder-completion-map) 743 (minibuffer-local-completion-map mh-folder-completion-map)
743 (mh-allow-root-folder-flag allow-root-folder-flag)) 744 (mh-allow-root-folder-flag allow-root-folder-flag))
744 (completing-read prompt 'mh-folder-completion-function nil nil nil 745 (completing-read prompt 'mh-folder-completion-function nil nil nil
@@ -876,12 +877,12 @@ in this situation."
876 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the 877 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the
877 ;; header. The replacement allows From_ lines in the mail header. 878 ;; header. The replacement allows From_ lines in the mail header.
878 (goto-char (point-min)) 879 (goto-char (point-min))
879 (loop for p = (re-search-forward 880 (cl-loop for p = (re-search-forward
880 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) 881 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move)
881 do (cond ((null p) (return)) 882 do (cond ((null p) (cl-return))
882 (t (goto-char (match-beginning 0)) 883 (t (goto-char (match-beginning 0))
883 (unless (looking-at "From ") (return)) 884 (unless (looking-at "From ") (cl-return))
884 (goto-char p)))) 885 (goto-char p))))
885 (point))) 886 (point)))
886 887
887;;;###mh-autoload 888;;;###mh-autoload
@@ -918,9 +919,9 @@ Handle RFC 822 (or later) continuation lines."
918(defun mh-letter-skipped-header-field-p (field) 919(defun mh-letter-skipped-header-field-p (field)
919 "Check if FIELD is to be skipped." 920 "Check if FIELD is to be skipped."
920 (let ((field (downcase field))) 921 (let ((field (downcase field)))
921 (loop for x in mh-compose-skipped-header-fields 922 (cl-loop for x in mh-compose-skipped-header-fields
922 when (equal (downcase x) field) return t 923 when (equal (downcase x) field) return t
923 finally return nil))) 924 finally return nil)))
924 925
925(defvar mh-hidden-header-keymap 926(defvar mh-hidden-header-keymap
926 (let ((map (make-sparse-keymap))) 927 (let ((map (make-sparse-keymap)))
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index 4ff84a66f76..5ffcfe5e4b1 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -28,7 +28,6 @@
28;;; Code: 28;;; Code:
29 29
30(require 'mh-e) 30(require 'mh-e)
31(mh-require-cl)
32 31
33(autoload 'message-fetch-field "message") 32(autoload 'message-fetch-field "message")
34 33
@@ -74,8 +73,8 @@ in this order is used."
74 (x-face (setq raw (mh-uncompface x-face) 73 (x-face (setq raw (mh-uncompface x-face)
75 type 'pbm)) 74 type 'pbm))
76 (url (setq type 'url)) 75 (url (setq type 'url))
77 (t (multiple-value-setq (type raw) 76 (t (cl-multiple-value-setq (type raw)
78 (values-list (mh-picon-get-image))))) 77 (cl-values-list (mh-picon-get-image)))))
79 (when type 78 (when type
80 (goto-char (point-min)) 79 (goto-char (point-min))
81 (when (re-search-forward "^from:" (point-max) t) 80 (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.")
177(defvar mh-picon-cache (make-hash-table :test #'equal)) 176(defvar mh-picon-cache (make-hash-table :test #'equal))
178 177
179(defvar mh-picon-image-types 178(defvar mh-picon-image-types
180 (loop for type in '(xpm xbm gif) 179 (cl-loop for type in '(xpm xbm gif)
181 when (or (mh-do-in-gnu-emacs 180 when (or (mh-do-in-gnu-emacs
182 (ignore-errors 181 (ignore-errors
183 (mh-funcall-if-exists image-type-available-p type))) 182 (mh-funcall-if-exists image-type-available-p type)))
184 (mh-do-in-xemacs (featurep type))) 183 (mh-do-in-xemacs (featurep type)))
185 collect type)) 184 collect type))
186 185
187(autoload 'message-tokenize-header "sendmail") 186(autoload 'message-tokenize-header "sendmail")
188 187
189(defun* mh-picon-get-image () 188(defun mh-picon-get-image ()
190 "Find the best possible match and return contents." 189 "Find the best possible match and return contents."
191 (mh-picon-set-directory-list) 190 (mh-picon-set-directory-list)
192 (save-restriction 191 (save-restriction
193 (let* ((from-field (ignore-errors (car (message-tokenize-header 192 (let* ((from-field (ignore-errors (car (message-tokenize-header
194 (mh-get-header-field "from:"))))) 193 (mh-get-header-field "from:")))))
195 (from (car (ignore-errors 194 (from (car (ignore-errors
196 (mh-funcall-if-exists ietf-drums-parse-address 195 ;; Don't use mh-funcall-if-exists because
197 from-field)))) 196 ;; ietf-drums-parse-address might exist at run-time but
197 ;; not at compile-time.
198 (when (fboundp 'ietf-drums-parse-address)
199 (ietf-drums-parse-address from-field)))))
198 (host (and from 200 (host (and from
199 (string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from) 201 (string-match "\\([^+]*\\)\\(\\+.*\\)?@\\(.*\\)" from)
200 (downcase (match-string 3 from)))) 202 (downcase (match-string 3 from))))
201 (user (and host (downcase (match-string 1 from)))) 203 (user (and host (downcase (match-string 1 from))))
202 (canonical-address (format "%s@%s" user host)) 204 (canonical-address (format "%s@%s" user host))
203 (cached-value (gethash canonical-address mh-picon-cache)) 205 (cached-value (gethash canonical-address mh-picon-cache))
204 (host-list (and host (delete "" (split-string host "\\.")))) 206 (host-list (and host (delete "" (split-string host "\\.")))))
205 (match nil)) 207 (cond
206 (cond (cached-value (return-from mh-picon-get-image cached-value)) 208 (cached-value cached-value)
207 ((not host-list) (return-from mh-picon-get-image nil))) 209 ((not host-list) nil)
208 (setq match 210 (t
209 (block loop 211 (let ((match
210 ;; u@h search 212 (cl-block loop
211 (loop for dir in mh-picon-existing-directory-list 213 ;; u@h search
212 do (loop for type in mh-picon-image-types 214 (dolist (dir mh-picon-existing-directory-list)
213 ;; [path]user@host 215 (cl-loop for type in mh-picon-image-types
214 for file1 = (format "%s/%s.%s" 216 ;; [path]user@host
215 dir canonical-address type) 217 for file1 = (format "%s/%s.%s"
216 when (file-exists-p file1) 218 dir canonical-address type)
217 do (return-from loop file1) 219 when (file-exists-p file1)
218 ;; [path]user 220 do (cl-return-from loop file1)
219 for file2 = (format "%s/%s.%s" dir user type) 221 ;; [path]user
220 when (file-exists-p file2) 222 for file2 = (format "%s/%s.%s" dir user type)
221 do (return-from loop file2) 223 when (file-exists-p file2)
222 ;; [path]host 224 do (cl-return-from loop file2)
223 for file3 = (format "%s/%s.%s" dir host type) 225 ;; [path]host
224 when (file-exists-p file3) 226 for file3 = (format "%s/%s.%s" dir host type)
225 do (return-from loop file3))) 227 when (file-exists-p file3)
226 ;; facedb search 228 do (cl-return-from loop file3)))
227 ;; Search order for user@foo.net: 229 ;; facedb search
228 ;; [path]net/foo/user 230 ;; Search order for user@foo.net:
229 ;; [path]net/foo/user/face 231 ;; [path]net/foo/user
230 ;; [path]net/user 232 ;; [path]net/foo/user/face
231 ;; [path]net/user/face 233 ;; [path]net/user
232 ;; [path]net/foo/unknown 234 ;; [path]net/user/face
233 ;; [path]net/foo/unknown/face 235 ;; [path]net/foo/unknown
234 ;; [path]net/unknown 236 ;; [path]net/foo/unknown/face
235 ;; [path]net/unknown/face 237 ;; [path]net/unknown
236 (loop for u in (list user "unknown") 238 ;; [path]net/unknown/face
237 do (loop for dir in mh-picon-existing-directory-list 239 (dolist (u (list user "unknown"))
238 do (loop for x on host-list by #'cdr 240 (dolist (dir mh-picon-existing-directory-list)
239 for y = (mh-picon-generate-path x u dir) 241 (cl-loop for x on host-list by #'cdr
240 do (loop for type in mh-picon-image-types 242 for y = (mh-picon-generate-path x u dir)
241 for z1 = (format "%s.%s" y type) 243 do (cl-loop for type in mh-picon-image-types
242 when (file-exists-p z1) 244 for z1 = (format "%s.%s" y type)
243 do (return-from loop z1) 245 when (file-exists-p z1)
244 for z2 = (format "%s/face.%s" 246 do (cl-return-from loop z1)
245 y type) 247 for z2 = (format "%s/face.%s"
246 when (file-exists-p z2) 248 y type)
247 do (return-from loop z2))))))) 249 when (file-exists-p z2)
248 (setf (gethash canonical-address mh-picon-cache) 250 do (cl-return-from loop z2))))))))
249 (mh-picon-file-contents match))))) 251 (setf (gethash canonical-address mh-picon-cache)
252 (mh-picon-file-contents match))))))))
250 253
251(defun mh-picon-set-directory-list () 254(defun mh-picon-set-directory-list ()
252 "Update `mh-picon-existing-directory-list' if needed." 255 "Update `mh-picon-existing-directory-list' if needed."
253 (when (eq mh-picon-existing-directory-list 'unset) 256 (when (eq mh-picon-existing-directory-list 'unset)
254 (setq mh-picon-existing-directory-list 257 (setq mh-picon-existing-directory-list
255 (loop for x in mh-picon-directory-list 258 (cl-loop for x in mh-picon-directory-list
256 when (file-directory-p x) collect x)))) 259 when (file-directory-p x) collect x))))
257 260
258(defun mh-picon-generate-path (host-list user directory) 261(defun mh-picon-generate-path (host-list user directory)
259 "Generate the image file path. 262 "Generate the image file path.
260HOST-LIST is the parsed host address of the email address, USER 263HOST-LIST is the parsed host address of the email address, USER
261the username and DIRECTORY is the directory relative to which the 264the username and DIRECTORY is the directory relative to which the
262path is generated." 265path is generated."
263 (loop with acc = "" 266 (cl-loop with acc = ""
264 for elem in host-list 267 for elem in host-list
265 do (setq acc (format "%s/%s" elem acc)) 268 do (setq acc (format "%s/%s" elem acc))
266 finally return (format "%s/%s%s" directory acc user))) 269 finally return (format "%s/%s%s" directory acc user)))
267 270
268(defun mh-picon-file-contents (file) 271(defun mh-picon-file-contents (file)
269 "Return details about FILE. 272 "Return details about FILE.
@@ -437,7 +440,7 @@ actual display is carried out by the SENTINEL function."
437 ;; Temporary failure 440 ;; Temporary failure
438 (mh-x-image-set-download-state cache-file 'try-again))) 441 (mh-x-image-set-download-state cache-file 'try-again)))
439 442
440(defun mh-x-image-scale-and-display (process change) 443(defun mh-x-image-scale-and-display (process _change)
441 "When the wget PROCESS terminates scale and display image. 444 "When the wget PROCESS terminates scale and display image.
442The argument CHANGE is ignored." 445The argument CHANGE is ignored."
443 (when (eq (process-status process) 'exit) 446 (when (eq (process-status process) 'exit)