(write-region (point-min) (point-max) file))
(kill-buffer (current-buffer))))
+(defvar mailcap-maybe-eval-warning
+ "*** WARNING ***
+
+This MIME part contains untrusted and possibly harmful content.
+If you evaluate the Emacs Lisp code contained in it, a lot of nasty
+things can happen. Please examine the code very carefully before you
+instruct Emacs to evaluate it. You can browse the buffer containing
+the code using \\[scroll-other-window].
+
+If you are unsure what to do, please answer \"no\"."
+ "Text of warning message displayed by `mailcap-maybe-eval'.
+Make sure that this text consists only of few text lines. Otherwise,
+Gnus might fail to display all of it.")
+
(defun mailcap-maybe-eval ()
"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)))
+ (let ((lisp-buffer (current-buffer)))
+ (goto-char (point-min))
+ (when
+ (save-window-excursion
+ (delete-other-windows)
+ (let ((buffer (get-buffer-create (generate-new-buffer-name
+ "*Warning*"))))
+ (unwind-protect
+ (with-current-buffer buffer
+ (insert (substitute-command-keys
+ mailcap-maybe-eval-warning))
+ (goto-char (point-min))
+ (display-buffer buffer)
+ (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
+ (kill-buffer buffer))))
+ (eval-buffer (current-buffer)))
+ (when (buffer-live-p lisp-buffer)
+ (with-current-buffer lisp-buffer
+ (emacs-lisp-mode)))))
+
;;;
;;; The mailcap parser
(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)
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
((memq system-type '(ms-dos ms-windows windows-nt))
(setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
- (t (setq path '("~/.mailcap" "/usr/etc/mailcap" "/etc/mailcap"
- "/usr/local/etc/mailcap"))))
+ (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
(if (stringp path)
- (split-string
- path (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";"
- ":"))
+ (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)))
(".jpeg" . "image/jpeg"))
"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
- (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))
- ";" ":"))))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
- (mailcap-parse-mimetype-file (car fnames)))
- (setq fnames (cdr fnames)))))
+(defvar mailcap-mimetypes-parsed-p nil)
+
+(defun mailcap-parse-mimetypes (&optional path force)
+ "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.
+If FORCE, re-parse even if already parsed."
+ (interactive (list nil t))
+ (when (or (not mailcap-mimetypes-parsed-p)
+ force)
+ (cond
+ (path nil)
+ ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
+ ((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-readable-p fname))
+ (mailcap-parse-mimetype-file fname))
+ (setq fnames (cdr fnames))))
+ (setq mailcap-mimetypes-parsed-p t)))
(defun mailcap-parse-mimetype-file (fname)
;; Parse out a mime-types file
(while (not (eobp))
(skip-chars-forward " \t\n")
(setq save-pos (point))
- (skip-chars-forward "^ \t")
+ (skip-chars-forward "^ \t\n")
(downcase-region save-pos (point))
(setq type (buffer-substring save-pos (point)))
(while (not (eolp))
(defun mailcap-extension-to-mime (extn)
"Return the MIME content type of the file extensions EXTN."
+ (mailcap-parse-mimetypes)
(if (and (stringp extn)
(not (eq (string-to-char extn) ?.)))
(setq extn (concat "." extn)))
(defun mailcap-mime-types ()
"Return a list of MIME media types."
- (mm-delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+ (mailcap-parse-mimetypes)
+ (mm-delete-duplicates
+ (nconc
+ (mapcar 'cdr mailcap-mime-extensions)
+ (apply
+ 'nconc
+ (mapcar
+ (lambda (l)
+ (delq nil
+ (mapcar
+ (lambda (m)
+ (let ((type (cdr (assq 'type (cdr m)))))
+ (if (equal (cadr (split-string type "/"))
+ "*")
+ nil
+ type)))
+ (cdr l))))
+ mailcap-mime-data)))))
(provide 'gnus-mailcap)
projects / elisp / gnus.git- / blobdiff