aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/net/mailcap.el56
1 files changed, 38 insertions, 18 deletions
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 414ba0fd852..a8ade01e818 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -427,20 +427,32 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
427 ((memq system-type mailcap-poor-system-types) 427 ((memq system-type mailcap-poor-system-types)
428 (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap"))) 428 (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
429 (t (setq path 429 (t (setq path
430 ;; This is per RFC 1524, specifically 430 ;; This is per RFC 1524, specifically with /usr before
431 ;; with /usr before /usr/local. 431 ;; /usr/local.
432 '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap" 432 '("~/.mailcap"
433 "/usr/local/etc/mailcap")))) 433 ("/etc/mailcap" 'after)
434 (dolist (fname (reverse 434 ("/usr/etc/mailcap" 'after)
435 (if (stringp path) 435 ("/usr/local/etc/mailcap" 'after)))))
436 (split-string path path-separator t) 436 ;; We read the entries from ~/.mailcap before the built-in values,
437 path))) 437 ;; but place the rest of then afterwards as fallback values.
438 (when (and (file-readable-p fname) (file-regular-p fname)) 438 (dolist (spec (reverse
439 (mailcap-parse-mailcap fname))) 439 (if (stringp path)
440 (split-string path path-separator t)
441 path)))
442 (let ((afterp (and (consp spec)
443 (cadr spec)))
444 (file-name (if (stringp spec)
445 spec
446 (car spec))))
447 (when (and (file-readable-p file-name)
448 (file-regular-p file-name))
449 (mailcap-parse-mailcap file-name afterp))))
440 (setq mailcap-parsed-p t))) 450 (setq mailcap-parsed-p t)))
441 451
442(defun mailcap-parse-mailcap (fname) 452(defun mailcap-parse-mailcap (fname &optional after)
443 "Parse out the mailcap file specified by FNAME." 453 "Parse out the mailcap file specified by FNAME.
454If AFTER, place the entries from the file after the ones that are
455already there."
444 (let (major ; The major mime type (image/audio/etc) 456 (let (major ; The major mime type (image/audio/etc)
445 minor ; The minor mime type (gif, basic, etc) 457 minor ; The minor mime type (gif, basic, etc)
446 save-pos ; Misc saved positions used in parsing 458 save-pos ; Misc saved positions used in parsing
@@ -510,7 +522,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
510 "*" minor)))) 522 "*" minor))))
511 (mailcap-parse-mailcap-extras save-pos (point)))) 523 (mailcap-parse-mailcap-extras save-pos (point))))
512 (mailcap-mailcap-entry-passes-test info) 524 (mailcap-mailcap-entry-passes-test info)
513 (mailcap-add-mailcap-entry major minor info)) 525 (mailcap-add-mailcap-entry major minor info after))
514 (beginning-of-line))))) 526 (beginning-of-line)))))
515 527
516(defun mailcap-parse-mailcap-extras (st nd) 528(defun mailcap-parse-mailcap-extras (st nd)
@@ -693,7 +705,7 @@ to supply to the test."
693 (push (list otest result) mailcap-viewer-test-cache) 705 (push (list otest result) mailcap-viewer-test-cache)
694 result)))) 706 result))))
695 707
696(defun mailcap-add-mailcap-entry (major minor info) 708(defun mailcap-add-mailcap-entry (major minor info &optional after)
697 (let ((old-major (assoc major mailcap-mime-data))) 709 (let ((old-major (assoc major mailcap-mime-data)))
698 (if (null old-major) ; New major area 710 (if (null old-major) ; New major area
699 (push (cons major (list (cons minor info))) mailcap-mime-data) 711 (push (cons major (list (cons minor info))) mailcap-mime-data)
@@ -701,15 +713,23 @@ to supply to the test."
701 (cond 713 (cond
702 ((or (null cur-minor) ; New minor area, or 714 ((or (null cur-minor) ; New minor area, or
703 (assq 'test info)) ; Has a test, insert at beginning 715 (assq 'test info)) ; Has a test, insert at beginning
704 (setcdr old-major (cons (cons minor info) (cdr old-major)))) 716 (setcdr old-major
717 (if after ; Or after, if specified.
718 (nconc (cdr old-major)
719 (list (cons minor info)))
720 (cons (cons minor info) (cdr old-major)))))
705 ((and (not (assq 'test info)) ; No test info, replace completely 721 ((and (not (assq 'test info)) ; No test info, replace completely
706 (not (assq 'test cur-minor)) 722 (not (assq 'test cur-minor))
707 (equal (assq 'viewer info) ; Keep alternative viewer 723 (equal (assq 'viewer info) ; Keep alternative viewer
708 (assq 'viewer cur-minor))) 724 (assq 'viewer cur-minor)))
709 (setcdr cur-minor info)) 725 (unless after
726 (setcdr cur-minor info)))
710 (t 727 (t
711 (setcdr old-major (cons (cons minor info) (cdr old-major)))))) 728 (setcdr old-major
712 ))) 729 (if after
730 (nconc (cdr old-major) (list (cons minor info)))
731 (setcdr old-major
732 (cons (cons minor info) (cdr old-major)))))))))))
713 733
714(defun mailcap-add (type viewer &optional test) 734(defun mailcap-add (type viewer &optional test)
715 "Add VIEWER as a handler for TYPE. 735 "Add VIEWER as a handler for TYPE.