Mercurial > emacs

comparison lisp/image-mode.el @ 91999:a58e06f6236c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Extend [hv]scroll support to per-window properties. (image-mode-current-vscroll, image-mode-current-hscroll): Remove. (image-mode-winprops-alist): New var to replace them. (image-mode-new-window-functions): New hook. (image-mode-winprops, image-mode-window-get, image-mode-window-put): New funs. (image-set-window-vscroll, image-set-window-hscroll): Use them. Remove the `window' argument, update callers. (image-mode-reapply-winprops): Rename image-reset-current-vhscroll. Use the new functions. (image-mode-reapply-winprops): New fun. (image-mode): Use it.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Thu, 21 Feb 2008 03:27:15 +0000
parents e788f311729d
children a7a0e6010c46
comparison
equal deleted inserted replaced
91998:eb8f54e30990 91999:a58e06f6236c
33 ;; the image data to the new file. 33 ;; the image data to the new file.
34 34
35 ;;; Code: 35 ;;; Code:
36 36
37 (require 'image) 37 (require 'image)
38 (eval-when-compile (require 'cl))
38 39
39 ;;;###autoload (push '("\\.jpe?g\\'" . image-mode) auto-mode-alist) 40 ;;;###autoload (push '("\\.jpe?g\\'" . image-mode) auto-mode-alist)
40 ;;;###autoload (push '("\\.png\\'" . image-mode) auto-mode-alist) 41 ;;;###autoload (push '("\\.png\\'" . image-mode) auto-mode-alist)
41 ;;;###autoload (push '("\\.gif\\'" . image-mode) auto-mode-alist) 42 ;;;###autoload (push '("\\.gif\\'" . image-mode) auto-mode-alist)
42 ;;;###autoload (push '("\\.tiff?\\'" . image-mode) auto-mode-alist) 43 ;;;###autoload (push '("\\.tiff?\\'" . image-mode) auto-mode-alist)
46 ;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist) 47 ;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist)
47 48
48 ;;;###autoload (push '("\\.svgz?\\'" . xml-mode) auto-mode-alist) 49 ;;;###autoload (push '("\\.svgz?\\'" . xml-mode) auto-mode-alist)
49 ;;;###autoload (push '("\\.svgz?\\'" . image-mode-maybe) auto-mode-alist) 50 ;;;###autoload (push '("\\.svgz?\\'" . image-mode-maybe) auto-mode-alist)
50 51
51 ;;; Image scrolling functions 52 ;;; Image mode window-info management.
52 53
53 (defvar image-mode-current-vscroll nil 54 (defvar image-mode-winprops-alist t)
54 "An alist with elements (WINDOW . VSCROLL).") 55 (make-variable-buffer-local 'image-mode-winprops-alist)
55 (make-variable-buffer-local 'image-mode-current-vscroll) 56
56 57 (defvar image-mode-new-window-functions nil
57 (defvar image-mode-current-hscroll nil 58 "Special hook run when image data is requested in a new window.
58 "An alist with elements (WINDOW . HSCROLL).") 59 It is called with one argument, the initial WINPROPS.")
59 (make-variable-buffer-local 'image-mode-current-hscroll) 60
60 61 (defun image-mode-winprops (&optional window)
61 (defun image-set-window-vscroll (window vscroll &optional pixels-p) 62 "Return winprops of WINDOW.
62 (setq image-mode-current-vscroll 63 A winprops object has the shape (WINDOW . ALIST)."
63 (cons (cons window vscroll) 64 (unless window (setq window (selected-window)))
64 (delq (assq window image-mode-current-vscroll) 65 (let ((winprops (assq window image-mode-winprops-alist)))
65 image-mode-current-vscroll))) 66 ;; For new windows, set defaults from the latest.
66 (set-window-vscroll window vscroll pixels-p)) 67 (unless winprops
67 68 (setq winprops (cons window
68 (defun image-set-window-hscroll (window ncol) 69 (copy-alist (cdar image-mode-winprops-alist))))
69 (setq image-mode-current-hscroll 70 (run-hook-with-args 'image-mode-new-window-functions winprops))
70 (cons (cons window ncol) 71 ;; Move window to front.
71 (delq (assq window image-mode-current-hscroll) 72 (setq image-mode-winprops-alist
72 image-mode-current-hscroll))) 73 (cons winprops (delq winprops image-mode-winprops-alist)))
73 (set-window-hscroll window ncol)) 74 winprops))
74 75
75 (defun image-reset-current-vhscroll () 76 (defun image-mode-window-get (prop &optional winprops)
77 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
78 (cdr (assq prop (cdr winprops))))
79
80 (defsetf image-mode-window-get (prop &optional winprops) (val)
81 `(image-mode-window-put ,prop ,val ,winprops))
82
83 (defun image-mode-window-put (prop val &optional winprops)
84 (unless (consp winprops) (setq winprops (image-mode-winprops winprops)))
85 (setcdr winprops (cons (cons prop val)
86 (delq (assq prop (cdr winprops)) (cdr winprops)))))
87
88 (defun image-set-window-vscroll (vscroll)
89 (setf (image-mode-window-get 'vscroll) vscroll)
90 (set-window-vscroll (selected-window) vscroll))
91
92 (defun image-set-window-hscroll (ncol)
93 (setf (image-mode-window-put 'hscroll) ncol)
94 (set-window-hscroll (selected-window) ncol))
95
96 (defun image-mode-reapply-winprops ()
76 (walk-windows 97 (walk-windows
77 (lambda (win) 98 (lambda (win)
78 (with-current-buffer (window-buffer win) 99 (with-current-buffer (window-buffer win)
79 ;; When set-window-buffer, set hscroll and vscroll to what they were 100 ;; When set-window-buffer, set hscroll and vscroll to what they were
80 ;; last time the image was displayed in this window. If it's the first 101 ;; last time the image was displayed in this window.
81 ;; time it's displayed in this window, use the most recent setting. 102 (when (listp image-mode-winprops-alist)
82 (when image-mode-current-hscroll 103 (let* ((winprops (image-mode-winprops win))
83 (set-window-hscroll win (cdr (or (assoc win image-mode-current-hscroll) 104 (hscroll (image-mode-window-get 'hscroll winprops))
84 (car image-mode-current-hscroll))))) 105 (vscroll (image-mode-window-get 'vscroll winprops)))
85 (when image-mode-current-vscroll 106 (if hscroll (set-window-hscroll win hscroll))
86 (set-window-vscroll win (cdr (or (assoc win image-mode-current-vscroll) 107 (if vscroll (set-window-vscroll win vscroll))))))
87 (car image-mode-current-vscroll)))))))
88 'nomini 108 'nomini
89 (selected-frame))) 109 (selected-frame)))
110
111 (defun image-mode-setup-winprops ()
112 ;; Record current scroll settings.
113 (unless (listp image-mode-winprops-alist)
114 (setq image-mode-winprops-alist nil))
115 (add-hook 'window-configuration-change-hook
116 'image-mode-reapply-winprops nil t))
117
118 ;;; Image scrolling functions
90 119
91 (defun image-get-display-property () 120 (defun image-get-display-property ()
92 (get-char-property (point-min) 'display 121 (get-char-property (point-min) 'display
93 ;; There might be different images for different displays. 122 ;; There might be different images for different displays.
94 (if (eq (window-buffer) (current-buffer)) 123 (if (eq (window-buffer) (current-buffer))
98 "Scroll image in current window to the left by N character widths. 127 "Scroll image in current window to the left by N character widths.
99 Stop if the right edge of the image is reached." 128 Stop if the right edge of the image is reached."
100 (interactive "p") 129 (interactive "p")
101 (cond ((= n 0) nil) 130 (cond ((= n 0) nil)
102 ((< n 0) 131 ((< n 0)
103 (image-set-window-hscroll (selected-window) 132 (image-set-window-hscroll (max 0 (+ (window-hscroll) n))))
104 (max 0 (+ (window-hscroll) n))))
105 (t 133 (t
106 (let* ((image (image-get-display-property)) 134 (let* ((image (image-get-display-property))
107 (edges (window-inside-edges)) 135 (edges (window-inside-edges))
108 (win-width (- (nth 2 edges) (nth 0 edges))) 136 (win-width (- (nth 2 edges) (nth 0 edges)))
109 (img-width (ceiling (car (image-size image))))) 137 (img-width (ceiling (car (image-size image)))))
110 (image-set-window-hscroll (selected-window) 138 (image-set-window-hscroll (min (max 0 (- img-width win-width))
111 (min (max 0 (- img-width win-width))
112 (+ n (window-hscroll)))))))) 139 (+ n (window-hscroll))))))))
113 140
114 (defun image-backward-hscroll (&optional n) 141 (defun image-backward-hscroll (&optional n)
115 "Scroll image in current window to the right by N character widths. 142 "Scroll image in current window to the right by N character widths.
116 Stop if the left edge of the image is reached." 143 Stop if the left edge of the image is reached."
121 "Scroll image in current window upward by N lines. 148 "Scroll image in current window upward by N lines.
122 Stop if the bottom edge of the image is reached." 149 Stop if the bottom edge of the image is reached."
123 (interactive "p") 150 (interactive "p")
124 (cond ((= n 0) nil) 151 (cond ((= n 0) nil)
125 ((< n 0) 152 ((< n 0)
126 (image-set-window-vscroll (selected-window) 153 (image-set-window-vscroll (max 0 (+ (window-vscroll) n))))
127 (max 0 (+ (window-vscroll) n))))
128 (t 154 (t
129 (let* ((image (image-get-display-property)) 155 (let* ((image (image-get-display-property))
130 (edges (window-inside-edges)) 156 (edges (window-inside-edges))
131 (win-height (- (nth 3 edges) (nth 1 edges))) 157 (win-height (- (nth 3 edges) (nth 1 edges)))
132 (img-height (ceiling (cdr (image-size image))))) 158 (img-height (ceiling (cdr (image-size image)))))
133 (image-set-window-vscroll (selected-window) 159 (image-set-window-vscroll (min (max 0 (- img-height win-height))
134 (min (max 0 (- img-height win-height))
135 (+ n (window-vscroll)))))))) 160 (+ n (window-vscroll))))))))
136 161
137 (defun image-previous-line (&optional n) 162 (defun image-previous-line (&optional n)
138 "Scroll image in current window downward by N lines. 163 "Scroll image in current window downward by N lines.
139 Stop if the top edge of the image is reached." 164 Stop if the top edge of the image is reached."
188 stopping if the top or bottom edge of the image is reached." 213 stopping if the top or bottom edge of the image is reached."
189 (interactive "p") 214 (interactive "p")
190 (and arg 215 (and arg
191 (/= (setq arg (prefix-numeric-value arg)) 1) 216 (/= (setq arg (prefix-numeric-value arg)) 1)
192 (image-next-line (- arg 1))) 217 (image-next-line (- arg 1)))
193 (image-set-window-hscroll (selected-window) 0)) 218 (image-set-window-hscroll 0))
194 219
195 (defun image-eol (arg) 220 (defun image-eol (arg)
196 "Scroll horizontally to the right edge of the image in the current window. 221 "Scroll horizontally to the right edge of the image in the current window.
197 With argument ARG not nil or 1, move forward ARG - 1 lines first, 222 With argument ARG not nil or 1, move forward ARG - 1 lines first,
198 stopping if the top or bottom edge of the image is reached." 223 stopping if the top or bottom edge of the image is reached."
202 (image-next-line (- arg 1))) 227 (image-next-line (- arg 1)))
203 (let* ((image (image-get-display-property)) 228 (let* ((image (image-get-display-property))
204 (edges (window-inside-edges)) 229 (edges (window-inside-edges))
205 (win-width (- (nth 2 edges) (nth 0 edges))) 230 (win-width (- (nth 2 edges) (nth 0 edges)))
206 (img-width (ceiling (car (image-size image))))) 231 (img-width (ceiling (car (image-size image)))))
207 (image-set-window-hscroll (selected-window) 232 (image-set-window-hscroll (max 0 (- img-width win-width)))))
208 (max 0 (- img-width win-width)))))
209 233
210 (defun image-bob () 234 (defun image-bob ()
211 "Scroll to the top-left corner of the image in the current window." 235 "Scroll to the top-left corner of the image in the current window."
212 (interactive) 236 (interactive)
213 (image-set-window-hscroll (selected-window) 0) 237 (image-set-window-hscroll 0)
214 (image-set-window-vscroll (selected-window) 0)) 238 (image-set-window-vscroll 0))
215 239
216 (defun image-eob () 240 (defun image-eob ()
217 "Scroll to the bottom-right corner of the image in the current window." 241 "Scroll to the bottom-right corner of the image in the current window."
218 (interactive) 242 (interactive)
219 (let* ((image (image-get-display-property)) 243 (let* ((image (image-get-display-property))
220 (edges (window-inside-edges)) 244 (edges (window-inside-edges))
221 (win-width (- (nth 2 edges) (nth 0 edges))) 245 (win-width (- (nth 2 edges) (nth 0 edges)))
222 (img-width (ceiling (car (image-size image)))) 246 (img-width (ceiling (car (image-size image))))
223 (win-height (- (nth 3 edges) (nth 1 edges))) 247 (win-height (- (nth 3 edges) (nth 1 edges)))
224 (img-height (ceiling (cdr (image-size image))))) 248 (img-height (ceiling (cdr (image-size image)))))
225 (image-set-window-hscroll (selected-window) (max 0 (- img-width win-width))) 249 (image-set-window-hscroll (max 0 (- img-width win-width)))
226 (image-set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) 250 (image-set-window-vscroll (max 0 (- img-height win-height)))))
227 251
228 ;;; Image Mode setup 252 ;;; Image Mode setup
229 253
230 (defvar image-type nil 254 (defvar image-type nil
231 "Current image type. 255 "Current image type.
268 ;; Use our own bookmarking function for images. 292 ;; Use our own bookmarking function for images.
269 (set (make-local-variable 'bookmark-make-cell-function) 293 (set (make-local-variable 'bookmark-make-cell-function)
270 'image-bookmark-make-cell) 294 'image-bookmark-make-cell)
271 295
272 ;; Keep track of [vh]scroll when switching buffers 296 ;; Keep track of [vh]scroll when switching buffers
273 (image-set-window-hscroll (selected-window) (window-hscroll)) 297 (image-mode-setup-winprops)
274 (image-set-window-vscroll (selected-window) (window-vscroll))
275 (add-hook 'window-configuration-change-hook
276 'image-reset-current-vhscroll nil t)
277 298
278 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) 299 (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t)
279 (if (and (display-images-p) 300 (if (and (display-images-p)
280 (not (image-get-display-property))) 301 (not (image-get-display-property)))
281 (image-toggle-display) 302 (image-toggle-display)