X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-image.el;h=a405a4a14ea676a455f75e45d14beff643c4dedd;hb=f5641880ea7f81f9d660a8e8feec74d65bee7f8e;hp=5a46be6d409e0b136cae8e6befe3d4a1ad59e7f8;hpb=12d2cc7bdbb2fc31c100bfdd54ae5e251241b2c1;p=elisp%2Fsemi.git

diff --git a/mime-image.el b/mime-image.el
index 5a46be6..a405a4a 100644
--- a/mime-image.el
+++ b/mime-image.el
@@ -1,6 +1,6 @@
 ;;; mime-image.el --- mime-view filter to display images
 
-;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
+;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko
 ;; Copyright (C) 1996 Dan Rich
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -8,12 +8,10 @@
 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/12/15
 ;;	Renamed: 1997/2/21 from tm-image.el
-;; Version:
-;;	$Id: mime-image.el,v 0.9 1997-03-16 01:02:03 morioka Exp $
 
 ;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news
 
-;; This file is part of XEmacs.
+;; This file is part of SEMI (Showy Emacs MIME Interfaces).
 
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -39,7 +37,7 @@
 (require 'mime-view)
 (require 'alist)
 
-(cond (running-xemacs
+(cond ((featurep 'xemacs)
        (require 'images)
        
        (defun-maybe image-inline-p (format)
@@ -67,12 +65,12 @@
        ;;
        (autoload 'highlight-headers "highlight-headers")
        
-       (defun mime-preview/x-face-function-use-highlight-headers ()
+       (defun mime-preview-x-face-function-use-highlight-headers ()
 	 (highlight-headers (point-min) (re-search-forward "^$" nil t) t)
 	 )
        
        (add-hook 'mime-view-content-header-filter-hook
-		 'mime-preview/x-face-function-use-highlight-headers)
+		 'mime-preview-x-face-function-use-highlight-headers)
        
        )
       ((featurep 'mule)
@@ -93,7 +91,7 @@
        ;;
        ;; X-Face
        ;;
-       (if (file-installed-p uncompface-program exec-path)
+       (if (exec-installed-p uncompface-program exec-path)
 	   (add-hook 'mime-view-content-header-filter-hook
 		     'x-face-decode-message-header)
 	 )
@@ -107,52 +105,45 @@
 	  ))
     )
 
-(defvar mime-view-image-converter-alist nil)
-
 (mapcar (function
 	 (lambda (rule)
-	   (let ((ctype  (car rule))
-		 (format (cdr rule))
-		 )
+	   (let ((type    (car rule))
+		 (subtype (nth 1 rule))
+		 (format  (nth 2 rule)))
 	     (if (image-inline-p format)
-		 (progn
-		   (set-alist 'mime-view-content-filter-alist
-			      ctype
-			      (function mime-preview/filter-for-image))
-		   (set-alist 'mime-view-image-converter-alist
-			      ctype format)
-		   (add-to-list
-		    'mime-view-visible-media-type-list
-		    ctype)
-		   )
-	       ))))
-	'(("image/jpeg"			. jpeg)
-	  ("image/gif"			. gif)
-	  ("image/tiff"			. tiff)
-	  ("image/x-tiff"		. tiff)
-	  ("image/xbm"			. xbm)
-	  ("image/x-xbm"		. xbm)
-	  ("image/x-xpixmap"		. xpm)
-	  ("image/x-pic"		. pic)
-	  ("image/x-mag"		. mag)
+		 (ctree-set-calist-strictly
+		  'mime-preview-condition
+		  (list (cons 'type type)(cons 'subtype subtype)
+			'(body . visible)
+			'(body-presentation-method . with-filter)
+			(cons 'body-filter #'mime-preview-filter-for-image)
+			(cons 'image-format format))
+		  )))))
+	'((image jpeg		jpeg)
+	  (image gif		gif)
+	  (image tiff		tiff)
+	  (image x-tiff		tiff)
+	  (image xbm		xbm)
+	  (image x-xbm		xbm)
+	  (image x-xpixmap	xpm)
+	  (image x-pic		pic)
+	  (image x-mag		mag)
+	  (image png		png)
 	  ))
 
-(defvar mime-view-ps-to-gif-command "pstogif")
-
 
 ;;; @ content filter for images
 ;;;
 ;;    (for XEmacs 19.12 or later)
 
-(defun mime-preview/filter-for-image (ctype params encoding)
+(defun mime-preview-filter-for-image (situation)
   (let ((beg (point-min))
 	(end (point-max)))
     (remove-text-properties beg end '(face nil))
     (message "Decoding image...")
-    (mime-decode-region beg end encoding)
-    (let* ((minor (cdr (assoc ctype mime-view-image-converter-alist)))
-	   (gl (image-normalize minor (buffer-string)))
-	   e)
+    (mime-decode-region beg end (cdr (assq 'encoding situation)))
+    (let ((gl (image-normalize (cdr (assq 'image-format situation))
+			       (buffer-string))))
       (delete-region (point-min)(point-max))
       (cond ((image-invalid-glyph-p gl)
 	     (setq gl nil)
@@ -173,8 +164,9 @@
 	     )
 	    (t
 	     (setq gl (make-glyph gl))
-	     (setq e (make-extent (point) (point)))
-	     (set-extent-end-glyph e gl)
+	     (let ((e (make-extent (point) (point))))
+	       (set-extent-end-glyph e gl)
+	       )
 	     (message "Decoding image... done")
 	     ))
       )
@@ -186,34 +178,40 @@
 ;;;
 ;;    (for XEmacs 19.14 or later)
 
-(defun mime-preview/filter-for-application/postscript (ctype params encoding)
-  (let* ((beg (point-min)) (end (point-max))
-	 (file-base
-	  (make-temp-name (expand-file-name "tm" mime-temp-directory)))
-	 (ps-file (concat file-base ".ps"))
-	 (gif-file (concat file-base ".gif"))
-	 )
-    (remove-text-properties beg end '(face nil))
-    (message "Decoding Postscript...")
-    (mime-decode-region beg end encoding)
-    (write-region (point-min)(point-max) ps-file) 
-    (message "Decoding Postscript...")
-    (delete-region (point-min)(point-max))
-    (call-process mime-view-ps-to-gif-command nil nil nil ps-file)
-    (set-extent-end-glyph (make-extent (point) (point))
-			  (make-glyph (vector 'gif :file gif-file)))
-    (message "Decoding Postscript... done")
-    (delete-file ps-file)
-    (delete-file gif-file)
-    ))
-
-(set-alist 'mime-view-content-filter-alist
-	   "application/postscript"
-	   (function mime-preview/filter-for-application/postscript))
-
-(if (featurep 'gif)
-    (add-to-list 'mime-view-visible-media-type-list "application/postscript")
-  )
+;; (defvar mime-view-ps-to-gif-command "pstogif")
+
+;; (defun mime-preview-filter-for-application/postscript (ctype params encoding)
+;;   (let* ((beg (point-min)) (end (point-max))
+;;          (file-base
+;;           (make-temp-name (expand-file-name "tm" mime-temp-directory)))
+;;          (ps-file (concat file-base ".ps"))
+;;          (gif-file (concat file-base ".gif"))
+;;          )
+;;     (remove-text-properties beg end '(face nil))
+;;     (message "Decoding Postscript...")
+;;     (mime-decode-region beg end encoding)
+;;     (write-region (point-min)(point-max) ps-file) 
+;;     (message "Decoding Postscript...")
+;;     (delete-region (point-min)(point-max))
+;;     (call-process mime-view-ps-to-gif-command nil nil nil ps-file)
+;;     (set-extent-end-glyph (make-extent (point) (point))
+;;                           (make-glyph (vector 'gif :file gif-file)))
+;;     (message "Decoding Postscript... done")
+;;     (delete-file ps-file)
+;;     (delete-file gif-file)
+;;     ))
+
+;; If you would like to display inline Postscript image, please
+;; activate following:
+
+;; (set-alist 'mime-view-content-filter-alist
+;;            "application/postscript"
+;;            (function mime-preview-filter-for-application/postscript))
+
+;; (if (featurep 'gif)
+;;     (add-to-list
+;;      'mime-view-visible-media-type-list "application/postscript")
+;;   )
 
 
 ;;; @ end