comparison lisp/image-mode.el @ 109871:3226ac2da7f7

merge from trunk
author Joakim <joakim@localhost.localdomain>
date Tue, 17 Aug 2010 23:19:11 +0200
parents 2ea89e2c498f a4b9fa0b861b
children 280c8ae2476d
comparison
equal deleted inserted replaced
109870:2ea89e2c498f 109871:3226ac2da7f7
126 (if (eq (window-buffer) (current-buffer)) 126 (if (eq (window-buffer) (current-buffer))
127 (selected-window)))) 127 (selected-window))))
128 128
129 (declare-function image-size "image.c" (spec &optional pixels frame)) 129 (declare-function image-size "image.c" (spec &optional pixels frame))
130 130
131 (defun image-display-size (spec &optional pixels frame)
132 "Wrapper around `image-size', to handle slice display properties.
133 If SPEC is an image display property, call `image-size' with the
134 given arguments.
135 If SPEC is a list of properties containing `image' and `slice'
136 properties, calculate the display size from the slice property.
137 If SPEC contains `image' but not `slice', call `image-size' with
138 the specified image."
139 (if (eq (car spec) 'image)
140 (image-size spec pixels frame)
141 (let ((image (assoc 'image spec))
142 (slice (assoc 'slice spec)))
143 (cond ((and image slice)
144 (if pixels
145 (cons (nth 3 slice) (nth 4 slice))
146 (cons (/ (float (nth 3 slice)) (frame-char-width frame))
147 (/ (float (nth 4 slice)) (frame-char-height frame)))))
148 (image
149 (image-size image pixels frame))
150 (t
151 (error "Invalid image specification: %s" spec))))))
152
131 (defun image-forward-hscroll (&optional n) 153 (defun image-forward-hscroll (&optional n)
132 "Scroll image in current window to the left by N character widths. 154 "Scroll image in current window to the left by N character widths.
133 Stop if the right edge of the image is reached." 155 Stop if the right edge of the image is reached."
134 (interactive "p") 156 (interactive "p")
135 (cond ((= n 0) nil) 157 (cond ((= n 0) nil)
137 (image-set-window-hscroll (max 0 (+ (window-hscroll) n)))) 159 (image-set-window-hscroll (max 0 (+ (window-hscroll) n))))
138 (t 160 (t
139 (let* ((image (image-get-display-property)) 161 (let* ((image (image-get-display-property))
140 (edges (window-inside-edges)) 162 (edges (window-inside-edges))
141 (win-width (- (nth 2 edges) (nth 0 edges))) 163 (win-width (- (nth 2 edges) (nth 0 edges)))
142 (img-width (ceiling (car (image-size image))))) 164 (img-width (ceiling (car (image-display-size image)))))
143 (image-set-window-hscroll (min (max 0 (- img-width win-width)) 165 (image-set-window-hscroll (min (max 0 (- img-width win-width))
144 (+ n (window-hscroll)))))))) 166 (+ n (window-hscroll))))))))
145 167
146 (defun image-backward-hscroll (&optional n) 168 (defun image-backward-hscroll (&optional n)
147 "Scroll image in current window to the right by N character widths. 169 "Scroll image in current window to the right by N character widths.
158 (image-set-window-vscroll (max 0 (+ (window-vscroll) n)))) 180 (image-set-window-vscroll (max 0 (+ (window-vscroll) n))))
159 (t 181 (t
160 (let* ((image (image-get-display-property)) 182 (let* ((image (image-get-display-property))
161 (edges (window-inside-edges)) 183 (edges (window-inside-edges))
162 (win-height (- (nth 3 edges) (nth 1 edges))) 184 (win-height (- (nth 3 edges) (nth 1 edges)))
163 (img-height (ceiling (cdr (image-size image))))) 185 (img-height (ceiling (cdr (image-display-size image)))))
164 (image-set-window-vscroll (min (max 0 (- img-height win-height)) 186 (image-set-window-vscroll (min (max 0 (- img-height win-height))
165 (+ n (window-vscroll)))))))) 187 (+ n (window-vscroll))))))))
166 188
167 (defun image-previous-line (&optional n) 189 (defun image-previous-line (&optional n)
168 "Scroll image in current window downward by N lines. 190 "Scroll image in current window downward by N lines.
231 (/= (setq arg (prefix-numeric-value arg)) 1) 253 (/= (setq arg (prefix-numeric-value arg)) 1)
232 (image-next-line (- arg 1))) 254 (image-next-line (- arg 1)))
233 (let* ((image (image-get-display-property)) 255 (let* ((image (image-get-display-property))
234 (edges (window-inside-edges)) 256 (edges (window-inside-edges))
235 (win-width (- (nth 2 edges) (nth 0 edges))) 257 (win-width (- (nth 2 edges) (nth 0 edges)))
236 (img-width (ceiling (car (image-size image))))) 258 (img-width (ceiling (car (image-display-size image)))))
237 (image-set-window-hscroll (max 0 (- img-width win-width))))) 259 (image-set-window-hscroll (max 0 (- img-width win-width)))))
238 260
239 (defun image-bob () 261 (defun image-bob ()
240 "Scroll to the top-left corner of the image in the current window." 262 "Scroll to the top-left corner of the image in the current window."
241 (interactive) 263 (interactive)
246 "Scroll to the bottom-right corner of the image in the current window." 268 "Scroll to the bottom-right corner of the image in the current window."
247 (interactive) 269 (interactive)
248 (let* ((image (image-get-display-property)) 270 (let* ((image (image-get-display-property))
249 (edges (window-inside-edges)) 271 (edges (window-inside-edges))
250 (win-width (- (nth 2 edges) (nth 0 edges))) 272 (win-width (- (nth 2 edges) (nth 0 edges)))
251 (img-width (ceiling (car (image-size image)))) 273 (img-width (ceiling (car (image-display-size image))))
252 (win-height (- (nth 3 edges) (nth 1 edges))) 274 (win-height (- (nth 3 edges) (nth 1 edges)))
253 (img-height (ceiling (cdr (image-size image))))) 275 (img-height (ceiling (cdr (image-display-size image)))))
254 (image-set-window-hscroll (max 0 (- img-width win-width))) 276 (image-set-window-hscroll (max 0 (- img-width win-width)))
255 (image-set-window-vscroll (max 0 (- img-height win-height))))) 277 (image-set-window-vscroll (max 0 (- img-height win-height)))))
256 278
257 ;; Adjust frame and image size. 279 ;; Adjust frame and image size.
258 280
262 ;; FIXME: This does not take into account decorations like mode-line, 284 ;; FIXME: This does not take into account decorations like mode-line,
263 ;; minibuffer, header-line, ... 285 ;; minibuffer, header-line, ...
264 (interactive) 286 (interactive)
265 (let* ((saved (frame-parameter nil 'image-mode-saved-size)) 287 (let* ((saved (frame-parameter nil 'image-mode-saved-size))
266 (display (image-get-display-property)) 288 (display (image-get-display-property))
267 (size (image-size display))) 289 (size (image-display-size display)))
268 (if (and saved 290 (if (and saved
269 (eq (caar saved) (frame-width)) 291 (eq (caar saved) (frame-width))
270 (eq (cdar saved) (frame-height))) 292 (eq (cdar saved) (frame-height)))
271 (progn ;; Toggle back to previous non-fitted size. 293 (progn ;; Toggle back to previous non-fitted size.
272 (set-frame-parameter nil 'image-mode-saved-size nil) 294 (set-frame-parameter nil 'image-mode-saved-size nil)
517 (redraw-frame (selected-frame)) 539 (redraw-frame (selected-frame))
518 (image-toggle-display-image))) 540 (image-toggle-display-image)))
519 541
520 542
521 ;;; Support for bookmark.el 543 ;;; Support for bookmark.el
522 (declare-function bookmark-make-record-default "bookmark" 544 (declare-function bookmark-make-record-default
523 (&optional point-only)) 545 "bookmark" (&optional no-file no-context posn))
524 (declare-function bookmark-prop-get "bookmark" (bookmark prop)) 546 (declare-function bookmark-prop-get "bookmark" (bookmark prop))
525 (declare-function bookmark-default-handler "bookmark" (bmk)) 547 (declare-function bookmark-default-handler "bookmark" (bmk))
526 548
527 (defun image-bookmark-make-record () 549 (defun image-bookmark-make-record ()
528 (nconc (bookmark-make-record-default) 550 `(,@(bookmark-make-record-default nil 'no-context 0)
529 `((image-type . ,image-type) 551 (image-type . ,image-type)
530 (handler . image-bookmark-jump)))) 552 (handler . image-bookmark-jump)))
531 553
532 ;;;###autoload 554 ;;;###autoload
533 (defun image-bookmark-jump (bmk) 555 (defun image-bookmark-jump (bmk)
534 ;; This implements the `handler' function interface for record type 556 ;; This implements the `handler' function interface for record type
535 ;; returned by `bookmark-make-record-function', which see. 557 ;; returned by `bookmark-make-record-function', which see.