cgit.sxemacs.org Git - packages/blob - xemacs-packages/text-modes/image-mode.el

   1 ;;; image-mode.el --- Major mode for navigating images
   2
   3 ;; Copyright (C) 1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1997/6/27
   7 ;; Version: image-mode.el,v 20.3.1.2 1997/07/01 17:29:44 morioka Exp
   8 ;; Keywords: image, graphics
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Modified: 2001-07-10, Glynn Clements <glynn.clements@virgin.net>
  30 ;;      Substantially re-written to avoid use of format-alist
  31 ;; Modified: 2002-10-18, Glynn Clements <glynn.clements@virgin.net>
  32 ;;      Autoload image-mode-install
  33 ;; Modified: 2002-10-22, Glynn Clements <glynn.clements@virgin.net>
  34 ;;      Remove format-alist entries
  35
  36 ;;; Code:
  37
  38 (require 'cl)
  39
  40 (defvar image-format nil)
  41 (make-variable-buffer-local 'image-format)
  42
  43 (defvar image-decoded nil)
  44 (make-variable-buffer-local 'image-decoded)
  45
  46 ;;;###autoload
  47 (defvar image-formats-alist
  48   '(("png"   . png )
  49     ("gif"   . gif )
  50     ("jpe?g" . jpeg)
  51     ("tiff?" . tiff)
  52     ("xbm"   . xbm )
  53     ("xpm"   . xpm )
  54     ("bmp"   . bmp )))
  55
  56 (defun image-guess-type ()
  57   (let (ext item)
  58     (and buffer-file-name
  59          (setq ext (downcase (file-name-extension buffer-file-name)))
  60          (setq item (assoc* ext image-formats-alist
  61                             :test (lambda (str re)
  62                                     (string-match (concat "^" re "\\'")
  63                                                   str))))
  64          (setq image-format (cdr item)))))
  65
  66 (defun image-decode-buffer ()
  67   (image-decode (point-min) (point-max) image-format)
  68   (setq image-decoded t)
  69   (set-buffer-modified-p nil))
  70
  71 (defun image-undecode-buffer ()
  72   (setq buffer-read-only nil)
  73   (map-extents (function
  74                 (lambda (extent maparg)
  75                   (delete-extent extent)))
  76                nil (point-min) (point-max) nil 'end-closed)
  77   (setq image-decoded nil))
  78
  79 (defun image-decode (start end type)
  80   "Decode the image between START and END which is encoded in TYPE."
  81   (save-excursion
  82     (let ((image (and type
  83                       (make-image-instance
  84                        (vector type :data (buffer-string start end))
  85                        nil nil 'no-error))))
  86       (unless image
  87         (setq image (make-image-instance
  88                      (vector 'string :data "format is not supported!\n")
  89                      nil nil 'no-error)))
  90       (set-extent-property (make-extent start end) 'invisible t)
  91       (let ((glyph (make-glyph image)))
  92         (set-extent-end-glyph (make-extent end end) glyph))
  93       (setq buffer-read-only t))))
  94
  95 (defvar image-mode-map (make-keymap))
  96 (suppress-keymap image-mode-map)
  97 (define-key image-mode-map "v" 'image-start-external-viewer)
  98 (define-key image-mode-map "t" 'image-toggle-decoding)
  99 (define-key image-mode-map "h" 'image-enter-hexl-mode)
 100 (define-key image-mode-map "e" 'image-enter-xpm-mode)
 101 (define-key image-mode-map "q" 'image-mode-quit)
 102
 103 ;; ### There must be a general way of doing this, using mimecap....
 104 (defvar image-external-viewer-list
 105   '(
 106     "xv"                                ; xv
 107     "display"                           ; ImageMagic
 108     )
 109   "*List of external viewers for image-mode.
 110
 111 Each viewer is a string, to be called via `start-process'.  If null,
 112 no external viewer will be used.")
 113
 114 (defun image-start-external-viewer ()
 115   "Start external image viewer for current-buffer.
 116
 117 It tries each program name in `image-external-viewer-list' in order.
 118 If `image-external-viewer-list' is empty, or none of the viewers can
 119 be found, signals an error."
 120
 121   (interactive)
 122   (let ((vl image-external-viewer-list))
 123     (if vl
 124         (catch 'done
 125           (while vl
 126             (condition-case nil
 127                 (progn
 128                   (start-process "external image viewer" nil
 129                                  (car vl) buffer-file-name)
 130                   (throw 'done nil))    ; exit loop
 131               (file-error (setq vl (cdr vl)))))
 132           (error "image-start-external-viewer:  couldn't start any viewer in `image-external-viewer-list'"))
 133       (error "image-start-external-viewer:  `image-external-viewer-list' is empty."))))
 134
 135 (defun image-toggle-decoding ()
 136   "Toggle image display mode in current buffer."
 137   (interactive)
 138   (if image-decoded
 139       (image-undecode-buffer)
 140     (image-decode-buffer)))
 141
 142 (defun image-exit-hexl-mode-function ()
 143   (image-decode-buffer)
 144   (remove-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
 145
 146 (defun image-enter-hexl-mode ()
 147   "Enter hexl-mode."
 148   (interactive)
 149   (when image-decoded
 150     (image-undecode-buffer)
 151     (add-hook 'hexl-mode-exit-hook 'image-exit-hexl-mode-function))
 152   (hexl-mode))
 153
 154 (defun image-enter-xpm-mode ()
 155   "Enter xpm-mode."
 156   (interactive)
 157   (if (not (eq image-format 'xpm))
 158       (error "Not an XPM image."))
 159   (when image-decoded
 160     (image-undecode-buffer))
 161   (xpm-mode 1))
 162
 163 (defun image-mode-quit ()
 164   "Exit image-mode."
 165   (interactive)
 166   (kill-buffer (current-buffer)))
 167
 168 (defun image-maybe-restore ()
 169   "Restore buffer if it is decoded."
 170   (when image-decoded
 171     (image-undecode-buffer)))
 172
 173 (add-hook 'change-major-mode-hook 'image-maybe-restore)
 174
 175 ;;;###autoload
 176 (defun image-mode (&optional arg)
 177   "\\{image-mode-map}"
 178   (interactive)
 179   (setq major-mode 'image-mode)
 180   (setq mode-name "Image")
 181   (use-local-map image-mode-map)
 182   (image-guess-type)
 183   (image-decode-buffer))
 184
 185 ;;;###autoload
 186 (progn
 187   (setq format-alist
 188         (remove-if (lambda (x)
 189                      (eq (nth 6 x) 'image-mode))
 190                    format-alist))
 191   (dolist (format image-formats-alist)
 192     (let* ((re (car format))
 193            (type (cdr format))
 194            (regexp (concat "\\.\\(" re "\\|" (upcase re) "\\)\\'"))
 195            (item (cons regexp 'image-mode)))
 196       (and (featurep type)
 197            (add-to-list 'auto-mode-alist item)))))
 198
 199 (provide 'image-mode)
 200
 201 ;;; image-mode.el ends here