X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/02cbe062bee38a6705bafb1699d77e3c44cfafcf..26e99723805dcf1809ffbe209f05722dc82845c3:/lisp/image-mode.el diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 55caae9a91..23d9aff737 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -35,6 +35,7 @@ ;;; Code: (require 'image) +(eval-when-compile (require 'cl)) ;;;###autoload (push '("\\.jpe?g\\'" . image-mode) auto-mode-alist) ;;;###autoload (push '("\\.png\\'" . image-mode) auto-mode-alist) @@ -48,34 +49,79 @@ ;;;###autoload (push '("\\.svgz?\\'" . xml-mode) auto-mode-alist) ;;;###autoload (push '("\\.svgz?\\'" . image-mode-maybe) auto-mode-alist) +;;; Image mode window-info management. + +(defvar image-mode-winprops-alist t) +(make-variable-buffer-local 'image-mode-winprops-alist) + +(defvar image-mode-new-window-functions nil + "Special hook run when image data is requested in a new window. +It is called with one argument, the initial WINPROPS.") + +(defun image-mode-winprops (&optional window) + "Return winprops of WINDOW. +A winprops object has the shape (WINDOW . ALIST)." + (unless window (setq window (selected-window))) + (let ((winprops (assq window image-mode-winprops-alist))) + ;; For new windows, set defaults from the latest. + (unless winprops + (setq winprops (cons window + (copy-alist (cdar image-mode-winprops-alist)))) + (run-hook-with-args 'image-mode-new-window-functions winprops)) + ;; Move window to front. + (setq image-mode-winprops-alist + (cons winprops (delq winprops image-mode-winprops-alist))) + winprops)) + +(defun image-mode-window-get (prop &optional winprops) + (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) + (cdr (assq prop (cdr winprops)))) + +(defsetf image-mode-window-get (prop &optional winprops) (val) + `(image-mode-window-put ,prop ,val ,winprops)) + +(defun image-mode-window-put (prop val &optional winprops) + (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) + (setcdr winprops (cons (cons prop val) + (delq (assq prop (cdr winprops)) (cdr winprops))))) + +(defun image-set-window-vscroll (vscroll) + (setf (image-mode-window-get 'vscroll) vscroll) + (set-window-vscroll (selected-window) vscroll)) + +(defun image-set-window-hscroll (ncol) + (setf (image-mode-window-get 'hscroll) ncol) + (set-window-hscroll (selected-window) ncol)) + +(defun image-mode-reapply-winprops () + (walk-windows + (lambda (win) + (with-current-buffer (window-buffer win) + ;; When set-window-buffer, set hscroll and vscroll to what they were + ;; last time the image was displayed in this window. + (when (listp image-mode-winprops-alist) + (let* ((winprops (image-mode-winprops win)) + (hscroll (image-mode-window-get 'hscroll winprops)) + (vscroll (image-mode-window-get 'vscroll winprops))) + (if hscroll (set-window-hscroll win hscroll)) + (if vscroll (set-window-vscroll win vscroll)))))) + 'nomini + (selected-frame))) + +(defun image-mode-setup-winprops () + ;; Record current scroll settings. + (unless (listp image-mode-winprops-alist) + (setq image-mode-winprops-alist nil)) + (add-hook 'window-configuration-change-hook + 'image-mode-reapply-winprops nil t)) + ;;; Image scrolling functions -(defvar image-mode-current-vscroll nil - "An alist with elements (WINDOW . VSCROLL).") - -(defvar image-mode-current-hscroll nil - "An alist with elements (WINDOW . HSCROLL).") - -(defun image-set-window-vscroll (window vscroll &optional pixels-p) - (setq image-mode-current-vscroll - (append (list (cons window vscroll)) - (delete (assoc window image-mode-current-vscroll) - image-mode-current-vscroll))) - (set-window-vscroll window vscroll pixels-p)) - -(defun image-set-window-hscroll (window ncol) - (setq image-mode-current-hscroll - (append (list (cons window ncol)) - (delete (assoc window image-mode-current-hscroll) - image-mode-current-hscroll))) - (set-window-hscroll window ncol)) - -(defun image-reset-current-vhscroll () - (let ((win (selected-window))) - (when (assoc win image-mode-current-hscroll) - (set-window-hscroll win (cdr (assoc win image-mode-current-hscroll)))) - (when (assoc win image-mode-current-vscroll) - (set-window-vscroll win (cdr (assoc win image-mode-current-vscroll)))))) +(defun image-get-display-property () + (get-char-property (point-min) 'display + ;; There might be different images for different displays. + (if (eq (window-buffer) (current-buffer)) + (selected-window)))) (defun image-forward-hscroll (&optional n) "Scroll image in current window to the left by N character widths. @@ -83,15 +129,13 @@ Stop if the right edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (image-set-window-hscroll (selected-window) - (max 0 (+ (window-hscroll) n)))) + (image-set-window-hscroll (max 0 (+ (window-hscroll) n)))) (t - (let* ((image (get-char-property (point-min) 'display)) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) (img-width (ceiling (car (image-size image))))) - (image-set-window-hscroll (selected-window) - (min (max 0 (- img-width win-width)) + (image-set-window-hscroll (min (max 0 (- img-width win-width)) (+ n (window-hscroll)))))))) (defun image-backward-hscroll (&optional n) @@ -106,15 +150,13 @@ Stop if the bottom edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (image-set-window-vscroll (selected-window) - (max 0 (+ (window-vscroll) n)))) + (image-set-window-vscroll (max 0 (+ (window-vscroll) n)))) (t - (let* ((image (get-char-property (point-min) 'display)) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-height (- (nth 3 edges) (nth 1 edges))) (img-height (ceiling (cdr (image-size image))))) - (image-set-window-vscroll (selected-window) - (min (max 0 (- img-height win-height)) + (image-set-window-vscroll (min (max 0 (- img-height win-height)) (+ n (window-vscroll)))))))) (defun image-previous-line (&optional n) @@ -145,7 +187,7 @@ When calling from a program, supply as argument a number, nil, or `-'." (t (image-next-line (prefix-numeric-value n))))) (defun image-scroll-down (&optional n) - "Scroll image in current window downward by N lines + "Scroll image in current window downward by N lines. Stop if the top edge of the image is reached. If ARG is omitted or nil, scroll downward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. @@ -173,7 +215,7 @@ stopping if the top or bottom edge of the image is reached." (and arg (/= (setq arg (prefix-numeric-value arg)) 1) (image-next-line (- arg 1))) - (image-set-window-hscroll (selected-window) 0)) + (image-set-window-hscroll 0)) (defun image-eol (arg) "Scroll horizontally to the right edge of the image in the current window. @@ -183,30 +225,29 @@ stopping if the top or bottom edge of the image is reached." (and arg (/= (setq arg (prefix-numeric-value arg)) 1) (image-next-line (- arg 1))) - (let* ((image (get-char-property (point-min) 'display)) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) (img-width (ceiling (car (image-size image))))) - (image-set-window-hscroll (selected-window) - (max 0 (- img-width win-width))))) + (image-set-window-hscroll (max 0 (- img-width win-width))))) (defun image-bob () "Scroll to the top-left corner of the image in the current window." (interactive) - (image-set-window-hscroll (selected-window) 0) - (image-set-window-vscroll (selected-window) 0)) + (image-set-window-hscroll 0) + (image-set-window-vscroll 0)) (defun image-eob () "Scroll to the bottom-right corner of the image in the current window." (interactive) - (let* ((image (get-char-property (point-min) 'display)) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) (win-width (- (nth 2 edges) (nth 0 edges))) (img-width (ceiling (car (image-size image)))) (win-height (- (nth 3 edges) (nth 1 edges))) (img-height (ceiling (cdr (image-size image))))) - (image-set-window-hscroll (selected-window) (max 0 (- img-width win-width))) - (image-set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) + (image-set-window-hscroll (max 0 (- img-width win-width))) + (image-set-window-vscroll (max 0 (- img-height win-height))))) ;;; Image Mode setup @@ -253,16 +294,11 @@ to toggle between display as an image and display as text." 'image-bookmark-make-cell) ;; Keep track of [vh]scroll when switching buffers - (make-local-variable 'image-mode-current-hscroll) - (make-local-variable 'image-mode-current-vscroll) - (image-set-window-hscroll (selected-window) (window-hscroll)) - (image-set-window-vscroll (selected-window) (window-vscroll)) - (add-hook 'window-configuration-change-hook - 'image-reset-current-vhscroll nil t) + (image-mode-setup-winprops) (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) (if (and (display-images-p) - (not (get-char-property (point-min) 'display))) + (not (image-get-display-property))) (image-toggle-display) ;; Set next vars when image is already displayed but local ;; variables were cleared by kill-all-local-variables @@ -273,7 +309,7 @@ to toggle between display as an image and display as text." (message "%s" (concat (substitute-command-keys "Type \\[image-toggle-display] to view as ") - (if (get-char-property (point-min) 'display) + (if (image-get-display-property) "text" "an image") ".")))) ;;;###autoload @@ -286,13 +322,13 @@ See the command `image-mode' for more information on this mode." :version "22.1" (if (not image-minor-mode) (image-toggle-display-text) - (if (get-char-property (point-min) 'display) + (if (image-get-display-property) (setq cursor-type nil truncate-lines t) (setq image-type "text")) (add-hook 'change-major-mode-hook (lambda () (image-minor-mode -1)) nil t) (message "%s" (concat (substitute-command-keys "Type \\[image-toggle-display] to view the image as ") - (if (get-char-property (point-min) 'display) + (if (image-get-display-property) "text" "an image") ".")))) ;;;###autoload @@ -322,7 +358,7 @@ information on these modes." (defun image-toggle-display-text () "Showing the text of the image file." - (if (get-char-property (point-min) 'display) + (if (image-get-display-property) (image-toggle-display))) (defvar archive-superior-buffer) @@ -333,7 +369,7 @@ information on these modes." This command toggles between showing the text of the image file and showing the image as an image." (interactive) - (if (get-char-property (point-min) 'display) + (if (image-get-display-property) (let ((inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p)))