|
42558
|
1 ;;; image-file.el --- support for visiting image files
|
|
31934
|
2 ;;
|
|
64762
|
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
|
|
79721
|
4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
|
31934
|
5 ;;
|
|
|
6 ;; Author: Miles Bader <miles@gnu.org>
|
|
|
7 ;; Keywords: multimedia
|
|
|
8
|
|
|
9 ;; This file is part of GNU Emacs.
|
|
|
10
|
|
94678
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
|
31934
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
94678
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
|
14 ;; (at your option) any later version.
|
|
31934
|
15
|
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
19 ;; GNU General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
94678
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
|
31934
|
23
|
|
|
24 ;;; Commentary:
|
|
|
25
|
|
|
26 ;; Defines a file-name-handler hook that transforms visited (or
|
|
42558
|
27 ;; inserted) image files so that they are displayed by Emacs as
|
|
31934
|
28 ;; images. This is done by putting a `display' text-property on the
|
|
|
29 ;; image data, with the image-data still present underneath; if the
|
|
|
30 ;; resulting buffer file is saved to another name it will correctly save
|
|
|
31 ;; the image data to the new file.
|
|
|
32
|
|
|
33 ;;; Code:
|
|
|
34
|
|
|
35 (require 'image)
|
|
|
36
|
|
32003
|
37
|
32440
4e98e54082d2
(image-file-name-extensions, image-file-name-regexps): Add autoload cookies.
Miles Bader <miles@gnu.org>
diff
changeset
|
38 ;;;###autoload
|
|
32003
|
39 (defcustom image-file-name-extensions
|
|
82520
|
40 '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")
|
|
32003
|
41 "*A list of image-file filename extensions.
|
|
|
42 Filenames having one of these extensions are considered image files,
|
|
|
43 in addition to those matching `image-file-name-regexps'.
|
|
31934
|
44
|
|
32003
|
45 See `auto-image-file-mode'; if `auto-image-file-mode' is enabled,
|
|
|
46 setting this variable directly does not take effect unless
|
|
42141
|
47 `auto-image-file-mode' is re-enabled; this happens automatically when
|
|
|
48 the variable is set using \\[customize]."
|
|
32003
|
49 :type '(repeat string)
|
|
|
50 :set (lambda (sym val)
|
|
|
51 (set-default sym val)
|
|
|
52 (when auto-image-file-mode
|
|
|
53 ;; Re-initialize the image-file handler
|
|
|
54 (auto-image-file-mode t)))
|
|
31934
|
55 :initialize 'custom-initialize-default
|
|
|
56 :group 'image)
|
|
|
57
|
32440
4e98e54082d2
(image-file-name-extensions, image-file-name-regexps): Add autoload cookies.
Miles Bader <miles@gnu.org>
diff
changeset
|
58 ;;;###autoload
|
|
32003
|
59 (defcustom image-file-name-regexps nil
|
|
32185
|
60 "*List of regexps matching image-file filenames.
|
|
32003
|
61 Filenames matching one of these regexps are considered image files,
|
|
|
62 in addition to those with an extension in `image-file-name-extensions'.
|
|
31934
|
63
|
|
32220
|
64 See function `auto-image-file-mode'; if `auto-image-file-mode' is
|
|
|
65 enabled, setting this variable directly does not take effect unless
|
|
42141
|
66 `auto-image-file-mode' is re-enabled; this happens automatically when
|
|
|
67 the variable is set using \\[customize]."
|
|
31934
|
68 :type '(repeat regexp)
|
|
|
69 :set (lambda (sym val)
|
|
|
70 (set-default sym val)
|
|
32003
|
71 (when auto-image-file-mode
|
|
31934
|
72 ;; Re-initialize the image-file handler
|
|
32003
|
73 (auto-image-file-mode t)))
|
|
31934
|
74 :initialize 'custom-initialize-default
|
|
|
75 :group 'image)
|
|
|
76
|
|
32003
|
77
|
|
|
78 ;;;###autoload
|
|
|
79 (defun image-file-name-regexp ()
|
|
32185
|
80 "Return a regular expression matching image-file filenames."
|
|
32003
|
81 (let ((exts-regexp
|
|
|
82 (and image-file-name-extensions
|
|
|
83 (concat "\\."
|
34074
89fcace178df
(image-file-name-regexp): Automatically add upper-case variants of each
Miles Bader <miles@gnu.org>
diff
changeset
|
84 (regexp-opt (nconc (mapcar #'upcase
|
89fcace178df
(image-file-name-regexp): Automatically add upper-case variants of each
Miles Bader <miles@gnu.org>
diff
changeset
|
85 image-file-name-extensions)
|
89fcace178df
(image-file-name-regexp): Automatically add upper-case variants of each
Miles Bader <miles@gnu.org>
diff
changeset
|
86 image-file-name-extensions)
|
89fcace178df
(image-file-name-regexp): Automatically add upper-case variants of each
Miles Bader <miles@gnu.org>
diff
changeset
|
87 t)
|
|
32003
|
88 "\\'"))))
|
|
|
89 (if image-file-name-regexps
|
|
|
90 (mapconcat 'identity
|
|
|
91 (if exts-regexp
|
|
32218
|
92 (cons exts-regexp image-file-name-regexps)
|
|
|
93 image-file-name-regexps)
|
|
32003
|
94 "\\|")
|
|
|
95 exts-regexp)))
|
|
|
96
|
|
|
97
|
|
|
98 ;;;###autoload
|
|
31934
|
99 (defun insert-image-file (file &optional visit beg end replace)
|
|
|
100 "Insert the image file FILE into the current buffer.
|
|
|
101 Optional arguments VISIT, BEG, END, and REPLACE are interpreted as for
|
|
|
102 the command `insert-file-contents'."
|
|
|
103 (let ((rval
|
|
|
104 (image-file-call-underlying #'insert-file-contents-literally
|
|
|
105 'insert-file-contents
|
|
|
106 file visit beg end replace)))
|
|
32003
|
107 ;; Turn the image data into a real image, but only if the whole file
|
|
|
108 ;; was inserted
|
|
|
109 (when (and (or (null beg) (zerop beg)) (null end))
|
|
31934
|
110 (let* ((ibeg (point))
|
|
|
111 (iend (+ (point) (cadr rval)))
|
35854
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
112 (visitingp (and visit (= ibeg (point-min)) (= iend (point-max))))
|
|
31934
|
113 (data
|
|
32003
|
114 (string-make-unibyte
|
|
|
115 (buffer-substring-no-properties ibeg iend)))
|
|
31934
|
116 (image
|
|
|
117 (create-image data nil t))
|
|
|
118 (props
|
|
|
119 `(display ,image
|
|
64594
|
120 yank-handler
|
|
|
121 (image-file-yank-handler nil t)
|
|
31934
|
122 intangible ,image
|
|
33727
|
123 rear-nonsticky (display intangible)
|
|
31934
|
124 ;; This a cheap attempt to make the whole buffer
|
|
33727
|
125 ;; read-only when we're visiting the file (as
|
|
|
126 ;; opposed to just inserting it).
|
35854
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
127 ,@(and visitingp
|
|
31934
|
128 '(read-only t front-sticky (read-only))))))
|
35854
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
129 (add-text-properties ibeg iend props)
|
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
130 (when visitingp
|
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
131 ;; Inhibit the cursor when the buffer contains only an image,
|
a8fd9112792b
(insert-image-file): When visiting an image, suppress the cursor in the
Miles Bader <miles@gnu.org>
diff
changeset
|
132 ;; because cursors look very strange on top of images.
|
35884
3d9c9fe711c4
(insert-image-file): When visiting an image, set `truncate-lines' to t
Miles Bader <miles@gnu.org>
diff
changeset
|
133 (setq cursor-type nil)
|
3d9c9fe711c4
(insert-image-file): When visiting an image, set `truncate-lines' to t
Miles Bader <miles@gnu.org>
diff
changeset
|
134 ;; This just makes the arrow displayed in the right fringe
|
3d9c9fe711c4
(insert-image-file): When visiting an image, set `truncate-lines' to t
Miles Bader <miles@gnu.org>
diff
changeset
|
135 ;; area look correct when the image is wider than the window.
|
3d9c9fe711c4
(insert-image-file): When visiting an image, set `truncate-lines' to t
Miles Bader <miles@gnu.org>
diff
changeset
|
136 (setq truncate-lines t))))
|
|
31934
|
137 rval))
|
|
|
138
|
|
64556
|
139 ;; We use a yank-handler to make yanked images unique, so that
|
|
|
140 ;; yanking two copies of the same image next to each other are
|
|
|
141 ;; recognized as two different images.
|
|
|
142 (defun image-file-yank-handler (string)
|
|
|
143 "Yank handler for inserting an image into a buffer."
|
|
64594
|
144 (let ((len (length string))
|
|
|
145 (image (get-text-property 0 'display string)))
|
|
|
146 (remove-text-properties 0 len yank-excluded-properties string)
|
|
64556
|
147 (if (consp image)
|
|
64594
|
148 (add-text-properties 0
|
|
|
149 (or (next-single-property-change 0 'image-counter string)
|
|
|
150 (length string))
|
|
|
151 `(display
|
|
|
152 ,(cons (car image) (cdr image))
|
|
|
153 yank-handler
|
|
|
154 ,(cons 'image-file-yank-handler '(nil t)))
|
|
|
155 string))
|
|
64556
|
156 (insert string)))
|
|
|
157
|
|
60523
|
158 (put 'image-file-handler 'safe-magic t)
|
|
31934
|
159 (defun image-file-handler (operation &rest args)
|
|
32185
|
160 "Filename handler for inserting image files.
|
|
31934
|
161 OPERATION is the operation to perform, on ARGS.
|
|
|
162 See `file-name-handler-alist' for details."
|
|
32003
|
163 (if (and (eq operation 'insert-file-contents)
|
|
|
164 auto-image-file-mode)
|
|
31934
|
165 (apply #'insert-image-file args)
|
|
|
166 ;; We don't handle OPERATION, use another handler or the default
|
|
|
167 (apply #'image-file-call-underlying operation operation args)))
|
|
|
168
|
|
|
169 (defun image-file-call-underlying (function operation &rest args)
|
|
|
170 "Call FUNCTION with `image-file-handler' and OPERATION inhibited.
|
|
|
171 Optional argument ARGS are the arguments to call FUNCTION with."
|
|
|
172 (let ((inhibit-file-name-handlers
|
|
|
173 (cons 'image-file-handler
|
|
|
174 (and (eq inhibit-file-name-operation operation)
|
|
|
175 inhibit-file-name-handlers)))
|
|
|
176 (inhibit-file-name-operation operation))
|
|
|
177 (apply function args)))
|
|
|
178
|
|
|
179
|
|
32316
|
180 ;;;###autoload
|
|
|
181 (define-minor-mode auto-image-file-mode
|
|
|
182 "Toggle visiting of image files as images.
|
|
|
183 With prefix argument ARG, turn on if positive, otherwise off.
|
|
|
184 Returns non-nil if the new state is enabled.
|
|
|
185
|
|
|
186 Image files are those whose name has an extension in
|
|
|
187 `image-file-name-extensions', or matches a regexp in
|
|
|
188 `image-file-name-regexps'."
|
|
|
189 :global t
|
|
|
190 :group 'image
|
|
|
191 ;; Remove existing handler
|
|
|
192 (let ((existing-entry
|
|
|
193 (rassq 'image-file-handler file-name-handler-alist)))
|
|
|
194 (when existing-entry
|
|
|
195 (setq file-name-handler-alist
|
|
|
196 (delq existing-entry file-name-handler-alist))))
|
|
|
197 ;; Add new handler, if enabled
|
|
|
198 (when auto-image-file-mode
|
|
|
199 (push (cons (image-file-name-regexp) 'image-file-handler)
|
|
|
200 file-name-handler-alist)))
|
|
|
201
|
|
|
202
|
|
31934
|
203 (provide 'image-file)
|
|
|
204
|
|
93975
|
205 ;; arch-tag: 04cafe36-f7ba-4c80-9f47-4cb656520ce1
|
|
31934
|
206 ;;; image-file.el ends here
|
