diff options
Diffstat (limited to 'lisp/image-mode.el')
| -rw-r--r-- | lisp/image-mode.el | 231 |
1 files changed, 182 insertions, 49 deletions
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 6891796d122..23d9aff737d 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -35,31 +35,108 @@ ;;; 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) ;;;###autoload (push '("\\.gif\\'" . image-mode) auto-mode-alist) ;;;###autoload (push '("\\.tiff?\\'" . image-mode) auto-mode-alist) ;;;###autoload (push '("\\.p[bpgn]m\\'" . image-mode) auto-mode-alist) + +;;;###autoload (push '("\\.x[bp]m\\'" . c-mode) auto-mode-alist) ;;;###autoload (push '("\\.x[bp]m\\'" . image-mode-maybe) auto-mode-alist) +;;;###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 +(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 nil (max 0 (+ (window-hscroll) n)))) + (image-set-window-hscroll (max 0 (+ (window-hscroll) n)))) (t - (let* ((image (get-text-property 1 'display)) - (img-width (ceiling (car (image-size image)))) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) - (win-width (- (nth 2 edges) (nth 0 edges)))) - (set-window-hscroll nil - (min (max 0 (- img-width win-width)) - (+ n (window-hscroll)))))))) + (win-width (- (nth 2 edges) (nth 0 edges))) + (img-width (ceiling (car (image-size image))))) + (image-set-window-hscroll (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. @@ -73,15 +150,14 @@ Stop if the bottom edge of the image is reached." (interactive "p") (cond ((= n 0) nil) ((< n 0) - (set-window-vscroll nil (max 0 (+ (window-vscroll) n)))) + (image-set-window-vscroll (max 0 (+ (window-vscroll) n)))) (t - (let* ((image (get-text-property 1 'display)) - (img-height (ceiling (cdr (image-size image)))) + (let* ((image (image-get-display-property)) (edges (window-inside-edges)) - (win-height (- (nth 3 edges) (nth 1 edges)))) - (set-window-vscroll nil - (min (max 0 (- img-height win-height)) - (+ n (window-vscroll)))))))) + (win-height (- (nth 3 edges) (nth 1 edges))) + (img-height (ceiling (cdr (image-size image))))) + (image-set-window-vscroll (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. @@ -111,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. @@ -139,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))) - (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. @@ -149,33 +225,37 @@ 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-text-property 1 '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 (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 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-text-property 1 '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 (max 0 (- img-width win-width))) + (image-set-window-vscroll (max 0 (- img-height win-height))))) ;;; Image Mode setup +(defvar image-type nil + "Current image type. +This variable is used to display the current image type in the mode line.") +(make-variable-buffer-local 'image-type) + (defvar image-mode-map (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'image-toggle-display) @@ -198,6 +278,8 @@ stopping if the top or bottom edge of the image is reached." 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. @@ -205,11 +287,18 @@ You can use \\<image-mode-map>\\[image-toggle-display] to toggle between display as an image and display as text." (interactive) (kill-all-local-variables) - (setq mode-name "Image") + (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-mode-setup-winprops) + (add-hook 'change-major-mode-hook 'image-toggle-display-text nil t) (if (and (display-images-p) - (not (get-text-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 @@ -220,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-text-property (point-min) 'display) + (if (image-get-display-property) "text" "an image") ".")))) ;;;###autoload @@ -228,18 +317,19 @@ to toggle between display as an image and display as text." "Toggle Image minor mode. With arg, turn Image minor mode on if arg is positive, off otherwise. See the command `image-mode' for more information on this mode." - nil " Image" image-mode-text-map + nil (:eval (format " Image[%s]" image-type)) image-mode-text-map :group 'image :version "22.1" (if (not image-minor-mode) (image-toggle-display-text) - (if (get-text-property (point-min) 'display) - (setq cursor-type nil truncate-lines t)) + (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-text-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 () @@ -268,7 +358,7 @@ information on these modes." (defun image-toggle-display-text () "Showing the text of the image file." - (if (get-text-property (point-min) 'display) + (if (image-get-display-property) (image-toggle-display))) (defvar archive-superior-buffer) @@ -279,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-text-property (point-min) 'display) + (if (image-get-display-property) (let ((inhibit-read-only t) (buffer-undo-list t) (modified (buffer-modified-p))) @@ -291,25 +381,28 @@ and showing the image as an image." (kill-local-variable 'truncate-lines) (kill-local-variable 'auto-hscroll-mode) (use-local-map image-mode-text-map) + (setq image-type "text") + (if (eq major-mode 'image-mode) + (setq mode-name "Image[text]")) (if (called-interactively-p) (message "Repeat this command to go back to displaying the image"))) ;; Turn the image data into a real image, but only if the whole file ;; was inserted (let* ((filename (buffer-file-name)) - (image - (if (and filename - (file-readable-p filename) - (not (file-remote-p filename)) - (not (buffer-modified-p)) - (not (and (boundp 'archive-superior-buffer) - archive-superior-buffer)) - (not (and (boundp 'tar-superior-buffer) - tar-superior-buffer))) - (create-image filename) - (create-image - (string-make-unibyte - (buffer-substring-no-properties (point-min) (point-max))) - nil t))) + (data-p (not (and filename + (file-readable-p filename) + (not (file-remote-p filename)) + (not (buffer-modified-p)) + (not (and (boundp 'archive-superior-buffer) + archive-superior-buffer)) + (not (and (boundp 'tar-superior-buffer) + tar-superior-buffer))))) + (file-or-data (if data-p + (string-make-unibyte + (buffer-substring-no-properties (point-min) (point-max))) + filename)) + (type (image-type file-or-data nil data-p)) + (image (create-image file-or-data type data-p)) (props `(display ,image intangible ,image @@ -330,9 +423,49 @@ and showing the image as an image." ;; Allow navigation of large images (set (make-local-variable 'auto-hscroll-mode) nil) (use-local-map image-mode-map) + (setq image-type type) + (if (eq major-mode 'image-mode) + (setq mode-name (format "Image[%s]" type))) (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 |