Small doc fixes. Require cl when compiling.
authorDave Love <fx@gnu.org>
Thu, 27 Apr 2000 21:58:47 +0000 (21:58 +0000)
committerDave Love <fx@gnu.org>
Thu, 27 Apr 2000 21:58:47 +0000 (21:58 +0000)
(mm-xemacs-p): Deleted.
(mm-get-image-emacs, mm-get-image-xemacs): Deleted.
(mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs, use
create-image and don't special-case xbm.
(mm-valid-image-format-p): Use display-graphic-p.

lisp/mm-decode.el

index fe9b5f7..6e8413e 100644 (file)
 (require 'mail-parse)
 (require 'mailcap)
 (require 'mm-bodies)
 (require 'mail-parse)
 (require 'mailcap)
 (require 'mm-bodies)
+(eval-when-compile (require 'cl))
 
 (eval-and-compile
   (autoload 'mm-inline-partial "mm-partial"))
 
 
 (eval-and-compile
   (autoload 'mm-inline-partial "mm-partial"))
 
-(defvar mm-xemacs-p (string-match "XEmacs" (emacs-version)))
-
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
   :link '(custom-manual "(emacs-mime)Customization")
 (defgroup mime-display ()
   "Display of MIME in mail and news articles."
   :link '(custom-manual "(emacs-mime)Customization")
 Viewing agents are supposed to view the last possible part of a message,
 as that is supposed to be the richest.  However, users may prefer other
 types instead, and this list says what types are most unwanted.  If,
 Viewing agents are supposed to view the last possible part of a message,
 as that is supposed to be the richest.  However, users may prefer other
 types instead, and this list says what types are most unwanted.  If,
-for instance, text/html parts are very unwanted, and text/richtech are
+for instance, text/html parts are very unwanted, and text/richtext are
 somewhat unwanted, then the value of this variable should be set
 to:
 
 somewhat unwanted, then the value of this variable should be set
 to:
 
@@ -232,7 +231,7 @@ to:
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
       (if (or (not ctl)
              (not (string-match "/" (car ctl))))
          (mm-dissect-singlepart
-          '("text/plain") 
+          '("text/plain")
           (and cte (intern (downcase (mail-header-remove-whitespace
                                       (mail-header-remove-comments
                                        cte)))))
           (and cte (intern (downcase (mail-header-remove-whitespace
                                       (mail-header-remove-comments
                                        cte)))))
@@ -397,7 +396,7 @@ external if displayed external."
                 (unwind-protect
                     (start-process "*display*" nil
                                    "xterm"
                 (unwind-protect
                     (start-process "*display*" nil
                                    "xterm"
-                                   "-e" shell-file-name 
+                                   "-e" shell-file-name
                                    shell-command-switch
                                    (mm-mailcap-command
                                     method file (mm-handle-type handle)))
                                    shell-command-switch
                                    (mm-mailcap-command
                                     method file (mm-handle-type handle)))
@@ -412,7 +411,7 @@ external if displayed external."
                    (unwind-protect
                        (progn
                          (call-process shell-file-name nil
                    (unwind-protect
                        (progn
                          (call-process shell-file-name nil
-                                       (setq buffer 
+                                       (setq buffer
                                              (generate-new-buffer "*mm*"))
                                        nil
                                        shell-command-switch
                                              (generate-new-buffer "*mm*"))
                                        nil
                                        shell-command-switch
@@ -469,7 +468,7 @@ external if displayed external."
     (mapconcat 'identity (nreverse out) "")))
     
 (defun mm-remove-parts (handles)
     (mapconcat 'identity (nreverse out) "")))
     
 (defun mm-remove-parts (handles)
-  "Remove the displayed MIME parts represented by HANDLE."
+  "Remove the displayed MIME parts represented by HANDLES."
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-remove-part handles)
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-remove-part handles)
@@ -486,7 +485,7 @@ external if displayed external."
          (mm-remove-part handle)))))))
 
 (defun mm-destroy-parts (handles)
          (mm-remove-part handle)))))))
 
 (defun mm-destroy-parts (handles)
-  "Remove the displayed MIME parts represented by HANDLE."
+  "Remove the displayed MIME parts represented by HANDLES."
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-destroy-part handles)
   (if (and (listp handles)
           (bufferp (car handles)))
       (mm-destroy-part handles)
@@ -725,9 +724,8 @@ external if displayed external."
     result))
 
 (defun mm-preferred-alternative-precedence (handles)
     result))
 
 (defun mm-preferred-alternative-precedence (handles)
-  "Return the precedence based on HANDLES and mm-discouraged-alternatives."
-  (let ((seq (nreverse (mapcar (lambda (h)
-                                (mm-handle-media-type h))
+  "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
+  (let ((seq (nreverse (mapcar #'mm-handle-media-type
                               handles))))
     (dolist (disc (reverse mm-discouraged-alternatives))
       (dolist (elem (copy-sequence seq))
                               handles))))
     (dolist (disc (reverse mm-discouraged-alternatives))
       (dolist (elem (copy-sequence seq))
@@ -739,37 +737,7 @@ external if displayed external."
   "Return the handle(s) referred to by ID."
   (cdr (assoc id mm-content-id-alist)))
 
   "Return the handle(s) referred to by ID."
   (cdr (assoc id mm-content-id-alist)))
 
-(defun mm-get-image-emacs (handle)
-  "Return an image instance based on HANDLE."
-  (let ((type (mm-handle-media-subtype handle))
-       spec)
-    ;; Allow some common translations.
-    (setq type
-         (cond
-          ((equal type "x-pixmap")
-           "xpm")
-          ((equal type "x-xbitmap")
-           "xbm")
-          (t type)))
-    (or (mm-handle-cache handle)
-       (mm-with-unibyte-buffer
-         (mm-insert-part handle)
-         (prog1
-             (setq spec
-                   (ignore-errors
-                     (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.
-                       (error "Don't know what to do for XBMs right now."))
-                      (t
-                       (list 'image :type (intern type) :data (buffer-string))))))
-           (mm-handle-set-cache handle spec))))))
-
-(defun mm-get-image-xemacs (handle)
+(defun mm-get-image (handle)
   "Return an image instance based on HANDLE."
   (let ((type (mm-handle-media-subtype handle))
        spec)
   "Return an image instance based on HANDLE."
   (let ((type (mm-handle-media-subtype handle))
        spec)
@@ -787,32 +755,29 @@ external if displayed external."
          (prog1
              (setq spec
                    (ignore-errors
          (prog1
              (setq spec
                    (ignore-errors
-                     (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 (make-temp-name
-                                    (expand-file-name "emm.xbm"
-                                                      mm-tmp-directory))))
-                         (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 (intern type) :data (buffer-string)))))))
+                     (if (fboundp 'make-glyph)
+                         (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 (make-temp-name
+                                        (expand-file-name "emm.xbm"
+                                                          mm-tmp-directory))))
+                             (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 (intern type) :data (buffer-string)))))
+                       (create-image (buffer-string) (intern type) 'data-p))))
            (mm-handle-set-cache handle spec))))))
 
            (mm-handle-set-cache handle spec))))))
 
-(defun mm-get-image (handle)
-  (if mm-xemacs-p
-      (mm-get-image-xemacs handle)
-    (mm-get-image-emacs handle)))
-
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))
 (defun mm-image-fit-p (handle)
   "Say whether the image in HANDLE will fit the current window."
   (let ((image (mm-get-image handle)))
@@ -835,7 +800,8 @@ external if displayed external."
     (valid-image-instantiator-format-p format))
    ;; Handle Emacs 21
    ((fboundp 'image-type-available-p)
     (valid-image-instantiator-format-p format))
    ;; Handle Emacs 21
    ((fboundp 'image-type-available-p)
-    (image-type-available-p format))
+    (and (display-graphic-p)
+        (image-type-available-p format)))
    ;; Nobody else can do images yet.
    (t
     nil)))
    ;; Nobody else can do images yet.
    (t
     nil)))
@@ -848,4 +814,4 @@ external if displayed external."
 
 (provide 'mm-decode)
 
 
 (provide 'mm-decode)
 
-;; mm-decode.el ends here
+;;; mm-decode.el ends here