diff options
Diffstat (limited to 'lisp/gnus/mm-decode.el')
| -rw-r--r-- | lisp/gnus/mm-decode.el | 119 |
1 files changed, 31 insertions, 88 deletions
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 3ea63c74034..f45337dc042 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -28,9 +28,6 @@ (eval-when-compile (require 'cl)) (autoload 'gnus-map-function "gnus-util") -(autoload 'gnus-replace-in-string "gnus-util") -(autoload 'gnus-read-shell-command "gnus-util") -(autoload 'gnus-format-message "gnus-util") (autoload 'mm-inline-partial "mm-partial") (autoload 'mm-inline-external-body "mm-extern") @@ -291,10 +288,7 @@ before the external MIME handler is invoked." (mm-insert-part handle) (let ((image (ignore-errors - (if (fboundp 'create-image) - (create-image (buffer-string) 'imagemagick 'data-p) - (mm-create-image-xemacs - (mm-handle-media-subtype handle)))))) + (create-image (buffer-string) 'imagemagick 'data-p)))) (when image (setcar (cdr handle) (list "image/imagemagick")) (mm-image-fit-p handle))))))) @@ -388,12 +382,7 @@ enables you to choose manually one of two types those mails include." :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'. :group 'mime-display) -(defcustom mm-tmp-directory - (if (fboundp 'temp-directory) - (temp-directory) - (if (boundp 'temporary-file-directory) - temporary-file-directory - "/tmp/")) +(defcustom mm-tmp-directory temporary-file-directory "Where mm will store its temporary files." :type 'directory :group 'mime-display) @@ -778,7 +767,7 @@ MIME-Version header before proceeding." (with-current-buffer (generate-new-buffer " *mm*") ;; Preserve the data's unibyteness (for url-insert-file-contents). - (mm-set-buffer-multibyte mb) + (set-buffer-multibyte mb) (insert-buffer-substring obuf beg) (current-buffer)))) @@ -862,7 +851,7 @@ external if displayed external." (concat "using external program \"" (format method filename) "\"") - (gnus-format-message + (format-message "by calling `%s' on the contents)" method)) "? ")))))) (if external @@ -893,7 +882,7 @@ external if displayed external." (select-window win))) (switch-to-buffer (generate-new-buffer " *mm*"))) (buffer-disable-undo) - (mm-set-buffer-file-coding-system mm-binary-coding-system) + (set-buffer-file-coding-system mm-binary-coding-system) (insert-buffer-substring cur) (goto-char (point-min)) (when method @@ -920,7 +909,7 @@ external if displayed external." ;; The function is a string to be executed. (mm-insert-part handle) (mm-add-meta-html-tag handle) - (let* ((dir (mm-make-temp-file + (let* ((dir (make-temp-file (expand-file-name "emm." mm-tmp-directory) 'dir)) (filename (or (mail-content-type-get @@ -950,8 +939,8 @@ external if displayed external." ;; `mailcap-mime-extensions'. (setq suffix (car (rassoc (mm-handle-media-type handle) mailcap-mime-extensions)))) - (setq file (mm-make-temp-file (expand-file-name "mm." dir) - nil suffix)))) + (setq file (make-temp-file (expand-file-name "mm." dir) + nil suffix)))) (let ((coding-system-for-write mm-binary-coding-system)) (write-region (point-min) (point-max) file nil 'nomesg)) ;; The file is deleted after the viewer exists. If the users edits @@ -1149,9 +1138,6 @@ external if displayed external." (ignore-errors (cond ;; Internally displayed part. - ((mm-annotationp object) - (if (featurep 'xemacs) - (delete-annotation object))) ((or (functionp object) (and (listp object) (eq (car object) 'lambda))) @@ -1315,7 +1301,7 @@ are ignored." (with-current-buffer (mm-handle-buffer handle) (buffer-string))) ((mm-multibyte-p) - (mm-string-to-multibyte (mm-get-part handle no-cache))) + (string-to-multibyte (mm-get-part handle no-cache))) (t (mm-get-part handle no-cache))))) (save-restriction @@ -1361,12 +1347,12 @@ string if you do not like underscores." (defun mm-file-name-delete-control (filename) "Delete control characters from FILENAME." - (gnus-replace-in-string filename "[\x00-\x1f\x7f]" "")) + (replace-regexp-in-string "[\x00-\x1f\x7f]" "" filename)) (defun mm-file-name-delete-gotchas (filename) "Delete shell gotchas from FILENAME." - (setq filename (gnus-replace-in-string filename "[<>|]" "")) - (gnus-replace-in-string filename "^[.-]+" "")) + (setq filename (replace-regexp-in-string "[<>|]" "" filename)) + (replace-regexp-in-string "^[.-]+" "" filename)) (defun mm-save-part (handle &optional prompt) "Write HANDLE to a file. @@ -1459,7 +1445,7 @@ text/\\(\\sw+\\)\\(?:;\\s-*charset=\\([^\"'>]+\\)\\)?[^>]*>" nil t) Use CMD as the process." (let ((name (mail-content-type-get (mm-handle-type handle) 'name)) (command (or cmd - (gnus-read-shell-command + (read-shell-command "Shell command on MIME part: " mm-last-shell-command)))) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -1575,73 +1561,29 @@ be determined." (prog1 (setq spec (ignore-errors - ;; Avoid testing `make-glyph' since W3 may define - ;; a bogus version of it. - (if (fboundp 'create-image) - (create-image (buffer-string) - (or (mm-image-type-from-buffer) - (intern type)) - 'data-p) - (mm-create-image-xemacs type)))) + (create-image (buffer-string) + (or (mm-image-type-from-buffer) + (intern type)) + 'data-p))) (mm-handle-set-cache handle spec)))))) -(defun mm-create-image-xemacs (type) - (when (featurep 'xemacs) - (cond - ((equal type "xbm") - ;; xbm images require special handling, since - ;; the only way to create glyphs from these - ;; (without a ton of work) is to write them - ;; out to a file, and then create a file - ;; specifier. - (let ((file (mm-make-temp-file - (expand-file-name "emm" mm-tmp-directory) - nil ".xbm"))) - (unwind-protect - (progn - (write-region (point-min) (point-max) file) - (make-glyph (list (cons 'x file)))) - (ignore-errors - (delete-file file))))) - (t - (make-glyph - (vector - (or (mm-image-type-from-buffer) - (intern type)) - :data (buffer-string))))))) - (declare-function image-size "image.c" (spec &optional pixels frame)) (defun mm-image-fit-p (handle) "Say whether the image in HANDLE will fit the current window." (let ((image (mm-get-image handle))) (or (not image) - (if (featurep 'xemacs) - ;; XEmacs's glyphs can actually tell us about their width, so - ;; let's be nice and smart about them. - (or mm-inline-large-images - (and (<= (glyph-width image) (window-pixel-width)) - (<= (glyph-height image) (window-pixel-height)))) - (let* ((size (image-size image)) - (w (car size)) - (h (cdr size))) - (or mm-inline-large-images - (and (<= h (1- (window-height))) ; Don't include mode line. - (<= w (window-width))))))))) + (let* ((size (image-size image)) + (w (car size)) + (h (cdr size))) + (or mm-inline-large-images + (and (<= h (1- (window-height))) ; Don't include mode line. + (<= w (window-width)))))))) (defun mm-valid-image-format-p (format) "Say whether FORMAT can be displayed natively by Emacs." - (cond - ;; Handle XEmacs - ((fboundp 'valid-image-instantiator-format-p) - (valid-image-instantiator-format-p format)) - ;; Handle Emacs - ((fboundp 'image-type-available-p) - (and (display-graphic-p) - (image-type-available-p format))) - ;; Nobody else can do images yet. - (t - nil))) + (and (display-graphic-p) + (image-type-available-p format))) (defun mm-valid-and-fit-image-p (format handle) "Say whether FORMAT can be displayed natively and HANDLE fits the window." @@ -1839,8 +1781,7 @@ If RECURSIVE, search recursively." (defun mm-shr (handle) ;; Require since we bind its variables. (require 'shr) - (let ((shr-width (if (and (boundp 'shr-use-fonts) - shr-use-fonts) + (let ((shr-width (if shr-use-fonts nil fill-column)) (shr-content-function (lambda (id) @@ -1864,8 +1805,8 @@ If RECURSIVE, search recursively." (mm-charset-to-coding-system charset nil t)) (not (eq charset 'ascii))) - (mm-decode-coding-string (buffer-string) charset) - (mm-string-as-multibyte (buffer-string))) + (decode-coding-string (buffer-string) charset) + (string-as-multibyte (buffer-string))) (erase-buffer) (mm-enable-multibyte))) (goto-char (point-min)) @@ -1894,6 +1835,7 @@ If RECURSIVE, search recursively." ,(point-max-marker)))))))) (defvar shr-map) +(defvar shr-image-map) (autoload 'widget-convert-button "wid-edit") @@ -1907,7 +1849,8 @@ If RECURSIVE, search recursively." (widget-convert-button 'url-link start end :help-echo (get-text-property start 'help-echo) - :keymap shr-map + ;;; FIXME Should only use the image map on images. + :keymap shr-image-map (get-text-property start 'shr-url)) (put-text-property start end 'local-map nil) (dolist (overlay (overlays-at start)) |