X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmailcap.el;h=426c70d45c31f342900e48b0e10c2afc72001166;hb=e4cd2c48b6a75de831dbe75d76ea3107c7062ba6;hp=b576100bd216ad30f13057be7bccde61cea503be;hpb=5b8ecce52d86ed7352e6e5b5d768c34321a4c58d;p=gnus diff --git a/lisp/mailcap.el b/lisp/mailcap.el index b576100bd..426c70d45 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -26,9 +26,9 @@ ;;; Code: -(eval-and-compile - (require 'cl)) +(eval-when-compile (require 'cl)) (require 'mail-parse) +(require 'mm-util) (defvar mailcap-parse-args-syntax-table (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) @@ -119,12 +119,6 @@ ("x-mpeg" (viewer . "maplay %s") (type . "audio/x-mpeg")) - (".*" - (viewer . mailcap-save-binary-file) - (non-viewer . t) - (test . (or (featurep 'nas-sound) - (featurep 'native-sound))) - (type . "audio/*")) (".*" (viewer . "showaudio") (type . "audio/*"))) @@ -219,7 +213,7 @@ (viewer . tar-mode) (type . "archive/tar") (test . (fboundp 'tar-mode))))) - "The mailcap structure is an assoc list of assoc lists. + "The mailcap structure is an assoc list of assoc lists. 1st assoc list is keyed on the major content-type 2nd assoc list is keyed on the minor content-type (which can be a regexp) @@ -261,7 +255,7 @@ not.") ;;; (defun mailcap-generate-unique-filename (&optional fmt) - "Generate a unique filename in mailcap-temporary-directory" + "Generate a unique filename in mailcap-temporary-directory." (if (not fmt) (let ((base (format "mailcap-tmp.%d" (user-real-uid))) (fname "") @@ -293,7 +287,7 @@ not.") (kill-buffer (current-buffer)))) (defun mailcap-maybe-eval () - "Maybe evaluate a buffer of emacs lisp code" + "Maybe evaluate a buffer of emacs lisp code." (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ") (eval-buffer (current-buffer)) (emacs-lisp-mode))) @@ -336,8 +330,8 @@ If FORCE, re-parse even if already parsed." fname) (while fnames (setq fname (car fnames)) - (if (and (file-exists-p fname) (file-readable-p fname) - (file-regular-p fname)) + (if (and (file-exists-p fname) (file-readable-p fname) + (file-regular-p fname)) (mailcap-parse-mailcap (car fnames))) (setq fnames (cdr fnames)))) (setq mailcap-parsed-p t))) @@ -365,43 +359,56 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward " \t\n") (setq save-pos (point) info nil) - (skip-chars-forward "^/;") + (skip-chars-forward "^/; \t\n") (downcase-region save-pos (point)) (setq major (buffer-substring save-pos (point))) - (skip-chars-forward "/ \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;") - (downcase-region save-pos (point)) - (setq minor - (cond - ((eq ?* (or (char-after save-pos) 0)) ".*") - ((= (point) save-pos) ".*") - (t (buffer-substring save-pos (point))))) - (skip-chars-forward "; \t\n") + (skip-chars-forward " \t\n") + (setq minor "") + (when (eq (char-after) ?/) + (forward-char) + (skip-chars-forward " \t\n") + (setq save-pos (point)) + (skip-chars-forward "^; \t\n") + (downcase-region save-pos (point)) + (setq minor + (cond + ((eq ?* (or (char-after save-pos) 0)) ".*") + ((= (point) save-pos) ".*") + (t (regexp-quote (buffer-substring save-pos (point))))))) + (skip-chars-forward " \t\n") ;;; 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) - (skip-chars-forward "; \t\n") - (setq save-pos (point)) - (skip-chars-forward "^;\n") - (if (eq (or (char-after save-pos) 0) ?') - (setq viewer (progn - (narrow-to-region (1+ save-pos) (point)) - (goto-char (point-min)) - (prog1 - (read (current-buffer)) - (goto-char (point-max)) - (widen)))) - (setq viewer (buffer-substring save-pos (point)))) + (setq viewer "") + (when (eq (char-after) ?\;) + (forward-char) + (skip-chars-forward " \t\n") + (setq save-pos (point)) + (skip-chars-forward "^;\n") + ;; skip \; + (while (eq (char-before) ?\\) + (backward-delete-char 1) + (forward-char) + (skip-chars-forward "^;\n")) + (if (eq (or (char-after save-pos) 0) ?') + (setq viewer (progn + (narrow-to-region (1+ save-pos) (point)) + (goto-char (point-min)) + (prog1 + (read (current-buffer)) + (goto-char (point-max)) + (widen)))) + (setq viewer (buffer-substring save-pos (point))))) (setq save-pos (point)) (end-of-line) - (setq info (nconc (list (cons 'viewer viewer) - (cons 'type (concat major "/" - (if (string= minor ".*") - "*" minor)))) - (mailcap-parse-mailcap-extras save-pos (point)))) - (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info))))) + (unless (equal viewer "") + (setq info (nconc (list (cons 'viewer viewer) + (cons 'type (concat major "/" + (if (string= minor ".*") + "*" minor)))) + (mailcap-parse-mailcap-extras save-pos (point)))) + (mailcap-mailcap-entry-passes-test info) + (mailcap-add-mailcap-entry major minor info)))))) (defun mailcap-parse-mailcap-extras (st nd) ;; Grab all the extra stuff from a mailcap entry @@ -419,14 +426,13 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward " \n\t;") (while (not (eobp)) (setq done nil) - (skip-chars-forward " \";\n\t") (setq name-pos (point)) - (skip-chars-forward "^ \n\t=") + (skip-chars-forward "^ \n\t=;") (downcase-region name-pos (point)) (setq name (buffer-substring name-pos (point))) (skip-chars-forward " \t\n") (if (not (eq (char-after (point)) ?=)) ; There is no value - (setq value nil) + (setq value t) (skip-chars-forward " \t\n=") (setq val-pos (point)) (if (memq (char-after val-pos) '(?\" ?')) @@ -445,7 +451,8 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward ";")) (setq done t)))) (setq value (buffer-substring val-pos (point)))) - (setq results (cons (cons name value) results))) + (setq results (cons (cons name value) results)) + (skip-chars-forward " \";\n\t")) results))) (defun mailcap-mailcap-entry-passes-test (info) @@ -456,6 +463,7 @@ If FORCE, re-parse even if already parsed." ) (setq status (and test (split-string (cdr test) " "))) (if (and (or (assoc "needsterm" info) + (assoc "needsterminal" info) (assoc "needsx11" info)) (not (getenv "DISPLAY"))) (setq status nil) @@ -587,7 +595,7 @@ If FORCE, re-parse even if already parsed." ((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 + ((and (not (assq 'test info)) ; No test info, replace completely (not (assq 'test cur-minor))) (setcdr cur-minor info)) (t @@ -617,12 +625,12 @@ If TEST is not given, it defaults to t." (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) "")))) (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) ""))))) (cond - ((and x-lisp (not y-lisp)) - t) - ((and (not y-lisp) x-wild (not y-wild)) - t) + ((and x-wild (not y-wild)) + nil) ((and (not x-wild) y-wild) t) + ((and (not y-lisp) x-lisp) + t) (t nil)))) (defun mailcap-mime-info (string &optional request) @@ -680,7 +688,7 @@ this type is returned." passed) (t ;; MUST make a copy *sigh*, else we modify mailcap-mime-data - (setq viewer (copy-tree viewer)) + (setq viewer (copy-sequence viewer)) (let ((view (assq 'viewer viewer)) (test (assq 'test viewer))) (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info))) @@ -706,6 +714,7 @@ this type is returned." (".cpio" . "application/x-cpio") (".csh" . "application/x-csh") (".dvi" . "application/x-dvi") + (".diff" . "text/x-patch") (".el" . "application/emacs-lisp") (".eps" . "application/postscript") (".etx" . "text/x-setext") @@ -740,7 +749,7 @@ this type is returned." (".nc" . "application/x-netcdf") (".nc" . "application/x-netcdf") (".oda" . "application/oda") - (".patch" . "application/x-patch") + (".patch" . "text/x-patch") (".pbm" . "image/x-portable-bitmap") (".pdf" . "application/pdf") (".pgm" . "image/portable-graymap") @@ -872,6 +881,10 @@ The path of COMMAND will be returned iff COMMAND is a command." (not (file-directory-p file))) (throw 'found file)))))))) +(defun mailcap-mime-types () + "Return a list of MIME media types." + (mm-delete-duplicates (mapcar 'cdr mailcap-mime-extensions))) + (provide 'mailcap) ;;; mailcap.el ends here