tm 7.68.

[elisp/tm.git] / tm-image.el

diff --git a/tm-image.el b/tm-image.el
index 2566c35..c9001ea 100644 (file)
--- a/tm-image.el
+++ b/tm-image.el
@@ -10,7 +10,7 @@
 ;;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;; Created: 1995/12/15
 ;;; Version:
-;;;    $Id: tm-image.el,v 7.5 1996/05/27 08:08:00 morioka Exp $
+;;;    $Id: tm-image.el,v 7.8 1996/06/12 05:22:11 morioka Exp $
 ;;;
 ;;; Keywords: mail, news, MIME, multimedia, image, picture
 ;;;
@@ -76,9 +76,15 @@
                  "image/x-mag" (function mime-preview/filter-for-image))
        
        (defvar tm-image/inline-image-types
-        '("image/jpeg" "image/gif" "image/tiff"
-          "image/x-tiff" "image/x-pic" "image/x-mag"
-          "image/x-xbm" "image/x-xpixmap"))
+        (if (featurep 'gif)
+            (nconc
+             '("image/jpeg" "image/gif" "image/tiff"
+               "image/x-tiff" "image/x-pic" "image/x-mag"
+               "image/x-xbm" "image/x-xpixmap")
+             (if (featurep 'gif)
+                 '("application/postscript")
+               )
+             )))
        
        (defun bitmap-read-xbm (file)
         (let (gl)
@@ -97,17 +103,6 @@
           ("image/x-xpixmap" . xpm)
           ))
        
-       (defun image-read-file (ctype file)
-        (let ((minor (assoc-value ctype mime-viewer/image-converter-alist))
-              gl)
-          (while (progn
-                   (setq gl (make-glyph (vector minor :file file)))
-                   (eq (image-instance-type (glyph-image-instance gl))
-                       'text)
-                   ))
-          (make-annotation gl (point) 'text)
-          ))
-       
        (defvar mime-viewer/use-highlight-headers t)
 
        (defvar mime-preview/x-face-function
@@ -221,50 +216,90 @@
       )))
 
 
+;;; @ content filter for xbm
+;;;
+
+(defun mime-preview/filter-for-image/xbm (ctype params encoding)
+  (let* ((mode mime::preview/original-major-mode)
+        (m (assq mode mime-viewer/code-converter-alist))
+        (charset (assoc "charset" params))
+        (beg (point-min)) (end (point-max))
+        (xbm-file (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
+        )
+    (remove-text-properties beg end '(face nil))
+    (mime-decode-region beg end encoding)
+    (write-region (point-min)(point-max) xbm-file)
+    (delete-region (point-min)(point-max))
+    (bitmap-read-xbm xbm-file)
+    (delete-file xbm-file)
+    ))
+
+(set-alist 'mime-viewer/content-filter-alist
+          "image/xbm" (function mime-preview/filter-for-image/xbm))
+
+(set-alist 'mime-viewer/content-filter-alist
+          "image/x-xbm" (function mime-preview/filter-for-image/xbm))
+
+
 ;;; @ content filter for support in-line image types
 ;;;
 ;;    (for XEmacs 19.14 or later)
 
 (defun mime-preview/filter-for-inline-image (ctype params encoding)
   (let* ((mode mime::preview/original-major-mode)
-       (m (assq mode mime-viewer/code-converter-alist))
-       (charset (assoc "charset" params))
-       (beg (point-min)) (end (point-max))
-       (image-file (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
-       )
+        (m (assq mode mime-viewer/code-converter-alist))
+        (charset (assoc "charset" params))
+        (beg (point-min)) (end (point-max))
+        )
     (remove-text-properties beg end '(face nil))
     (mime-decode-region beg end encoding)
-    (write-region (point-min)(point-max) image-file)
-    (delete-region (point-min)(point-max))
-    (image-read-file ctype image-file)
-    (delete-file image-file)
+    (let ((data (buffer-string))
+         (minor (assoc-value ctype mime-viewer/image-converter-alist))
+         gl)
+      (delete-region (point-min)(point-max))
+      (while (progn
+              (setq gl (make-glyph (vector minor :data data)))
+              (eq (image-instance-type (glyph-image-instance gl))
+                  'text)
+              ))
+      (make-annotation gl (point) 'text)
+      )
     (insert "\n")
     ))
 
 
-;;; @ content filter for xbm
+;;; @ content filter for Postscript
 ;;;
+;;    (for XEmacs 19.14 or later)
 
-(defun mime-preview/filter-for-image/xbm (ctype params encoding)
+(defun mime-preview/filter-for-application/postscript (ctype params encoding)
   (let* ((mode mime::preview/original-major-mode)
         (m (assq mode mime-viewer/code-converter-alist))
-        (charset (assoc "charset" params))
         (beg (point-min)) (end (point-max))
-        (xbm-file (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
+        (file-base (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
+        (ps-file (concat file-base ".ps"))
+        (gif-file (concat file-base ".gif"))
         )
     (remove-text-properties beg end '(face nil))
     (mime-decode-region beg end encoding)
-    (write-region (point-min)(point-max) xbm-file)
+    (write-region (point-min)(point-max) ps-file) 
     (delete-region (point-min)(point-max))
-    (bitmap-read-xbm xbm-file)
-    (delete-file xbm-file)
+    (call-process "pstogif" nil nil nil ps-file)
+    (let (gl)
+      (while (progn
+              (setq gl (make-glyph (vector 'gif :file gif-file)))
+              (eq (image-instance-type (glyph-image-instance gl))
+                  'text)
+              ))
+      (make-annotation gl (point) 'text)
+      )
+    (delete-file ps-file)
+    (delete-file gif-file)
     ))
 
 (set-alist 'mime-viewer/content-filter-alist
-          "image/xbm" (function mime-preview/filter-for-image/xbm))
-
-(set-alist 'mime-viewer/content-filter-alist
-          "image/x-xbm" (function mime-preview/filter-for-image/xbm))
+          "application/postscript"
+          (function mime-preview/filter-for-application/postscript))
 
 
 ;;; @ setting