X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-image.el;h=d5e4aa0f3d3b47d68ccf0211503970ce8ae5810b;hb=refs%2Fheads%2Fakemi;hp=d86501087f3b4e07f07b7685928d3a920a5cd73a;hpb=fe1871257333ddeed37ca682d4fbcefefff6c2a4;p=elisp%2Fsemi.git diff --git a/mime-image.el b/mime-image.el index d865010..d5e4aa0 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 @@ -8,12 +8,10 @@ ;; Maintainer: MORIOKA Tomohiko ;; Created: 1995/12/15 ;; Renamed: 1997/2/21 from tm-image.el -;; Version: -;; $Id: mime-image.el,v 0.10 1997-04-03 18:09:35 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) + (add-hook 'mime-display-header-hook + 'mime-preview-x-face-function-use-highlight-headers) ) ((featurep 'mule) @@ -93,8 +91,8 @@ ;; ;; X-Face ;; - (if (file-installed-p uncompface-program exec-path) - (add-hook 'mime-view-content-header-filter-hook + (if (exec-installed-p uncompface-program exec-path) + (add-hook 'mime-display-header-hook 'x-face-decode-message-header) ) )) @@ -107,112 +105,67 @@ )) ) -(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) + (ctree-set-calist-strictly + 'mime-preview-condition + (list (cons 'type type)(cons 'subtype subtype) + '(body . visible) + (cons 'body-presentation-method #'mime-display-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) - (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) - (delete-region (point-min)(point-max)) - (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" mime-temp-directory)))) +(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...") - (delete-region (point-min)(point-max)) - (bitmap-insert-xbm-file xbm-file) - (delete-file xbm-file) ) - (message "Decoding image... done") + (message "Decoding image...") + (bitmap-insert-xbm-file xbm-file) + (delete-file xbm-file) ) - (t - (setq gl (make-glyph gl)) - (setq e (make-extent (point) (point))) + (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") - )) - - -;;; @ content filter for Postscript -;;; -;; (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") + ) + (message "Decoding image... done") + )) + ) + (insert "\n") )