mime-image.el

   1 ;;; mime-image.el --- mime-view filter to display images
   2
   3 ;; Copyright (C) 1995,1996,1997 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 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   9 ;; Created: 1995/12/15
  10 ;;      Renamed: 1997/2/21 from tm-image.el
  11 ;; Version: $Id: mime-image.el,v 0.1 1997-02-21 06:43:51 tmorioka Exp $
  12
  13 ;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news
  14
  15 ;; This file is part of XEmacs.
  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., 59 Temple Place - Suite 330,
  30 ;; Boston, MA 02111-1307, 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
  40 (cond (running-xemacs
  41        (require 'images)
  42
  43        (defun-maybe image-inline-p (format)
  44          (or (memq format image-native-formats)
  45              (find-if (function
  46                        (lambda (native)
  47                          (image-converter-chain format native)
  48                          ))
  49                       image-native-formats)
  50              ))
  51
  52        (image-register-netpbm-utilities)
  53        (image-register-converter 'pic 'ppm "pictoppm")
  54        (image-register-converter 'mag 'ppm "magtoppm")
  55
  56        (defun bitmap-insert-xbm-file (file)
  57          (let ((gl (make-glyph (list (cons 'x file))))
  58                (e (make-extent (point) (point)))
  59                )
  60            (set-extent-end-glyph e gl)
  61            ))
  62
  63        ;;
  64        ;; X-Face
  65        ;;
  66        (autoload 'highlight-headers "highlight-headers")
  67
  68        (defun mime-preview/x-face-function-use-highlight-headers ()
  69          (highlight-headers (point-min) (re-search-forward "^$" nil t) t)
  70          )
  71
  72        (add-hook 'mime-view-content-header-filter-hook
  73                  'mime-preview/x-face-function-use-highlight-headers)
  74
  75        )
  76       ((featurep 'mule)
  77        ;; for MULE 2.* or mule merged EMACS
  78        (require 'x-face-mule)
  79
  80        (defvar image-native-formats '(xbm))
  81
  82        (defun-maybe image-inline-p (format)
  83          (memq format image-native-formats)
  84          )
  85
  86        (defun-maybe image-normalize (format data)
  87          (and (eq format 'xbm)
  88               (vector 'xbm ':data data)
  89               ))
  90
  91        ;;
  92        ;; X-Face
  93        ;;
  94        (if (file-installed-p uncompface-program exec-path)
  95            (add-hook 'mime-view-content-header-filter-hook
  96                      'x-face-decode-message-header)
  97          )
  98        ))
  99
 100 (or (fboundp 'image-invalid-glyph-p)
 101     (defsubst image-invalid-glyph-p (glyph)
 102       (or (null (aref glyph 0))
 103           (null (aref glyph 2))
 104           (equal (aref glyph 2) "")
 105           ))
 106     )
 107
 108 (defvar mime-view-image-converter-alist nil)
 109
 110 (mapcar (function
 111          (lambda (rule)
 112            (let ((ctype  (car rule))
 113                  (format (cdr rule))
 114                  )
 115              (if (image-inline-p format)
 116                  (progn
 117                    (set-alist 'mime-view-content-filter-alist
 118                               ctype
 119                               (function mime-preview/filter-for-image))
 120                    (set-alist 'mime-view-image-converter-alist
 121                               ctype format)
 122                    (add-to-list
 123                     'mime-view-default-showing-Content-Type-list
 124                     ctype)
 125                    )
 126                ))))
 127         '(("image/jpeg"                 . jpeg)
 128           ("image/gif"                  . gif)
 129           ("image/tiff"                 . tiff)
 130           ("image/x-tiff"               . tiff)
 131           ("image/xbm"                  . xbm)
 132           ("image/x-xbm"                . xbm)
 133           ("image/x-xpixmap"            . xpm)
 134           ("image/x-pic"                . pic)
 135           ("image/x-mag"                . mag)
 136           ))
 137
 138 (defvar mime-view-ps-to-gif-command "pstogif")
 139
 140
 141 ;;; @ content filter for images
 142 ;;;
 143 ;;    (for XEmacs 19.12 or later)
 144
 145 (defun mime-preview/filter-for-image (ctype params encoding)
 146   (let* ((mode mime::preview/original-major-mode)
 147          (m (assq mode mime-view-code-converter-alist))
 148          (charset (assoc "charset" params))
 149          (beg (point-min)) (end (point-max))
 150          )
 151     (remove-text-properties beg end '(face nil))
 152     (message "Decoding image...")
 153     (mime-decode-region beg end encoding)
 154     (let* ((minor (assoc-value ctype mime-view-image-converter-alist))
 155            (gl (image-normalize minor (buffer-string)))
 156            e)
 157       (delete-region (point-min)(point-max))
 158       (cond ((image-invalid-glyph-p gl)
 159              (setq gl nil)
 160              (message "Invalid glyph!")
 161              )
 162             ((eq (aref gl 0) 'xbm)
 163              (let ((xbm-file
 164                     (make-temp-name (expand-file-name "tm" mime/tmp-dir))))
 165                (insert (aref gl 2))
 166                (write-region (point-min)(point-max) xbm-file)
 167                (message "Decoding image...")
 168                (delete-region (point-min)(point-max))
 169                (bitmap-insert-xbm-file xbm-file)
 170                (delete-file xbm-file)
 171                )
 172              (message "Decoding image... done")
 173              )
 174             (t
 175              (setq gl (make-glyph gl))
 176              (setq e (make-extent (point) (point)))
 177              (set-extent-end-glyph e gl)
 178              (message "Decoding image... done")
 179              ))
 180       )
 181     (insert "\n")
 182     ))
 183
 184
 185 ;;; @ content filter for Postscript
 186 ;;;
 187 ;;    (for XEmacs 19.14 or later)
 188
 189 (defun mime-preview/filter-for-application/postscript (ctype params encoding)
 190   (let* ((mode mime::preview/original-major-mode)
 191          (m (assq mode mime-view-code-converter-alist))
 192          (beg (point-min)) (end (point-max))
 193          (file-base (make-temp-name (expand-file-name "tm" mime/tmp-dir)))
 194          (ps-file (concat file-base ".ps"))
 195          (gif-file (concat file-base ".gif"))
 196          )
 197     (remove-text-properties beg end '(face nil))
 198     (message "Decoding Postscript...")
 199     (mime-decode-region beg end encoding)
 200     (write-region (point-min)(point-max) ps-file)
 201     (message "Decoding Postscript...")
 202     (delete-region (point-min)(point-max))
 203     (call-process mime-view-ps-to-gif-command nil nil nil ps-file)
 204     (set-extent-end-glyph (make-extent (point) (point))
 205                           (make-glyph (vector 'gif :file gif-file)))
 206     (message "Decoding Postscript... done")
 207     (delete-file ps-file)
 208     (delete-file gif-file)
 209     ))
 210
 211 (set-alist 'mime-view-content-filter-alist
 212            "application/postscript"
 213            (function mime-preview/filter-for-application/postscript))
 214
 215 (if (featurep 'gif)
 216     (add-to-list 'mime-view-default-showing-Content-Type-list
 217                  "application/postscript")
 218   )
 219
 220
 221 ;;; @ end
 222 ;;;
 223
 224 (provide 'mime-image)
 225
 226 ;;; mime-image.el ends here