X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-image.el;h=d5e4aa0f3d3b47d68ccf0211503970ce8ae5810b;hb=refs%2Fheads%2Fakemi;hp=4eb0eef03522f4a9250dc828c9fb6664be027fa6;hpb=8c4c880a9852fb834ce9031c099ff3ba6b6a9183;p=elisp%2Fsemi.git diff --git a/mime-image.el b/mime-image.el index 4eb0eef..d5e4aa0 100644 --- a/mime-image.el +++ b/mime-image.el @@ -69,7 +69,7 @@ (highlight-headers (point-min) (re-search-forward "^$" nil t) t) ) - (add-hook 'mime-view-content-header-filter-hook + (add-hook 'mime-display-header-hook 'mime-preview-x-face-function-use-highlight-headers) ) @@ -92,7 +92,7 @@ ;; X-Face ;; (if (exec-installed-p uncompface-program exec-path) - (add-hook 'mime-view-content-header-filter-hook + (add-hook 'mime-display-header-hook 'x-face-decode-message-header) ) )) @@ -105,30 +105,19 @@ )) ) -(defvar mime-view-image-converter-alist nil) - (mapcar (function (lambda (rule) (let ((type (car rule)) (subtype (nth 1 rule)) (format (nth 2 rule))) (if (image-inline-p format) - (let ((type/subtype (mime-type/subtype-string type subtype))) - ;; (set-alist 'mime-view-content-filter-alist - ;; type/subtype #'mime-view-filter-for-image) - (set-alist 'mime-view-image-converter-alist - type/subtype format) - ;; (add-to-list - ;; 'mime-view-visible-media-type-list - ;; ctype) - (ctree-set-calist-strictly - 'mime-preview-condition - (list (cons 'type type)(cons 'subtype subtype) - '(body . visible) - (cons 'body-filter - #'mime-view-filter-for-image))) - ) - )))) + (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) @@ -141,87 +130,43 @@ (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) - )) - -;; If you would like to display inline Postscript image, please -;; activate following: - -;; (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") + ) ;;; @ end