Add keyword header `tools' to actually get listed in finder.
[bpt/emacs.git] / lisp / image-file.el
CommitLineData
5859e61a
MB
1;;; image-file.el --- Support for visiting image files
2;;
65e70fc4 3;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
5859e61a
MB
4;;
5;; Author: Miles Bader <miles@gnu.org>
6;; Keywords: multimedia
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
24
25;;; Commentary:
26
27;; Defines a file-name-handler hook that transforms visited (or
db623cef 28;; inserted) image files so that they are displayed by emacs as
5859e61a
MB
29;; images. This is done by putting a `display' text-property on the
30;; image data, with the image-data still present underneath; if the
31;; resulting buffer file is saved to another name it will correctly save
32;; the image data to the new file.
33
34;;; Code:
35
36(require 'image)
37
75e5b373 38
1c7e37a9 39;;;###autoload
75e5b373 40(defcustom image-file-name-extensions
228b0b9a 41 '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm")
75e5b373
MB
42 "*A list of image-file filename extensions.
43Filenames having one of these extensions are considered image files,
44in addition to those matching `image-file-name-regexps'.
45
46See `auto-image-file-mode'; if `auto-image-file-mode' is enabled,
47setting this variable directly does not take effect unless
228b0b9a
DL
48`auto-image-file-mode' is re-enabled; this happens automatically when
49the variable is set using \\[customize]."
75e5b373
MB
50 :type '(repeat string)
51 :set (lambda (sym val)
52 (set-default sym val)
53 (when auto-image-file-mode
54 ;; Re-initialize the image-file handler
55 (auto-image-file-mode t)))
5859e61a 56 :initialize 'custom-initialize-default
5859e61a
MB
57 :group 'image)
58
1c7e37a9 59;;;###autoload
75e5b373 60(defcustom image-file-name-regexps nil
34a19346 61 "*List of regexps matching image-file filenames.
75e5b373
MB
62Filenames matching one of these regexps are considered image files,
63in addition to those with an extension in `image-file-name-extensions'.
5859e61a 64
db623cef
DL
65See function `auto-image-file-mode'; if `auto-image-file-mode' is
66enabled, setting this variable directly does not take effect unless
228b0b9a
DL
67`auto-image-file-mode' is re-enabled; this happens automatically when
68the variable is set using \\[customize]."
5859e61a
MB
69 :type '(repeat regexp)
70 :set (lambda (sym val)
71 (set-default sym val)
75e5b373 72 (when auto-image-file-mode
5859e61a 73 ;; Re-initialize the image-file handler
75e5b373 74 (auto-image-file-mode t)))
5859e61a
MB
75 :initialize 'custom-initialize-default
76 :group 'image)
77
75e5b373
MB
78
79;;;###autoload
80(defun image-file-name-regexp ()
34a19346 81 "Return a regular expression matching image-file filenames."
75e5b373
MB
82 (let ((exts-regexp
83 (and image-file-name-extensions
84 (concat "\\."
b170205b
MB
85 (regexp-opt (nconc (mapcar #'upcase
86 image-file-name-extensions)
87 image-file-name-extensions)
88 t)
75e5b373
MB
89 "\\'"))))
90 (if image-file-name-regexps
91 (mapconcat 'identity
92 (if exts-regexp
a23ccdf2
DL
93 (cons exts-regexp image-file-name-regexps)
94 image-file-name-regexps)
75e5b373
MB
95 "\\|")
96 exts-regexp)))
97
98
5859e61a
MB
99;;;###autoload
100(defun insert-image-file (file &optional visit beg end replace)
101 "Insert the image file FILE into the current buffer.
102Optional arguments VISIT, BEG, END, and REPLACE are interpreted as for
103the command `insert-file-contents'."
104 (let ((rval
105 (image-file-call-underlying #'insert-file-contents-literally
106 'insert-file-contents
107 file visit beg end replace)))
75e5b373
MB
108 ;; Turn the image data into a real image, but only if the whole file
109 ;; was inserted
110 (when (and (or (null beg) (zerop beg)) (null end))
5859e61a
MB
111 (let* ((ibeg (point))
112 (iend (+ (point) (cadr rval)))
33155ffb 113 (visitingp (and visit (= ibeg (point-min)) (= iend (point-max))))
5859e61a 114 (data
75e5b373
MB
115 (string-make-unibyte
116 (buffer-substring-no-properties ibeg iend)))
5859e61a
MB
117 (image
118 (create-image data nil t))
119 (props
120 `(display ,image
121 intangible ,image
a02b5bb4 122 rear-nonsticky (display intangible)
5859e61a 123 ;; This a cheap attempt to make the whole buffer
a02b5bb4
MB
124 ;; read-only when we're visiting the file (as
125 ;; opposed to just inserting it).
33155ffb 126 ,@(and visitingp
5859e61a 127 '(read-only t front-sticky (read-only))))))
33155ffb
MB
128 (add-text-properties ibeg iend props)
129 (when visitingp
130 ;; Inhibit the cursor when the buffer contains only an image,
131 ;; because cursors look very strange on top of images.
65e70fc4
MB
132 (setq cursor-type nil)
133 ;; This just makes the arrow displayed in the right fringe
134 ;; area look correct when the image is wider than the window.
135 (setq truncate-lines t))))
5859e61a
MB
136 rval))
137
138(defun image-file-handler (operation &rest args)
34a19346 139 "Filename handler for inserting image files.
5859e61a
MB
140OPERATION is the operation to perform, on ARGS.
141See `file-name-handler-alist' for details."
75e5b373
MB
142 (if (and (eq operation 'insert-file-contents)
143 auto-image-file-mode)
5859e61a
MB
144 (apply #'insert-image-file args)
145 ;; We don't handle OPERATION, use another handler or the default
146 (apply #'image-file-call-underlying operation operation args)))
147
148(defun image-file-call-underlying (function operation &rest args)
149 "Call FUNCTION with `image-file-handler' and OPERATION inhibited.
150Optional argument ARGS are the arguments to call FUNCTION with."
151 (let ((inhibit-file-name-handlers
152 (cons 'image-file-handler
153 (and (eq inhibit-file-name-operation operation)
154 inhibit-file-name-handlers)))
155 (inhibit-file-name-operation operation))
156 (apply function args)))
157
5859e61a 158
33c7a00c
MB
159;;; Note this definition must be at the end of the file, because
160;;; `define-minor-mode' actually calls the mode-function if the
161;;; associated variable is non-nil, which requires that all needed
162;;; functions be already defined. [This is arguably a bug in d-m-m]
163;;;###autoload
164(define-minor-mode auto-image-file-mode
165 "Toggle visiting of image files as images.
166With prefix argument ARG, turn on if positive, otherwise off.
167Returns non-nil if the new state is enabled.
168
169Image files are those whose name has an extension in
170`image-file-name-extensions', or matches a regexp in
171`image-file-name-regexps'."
33c7a00c
MB
172 :global t
173 :group 'image
174 ;; Remove existing handler
175 (let ((existing-entry
176 (rassq 'image-file-handler file-name-handler-alist)))
177 (when existing-entry
178 (setq file-name-handler-alist
179 (delq existing-entry file-name-handler-alist))))
180 ;; Add new handler, if enabled
181 (when auto-image-file-mode
182 (push (cons (image-file-name-regexp) 'image-file-handler)
183 file-name-handler-alist)))
184
185
5859e61a
MB
186(provide 'image-file)
187
188;;; image-file.el ends here