Merge changes made in Gnus trunk.
[bpt/emacs.git] / lisp / image-mode.el
CommitLineData
c7bd5d57
RS
1;;; image-mode.el --- support for visiting image files
2;;
73b0cd50 3;; Copyright (C) 2005-2011 Free Software Foundation, Inc.
c7bd5d57
RS
4;;
5;; Author: Richard Stallman <rms@gnu.org>
6;; Keywords: multimedia
bd78fa1d 7;; Package: emacs
c7bd5d57
RS
8
9;; This file is part of GNU Emacs.
10
eb3fa2cf 11;; GNU Emacs is free software: you can redistribute it and/or modify
c7bd5d57 12;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
c7bd5d57
RS
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
eb3fa2cf 22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
c7bd5d57
RS
23
24;;; Commentary:
25
26;; Defines a major mode for visiting image files
27;; that allows conversion between viewing the text of the file
28;; and viewing the file as an image. Viewing the image
29;; works 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)
44e3c7c6 37(eval-when-compile (require 'cl))
c7bd5d57 38
44e3c7c6
SM
39;;; Image mode window-info management.
40
41(defvar image-mode-winprops-alist t)
42(make-variable-buffer-local 'image-mode-winprops-alist)
43
44(defvar image-mode-new-window-functions nil
45 "Special hook run when image data is requested in a new window.
46It is called with one argument, the initial WINPROPS.")
47
b81f0bab 48(defun image-mode-winprops (&optional window cleanup)
44e3c7c6
SM
49 "Return winprops of WINDOW.
50A winprops object has the shape (WINDOW . ALIST)."
b81f0bab
CY
51 (cond ((null window)
52 (setq window (selected-window)))
53 ((not (windowp window))
54 (error "Not a window: %s" window)))
55 (when cleanup
56 (setq image-mode-winprops-alist
57 (delq nil (mapcar (lambda (winprop)
58 (if (window-live-p (car-safe winprop))
59 winprop))
60 image-mode-winprops-alist))))
44e3c7c6
SM
61 (let ((winprops (assq window image-mode-winprops-alist)))
62 ;; For new windows, set defaults from the latest.
63 (unless winprops
64 (setq winprops (cons window
65 (copy-alist (cdar image-mode-winprops-alist))))
66 (run-hook-with-args 'image-mode-new-window-functions winprops))
67 ;; Move window to front.
68 (setq image-mode-winprops-alist
69 (cons winprops (delq winprops image-mode-winprops-alist)))
70 winprops))
71
72(defun image-mode-window-get (prop &optional winprops)
73 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
74 (cdr (assq prop (cdr winprops))))
75
76(defsetf image-mode-window-get (prop &optional winprops) (val)
77 `(image-mode-window-put ,prop ,val ,winprops))
78
79(defun image-mode-window-put (prop val &optional winprops)
80 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
81 (setcdr winprops (cons (cons prop val)
82 (delq (assq prop (cdr winprops)) (cdr winprops)))))
83
84(defun image-set-window-vscroll (vscroll)
85 (setf (image-mode-window-get 'vscroll) vscroll)
86 (set-window-vscroll (selected-window) vscroll))
87
88(defun image-set-window-hscroll (ncol)
60134fd4 89 (setf (image-mode-window-get 'hscroll) ncol)
44e3c7c6
SM
90 (set-window-hscroll (selected-window) ncol))
91
92(defun image-mode-reapply-winprops ()
6d401b4e
SM
93 ;; When set-window-buffer, set hscroll and vscroll to what they were
94 ;; last time the image was displayed in this window.
b81f0bab
CY
95 (when (and (image-get-display-property)
96 (listp image-mode-winprops-alist))
97 (let* ((winprops (image-mode-winprops nil t))
6d401b4e
SM
98 (hscroll (image-mode-window-get 'hscroll winprops))
99 (vscroll (image-mode-window-get 'vscroll winprops)))
c313b5fe
SM
100 (if hscroll (set-window-hscroll (selected-window) hscroll))
101 (if vscroll (set-window-vscroll (selected-window) vscroll)))))
36e1c289 102
44e3c7c6
SM
103(defun image-mode-setup-winprops ()
104 ;; Record current scroll settings.
105 (unless (listp image-mode-winprops-alist)
106 (setq image-mode-winprops-alist nil))
107 (add-hook 'window-configuration-change-hook
108 'image-mode-reapply-winprops nil t))
109
110;;; Image scrolling functions
111
91784462
SM
112(defun image-get-display-property ()
113 (get-char-property (point-min) 'display
114 ;; There might be different images for different displays.
115 (if (eq (window-buffer) (current-buffer))
116 (selected-window))))
117
aa360da1
GM
118(declare-function image-size "image.c" (spec &optional pixels frame))
119
c9088194 120(defun image-display-size (spec &optional pixels frame)
2f224f0b
CY
121 "Wrapper around `image-size', handling slice display properties.
122Like `image-size', the return value is (WIDTH . HEIGHT).
123WIDTH and HEIGHT are in canonical character units if PIXELS is
124nil, and in pixel units if PIXELS is non-nil.
125
126If SPEC is an image display property, this function is equivalent
127to `image-size'. If SPEC is a list of properties containing
128`image' and `slice' properties, return the display size taking
129the slice property into account. If the list contains `image'
130but not `slice', return the `image-size' of the specified image."
c9088194
SK
131 (if (eq (car spec) 'image)
132 (image-size spec pixels frame)
133 (let ((image (assoc 'image spec))
134 (slice (assoc 'slice spec)))
135 (cond ((and image slice)
136 (if pixels
137 (cons (nth 3 slice) (nth 4 slice))
138 (cons (/ (float (nth 3 slice)) (frame-char-width frame))
139 (/ (float (nth 4 slice)) (frame-char-height frame)))))
140 (image
141 (image-size image pixels frame))
142 (t
143 (error "Invalid image specification: %s" spec))))))
144
bb0cb417
CY
145(defun image-forward-hscroll (&optional n)
146 "Scroll image in current window to the left by N character widths.
147Stop if the right edge of the image is reached."
148 (interactive "p")
149 (cond ((= n 0) nil)
150 ((< n 0)
44e3c7c6 151 (image-set-window-hscroll (max 0 (+ (window-hscroll) n))))
bb0cb417 152 (t
91784462 153 (let* ((image (image-get-display-property))
bb0cb417
CY
154 (edges (window-inside-edges))
155 (win-width (- (nth 2 edges) (nth 0 edges)))
c9088194 156 (img-width (ceiling (car (image-display-size image)))))
44e3c7c6 157 (image-set-window-hscroll (min (max 0 (- img-width win-width))
36e1c289 158 (+ n (window-hscroll))))))))
bb0cb417
CY
159
160(defun image-backward-hscroll (&optional n)
161 "Scroll image in current window to the right by N character widths.
162Stop if the left edge of the image is reached."
163 (interactive "p")
164 (image-forward-hscroll (- n)))
165
166(defun image-next-line (&optional n)
167 "Scroll image in current window upward by N lines.
168Stop if the bottom edge of the image is reached."
169 (interactive "p")
170 (cond ((= n 0) nil)
171 ((< n 0)
44e3c7c6 172 (image-set-window-vscroll (max 0 (+ (window-vscroll) n))))
bb0cb417 173 (t
91784462 174 (let* ((image (image-get-display-property))
bb0cb417
CY
175 (edges (window-inside-edges))
176 (win-height (- (nth 3 edges) (nth 1 edges)))
c9088194 177 (img-height (ceiling (cdr (image-display-size image)))))
44e3c7c6 178 (image-set-window-vscroll (min (max 0 (- img-height win-height))
36e1c289 179 (+ n (window-vscroll))))))))
bb0cb417
CY
180
181(defun image-previous-line (&optional n)
182 "Scroll image in current window downward by N lines.
183Stop if the top edge of the image is reached."
184 (interactive "p")
185 (image-next-line (- n)))
186
187(defun image-scroll-up (&optional n)
188 "Scroll image in current window upward by N lines.
189Stop if the bottom edge of the image is reached.
190If ARG is omitted or nil, scroll upward by a near full screen.
191A near full screen is `next-screen-context-lines' less than a full screen.
192Negative ARG means scroll downward.
193If ARG is the atom `-', scroll downward by nearly full screen.
194When calling from a program, supply as argument a number, nil, or `-'."
195 (interactive "P")
196 (cond ((null n)
197 (let* ((edges (window-inside-edges))
198 (win-height (- (nth 3 edges) (nth 1 edges))))
199 (image-next-line
200 (max 0 (- win-height next-screen-context-lines)))))
201 ((eq n '-)
202 (let* ((edges (window-inside-edges))
203 (win-height (- (nth 3 edges) (nth 1 edges))))
204 (image-next-line
205 (min 0 (- next-screen-context-lines win-height)))))
206 (t (image-next-line (prefix-numeric-value n)))))
207
208(defun image-scroll-down (&optional n)
3488c456 209 "Scroll image in current window downward by N lines.
bb0cb417
CY
210Stop if the top edge of the image is reached.
211If ARG is omitted or nil, scroll downward by a near full screen.
212A near full screen is `next-screen-context-lines' less than a full screen.
213Negative ARG means scroll upward.
214If ARG is the atom `-', scroll upward by nearly full screen.
215When calling from a program, supply as argument a number, nil, or `-'."
216 (interactive "P")
217 (cond ((null n)
218 (let* ((edges (window-inside-edges))
219 (win-height (- (nth 3 edges) (nth 1 edges))))
220 (image-next-line
221 (min 0 (- next-screen-context-lines win-height)))))
222 ((eq n '-)
223 (let* ((edges (window-inside-edges))
224 (win-height (- (nth 3 edges) (nth 1 edges))))
225 (image-next-line
226 (max 0 (- win-height next-screen-context-lines)))))
227 (t (image-next-line (- (prefix-numeric-value n))))))
228
229(defun image-bol (arg)
230 "Scroll horizontally to the left edge of the image in the current window.
231With argument ARG not nil or 1, move forward ARG - 1 lines first,
232stopping if the top or bottom edge of the image is reached."
233 (interactive "p")
234 (and arg
235 (/= (setq arg (prefix-numeric-value arg)) 1)
236 (image-next-line (- arg 1)))
44e3c7c6 237 (image-set-window-hscroll 0))
bb0cb417
CY
238
239(defun image-eol (arg)
240 "Scroll horizontally to the right edge of the image in the current window.
241With argument ARG not nil or 1, move forward ARG - 1 lines first,
242stopping if the top or bottom edge of the image is reached."
243 (interactive "p")
244 (and arg
245 (/= (setq arg (prefix-numeric-value arg)) 1)
246 (image-next-line (- arg 1)))
91784462 247 (let* ((image (image-get-display-property))
bb0cb417
CY
248 (edges (window-inside-edges))
249 (win-width (- (nth 2 edges) (nth 0 edges)))
c9088194 250 (img-width (ceiling (car (image-display-size image)))))
44e3c7c6 251 (image-set-window-hscroll (max 0 (- img-width win-width)))))
bb0cb417
CY
252
253(defun image-bob ()
254 "Scroll to the top-left corner of the image in the current window."
255 (interactive)
44e3c7c6
SM
256 (image-set-window-hscroll 0)
257 (image-set-window-vscroll 0))
bb0cb417
CY
258
259(defun image-eob ()
260 "Scroll to the bottom-right corner of the image in the current window."
261 (interactive)
91784462 262 (let* ((image (image-get-display-property))
bb0cb417
CY
263 (edges (window-inside-edges))
264 (win-width (- (nth 2 edges) (nth 0 edges)))
c9088194 265 (img-width (ceiling (car (image-display-size image))))
bb0cb417 266 (win-height (- (nth 3 edges) (nth 1 edges)))
c9088194 267 (img-height (ceiling (cdr (image-display-size image)))))
44e3c7c6
SM
268 (image-set-window-hscroll (max 0 (- img-width win-width)))
269 (image-set-window-vscroll (max 0 (- img-height win-height)))))
bb0cb417 270
bd1d6a63
SM
271;; Adjust frame and image size.
272
273(defun image-mode-fit-frame ()
274 "Fit the frame to the current image.
275This function assumes the current frame has only one window."
276 ;; FIXME: This does not take into account decorations like mode-line,
277 ;; minibuffer, header-line, ...
278 (interactive)
279 (let* ((saved (frame-parameter nil 'image-mode-saved-size))
280 (display (image-get-display-property))
c9088194 281 (size (image-display-size display)))
bd1d6a63
SM
282 (if (and saved
283 (eq (caar saved) (frame-width))
284 (eq (cdar saved) (frame-height)))
285 (progn ;; Toggle back to previous non-fitted size.
286 (set-frame-parameter nil 'image-mode-saved-size nil)
287 (setq size (cdr saved)))
288 ;; Round up size, and save current size so we can toggle back to it.
289 (setcar size (ceiling (car size)))
290 (setcdr size (ceiling (cdr size)))
291 (set-frame-parameter nil 'image-mode-saved-size
292 (cons size (cons (frame-width) (frame-height)))))
293 (set-frame-width (selected-frame) (car size))
294 (set-frame-height (selected-frame) (cdr size))))
295
bb0cb417
CY
296;;; Image Mode setup
297
d487ca7d
JL
298(defvar image-type nil
299 "Current image type.
300This variable is used to display the current image type in the mode line.")
301(make-variable-buffer-local 'image-type)
302
9b9debd1
JL
303(defvar image-mode-previous-major-mode nil
304 "Internal variable to keep the previous non-image major mode.")
305
c7bd5d57 306(defvar image-mode-map
bb0cb417 307 (let ((map (make-sparse-keymap)))
abef340a 308 (set-keymap-parent map special-mode-map)
bb0cb417 309 (define-key map "\C-c\C-c" 'image-toggle-display)
42c27c2a
SM
310 (define-key map (kbd "SPC") 'image-scroll-up)
311 (define-key map (kbd "DEL") 'image-scroll-down)
bb0cb417
CY
312 (define-key map [remap forward-char] 'image-forward-hscroll)
313 (define-key map [remap backward-char] 'image-backward-hscroll)
d8b0cddd
SM
314 (define-key map [remap right-char] 'image-forward-hscroll)
315 (define-key map [remap left-char] 'image-backward-hscroll)
bb0cb417
CY
316 (define-key map [remap previous-line] 'image-previous-line)
317 (define-key map [remap next-line] 'image-next-line)
318 (define-key map [remap scroll-up] 'image-scroll-up)
319 (define-key map [remap scroll-down] 'image-scroll-down)
32129746
JL
320 (define-key map [remap scroll-up-command] 'image-scroll-up)
321 (define-key map [remap scroll-down-command] 'image-scroll-down)
bb0cb417
CY
322 (define-key map [remap move-beginning-of-line] 'image-bol)
323 (define-key map [remap move-end-of-line] 'image-eol)
324 (define-key map [remap beginning-of-buffer] 'image-bob)
325 (define-key map [remap end-of-buffer] 'image-eob)
326 map)
327 "Major mode keymap for viewing images in Image mode.")
328
9b9debd1 329(defvar image-minor-mode-map
c7bd5d57
RS
330 (let ((map (make-sparse-keymap)))
331 (define-key map "\C-c\C-c" 'image-toggle-display)
332 map)
9b9debd1 333 "Minor mode keymap for viewing images as text in Image mode.")
c7bd5d57 334
e0385bf4 335(defvar bookmark-make-record-function)
a47d49c0 336
0d17c4b9
JL
337(put 'image-mode 'mode-class 'special)
338
c7bd5d57
RS
339;;;###autoload
340(defun image-mode ()
341 "Major mode for image files.
342You can use \\<image-mode-map>\\[image-toggle-display]
343to toggle between display as an image and display as text."
344 (interactive)
9b9debd1
JL
345 (condition-case err
346 (progn
347 (unless (display-images-p)
348 (error "Display does not support images"))
349
350 (kill-all-local-variables)
351 (setq major-mode 'image-mode)
352
353 (if (not (image-get-display-property))
354 (progn
355 (image-toggle-display-image)
356 ;; If attempt to display the image fails.
357 (if (not (image-get-display-property))
358 (error "Invalid image")))
359 ;; Set next vars when image is already displayed but local
360 ;; variables were cleared by kill-all-local-variables
361 (setq cursor-type nil truncate-lines t
362 image-type (plist-get (cdr (image-get-display-property)) :type)))
363
364 (setq mode-name (if image-type (format "Image[%s]" image-type) "Image"))
bb43424b 365 (use-local-map image-mode-map)
9b9debd1
JL
366
367 ;; Use our own bookmarking function for images.
368 (set (make-local-variable 'bookmark-make-record-function)
369 'image-bookmark-make-record)
370
371 ;; Keep track of [vh]scroll when switching buffers
372 (image-mode-setup-winprops)
373
374 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
0fb1193d 375 (add-hook 'after-revert-hook 'image-after-revert-hook nil t)
9b9debd1
JL
376 (run-mode-hooks 'image-mode-hook)
377 (message "%s" (concat
378 (substitute-command-keys
379 "Type \\[image-toggle-display] to view the image as ")
380 (if (image-get-display-property)
381 "text" "an image") ".")))
382 (error
383 (image-mode-as-text)
384 (funcall
385 (if (called-interactively-p 'any) 'error 'message)
386 "Cannot display image: %s" (cdr err)))))
d90e651e
JL
387;;;###autoload
388(define-minor-mode image-minor-mode
389 "Toggle Image minor mode.
390With arg, turn Image minor mode on if arg is positive, off otherwise.
9b9debd1
JL
391It provides the key \\<image-mode-map>\\[image-toggle-display] \
392to switch back to `image-mode'
393to display an image file as the actual image."
394 nil (:eval (if image-type (format " Image[%s]" image-type) " Image"))
395 image-minor-mode-map
d90e651e
JL
396 :group 'image
397 :version "22.1"
9b9debd1
JL
398 (if image-minor-mode
399 (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t)))
d90e651e
JL
400
401;;;###autoload
9b9debd1
JL
402(defun image-mode-as-text ()
403 "Set a non-image mode as major mode in combination with image minor mode.
404A non-image major mode found from `auto-mode-alist' or Fundamental mode
405displays an image file as text. `image-minor-mode' provides the key
406\\<image-mode-map>\\[image-toggle-display] to switch back to `image-mode'
407to display an image file as the actual image.
408
409You can use `image-mode-as-text' in `auto-mode-alist' when you want
316d12fb 410to display an image file as text initially.
9b9debd1
JL
411
412See commands `image-mode' and `image-minor-mode' for more information
413on these modes."
d90e651e 414 (interactive)
9b9debd1
JL
415 ;; image-mode-as-text = normal-mode + image-minor-mode
416 (let ((previous-image-type image-type)) ; preserve `image-type'
417 (if image-mode-previous-major-mode
418 ;; Restore previous major mode that was already found by this
419 ;; function and cached in `image-mode-previous-major-mode'
420 (funcall image-mode-previous-major-mode)
421 (let ((auto-mode-alist
422 (delq nil (mapcar
423 (lambda (elt)
424 (unless (memq (or (car-safe (cdr elt)) (cdr elt))
425 '(image-mode image-mode-maybe image-mode-as-text))
426 elt))
427 auto-mode-alist)))
428 (magic-fallback-mode-alist
429 (delq nil (mapcar
430 (lambda (elt)
431 (unless (memq (or (car-safe (cdr elt)) (cdr elt))
432 '(image-mode image-mode-maybe image-mode-as-text))
433 elt))
434 magic-fallback-mode-alist))))
435 (normal-mode)
436 (set (make-local-variable 'image-mode-previous-major-mode) major-mode)))
437 ;; Restore `image-type' after `kill-all-local-variables' in `normal-mode'.
438 (setq image-type previous-image-type)
439 ;; Enable image minor mode with `C-c C-c'.
440 (image-minor-mode 1)
441 ;; Show the image file as text.
442 (image-toggle-display-text)
443 (message "%s" (concat
444 (substitute-command-keys
445 "Type \\[image-toggle-display] to view the image as ")
446 (if (image-get-display-property)
447 "text" "an image") "."))))
448
449(define-obsolete-function-alias 'image-mode-maybe 'image-mode "23.2")
d90e651e
JL
450
451(defun image-toggle-display-text ()
9b9debd1
JL
452 "Show the image file as text.
453Remove text properties that display the image."
454 (let ((inhibit-read-only t)
455 (buffer-undo-list t)
456 (modified (buffer-modified-p)))
457 (remove-list-of-text-properties (point-min) (point-max)
458 '(display intangible read-nonsticky
459 read-only front-sticky))
460 (set-buffer-modified-p modified)
461 (if (called-interactively-p 'any)
462 (message "Repeat this command to go back to displaying the image"))))
c7bd5d57 463
f2920ffe
RS
464(defvar archive-superior-buffer)
465(defvar tar-superior-buffer)
110683ad 466(declare-function image-flush "image.c" (spec &optional frame))
f2920ffe 467
9b9debd1
JL
468(defun image-toggle-display-image ()
469 "Show the image of the image file.
470Turn the image data into a real image, but only if the whole file
471was inserted."
a32d4040
CY
472 (unless (derived-mode-p 'image-mode major-mode)
473 (error "The buffer is not in Image mode"))
9b9debd1
JL
474 (let* ((filename (buffer-file-name))
475 (data-p (not (and filename
476 (file-readable-p filename)
477 (not (file-remote-p filename))
478 (not (buffer-modified-p))
479 (not (and (boundp 'archive-superior-buffer)
480 archive-superior-buffer))
481 (not (and (boundp 'tar-superior-buffer)
482 tar-superior-buffer)))))
483 (file-or-data (if data-p
484 (string-make-unibyte
485 (buffer-substring-no-properties (point-min) (point-max)))
486 filename))
487 (type (image-type file-or-data nil data-p))
c7f514b5
JV
488 (image0 (create-animated-image file-or-data type data-p))
489 (image (append image0
a32d4040 490 (image-transform-properties image0)))
9b9debd1
JL
491 (props
492 `(display ,image
493 intangible ,image
494 rear-nonsticky (display intangible)
495 read-only t front-sticky (read-only)))
496 (inhibit-read-only t)
497 (buffer-undo-list t)
498 (modified (buffer-modified-p)))
110683ad 499 (image-flush image)
9b9debd1
JL
500 (let ((buffer-file-truename nil)) ; avoid changing dir mtime by lock_file
501 (add-text-properties (point-min) (point-max) props)
502 (restore-buffer-modified-p modified))
503 ;; Inhibit the cursor when the buffer contains only an image,
504 ;; because cursors look very strange on top of images.
505 (setq cursor-type nil)
506 ;; This just makes the arrow displayed in the right fringe
507 ;; area look correct when the image is wider than the window.
508 (setq truncate-lines t)
4114ed61
EZ
509 ;; Disable adding a newline at the end of the image file when it
510 ;; is written with, e.g., C-x C-w.
511 (if (coding-system-equal (coding-system-base buffer-file-coding-system)
512 'no-conversion)
513 (set (make-local-variable 'find-file-literally) t))
9b9debd1
JL
514 ;; Allow navigation of large images
515 (set (make-local-variable 'auto-hscroll-mode) nil)
516 (setq image-type type)
517 (if (eq major-mode 'image-mode)
518 (setq mode-name (format "Image[%s]" type)))
519 (if (called-interactively-p 'any)
520 (message "Repeat this command to go back to displaying the file as text"))))
521
c7bd5d57
RS
522(defun image-toggle-display ()
523 "Start or stop displaying an image file as the actual image.
9b9debd1
JL
524This command toggles between `image-mode-as-text' showing the text of
525the image file and `image-mode' showing the image as an image."
c7bd5d57 526 (interactive)
91784462 527 (if (image-get-display-property)
9b9debd1
JL
528 (image-mode-as-text)
529 (image-mode)))
0fb1193d
JL
530
531(defun image-after-revert-hook ()
532 (when (image-get-display-property)
533 (image-toggle-display-text)
534 ;; Update image display.
535 (redraw-frame (selected-frame))
536 (image-toggle-display-image)))
537
97666703 538\f
137187c8 539;;; Support for bookmark.el
e44fa724
KF
540(declare-function bookmark-make-record-default
541 "bookmark" (&optional no-file no-context posn))
43f8b275
SM
542(declare-function bookmark-prop-get "bookmark" (bookmark prop))
543(declare-function bookmark-default-handler "bookmark" (bmk))
137187c8 544
43f8b275 545(defun image-bookmark-make-record ()
f12492c8
TV
546 `(,@(bookmark-make-record-default nil 'no-context 0)
547 (image-type . ,image-type)
548 (handler . image-bookmark-jump)))
137187c8 549
137187c8
TH
550;;;###autoload
551(defun image-bookmark-jump (bmk)
03e26a79 552 ;; This implements the `handler' function interface for record type
e0385bf4 553 ;; returned by `bookmark-make-record-function', which see.
43f8b275
SM
554 (prog1 (bookmark-default-handler bmk)
555 (when (not (string= image-type (bookmark-prop-get bmk 'image-type)))
556 (image-toggle-display))))
97666703 557\f
c7f514b5
JV
558
559(defvar image-transform-minor-mode-map
560 (let ((map (make-sparse-keymap)))
a32d4040
CY
561 ;; (define-key map [(control ?+)] 'image-scale-in)
562 ;; (define-key map [(control ?-)] 'image-scale-out)
563 ;; (define-key map [(control ?=)] 'image-scale-none)
564 ;; (define-key map "c f h" 'image-scale-fit-height)
565 ;; (define-key map "c ]" 'image-rotate-right)
c7f514b5 566 map)
a32d4040 567 "Minor mode keymap `image-transform-mode'.")
c7f514b5
JV
568
569(define-minor-mode image-transform-mode
a32d4040
CY
570 "Minor mode for scaling and rotating images.
571This minor mode has no effect unless Emacs is compiled with
572ImageMagick support."
573 nil "image-transform" image-transform-minor-mode-map)
574
575(defvar image-transform-resize nil
576 "The image resize operation.
577Its value should be one of the following:
578 - nil, meaning no resizing.
579 - `fit-height', meaning to fit the image to the window height.
580 - `fit-width', meaning to fit the image to the window width.
581 - A number, which is a scale factor (the default size is 100).")
c7f514b5 582
c7f514b5
JV
583(defvar image-transform-rotation 0.0)
584
c7f514b5 585(defun image-transform-properties (display)
a32d4040
CY
586 "Rescale and/or rotate the current image.
587The scale factor and rotation angle are given by the variables
588`image-transform-resize' and `image-transform-rotation'. This
589takes effect only if Emacs is compiled with ImageMagick support."
590 (let* ((size (image-size display t))
591 (height
592 (cond
593 ((numberp image-transform-resize)
594 (unless (= image-transform-resize 100)
595 (* image-transform-resize (cdr size))))
596 ((eq image-transform-resize 'fit-height)
597 (- (nth 3 (window-inside-pixel-edges))
598 (nth 1 (window-inside-pixel-edges))))))
599 (width (if (eq image-transform-resize 'fit-width)
600 (- (nth 2 (window-inside-pixel-edges))
601 (nth 0 (window-inside-pixel-edges))))))
602 ;;TODO fit-to-* should consider the rotation angle
3a50be51
JV
603 `(,@(if height (list :height height))
604 ,@(if width (list :width width))
605 ,@(if (not (equal 0.0 image-transform-rotation))
a32d4040 606 (list :rotation image-transform-rotation)))))
c7f514b5
JV
607
608(defun image-transform-set-scale (scale)
a32d4040
CY
609 "Prompt for a number, and resize the current image by that amount.
610This command has no effect unless Emacs is compiled with
611ImageMagick support."
612 (interactive "nScale: ")
613 (setq image-transform-resize resize)
614 (image-toggle-display-image))
c7f514b5
JV
615
616(defun image-transform-fit-to-height ()
a32d4040
CY
617 "Fit the current image to the height of the current window.
618This command has no effect unless Emacs is compiled with
619ImageMagick support."
c7f514b5 620 (interactive)
a32d4040
CY
621 (setq image-transform-resize 'fit-height)
622 (image-toggle-display-image))
c7f514b5 623
3a50be51 624(defun image-transform-fit-to-width ()
a32d4040
CY
625 "Fit the current image to the width of the current window.
626This command has no effect unless Emacs is compiled with
627ImageMagick support."
3a50be51 628 (interactive)
a32d4040
CY
629 (setq image-transform-resize 'fit-width)
630 (image-toggle-display-image))
c7f514b5
JV
631
632(defun image-transform-set-rotation (rotation)
a32d4040
CY
633 "Prompt for an angle ROTATION, and rotate the image by that amount.
634ROTATION should be in degrees. This command has no effect unless
635Emacs is compiled with ImageMagick support."
636 (interactive "nRotation angle (in degrees): ")
fe72c5b4
JV
637 ;;TODO 0 90 180 270 degrees are the only reasonable angles here
638 ;;otherwise combining with rescaling will get very awkward
c7f514b5 639 (setq image-transform-rotation (float rotation))
a32d4040 640 (image-toggle-display-image))
c7f514b5 641
c7bd5d57
RS
642(provide 'image-mode)
643
644;;; image-mode.el ends here