(mime-display-image): Use `mime-image-normalize-xbm' if the feature `xemacs'
authoryamaoka <yamaoka>
Wed, 17 Nov 1999 23:57:36 +0000 (23:57 +0000)
committeryamaoka <yamaoka>
Wed, 17 Nov 1999 23:57:36 +0000 (23:57 +0000)
is provided or the variable `image-types' is bound.
(mime-image-normalize-xbm): New macro.

ChangeLog
mime-image.el

index e0f7646..39080d1 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,20 @@
+1999-11-17  Katsumi Yamaoka <yamaoka@jpl.org>
+
+       * mime-image.el (mime-display-image): Use
+       `mime-image-normalize-xbm' if the feature `xemacs' is provided or
+       the variable `image-types' is bound.
+
+1999-11-17   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * mime-image.el (mime-image-normalize-xbm): Work for the future
+       FSF Emacsen as well.
+       (mime-display-image): Always use `mime-image-normalize-xbm'.
+
+1999-11-17  Katsumi Yamaoka <yamaoka@jpl.org>
+
+       * mime-image.el (mime-image-normalize-xbm): New macro.
+       (mime-display-image): Use it.
+
 1999-11-13   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
 
        * pgg.el (pgg-temp-buffer-show-function): New function.
index 6ceb43f..b01dda6 100644 (file)
 
 ;;; Code:
 
+(eval-when-compile (require 'static))
 (require 'mime-view)
 (require 'alist)
 (require 'path-util)
 
-(cond 
- ((featurep 'xemacs) 
+(cond
+ ((featurep 'xemacs)
 
   (require 'images)
 
                    ))
                 image-native-formats)
        ))
-       
+
   (image-register-netpbm-utilities)
   (image-register-converter 'pic 'ppm "pictoppm")
   (image-register-converter 'mag 'ppm "magtoppm")
-       
+
   (defun image-insert-at-point (image)
     (let ((e (make-extent (point) (point))))
       (set-extent-end-glyph e (make-glyph image))))
@@ -66,9 +67,7 @@
        (equal (aref glyph 2) "")
        ))
   )
- ((featurep 'mule) 
-
-  (eval-when-compile (require 'static))
+ ((featurep 'mule)
 
   (eval-and-compile
     (autoload 'bitmap-insert-xbm-buffer "bitmap")
@@ -83,8 +82,8 @@
   (defun-maybe image-normalize (format data)
     (if (memq format '(xbm xpm))
        (list 'image ':type format ':data data)
-      (let ((image-file 
-            (make-temp-name 
+      (let ((image-file
+            (make-temp-name
              (expand-file-name "tm" temporary-file-directory))))
        (with-temp-buffer
          (insert data)
  ((module-installed-p 'highlight-headers)
   (eval-and-compile
     (autoload 'highlight-headers "highlight-headers"))
+
   (defun mime-preview-x-face-function-use-highlight-headers ()
     (highlight-headers (point-min) (re-search-forward "^$" nil t) t)
     )
 ;;;
 ;;    (for XEmacs 19.12 or later)
 
+(eval-when-compile
+  (defmacro mime-image-normalize-xbm (entity)
+    (` (with-temp-buffer
+        (mime-insert-entity-content (, entity))
+        (let ((cur (current-buffer))
+              width height)
+          (goto-char (point-min))
+          (search-forward "width ")
+          (setq width (read cur))
+          (goto-char (point-min))
+          (search-forward "height ")
+          (setq height (read cur))
+          (goto-char (point-min))
+          (search-forward "{")
+          (delete-region (point-min) (point))
+          (insert "\"")
+          (search-forward "}")
+          (delete-region (1- (point)) (point-max))
+          (insert "\"")
+          (goto-char (point-min))
+          (while (re-search-forward "[^\"0-9A-FXa-fx]+" nil t)
+            (replace-match ""))
+          (goto-char (point-min))
+          (while (search-forward "0x" nil t)
+            (replace-match "\\\\x"))
+          (goto-char (point-min))
+          (, (if (featurep 'xemacs)
+                 (` (vector 'xbm :data
+                            (list width height (read cur))))
+               '(` (image :type xbm :width (, width) :height (, height)
+                          :data (, (read cur))))))))))
+  )
+
 (defun mime-display-image (entity situation)
   (message "Decoding image...")
-  (let ((image (image-normalize (cdr (assq 'image-format situation))
-                               (mime-entity-content entity))))
+  (let* ((format (cdr (assq 'image-format situation)))
+        (image (if (or (featurep 'xemacs) (boundp 'image-types))
+                   (if (eq 'xbm format)
+                       (mime-image-normalize-xbm entity)
+                     (image-normalize format (mime-entity-content entity)))
+                 (image-normalize format (mime-entity-content entity)))))
     (if (image-invalid-glyph-p image)
        (message "Invalid glyph!")
       (image-insert-at-point image)
       (message "Decoding image... done")))
-  (insert "\n")
-  )
+  (static-when (featurep 'xemacs)
+    (insert "\n")))
 
 
 ;;; @ end