(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
(".jpeg" . "image/jpeg"))
"An assoc list of file extensions and corresponding MIME content-types.")
-(defun mailcap-parse-mimetypes (&optional path)
+(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."
- (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)))))
+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 'mailcap)
projects / gnus / blobdiff