X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/257210319f10abebbfd7c12784cf3a8e112c3562..3f82a88a05e227145b0470991050698085d19fbe:/lisp/image-mode.el diff --git a/lisp/image-mode.el b/lisp/image-mode.el index fabc12c021..6a13d52803 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -1,6 +1,6 @@ -;;; image-mode.el --- support for visiting image files +;;; image-mode.el --- support for visiting image files -*- lexical-binding: t -*- ;; -;; Copyright (C) 2005-2012 Free Software Foundation, Inc. +;; Copyright (C) 2005-2013 Free Software Foundation, Inc. ;; ;; Author: Richard Stallman ;; Keywords: multimedia @@ -31,6 +31,11 @@ ;; resulting buffer file is saved to another name it will correctly save ;; the image data to the new file. +;; Todo: + +;; Consolidate with doc-view to make them work on directories of images or on +;; image files containing various "pages". + ;;; Code: (require 'image) @@ -38,8 +43,7 @@ ;;; Image mode window-info management. -(defvar image-mode-winprops-alist t) -(make-variable-buffer-local 'image-mode-winprops-alist) +(defvar-local image-mode-winprops-alist t) (defvar image-mode-new-window-functions nil "Special hook run when image data is requested in a new window. @@ -47,16 +51,21 @@ It is called with one argument, the initial WINPROPS.") (defun image-mode-winprops (&optional window cleanup) "Return winprops of WINDOW. -A winprops object has the shape (WINDOW . ALIST)." +A winprops object has the shape (WINDOW . ALIST). +WINDOW defaults to `selected-window' if it displays the current buffer, and +otherwise it defaults to t, used for times when the buffer is not displayed." (cond ((null window) - (setq window (selected-window))) + (setq window + (if (eq (current-buffer) (window-buffer)) (selected-window) t))) + ((eq window t)) ((not (windowp window)) (error "Not a window: %s" window))) (when cleanup (setq image-mode-winprops-alist (delq nil (mapcar (lambda (winprop) - (if (window-live-p (car-safe winprop)) - winprop)) + (let ((w (car-safe winprop))) + (if (or (not (windowp w)) (window-live-p w)) + winprop))) image-mode-winprops-alist)))) (let ((winprops (assq window image-mode-winprops-alist))) ;; For new windows, set defaults from the latest. @@ -269,28 +278,50 @@ stopping if the top or bottom edge of the image is reached." ;; Adjust frame and image size. -(defun image-mode-fit-frame () - "Toggle whether to fit the frame to the current image. -This function assumes the current frame has only one window." - ;; FIXME: This does not take into account decorations like mode-line, - ;; minibuffer, header-line, ... - (interactive) - (let* ((saved (frame-parameter nil 'image-mode-saved-size)) +(defun image-mode-fit-frame (&optional frame toggle) + "Fit FRAME to the current image. +If FRAME is omitted or nil, it defaults to the selected frame. +All other windows on the frame are deleted. + +If called interactively, or if TOGGLE is non-nil, toggle between +fitting FRAME to the current image and restoring the size and +window configuration prior to the last `image-mode-fit-frame' +call." + (interactive (list nil t)) + (let* ((buffer (current-buffer)) (display (image-get-display-property)) - (size (image-display-size display))) - (if (and saved - (eq (caar saved) (frame-width)) - (eq (cdar saved) (frame-height))) - (progn ;; Toggle back to previous non-fitted size. - (set-frame-parameter nil 'image-mode-saved-size nil) - (setq size (cdr saved))) - ;; Round up size, and save current size so we can toggle back to it. - (setcar size (ceiling (car size))) - (setcdr size (ceiling (cdr size))) - (set-frame-parameter nil 'image-mode-saved-size - (cons size (cons (frame-width) (frame-height))))) - (set-frame-width (selected-frame) (car size)) - (set-frame-height (selected-frame) (cdr size)))) + (size (image-display-size display)) + (saved (frame-parameter frame 'image-mode-saved-params)) + (window-configuration (current-window-configuration frame)) + (width (frame-width frame)) + (height (frame-height frame))) + (with-selected-frame (or frame (selected-frame)) + (if (and toggle saved + (= (caar saved) width) + (= (cdar saved) height)) + (progn + (set-frame-width frame (car (nth 1 saved))) + (set-frame-height frame (cdr (nth 1 saved))) + (set-window-configuration (nth 2 saved)) + (set-frame-parameter frame 'image-mode-saved-params nil)) + (delete-other-windows) + (switch-to-buffer buffer t t) + (let* ((edges (window-inside-edges)) + (inner-width (- (nth 2 edges) (nth 0 edges))) + (inner-height (- (nth 3 edges) (nth 1 edges)))) + (set-frame-width frame (+ (ceiling (car size)) + width (- inner-width))) + (set-frame-height frame (+ (ceiling (cdr size)) + height (- inner-height))) + ;; The frame size after the above `set-frame-*' calls may + ;; differ from what we specified, due to window manager + ;; interference. We have to call `frame-width' and + ;; `frame-height' to get the actual results. + (set-frame-parameter frame 'image-mode-saved-params + (list (cons (frame-width) + (frame-height)) + (cons width height) + window-configuration))))))) ;;; Image Mode setup @@ -308,6 +339,8 @@ This function assumes the current frame has only one window." (define-key map (kbd "SPC") 'image-scroll-up) (define-key map (kbd "DEL") 'image-scroll-down) (define-key map (kbd "RET") 'image-toggle-animation) + (define-key map "n" 'image-next-file) + (define-key map "p" 'image-previous-file) (define-key map [remap forward-char] 'image-forward-hscroll) (define-key map [remap backward-char] 'image-backward-hscroll) (define-key map [remap right-char] 'image-forward-hscroll) @@ -586,6 +619,52 @@ Otherwise it plays once, then stops." (image-animate image index (if image-animate-loop t))))))))) + +;;; Switching to the next/previous image + +(defun image-next-file (&optional n) + "Visit the next image in the same directory as the current image file. +With optional argument N, visit the Nth image file after the +current one, in cyclic alphabetical order. + +This command visits the specified file via `find-alternate-file', +replacing the current Image mode buffer." + (interactive "p") + (unless (derived-mode-p 'image-mode) + (error "The buffer is not in Image mode")) + (unless buffer-file-name + (error "The current image is not associated with a file")) + (let* ((file (file-name-nondirectory buffer-file-name)) + (images (image-mode--images-in-directory file)) + (idx 0)) + (catch 'image-visit-next-file + (dolist (f images) + (if (string= f file) + (throw 'image-visit-next-file (1+ idx))) + (setq idx (1+ idx)))) + (setq idx (mod (+ idx (or n 1)) (length images))) + (find-alternate-file (nth idx images)))) + +(defun image-previous-file (&optional n) + "Visit the preceding image in the same directory as the current file. +With optional argument N, visit the Nth image file preceding the +current one, in cyclic alphabetical order. + +This command visits the specified file via `find-alternate-file', +replacing the current Image mode buffer." + (interactive "p") + (image-next-file (- n))) + +(defun image-mode--images-in-directory (file) + (let* ((dir (file-name-directory buffer-file-name)) + (files (directory-files dir nil + (image-file-name-regexp) t))) + ;; Add the current file to the list of images if necessary, in + ;; case it does not match `image-file-name-regexp'. + (unless (member file files) + (push file files)) + (sort files 'string-lessp))) + ;;; Support for bookmark.el (declare-function bookmark-make-record-default @@ -738,8 +817,14 @@ close to a multiple of 90, see `image-transform-right-angle-fudge'." h))))) (defun image-transform-check-size () - "Check that the image exactly fits the width/height of the window." - (unless (numberp image-transform-resize) + "Check that the image exactly fits the width/height of the window. + +Do this for an image of type `imagemagick' to make sure that the +elisp code matches the way ImageMagick computes the bounding box +of a rotated image." + (when (and (not (numberp image-transform-resize)) + (boundp 'image-type) + (eq image-type 'imagemagick)) (let ((size (image-display-size (image-get-display-property) t))) (cond ((eq image-transform-resize 'fit-width) (cl-assert (= (car size)