X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/771f48f0638f4832c882b2eab1bbc11e36ed5cf5..d550787cc982e2cbb934ff6ba080d4fbe5838548:/lisp/image-mode.el diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 283f6ae3ff..56dff23e9b 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1,6 +1,6 @@ ;;; image-mode.el --- support for visiting image files ;; -;; Copyright (C) 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ;; ;; Author: Richard Stallman ;; Keywords: multimedia @@ -50,22 +50,66 @@ ;;; Image scrolling functions +(defvar image-mode-current-vscroll nil + "An alist with elements (WINDOW . VSCROLL).") +(make-variable-buffer-local 'image-mode-current-vscroll) + +(defvar image-mode-current-hscroll nil + "An alist with elements (WINDOW . HSCROLL).") +(make-variable-buffer-local 'image-mode-current-hscroll) + +(defun image-set-window-vscroll (window vscroll &optional pixels-p) + (setq image-mode-current-vscroll + (cons (cons window vscroll) + (delq (assq 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 + (cons (cons window ncol) + (delq (assq window image-mode-current-hscroll) + image-mode-current-hscroll))) + (set-window-hscroll window ncol)) + +(defun image-reset-current-vhscroll () + (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. If it's the first + ;; time it's displayed in this window, use the most recent setting. + (when image-mode-current-hscroll + (set-window-hscroll win (cdr (or (assoc win image-mode-current-hscroll) + (car image-mode-current-hscroll))))) + (when image-mode-current-vscroll + (set-window-vscroll win (cdr (or (assoc win image-mode-current-vscroll) + (car image-mode-current-vscroll))))))) + 'nomini + (selected-frame))) + +(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. Stop if the right edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (set-window-hscroll (selected-window) - (max 0 (+ (window-hscroll) n)))) + (image-set-window-hscroll (selected-window) + (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))))) - (set-window-hscroll (selected-window) - (min (max 0 (- img-width win-width)) - (+ n (window-hscroll)))))))) + (image-set-window-hscroll (selected-window) + (min (max 0 (- img-width win-width)) + (+ n (window-hscroll)))))))) (defun image-backward-hscroll (&optional n) "Scroll image in current window to the right by N character widths. @@ -79,16 +123,16 @@ Stop if the bottom edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (set-window-vscroll (selected-window) - (max 0 (+ (window-vscroll) n)))) + (image-set-window-vscroll (selected-window) + (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))))) - (set-window-vscroll (selected-window) - (min (max 0 (- img-height win-height)) - (+ n (window-vscroll)))))))) + (image-set-window-vscroll (selected-window) + (min (max 0 (- img-height win-height)) + (+ n (window-vscroll)))))))) (defun image-previous-line (&optional n) "Scroll image in current window downward by N lines. @@ -118,7 +162,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. @@ -146,7 +190,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))) - (set-window-hscroll (selected-window) 0)) + (image-set-window-hscroll (selected-window) 0)) (defun image-eol (arg) "Scroll horizontally to the right edge of the image in the current window. @@ -156,30 +200,30 @@ 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))))) - (set-window-hscroll (selected-window) - (max 0 (- img-width win-width))))) + (image-set-window-hscroll (selected-window) + (max 0 (- img-width win-width))))) (defun image-bob () "Scroll to the top-left corner of the image in the current window." (interactive) - (set-window-hscroll (selected-window) 0) - (set-window-vscroll (selected-window) 0)) + (image-set-window-hscroll (selected-window) 0) + (image-set-window-vscroll (selected-window) 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))))) - (set-window-hscroll (selected-window) (max 0 (- img-width win-width))) - (set-window-vscroll (selected-window) (max 0 (- img-height win-height))))) + (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 Mode setup @@ -210,6 +254,8 @@ This variable is used to display the current image type in the mode line.") map) "Major mode keymap for viewing images as text in Image mode.") +(defvar bookmark-make-cell-function) + ;;;###autoload (defun image-mode () "Major mode for image files. @@ -219,9 +265,19 @@ to toggle between display as an image and display as text." (kill-all-local-variables) (setq mode-name "Image[text]") (setq major-mode 'image-mode) + ;; Use our own bookmarking function for images. + (set (make-local-variable 'bookmark-make-cell-function) + 'image-bookmark-make-cell) + + ;; Keep track of [vh]scroll when switching buffers + (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) + (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 @@ -232,7 +288,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 @@ -245,14 +301,14 @@ 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) - "text" "an image") ".")))) + "Type \\[image-toggle-display] to view the image as ") + (if (image-get-display-property) + "text" "an image") ".")))) ;;;###autoload (defun image-mode-maybe () @@ -281,7 +337,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) @@ -292,7 +348,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))) @@ -328,9 +384,9 @@ and showing the image as an image." (image (create-image file-or-data type data-p)) (props `(display ,image - intangible ,image - rear-nonsticky (display intangible) - read-only t front-sticky (read-only))) + intangible ,image + rear-nonsticky (display intangible) + read-only t front-sticky (read-only))) (inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p))) @@ -352,6 +408,43 @@ and showing the image as an image." (if (called-interactively-p) (message "Repeat this command to go back to displaying the file as text"))))) +;;; Support for bookmark.el + +(defun image-bookmark-make-cell (annotation &rest args) + (let ((the-record + `((filename . ,(buffer-file-name)) + (image-type . ,image-type) + (position . ,(point)) + (handler . image-bookmark-jump)))) + + ;; Take no chances with text properties + (set-text-properties 0 (length annotation) nil annotation) + + (when annotation + (nconc the-record (list (cons 'annotation annotation)))) + + ;; Finally, return the completed record. + the-record)) + +(declare-function bookmark-get-filename "bookmark" (bookmark)) +(declare-function bookmark-get-bookmark-record "bookmark" (bookmark)) +(declare-function bookmark-get-position "bookmark" (bookmark)) + +;;;###autoload +(defun image-bookmark-jump (bmk) + ;; This implements the `handler' function interface for record type + ;; returned by `bookmark-make-cell-function', which see. + (save-window-excursion + (let ((filename (bookmark-get-filename bmk)) + (type (cdr (assq 'image-type (bookmark-get-bookmark-record bmk)))) + (pos (bookmark-get-position bmk))) + (find-file filename) + (when (not (string= image-type type)) + (image-toggle-display)) + (when (string= image-type "text") + (goto-char pos)) + `((buffer ,(current-buffer)) (position ,(point)))))) + (provide 'image-mode) ;; arch-tag: b5b2b7e6-26a7-4b79-96e3-1546b5c4c6cb