("octet-stream"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
- (type ."application/octet-stream"))
+ (type . "application/octet-stream"))
("dvi"
(viewer . "open %s")
(type . "application/dvi")
(defvar mailcap-parsed-p nil)
(defun mailcap-parse-mailcaps (&optional path force)
- "Parse out all the mailcaps specified in a unix-style path string PATH.
-If FORCE, re-parse even if already parsed."
+ "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system. If FORCE, re-parse even if already
+parsed. If PATH is omitted, use the value of environment variable
+MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
+/usr/local/etc/mailcap."
(interactive (list nil t))
(when (or (not mailcap-parsed-p)
force)
(path nil)
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name
- '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
- ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mailcap"
- "/etc/mailcap:/usr/etc/mailcap"
- "/usr/local/etc/mailcap") ":"))))
+ (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
+ (t (setq path
+ ;; This is per RFC 1524, specifically
+ ;; with /usr before /usr/local.
+ '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
+ "/usr/local/etc/mailcap"))))
(let ((fnames (reverse
- (split-string
- path (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";"
- ":"))))
+ (if (stringp path)
+ (parse-colon-path path)
+ path)))
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname)
+ (if (and (file-readable-p fname)
(file-regular-p fname))
- (mailcap-parse-mailcap (car fnames)))
+ (mailcap-parse-mailcap fname))
(setq fnames (cdr fnames))))
- (setq mailcap-parsed-p t)))
+ (setq mailcap-parsed-p t)))
(defun mailcap-parse-mailcap (fname)
;; Parse out the mailcap file specified by FNAME
(insert-file-contents fname)
(set-syntax-table mailcap-parse-args-syntax-table)
(mailcap-replace-regexp "#.*" "") ; Remove all comments
+ (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
(mailcap-replace-regexp "\n+" "\n") ; And blank lines
- (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces
- (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "")
(goto-char (point-max))
(skip-chars-backward " \t\n")
(delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
+ (while (not (bobp))
+ (skip-chars-backward " \t\n")
+ (beginning-of-line)
(setq save-pos (point)
info nil)
(skip-chars-forward "^/; \t\n")
(downcase-region save-pos (point))
(setq major (buffer-substring save-pos (point)))
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t")
(setq minor "")
(when (eq (char-after) ?/)
(forward-char)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t")
(setq save-pos (point))
(skip-chars-forward "^; \t\n")
(downcase-region save-pos (point))
((eq ?* (or (char-after save-pos) 0)) ".*")
((= (point) save-pos) ".*")
(t (regexp-quote (buffer-substring save-pos (point)))))))
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t")
;;; Got the major/minor chunks, now for the viewers/etc
;;; The first item _must_ be a viewer, according to the
;;; RFC for mailcap files (#1343)
(setq viewer "")
(when (eq (char-after) ?\;)
(forward-char)
- (skip-chars-forward " \t\n")
+ (skip-chars-forward " \t")
(setq save-pos (point))
(skip-chars-forward "^;\n")
;; skip \;
"*" minor))))
(mailcap-parse-mailcap-extras save-pos (point))))
(mailcap-mailcap-entry-passes-test info)
- (mailcap-add-mailcap-entry major minor info))))))
+ (mailcap-add-mailcap-entry major minor info))
+ (beginning-of-line)))))
(defun mailcap-parse-mailcap-extras (st nd)
;; Grab all the extra stuff from a mailcap entry
((and minor (string-match (car (car major)) minor))
(setq wildcard (cons (cdr (car major)) wildcard))))
(setq major (cdr major)))
- (nconc (nreverse exact) (nreverse wildcard))))
+ (nconc exact wildcard)))
(defun mailcap-unescape-mime-test (test type-info)
(let (save-pos save-chr subst)
(setq mailcap-mime-data
(cons (cons major (list (cons minor info)))
mailcap-mime-data))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assq 'test info)) ; Has a test, insert at beginning
- (setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assq 'test info)) ; No test info, replace completely
- (not (assq 'test cur-minor)))
- (setcdr cur-minor info))
- (t
- (setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
+ (let ((cur-minor (assoc minor old-major)))
+ (cond
+ ((or (null cur-minor) ; New minor area, or
+ (assq 'test info)) ; Has a test, insert at beginning
+ (setcdr old-major (cons (cons minor info) (cdr old-major))))
+ ((and (not (assq 'test info)) ; No test info, replace completely
+ (not (assq 'test cur-minor))
+ (equal (assq 'viewer info) ; Keep alternative viewer
+ (assq 'viewer cur-minor)))
+ (setcdr cur-minor info))
+ (t
+ (setcdr old-major (cons (cons minor info) (cdr old-major))))))
+ )))
(defun mailcap-add (type viewer &optional test)
"Add VIEWER as a handler for TYPE.
(if (mailcap-viewer-passes-test (car viewers) info)
(setq passed (cons (car viewers) passed)))
(setq viewers (cdr viewers)))
- (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
+ (setq passed (sort passed 'mailcap-viewer-lessp))
(setq viewer (car passed))))
- (setq passed (nreverse passed))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
(setq viewer (car passed)))
"An assoc list of file extensions and corresponding MIME content-types.")
(defun mailcap-parse-mimetypes (&optional path)
- ;; Parse out all the mimetypes specified in a unix-style path string PATH
+ "Parse out all the mimetypes specified in a unix-style path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system. If PATH is omitted, use the value of
+environment variable MIMETYPES if set; otherwise use a default path."
(cond
(path nil)
((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name
- '("~/mime.typ" "~/etc/mime.typ") ";")))
- (t (setq path (mapconcat
- 'expand-file-name
- ;; mime.types seems to be the normal name,
- ;; definitely so on current GNUish systems. The
- ;; ordering follows that for mailcap.
- '("~/.mime.types"
- "/etc/mime.types"
- "/usr/etc/mime.types"
- "/usr/local/etc/mime.types"
- "/usr/local/www/conf/mime.types"
- "~/.mime-types"
- "/etc/mime-types"
- "/usr/etc/mime-types"
- "/usr/local/etc/mime-types"
- "/usr/local/www/conf/mime-types") ":"))))
- (let ((fnames (reverse
- (split-string path
- (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";" ":"))))
+ (setq path '("~/mime.typ" "~/etc/mime.typ")))
+ (t (setq path
+ ;; mime.types seems to be the normal name, definitely so
+ ;; on current GNUish systems. The search order follows
+ ;; that for mailcap.
+ '("~/.mime.types"
+ "/etc/mime.types"
+ "/usr/etc/mime.types"
+ "/usr/local/etc/mime.types"
+ "/usr/local/www/conf/mime.types"
+ "~/.mime-types"
+ "/etc/mime-types"
+ "/usr/etc/mime-types"
+ "/usr/local/etc/mime-types"
+ "/usr/local/www/conf/mime-types"))))
+ (let ((fnames (reverse (if (stringp path)
+ (parse-colon-path path)
+ path)))
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
- (mailcap-parse-mimetype-file (car fnames)))
+ (if (and (file-readable-p fname))
+ (mailcap-parse-mimetype-file fname))
(setq fnames (cdr fnames)))))
(defun mailcap-parse-mimetype-file (fname)
projects / elisp / gnus.git- / blobdiff