diff options
| -rw-r--r-- | lisp/net/mailcap.el | 74 |
1 files changed, 29 insertions, 45 deletions
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f80b300084b..f71d7ba6675 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el | |||
| @@ -29,7 +29,7 @@ | |||
| 29 | 29 | ||
| 30 | ;;; Code: | 30 | ;;; Code: |
| 31 | 31 | ||
| 32 | (eval-when-compile (require 'cl)) | 32 | (eval-when-compile (require 'cl-lib)) |
| 33 | (autoload 'mail-header-parse-content-type "mail-parse") | 33 | (autoload 'mail-header-parse-content-type "mail-parse") |
| 34 | 34 | ||
| 35 | (defgroup mailcap nil | 35 | (defgroup mailcap nil |
| @@ -62,20 +62,20 @@ | |||
| 62 | (let ((val (default-value sym)) | 62 | (let ((val (default-value sym)) |
| 63 | res) | 63 | res) |
| 64 | (dolist (entry val) | 64 | (dolist (entry val) |
| 65 | (setq res (cons (list (cdr (assq 'viewer entry)) | 65 | (push (list (cdr (assq 'viewer entry)) |
| 66 | (cdr (assq 'type entry)) | 66 | (cdr (assq 'type entry)) |
| 67 | (cdr (assq 'test entry))) | 67 | (cdr (assq 'test entry))) |
| 68 | res))) | 68 | res)) |
| 69 | (nreverse res))) | 69 | (nreverse res))) |
| 70 | 70 | ||
| 71 | (defun mailcap--set-user-mime-data (sym val) | 71 | (defun mailcap--set-user-mime-data (sym val) |
| 72 | (let (res) | 72 | (let (res) |
| 73 | (dolist (entry val) | 73 | (dolist (entry val) |
| 74 | (setq res (cons `((viewer . ,(car entry)) | 74 | (push `((viewer . ,(car entry)) |
| 75 | (type . ,(cadr entry)) | 75 | (type . ,(cadr entry)) |
| 76 | ,@(when (caddr entry) | 76 | ,@(when (cl-caddr entry) |
| 77 | `((test . ,(caddr entry))))) | 77 | `((test . ,(cl-caddr entry))))) |
| 78 | res))) | 78 | res)) |
| 79 | (set-default sym (nreverse res)))) | 79 | (set-default sym (nreverse res)))) |
| 80 | 80 | ||
| 81 | (defcustom mailcap-user-mime-data nil | 81 | (defcustom mailcap-user-mime-data nil |
| @@ -430,18 +430,14 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus | |||
| 430 | ;; with /usr before /usr/local. | 430 | ;; with /usr before /usr/local. |
| 431 | '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" | 431 | '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" |
| 432 | "/usr/local/etc/mailcap")))) | 432 | "/usr/local/etc/mailcap")))) |
| 433 | (let ((fnames (reverse | 433 | (dolist (fname (reverse |
| 434 | (if (stringp path) | 434 | (if (stringp path) |
| 435 | (split-string path path-separator t) | 435 | (split-string path path-separator t) |
| 436 | path))) | 436 | path))) |
| 437 | fname) | 437 | (if (and (file-readable-p fname) |
| 438 | (while fnames | 438 | (file-regular-p fname)) |
| 439 | (setq fname (car fnames)) | 439 | (mailcap-parse-mailcap fname))) |
| 440 | (if (and (file-readable-p fname) | 440 | (setq mailcap-parsed-p t))) |
| 441 | (file-regular-p fname)) | ||
| 442 | (mailcap-parse-mailcap fname)) | ||
| 443 | (setq fnames (cdr fnames)))) | ||
| 444 | (setq mailcap-parsed-p t))) | ||
| 445 | 441 | ||
| 446 | (defun mailcap-parse-mailcap (fname) | 442 | (defun mailcap-parse-mailcap (fname) |
| 447 | "Parse out the mailcap file specified by FNAME." | 443 | "Parse out the mailcap file specified by FNAME." |
| @@ -560,10 +556,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus | |||
| 560 | (setq value (buffer-substring val-pos (point)))) | 556 | (setq value (buffer-substring val-pos (point)))) |
| 561 | ;; `test' as symbol, others like "copiousoutput" and "needsx11" as | 557 | ;; `test' as symbol, others like "copiousoutput" and "needsx11" as |
| 562 | ;; strings | 558 | ;; strings |
| 563 | (setq results (cons (cons (if (string-equal name "test") | 559 | (push (cons (if (string-equal name "test") 'test name) value) results) |
| 564 | 'test | ||
| 565 | name) | ||
| 566 | value) results)) | ||
| 567 | (skip-chars-forward " \";\n\t")) | 560 | (skip-chars-forward " \";\n\t")) |
| 568 | results))) | 561 | results))) |
| 569 | 562 | ||
| @@ -607,9 +600,9 @@ the test clause will be unchanged." | |||
| 607 | (while major | 600 | (while major |
| 608 | (cond | 601 | (cond |
| 609 | ((equal (car (car major)) minor) | 602 | ((equal (car (car major)) minor) |
| 610 | (setq exact (cons (cdr (car major)) exact))) | 603 | (push (cdr (car major)) exact)) |
| 611 | ((and minor (string-match (concat "^" (car (car major)) "$") minor)) | 604 | ((and minor (string-match (concat "^" (car (car major)) "$") minor)) |
| 612 | (setq wildcard (cons (cdr (car major)) wildcard)))) | 605 | (push (cdr (car major)) wildcard))) |
| 613 | (setq major (cdr major))) | 606 | (setq major (cdr major))) |
| 614 | (nconc exact wildcard))) | 607 | (nconc exact wildcard))) |
| 615 | 608 | ||
| @@ -672,7 +665,7 @@ to supply to the test." | |||
| 672 | (otest test) | 665 | (otest test) |
| 673 | (viewer (cdr (assq 'viewer viewer-info))) | 666 | (viewer (cdr (assq 'viewer viewer-info))) |
| 674 | (default-directory (expand-file-name "~/")) | 667 | (default-directory (expand-file-name "~/")) |
| 675 | status parsed-test cache result) | 668 | status cache result) |
| 676 | (cond ((not (or (stringp viewer) (fboundp viewer))) | 669 | (cond ((not (or (stringp viewer) (fboundp viewer))) |
| 677 | nil) ; Non-existent Lisp function | 670 | nil) ; Non-existent Lisp function |
| 678 | ((setq cache (assoc test mailcap-viewer-test-cache)) | 671 | ((setq cache (assoc test mailcap-viewer-test-cache)) |
| @@ -704,9 +697,7 @@ to supply to the test." | |||
| 704 | (defun mailcap-add-mailcap-entry (major minor info) | 697 | (defun mailcap-add-mailcap-entry (major minor info) |
| 705 | (let ((old-major (assoc major mailcap-mime-data))) | 698 | (let ((old-major (assoc major mailcap-mime-data))) |
| 706 | (if (null old-major) ; New major area | 699 | (if (null old-major) ; New major area |
| 707 | (setq mailcap-mime-data | 700 | (push (cons major (list (cons minor info))) mailcap-mime-data) |
| 708 | (cons (cons major (list (cons minor info))) | ||
| 709 | mailcap-mime-data)) | ||
| 710 | (let ((cur-minor (assoc minor old-major))) | 701 | (let ((cur-minor (assoc minor old-major))) |
| 711 | (cond | 702 | (cond |
| 712 | ((or (null cur-minor) ; New minor area, or | 703 | ((or (null cur-minor) ; New minor area, or |
| @@ -786,10 +777,7 @@ If NO-DECODE is non-nil, don't decode STRING." | |||
| 786 | major ; Major encoding (text, etc) | 777 | major ; Major encoding (text, etc) |
| 787 | minor ; Minor encoding (html, etc) | 778 | minor ; Minor encoding (html, etc) |
| 788 | info ; Other info | 779 | info ; Other info |
| 789 | save-pos ; Misc. position during parse | ||
| 790 | major-info ; (assoc major mailcap-mime-data) | 780 | major-info ; (assoc major mailcap-mime-data) |
| 791 | minor-info ; (assoc minor major-info) | ||
| 792 | test ; current test proc. | ||
| 793 | viewers ; Possible viewers | 781 | viewers ; Possible viewers |
| 794 | passed ; Viewers that passed the test | 782 | passed ; Viewers that passed the test |
| 795 | viewer ; The one and only viewer | 783 | viewer ; The one and only viewer |
| @@ -815,7 +803,7 @@ If NO-DECODE is non-nil, don't decode STRING." | |||
| 815 | (cdr ctl))) | 803 | (cdr ctl))) |
| 816 | (while viewers | 804 | (while viewers |
| 817 | (if (mailcap-viewer-passes-test (car viewers) info) | 805 | (if (mailcap-viewer-passes-test (car viewers) info) |
| 818 | (setq passed (cons (car viewers) passed))) | 806 | (push (car viewers) passed)) |
| 819 | (setq viewers (cdr viewers))) | 807 | (setq viewers (cdr viewers))) |
| 820 | (setq passed (sort passed 'mailcap-viewer-lessp)) | 808 | (setq passed (sort passed 'mailcap-viewer-lessp)) |
| 821 | (setq viewer (car passed)))) | 809 | (setq viewer (car passed)))) |
| @@ -980,15 +968,11 @@ If FORCE, re-parse even if already parsed." | |||
| 980 | "/usr/etc/mime-types" | 968 | "/usr/etc/mime-types" |
| 981 | "/usr/local/etc/mime-types" | 969 | "/usr/local/etc/mime-types" |
| 982 | "/usr/local/www/conf/mime-types")))) | 970 | "/usr/local/www/conf/mime-types")))) |
| 983 | (let ((fnames (reverse (if (stringp path) | 971 | (dolist (fname (reverse (if (stringp path) |
| 984 | (split-string path path-separator t) | 972 | (split-string path path-separator t) |
| 985 | path))) | 973 | path))) |
| 986 | fname) | 974 | (if (and (file-readable-p fname)) |
| 987 | (while fnames | 975 | (mailcap-parse-mimetype-file fname))) |
| 988 | (setq fname (car fnames)) | ||
| 989 | (if (and (file-readable-p fname)) | ||
| 990 | (mailcap-parse-mimetype-file fname)) | ||
| 991 | (setq fnames (cdr fnames)))) | ||
| 992 | (setq mailcap-mimetypes-parsed-p t))) | 976 | (setq mailcap-mimetypes-parsed-p t))) |
| 993 | 977 | ||
| 994 | (defun mailcap-parse-mimetype-file (fname) | 978 | (defun mailcap-parse-mimetype-file (fname) |