(mime/get-content-decoding-alist): Use 'ctree-match-calist instead of
[elisp/semi.git] / mime-image.el
index cea123c..a405a4a 100644 (file)
@@ -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.13 1997-09-25 12:31:15 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
        ;;
        (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)
          ))
     )
 
-(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-view-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)
-         ("image/png"                  . png)
+                (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-view-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)
             )
            (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")
             ))
       )
 ;;;
 ;;    (for XEmacs 19.14 or later)
 
-(defun mime-view-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-view-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