1;;; mime-image.el --- mime-view filter to display images -*- lexical-binding: t -*- 2 3;; Copyright (C) 1995,1996,1997,1998 MORIOKA Tomohiko 4;; Copyright (C) 1996 Dan Rich 5 6;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> 7;; Dan Rich <drich@morpheus.corp.sgi.com> 8;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp> 9;; Katsumi Yamaoka <yamaoka@jpl.org> 10;; Created: 1995/12/15 11;; Renamed: 1997/2/21 from tm-image.el 12 13;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news 14 15;; This file is part of SEMI (Showy Emacs MIME Interfaces). 16 17;; This program is free software; you can redistribute it and/or 18;; modify it under the terms of the GNU General Public License as 19;; published by the Free Software Foundation; either version 2, or (at 20;; your option) any later version. 21 22;; This program is distributed in the hope that it will be useful, but 23;; WITHOUT ANY WARRANTY; without even the implied warranty of 24;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 25;; General Public License for more details. 26 27;; You should have received a copy of the GNU General Public License 28;; along with GNU XEmacs; see the file COPYING. If not, write to the 29;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 30;; Boston, MA 02110-1301, USA. 31 32;;; Commentary: 33;; If you use this program with MULE, please install 34;; etl8x16-bitmap.bdf font included in tl package. 35 36;;; Code: 37 38(require 'mime-view) 39(require 'alist) 40(require 'path-util) 41 42(defsubst mime-image-normalize-xbm-buffer () 43 (save-excursion 44 (let ((case-fold-search t) width height) 45 (goto-char (point-min)) 46 (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t) 47 (error "!! Illegal xbm file format in the buffer: %s" 48 (current-buffer))) 49 (setq width (string-to-number (match-string 1))) 50 (goto-char (point-min)) 51 (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t) 52 (error "!! Illegal xbm file format in the buffer: %s" 53 (current-buffer))) 54 (setq height (string-to-number (match-string 1))) 55 (goto-char (point-min)) 56 (re-search-forward "0x[0-9a-f][0-9a-f],") 57 (delete-region (point-min) (match-beginning 0)) 58 (goto-char (point-min)) 59 (while (re-search-forward "[\n\r\t ,;}]" nil t) 60 (replace-match "")) 61 (goto-char (point-min)) 62 (while (re-search-forward "0x" nil t) 63 (replace-match "\\x" nil t)) 64 (goto-char (point-min)) 65 (insert "(" (number-to-string width) " " 66 (number-to-string height) " \"") 67 (goto-char (point-max)) 68 (insert "\")") 69 (goto-char (point-min)) 70 (read (current-buffer))))) 71 72(defcustom mime-image-max-height nil 73 "*Max displayed image height of attachment image to a message. 74It has effect only when imagemagick or image scaling support is 75available. 76When value is floating-point, it indicates ratio 77to `(frame-pixel-width)'. 78When `mime-image-normalize-xbm' is non-nil, original size is 79always used for xbm image." 80 :group 'mime-view 81 :type '(choice (const :tag "Use original size" nil) 82 (float :tag "Ratio to frame width") 83 (integer :tag "Specify in pixel"))) 84 85(defcustom mime-image-max-width nil 86 "*Max displayed image width of attachment image to a message. 87It has effect only when imagemagick or image scaling support is 88available. 89When value is floating-point number, it indicates ratio 90to `(frame-pixel-height)'. 91When `mime-image-normalize-xbm' is non-nil, original size is 92always used for xbm image." 93 :group 'mime-view 94 :type '(choice (const :tag "Use original size" nil) 95 (float :tag "Ratio to frame height") 96 (integer :tag "Specify in pixel"))) 97 98(defcustom mime-image-normalize-xbm t 99 "*When non-nil, build binary xbm image to display. 100Furthermore, image scaling for xbm image is disabled." 101 :group 'mime-view 102 :type 'boolean) 103 104(defalias 'mime-image-type-available-p 'image-type-available-p) 105(defun mime-image-create 106 (file-or-data &optional type data-p &rest props) 107 (let* ((scale-p (and (fboundp 'image-transforms-p) 108 (memq 'scale (image-transforms-p)))) 109 (imagemagick 110 (and (null scale-p) 111 (or mime-image-max-height mime-image-max-width) 112 (image-type-available-p 'imagemagick) 113 (fboundp 'imagemagick-filter-types) 114 (member (downcase (symbol-name type)) 115 (mapcar (lambda (e) (downcase (symbol-name e))) 116 (imagemagick-filter-types))))) 117 height width) 118 (when (and mime-image-normalize-xbm data-p (eq type 'xbm)) 119 (with-temp-buffer 120 (insert file-or-data) 121 (setq file-or-data 122 (mime-image-normalize-xbm-buffer))) 123 (setq width (car file-or-data) 124 height (nth 1 file-or-data) 125 file-or-data (nth 2 file-or-data))) 126 (setq props 127 (nconc (and width `(:width ,width)) 128 (and height `(:height ,height)) 129 (and (or scale-p imagemagick) 130 mime-image-max-width 131 `(:max-width 132 ,(if (integerp mime-image-max-width) 133 mime-image-max-width 134 (floor (* (frame-pixel-width) 135 mime-image-max-width))))) 136 (and (or scale-p imagemagick) 137 mime-image-max-height 138 `(:max-height 139 ,(if (integerp mime-image-max-height) 140 mime-image-max-height 141 (floor (* (frame-pixel-height) 142 mime-image-max-height))))) 143 props)) 144 (cond 145 (imagemagick 146 (apply #'create-image file-or-data 'imagemagick data-p props)) 147 (t 148 (apply #'create-image file-or-data type data-p props))))) 149(defalias 'mime-image-insert 'insert-image) 150 151(defvar mime-image-format-alist 152 '((image jpeg jpeg) 153 (image gif gif) 154 (image tiff tiff) 155 (image x-tiff tiff) 156 (image xbm xbm) 157 (image x-xbm xbm) 158 (image x-xpixmap xpm) 159 (image png png))) 160 161(dolist (rule mime-image-format-alist) 162 (when (mime-image-type-available-p (nth 2 rule)) 163 (ctree-set-calist-strictly 164 'mime-preview-condition 165 (list (cons 'type (car rule))(cons 'subtype (nth 1 rule)) 166 '(body . visible) 167 (cons 'body-presentation-method #'mime-display-image) 168 (cons 'image-format (nth 2 rule)))))) 169 170 171;;; @ content filter for images 172;;; 173;; (for XEmacs 19.12 or later) 174 175(defun mime-display-image (entity situation) 176 (message "Decoding image...") 177 (condition-case err 178 (let ((format (cdr (assq 'image-format situation))) 179 image) 180 (setq image 181 (mime-image-create (mime-entity-content entity) 182 format 'data)) 183 (if (null image) 184 (message "Invalid glyph!") 185 (save-excursion 186 (mime-image-insert image) 187 (insert "\n") 188 (message "Decoding image...done")))) 189 (error nil err))) 190 191 192;;; @ end 193;;; 194 195(provide 'mime-image) 196 197;;; mime-image.el ends here 198