X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-image.el;h=384269b63df466a4dae4018d70bb74213bae2b62;hb=cd47eed235f4258380f6d9b401c2fb1fc884931c;hp=23c3fcd163ca0cbda0670393f84eaa56dd13f35b;hpb=cac5fe424e2e46ed07ac582692c3d5b11db677d7;p=elisp%2Ftm.git diff --git a/tm-image.el b/tm-image.el index 23c3fcd..384269b 100644 --- a/tm-image.el +++ b/tm-image.el @@ -10,7 +10,7 @@ ;;; Maintainer: MORIOKA Tomohiko ;;; Created: 1995/12/15 ;;; Version: -;;; $Id: tm-image.el,v 7.3 1996/04/26 04:20:52 morioka Exp $ +;;; $Id: tm-image.el,v 7.10 1996/07/15 19:21:48 morioka Exp $ ;;; ;;; Keywords: mail, news, MIME, multimedia, image, picture ;;; @@ -31,36 +31,34 @@ ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; ;;; Commentary: -;;; If you use this program with Mule, please install bitmap -;;; extension package. It is available from -;;; ftp://etlport.etl.go.jp/pub/mule/contrib/bitmap.tar.gz +;;; If you use this program with Mule, please install +;;; etl8x16-bitmap.bdf font included in tl package. ;;; ;;; Code: (require 'tm-view) (cond (running-xemacs - (require 'xpm) (require 'annotations) (set-alist 'mime-viewer/content-filter-alist "image/jpeg" (if (featurep 'jpeg) ; Use built-in suport if available - (function mime-preview/filter-for-image/inline) + (function mime-preview/filter-for-inline-image) (function mime-preview/filter-for-image) )) (set-alist 'mime-viewer/content-filter-alist "image/gif" (if (featurep 'gif) ; Use built-in suport if available - (function mime-preview/filter-for-image/inline) + (function mime-preview/filter-for-inline-image) (function mime-preview/filter-for-image) )) (set-alist 'mime-viewer/content-filter-alist "image/x-xpixmap" (if (featurep 'xpm) ; Use built-in suport if available - (function mime-preview/filter-for-image/inline) + (function mime-preview/filter-for-inline-image) (function mime-preview/filter-for-image) )) @@ -76,9 +74,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 +101,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 @@ -131,6 +124,8 @@ (defvar mime-viewer/shell-command "/bin/sh") (defvar mime-viewer/shell-arguments '("-c")) +(defvar mime-viewer/ps-to-gif-command "pstogif") + (defvar mime-viewer/graphic-converter-alist '(("image/jpeg" . "djpeg -color 256 < %s | ppmtoxpm > %s") ("image/gif" . "giftopnm < %s | ppmtoxpm > %s") @@ -197,7 +192,7 @@ (xbm-file (concat orig-file ".xbm")) gl annot) ;;(remove-text-properties beg end '(face nil)) - (mime/decode-region encoding beg end) + (mime-decode-region beg end encoding) (write-region (point-min)(point-max) orig-file) (delete-region (point-min)(point-max)) (message "Now translating, please wait...") @@ -221,27 +216,6 @@ ))) -;;; @ content filter for support in-line image types -;;; -;; (for XEmacs 19.14 or later) - -(defun mime-preview/filter-for-image/inline (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))) - ) - (remove-text-properties beg end '(face nil)) - (mime/decode-region encoding beg end) - (write-region (point-min)(point-max) image-file) - (delete-region (point-min)(point-max)) - (image-read-file ctype image-file) - (delete-file image-file) - (insert "\n") - )) - - ;;; @ content filter for xbm ;;; @@ -253,7 +227,7 @@ (xbm-file (make-temp-name (expand-file-name "tm" mime/tmp-dir))) ) (remove-text-properties beg end '(face nil)) - (mime/decode-region encoding beg end) + (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) @@ -267,6 +241,67 @@ "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)) + ) + (remove-text-properties beg end '(face nil)) + (mime-decode-region beg end encoding) + (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 Postscript +;;; +;; (for XEmacs 19.14 or later) + +(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)) + (beg (point-min)) (end (point-max)) + (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) ps-file) + (delete-region (point-min)(point-max)) + (call-process mime-viewer/ps-to-gif-command 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 + "application/postscript" + (function mime-preview/filter-for-application/postscript)) + + ;;; @ setting ;;;