* mime-pgp.el: Add autoload settings for `smime-decrypt-region' and

[elisp/semi.git] / mime-image.el

diff --git a/mime-image.el b/mime-image.el
index f2c6796..bdfe1d8 100644 (file)
--- a/mime-image.el
+++ b/mime-image.el
@@ -4,7 +4,9 @@
 ;; Copyright (C) 1996 Dan Rich
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;         Dan Rich <drich@morpheus.corp.sgi.com>
+;;     Dan Rich <drich@morpheus.corp.sgi.com>
+;;     Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;;     Katsumi Yamaoka  <yamaoka@jpl.org>
 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/12/15
 ;;     Renamed: 1997/2/21 from tm-image.el
@@ -34,12 +36,14 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'static))
+
 (require 'mime-view)
 (require 'alist)
 (require 'path-util)
 
-(cond 
- ((featurep 'xemacs) 
+(cond
+ ((featurep 'xemacs)
 
   (require 'images)
 
@@ -51,11 +55,11 @@
                    ))
                 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 +70,7 @@
        (equal (aref glyph 2) "")
        ))
   )
- ((featurep 'mule) 
-
-  (eval-when-compile (require 'static))
+ ((featurep 'mule)
 
   (eval-and-compile
     (autoload 'bitmap-insert-xbm-buffer "bitmap")
@@ -83,13 +85,12 @@
   (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
-         (set-buffer-multibyte nil)
          (insert data)
-         (write-region (point-min)(point-max) image-file))
+         (write-region-as-binary (point-min)(point-max) image-file))
        (list 'image ':type format ':file image-file)
        )))
 
@@ -97,7 +98,12 @@
     (static-if (fboundp 'insert-image)
        (unwind-protect
            (save-excursion
-             (insert-image image)
+             (static-if (condition-case nil
+                            (progn (insert-image '(image)) nil)
+                          (wrong-number-of-arguments t))
+                 (insert-image image "x")
+               (insert-image image))
+             (insert "\n")
              (save-window-excursion
                (set-window-buffer (selected-window)(current-buffer))
                (sit-for 0)))
@@ -126,7 +132,7 @@
  ((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)
     )
@@ -170,38 +176,53 @@
 ;;;
 ;;    (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 ((gl (image-normalize (cdr (assq 'image-format situation))
-                            (mime-entity-content entity))))
-    (cond ((image-invalid-glyph-p gl)
-          (setq gl nil)
-          (message "Invalid glyph!")
-          )
-         ((eq (aref gl 0) 'xbm)
-          (let ((xbm-file
-                 (make-temp-name
-                  (expand-file-name "tm" temporary-file-directory))))
-            (with-temp-buffer
-              (insert (aref gl 2))
-              (write-region (point-min)(point-max) xbm-file)
-              )
-            (message "Decoding image...")
-            (bitmap-insert-xbm-file xbm-file)
-            (delete-file xbm-file)
-            )
-          (message "Decoding image... done")
-          )
-         (t
-          (setq gl (make-glyph gl))
-          (let ((e (make-extent (point) (point))))
-            (set-extent-end-glyph e gl)
-            )
-          (message "Decoding image... done")
-          ))
-    )
-  (insert "\n")
-  )
+  (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")))
+  (static-when (featurep 'xemacs)
+    (insert "\n")))
 
 
 ;;; @ end