diff options
| author | Stefan Monnier | 2019-08-06 03:56:51 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2019-08-06 03:56:51 -0400 |
| commit | 74b097b61c5201405ad7bc5bb76f1ca0e794184b (patch) | |
| tree | 9e616fd95c5cb01c7dac507c6d84a34637f14411 | |
| parent | b06917a4912a60402025286d07d4a195749245c4 (diff) | |
| download | emacs-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.el | 80 | ||||
| -rw-r--r-- | lisp/mh-e/mh-alias.el | 4 | ||||
| -rw-r--r-- | lisp/mh-e/mh-comp.el | 22 | ||||
| -rw-r--r-- | lisp/mh-e/mh-compat.el | 12 | ||||
| -rw-r--r-- | lisp/mh-e/mh-e.el | 103 | ||||
| -rw-r--r-- | lisp/mh-e/mh-folder.el | 57 | ||||
| -rw-r--r-- | lisp/mh-e/mh-funcs.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-gnus.el | 8 | ||||
| -rw-r--r-- | lisp/mh-e/mh-identity.el | 6 | ||||
| -rw-r--r-- | lisp/mh-e/mh-inc.el | 15 | ||||
| -rw-r--r-- | lisp/mh-e/mh-junk.el | 1 | ||||
| -rw-r--r-- | lisp/mh-e/mh-limit.el | 27 | ||||
| -rw-r--r-- | lisp/mh-e/mh-mime.el | 129 | ||||
| -rw-r--r-- | lisp/mh-e/mh-search.el | 266 | ||||
| -rw-r--r-- | lisp/mh-e/mh-seq.el | 21 | ||||
| -rw-r--r-- | lisp/mh-e/mh-show.el | 2 | ||||
| -rw-r--r-- | lisp/mh-e/mh-speed.el | 11 | ||||
| -rw-r--r-- | lisp/mh-e/mh-thread.el | 76 | ||||
| -rw-r--r-- | lisp/mh-e/mh-tool-bar.el | 97 | ||||
| -rw-r--r-- | lisp/mh-e/mh-utils.el | 79 | ||||
| -rw-r--r-- | lisp/mh-e/mh-xface.el | 133 |
21 files changed, 549 insertions, 602 deletions
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 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 | |||
| 57 | Emacs coding conventions require that the \"cl\" package not be | ||
| 58 | required at runtime. However, the \"cl\" package in Emacs 21.4 | ||
| 59 | and earlier left \"cl\" routines in their macro expansions. In | ||
| 60 | particular, the expansion of (setf (gethash ...) ...) used | ||
| 61 | functions in \"cl\" at run time. This macro recognizes that and | ||
| 62 | loads \"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. | ||
| 149 | The `defstruct' in the \"cl\" library produces compiler warnings, | ||
| 150 | and generates code that uses functions present in \"cl\" at | ||
| 151 | run-time. This is a partial replacement, that avoids these | ||
| 152 | issues. | ||
| 153 | |||
| 154 | NAME-SPEC declares the name of the structure, while FIELDS | ||
| 155 | describes the various structure fields. Lookup `defstruct' for | ||
| 156 | more 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 | ||
| 223 | This function does not prompt the user for any header fields, and | 223 | This 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. |
| 247 | This is the `mail-user-agent' entry point to MH-E. This function | 244 | This is the `mail-user-agent' entry point to MH-E. This function |
| 248 | conforms to the contract specified by `define-mail-user-agent' | 245 | conforms to the contract specified by `define-mail-user-agent' |
| @@ -256,8 +253,7 @@ OTHER-HEADERS is an alist specifying additional header fields. | |||
| 256 | Elements look like (HEADER . VALUE) where both HEADER and VALUE | 253 | Elements look like (HEADER . VALUE) where both HEADER and VALUE |
| 257 | are strings. | 254 | are strings. |
| 258 | 255 | ||
| 259 | CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and | 256 | Any additional arguments are IGNORED." |
| 260 | RETURN-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. |
| 1298 | The function doesn't work for XEmacs since `find-charset-region' | 1292 | The function doesn't work for XEmacs since `find-charset-region' |
| 1299 | doesn't exist there." | 1293 | doesn'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'. |
| 148 | This function returns nil on that system.") | 148 | This 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'. |
| 248 | This function returns nil on those systems." | 248 | This 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. |
| 297 | This function is used by XEmacs that lacks `match-string-no-properties'. | 297 | This function is used by XEmacs that lacks `match-string-no-properties'. |
| 298 | The function `buffer-substring-no-properties' is used instead. | 298 | The 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. |
| 306 | This function is used by XEmacs that lacks `replace-regexp-in-string'. | 306 | This function is used by XEmacs that lacks `replace-regexp-in-string'. |
| 307 | The function `replace-in-string' is used instead. | 307 | The 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. |
| 316 | XEmacs does not have `test-completion'. This function returns nil | 316 | XEmacs does not have `test-completion'. This function returns nil |
| 317 | on that system." nil) | 317 | on 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. |
| 357 | This function is defined in XEmacs as it lacks | 357 | This 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." | |||
| 509 | Adds double-quotes around entire string and quotes the characters | 509 | Adds 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. |
| 588 | Any output from the process is displayed in an asynchronous | 588 | Any output from the process is displayed in an asynchronous |
| 589 | pop-up window." | 589 | pop-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. |
| 87 | When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the | 84 | When desktop creates a buffer, FILE-NAME holds the |
| 88 | file name to visit, DESKTOP-BUFFER-NAME holds the desired buffer | 85 | file name to visit, NAME holds the desired buffer |
| 89 | name, and DESKTOP-BUFFER-MISC holds a list of miscellaneous info | 86 | name, and MISC holds a list of miscellaneous info |
| 90 | used by the `desktop-buffer-mode-handlers' functions." | 87 | used 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. |
| 128 | Display the results only if something went wrong." | 128 | Display 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\". |
| 210 | The ACTION is one of `remove' or `add'. If `add', the VALUE is added. | 210 | The ACTION is one of `remove' or `add'. If `add', the VALUE is added. |
| 211 | The buffer-local variable `mh-identity-pgg-default-user-id' is set to | 211 | The 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\". |
| 224 | The ACTION is one of `remove' or `add'. If `add', the VALUE is | 224 | The ACTION is one of `remove' or `add'. If `add', the VALUE is |
| 225 | added." | 225 | added." |
| @@ -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\". |
| 255 | The ACTION is one of `remove' or `add'. If `add', the VALUE is | 255 | The ACTION is one of `remove' or `add'. If `add', the VALUE is |
| 256 | added." | 256 | added." |
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. |
| 251 | If no prefix arg is given, then return DEFAULT." | 250 | If 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. |
| 307 | The MH command pick is used to do the match." | 306 | The 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. |
| 612 | If no part is preferred then all the parts are displayed." | 612 | If 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 | |||
| 770 | nested messages are opened)." | 770 | nested 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 | |||
| 995 | then that function must return non-nil at the button we stop." | 1000 | then 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. |
| 1037 | Parameter EL is unused." | 1042 | Parameter 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 | ||
| 1602 | METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". | 1607 | METHOD 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 | |||
| 331 | configuration and is used when the search folder is dismissed." | 331 | configuration 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 | |||
| 806 | searcher in `mh-search-choices' present on the system. If | 806 | searcher in `mh-search-choices' present on the system. If |
| 807 | optional argument SEARCHER is present, use it instead of | 807 | optional 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 | |||
| 1331 | match. If no other matches left then return nil. If the current | 1331 | match. If no other matches left then return nil. If the current |
| 1332 | record is invalid return 'error." | 1332 | record 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. |
| 1628 | SEQ-LIST is an assoc list whose keys are sequence names and whose | 1628 | SEQ-LIST is an assoc list whose keys are sequence names and whose |
| 1629 | cdr is the list of messages in that sequence." | 1629 | cdr 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'. |
| 1752 | PROC is used to serialize the values corresponding to the hash | 1752 | PROC is used to serialize the values corresponding to the hash |
| 1753 | table keys." | 1753 | table 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. |
| 1787 | PROC is used to convert the value to actual data." | 1787 | PROC 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. |
| 189 | BUFFER is the MH-E buffer for which the speedbar buffer is to be | 188 | BUFFER is the MH-E buffer for which the speedbar buffer is to be |
| 190 | created." | 189 | created." |
| @@ -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. |
| 443 | PROCESS is the flists process and OUTPUT is the results that must | 442 | PROCESS is the flists process and OUTPUT is the results that must |
| 444 | be handled next." | 443 | be 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. |
| 443 | In the limit, the function returns t if ANCESTOR and SUCCESSOR | 443 | In the limit, the function returns t if ANCESTOR and SUCCESSOR |
| 444 | are the same containers." | 444 | are 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'. |
| 41 | Optional argument ARG is not used." | 41 | Optional 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. |
| 259 | Use SEQUENCE-MAP if display is limited; DEFAULT-MAP otherwise." | 260 | Use 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. |
| 41 | If CHAR is not present in STRING then return nil. The function is | 40 | If CHAR is not present in STRING then return nil. The function is |
| 42 | used in lieu of `search' in the CL package." | 41 | used 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. |
| 379 | PROCESS is the flists process that was run to collect folder | 378 | PROCESS is the flists process that was run to collect folder |
| 380 | names and the function is called when OUTPUT is available." | 379 | names 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, | |||
| 621 | otherwise completion on +foo won't tell us about the option | 620 | otherwise 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." | |||
| 738 | If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be | 739 | If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be |
| 739 | a folder name corresponding to `mh-user-path'." | 740 | a 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. |
| 260 | HOST-LIST is the parsed host address of the email address, USER | 263 | HOST-LIST is the parsed host address of the email address, USER |
| 261 | the username and DIRECTORY is the directory relative to which the | 264 | the username and DIRECTORY is the directory relative to which the |
| 262 | path is generated." | 265 | path 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. |
| 442 | The argument CHANGE is ignored." | 445 | The argument CHANGE is ignored." |
| 443 | (when (eq (process-status process) 'exit) | 446 | (when (eq (process-status process) 'exit) |