aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2019-09-30 15:08:41 -0400
committerStefan Monnier2019-09-30 15:08:41 -0400
commit2e08014859773a8989d785e2b3f6c16294eb0190 (patch)
tree237112d0399874bc322ed719f6ed79f389647a12
parent9e9bd502ad8ec4e8156f823b048c0b3366ed16b4 (diff)
downloademacs-2e08014859773a8989d785e2b3f6c16294eb0190.tar.gz
emacs-2e08014859773a8989d785e2b3f6c16294eb0190.zip
* lisp/gnus/mm-uu.el: Use lexical-binding and cl-defstruct
(mm-uu-type-alist): Make functions visible to byte-compiler. (mm-uu-entry): New defstruct. (mm-uu-configure): Use mapconcat. (mm-uu-dissect): Avoid setq on `func`.
-rw-r--r--lisp/gnus/mm-uu.el131
1 files changed, 62 insertions, 69 deletions
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 981bf8ea3ea..fec3986dedd 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -1,4 +1,4 @@
1;;; mm-uu.el --- Return uu stuff as mm handles 1;;; mm-uu.el --- Return uu stuff as mm handles -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1998-2019 Free Software Foundation, Inc. 3;; Copyright (C) 1998-2019 Free Software Foundation, Inc.
4 4
@@ -29,6 +29,7 @@
29(require 'mm-decode) 29(require 'mm-decode)
30(require 'mailcap) 30(require 'mailcap)
31(require 'mml2015) 31(require 'mml2015)
32(eval-when-compile (require 'cl-lib))
32 33
33(autoload 'uudecode-decode-region "uudecode") 34(autoload 'uudecode-decode-region "uudecode")
34(autoload 'uudecode-decode-region-external "uudecode") 35(autoload 'uudecode-decode-region-external "uudecode")
@@ -90,124 +91,126 @@ This can be either \"inline\" or \"attachment\".")
90 :group 'gnus-article-mime) 91 :group 'gnus-article-mime)
91 92
92(defvar mm-uu-type-alist 93(defvar mm-uu-type-alist
93 '((postscript 94 `((postscript
94 "^%!PS-" 95 "^%!PS-"
95 "^%%EOF$" 96 "^%%EOF$"
96 mm-uu-postscript-extract 97 ,#'mm-uu-postscript-extract
97 nil) 98 nil)
98 (uu ;; Maybe we should have a more strict test here. 99 (uu ;; Maybe we should have a more strict test here.
99 "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+" 100 "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
100 "^end[ \t]*$" 101 "^end[ \t]*$"
101 mm-uu-uu-extract 102 ,#'mm-uu-uu-extract
102 mm-uu-uu-filename) 103 ,#'mm-uu-uu-filename)
103 (binhex 104 (binhex
104 "^:.\\{63,63\\}$" 105 "^:.\\{63,63\\}$"
105 ":$" 106 ":$"
106 mm-uu-binhex-extract 107 ,#'mm-uu-binhex-extract
107 nil 108 nil
108 mm-uu-binhex-filename) 109 ,#'mm-uu-binhex-filename)
109 (yenc 110 (yenc
110 "^=ybegin.*size=[0-9]+.*name=.*$" 111 "^=ybegin.*size=[0-9]+.*name=.*$"
111 "^=yend.*size=[0-9]+" 112 "^=yend.*size=[0-9]+"
112 mm-uu-yenc-extract 113 ,#'mm-uu-yenc-extract
113 mm-uu-yenc-filename) 114 ,#'mm-uu-yenc-filename)
114 (shar 115 (shar
115 "^#! */bin/sh" 116 "^#! */bin/sh"
116 "^exit 0$" 117 "^exit 0$"
117 mm-uu-shar-extract) 118 ,#'mm-uu-shar-extract)
118 (forward 119 (forward
119 ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and 120 ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
120 ;; Peter von der Ahé <pahe@daimi.au.dk> 121 ;; Peter von der Ahé <pahe@daimi.au.dk>
121 "^-+ \\(Start of \\)?Forwarded message" 122 "^-+ \\(Start of \\)?Forwarded message"
122 "^-+ End \\(of \\)?forwarded message" 123 "^-+ End \\(of \\)?forwarded message"
123 mm-uu-forward-extract 124 ,#'mm-uu-forward-extract
124 nil 125 nil
125 mm-uu-forward-test) 126 ,#'mm-uu-forward-test)
126 (gnatsweb 127 (gnatsweb
127 "^----gnatsweb-attachment----" 128 "^----gnatsweb-attachment----"
128 nil 129 nil
129 mm-uu-gnatsweb-extract) 130 ,#'mm-uu-gnatsweb-extract)
130 (pgp-signed 131 (pgp-signed
131 "^-----BEGIN PGP SIGNED MESSAGE-----" 132 "^-----BEGIN PGP SIGNED MESSAGE-----"
132 "^-----END PGP SIGNATURE-----" 133 "^-----END PGP SIGNATURE-----"
133 mm-uu-pgp-signed-extract 134 ,#'mm-uu-pgp-signed-extract
134 nil 135 nil
135 nil) 136 nil)
136 (pgp-encrypted 137 (pgp-encrypted
137 "^-----BEGIN PGP MESSAGE-----" 138 "^-----BEGIN PGP MESSAGE-----"
138 "^-----END PGP MESSAGE-----" 139 "^-----END PGP MESSAGE-----"
139 mm-uu-pgp-encrypted-extract 140 ,#'mm-uu-pgp-encrypted-extract
140 nil 141 nil
141 nil) 142 nil)
142 (pgp-key 143 (pgp-key
143 "^-----BEGIN PGP PUBLIC KEY BLOCK-----" 144 "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
144 "^-----END PGP PUBLIC KEY BLOCK-----" 145 "^-----END PGP PUBLIC KEY BLOCK-----"
145 mm-uu-pgp-key-extract 146 ,#'mm-uu-pgp-key-extract
146 mm-uu-gpg-key-skip-to-last 147 ,#'mm-uu-gpg-key-skip-to-last
147 nil) 148 nil)
148 (emacs-sources 149 (emacs-sources
149 "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--" 150 "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
150 "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here" 151 "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
151 mm-uu-emacs-sources-extract 152 ,#'mm-uu-emacs-sources-extract
152 nil 153 nil
153 mm-uu-emacs-sources-test) 154 ,#'mm-uu-emacs-sources-test)
154 (diff 155 (diff
155 "^Index: " 156 "^Index: "
156 nil 157 nil
157 mm-uu-diff-extract 158 ,#'mm-uu-diff-extract
158 nil 159 nil
159 mm-uu-diff-test) 160 ,#'mm-uu-diff-test)
160 (diff 161 (diff
161 "^=== modified file " 162 "^=== modified file "
162 nil 163 nil
163 mm-uu-diff-extract 164 ,#'mm-uu-diff-extract
164 nil 165 nil
165 mm-uu-diff-test) 166 ,#'mm-uu-diff-test)
166 (git-format-patch 167 (git-format-patch
167 "^diff --git " 168 "^diff --git "
168 "^-- " 169 "^-- "
169 mm-uu-diff-extract 170 ,#'mm-uu-diff-extract
170 nil 171 nil
171 mm-uu-diff-test) 172 ,#'mm-uu-diff-test)
172 (message-marks 173 (message-marks
173 ;; Text enclosed with tags similar to `message-mark-insert-begin' and 174 ;; Text enclosed with tags similar to `message-mark-insert-begin' and
174 ;; `message-mark-insert-end'. Don't use those variables to avoid 175 ;; `message-mark-insert-end'. Don't use those variables to avoid
175 ;; dependency on `message.el'. 176 ;; dependency on `message.el'.
176 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" 177 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
177 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$" 178 "^-+[8<>]*-\\{9,\\}[a-z ]+-\\{9,\\}[a-z ]+-\\{9,\\}[8<>]*-+$"
178 (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) 179 ,(lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
179 nil) 180 nil)
180 ;; Omitting [a-z8<] leads to false positives (bogus signature separators 181 ;; Omitting [a-z8<] leads to false positives (bogus signature separators
181 ;; and mailing list banners). 182 ;; and mailing list banners).
182 (insert-marks 183 (insert-marks
183 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$" 184 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
184 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$" 185 "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
185 (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1)) 186 ,(lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
186 nil) 187 nil)
187 (verbatim-marks 188 (verbatim-marks
188 ;; slrn-style verbatim marks, see 189 ;; slrn-style verbatim marks, see
189 ;; http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks 190 ;; http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
190 "^#v\\+" 191 "^#v\\+"
191 "^#v\\-$" 192 "^#v\\-$"
192 (lambda () (mm-uu-verbatim-marks-extract 0 0)) 193 ,(lambda () (mm-uu-verbatim-marks-extract 0 0))
193 nil) 194 nil)
194 (LaTeX 195 (LaTeX
195 "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]" 196 "^\\([\\\\%][^\n]+\n\\)*\\\\documentclass.*[[{%]"
196 "^\\\\end{document}" 197 "^\\\\end{document}"
197 mm-uu-latex-extract 198 ,#'mm-uu-latex-extract
198 nil 199 nil
199 mm-uu-latex-test) 200 ,#'mm-uu-latex-test)
200 (org-src-code-block 201 (org-src-code-block
201 "^[ \t]*#\\+begin_" 202 "^[ \t]*#\\+begin_"
202 "^[ \t]*#\\+end_" 203 "^[ \t]*#\\+end_"
203 mm-uu-org-src-code-block-extract) 204 ,#'mm-uu-org-src-code-block-extract)
204 (org-meta-line 205 (org-meta-line
205 "^[ \t]*#\\+[[:alpha:]]+: " 206 "^[ \t]*#\\+[[:alpha:]]+: "
206 "$" 207 "$"
207 mm-uu-org-src-code-block-extract)) 208 ,#'mm-uu-org-src-code-block-extract))
208 "A list of specifications for non-MIME attachments. 209 "A list of specifications for non-MIME attachments.
209Each element consist of the following entries: label, 210Each element consist of a `mm-uu-entry'.
210start-regexp, end-regexp, extract-function, test-function. 211The functions in the last 3 slots of this type can make use of the following
212dynamically-scoped variables:
213`file-name', `start-point', and `end-point'.
211 214
212After modifying this list you must run \\[mm-uu-configure]. 215After modifying this list you must run \\[mm-uu-configure].
213 216
@@ -230,23 +233,11 @@ To disable dissecting shar codes, for instance, add
230 233
231;; functions 234;; functions
232 235
233(defsubst mm-uu-type (entry) 236(cl-defstruct (mm-uu-entry
234 (car entry)) 237 (:conc-name mm-uu-)
235 238 (:constructor nil)
236(defsubst mm-uu-beginning-regexp (entry) 239 (:type list))
237 (nth 1 entry)) 240 type beginning-regexp end-regexp function-extract function-1 function-2)
238
239(defsubst mm-uu-end-regexp (entry)
240 (nth 2 entry))
241
242(defsubst mm-uu-function-extract (entry)
243 (nth 3 entry))
244
245(defsubst mm-uu-function-1 (entry)
246 (nth 4 entry))
247
248(defsubst mm-uu-function-2 (entry)
249 (nth 5 entry))
250 241
251(defcustom mm-uu-hide-markers (< 16 (length (defined-colors))) 242(defcustom mm-uu-hide-markers (< 16 (length (defined-colors)))
252 "If non-nil, hide verbatim markers. 243 "If non-nil, hide verbatim markers.
@@ -309,15 +300,15 @@ apply the face `mm-uu-extract'."
309 "Configure detection of non-MIME attachments." 300 "Configure detection of non-MIME attachments."
310 (interactive) 301 (interactive)
311 (if symbol (set-default symbol value)) 302 (if symbol (set-default symbol value))
312 (setq mm-uu-beginning-regexp nil) 303 (setq mm-uu-beginning-regexp
313 (mapcar (lambda (mm-uu-entry) 304 (mapconcat #'mm-uu-beginning-regexp
314 (if (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled) 305 (delq nil (mapcar
315 nil 306 (lambda (entry)
316 (setq mm-uu-beginning-regexp 307 (if (mm-uu-configure-p (mm-uu-type entry)
317 (concat mm-uu-beginning-regexp 308 'disabled)
318 (if mm-uu-beginning-regexp "\\|") 309 nil entry))
319 (mm-uu-beginning-regexp mm-uu-entry))))) 310 mm-uu-type-alist))
320 mm-uu-type-alist)) 311 "\\|")))
321 312
322(mm-uu-configure) 313(mm-uu-configure)
323 314
@@ -481,7 +472,7 @@ apply the face `mm-uu-extract'."
481 (narrow-to-region (point) end-point) 472 (narrow-to-region (point) end-point)
482 (mm-dissect-buffer t))) 473 (mm-dissect-buffer t)))
483 474
484(defun mm-uu-pgp-signed-test (&rest rest) 475(defun mm-uu-pgp-signed-test (&rest _)
485 (and 476 (and
486 mml2015-use 477 mml2015-use
487 (mml2015-clear-verify-function) 478 (mml2015-clear-verify-function)
@@ -495,7 +486,7 @@ apply the face `mm-uu-extract'."
495 486
496(defvar gnus-newsgroup-charset) 487(defvar gnus-newsgroup-charset)
497 488
498(defun mm-uu-pgp-signed-extract-1 (handles ctl) 489(defun mm-uu-pgp-signed-extract-1 (_handles _ctl)
499 (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))) 490 (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
500 (with-current-buffer buf 491 (with-current-buffer buf
501 (if (mm-uu-pgp-signed-test) 492 (if (mm-uu-pgp-signed-test)
@@ -530,7 +521,7 @@ apply the face `mm-uu-extract'."
530 mm-security-handle))) 521 mm-security-handle)))
531 mm-security-handle)) 522 mm-security-handle))
532 523
533(defun mm-uu-pgp-encrypted-test (&rest rest) 524(defun mm-uu-pgp-encrypted-test (&rest _)
534 (and 525 (and
535 mml2015-use 526 mml2015-use
536 (mml2015-clear-decrypt-function) 527 (mml2015-clear-decrypt-function)
@@ -542,7 +533,7 @@ apply the face `mm-uu-extract'."
542 (y-or-n-p "Decrypt pgp encrypted part? ") 533 (y-or-n-p "Decrypt pgp encrypted part? ")
543 (message "")))))) 534 (message ""))))))
544 535
545(defun mm-uu-pgp-encrypted-extract-1 (handles ctl) 536(defun mm-uu-pgp-encrypted-extract-1 (_handles _ctl)
546 (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))) 537 (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))
547 (first t) 538 (first t)
548 charset) 539 charset)
@@ -599,6 +590,9 @@ apply the face `mm-uu-extract'."
599 mm-security-handle)) 590 mm-security-handle))
600 591
601(defun mm-uu-gpg-key-skip-to-last () 592(defun mm-uu-gpg-key-skip-to-last ()
593 ;; FIXME: Don't use mm-uu-entry (we know which entry it is anyway!).
594 ;; FIXME: Move it to function-2 so it doesn't need to check
595 ;; mm-uu-configure-p.
602 (let ((point (point)) 596 (let ((point (point))
603 (end-regexp (mm-uu-end-regexp mm-uu-entry)) 597 (end-regexp (mm-uu-end-regexp mm-uu-entry))
604 (beginning-regexp (mm-uu-beginning-regexp mm-uu-entry))) 598 (beginning-regexp (mm-uu-beginning-regexp mm-uu-entry)))
@@ -623,7 +617,7 @@ MIME-TYPE specifies a MIME type and parameters, which defaults to the
623value of `mm-uu-text-plain-type'." 617value of `mm-uu-text-plain-type'."
624 (let ((case-fold-search t) 618 (let ((case-fold-search t)
625 (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type)) 619 (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
626 text-start start-point end-point file-name result mm-uu-entry func) 620 text-start start-point end-point file-name result mm-uu-entry)
627 (save-excursion 621 (save-excursion
628 (goto-char (point-min)) 622 (goto-char (point-min))
629 (cond 623 (cond
@@ -644,8 +638,7 @@ value of `mm-uu-text-plain-type'."
644 beginning-regexp) 638 beginning-regexp)
645 (setq mm-uu-entry (car alist)) 639 (setq mm-uu-entry (car alist))
646 (pop alist)))) 640 (pop alist))))
647 (if (setq func (mm-uu-function-1 mm-uu-entry)) 641 (funcall (or (mm-uu-function-1 mm-uu-entry) #'ignore))
648 (funcall func))
649 (forward-line);; in case of failure 642 (forward-line);; in case of failure
650 (when (and (not (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled)) 643 (when (and (not (mm-uu-configure-p (mm-uu-type mm-uu-entry) 'disabled))
651 (let ((end-regexp (mm-uu-end-regexp mm-uu-entry))) 644 (let ((end-regexp (mm-uu-end-regexp mm-uu-entry)))
@@ -655,8 +648,8 @@ value of `mm-uu-text-plain-type'."
655 (re-search-forward end-regexp nil t) 648 (re-search-forward end-regexp nil t)
656 (forward-line) 649 (forward-line)
657 (setq end-point (point))))) 650 (setq end-point (point)))))
658 (or (not (setq func (mm-uu-function-2 mm-uu-entry))) 651 (funcall (or (mm-uu-function-2 mm-uu-entry)
659 (funcall func))) 652 (lambda () t))))
660 (if (and (> start-point text-start) 653 (if (and (> start-point text-start)
661 (progn 654 (progn
662 (goto-char text-start) 655 (goto-char text-start)