diff options
Diffstat (limited to 'lisp/image-mode.el')
| -rw-r--r-- | lisp/image-mode.el | 236 |
1 files changed, 209 insertions, 27 deletions
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index a95dde1d999..ac090f020b3 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -278,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 @@ -307,6 +329,9 @@ This function assumes the current frame has only one window." "The image type for the current Image mode buffer.") (make-variable-buffer-local 'image-type) +(defvar-local image-multi-frame nil + "Non-nil if image for the current Image mode buffer has multiple frames.") + (defvar image-mode-previous-major-mode nil "Internal variable to keep the previous non-image major mode.") @@ -315,8 +340,14 @@ This function assumes the current frame has only one window." (set-keymap-parent map special-mode-map) (define-key map "\C-c\C-c" 'image-toggle-display) (define-key map (kbd "SPC") 'image-scroll-up) + (define-key map (kbd "S-SPC") 'image-scroll-down) (define-key map (kbd "DEL") 'image-scroll-down) (define-key map (kbd "RET") 'image-toggle-animation) + (define-key map "F" 'image-goto-frame) + (define-key map "f" 'image-next-frame) + (define-key map "b" 'image-previous-frame) + (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) @@ -331,6 +362,59 @@ This function assumes the current frame has only one window." (define-key map [remap move-end-of-line] 'image-eol) (define-key map [remap beginning-of-buffer] 'image-bob) (define-key map [remap end-of-buffer] 'image-eob) + (easy-menu-define image-mode-menu map "Menu for Image mode." + '("Image" + ["Show as Text" image-toggle-display :active t + :help "Show image as text"] + "--" + ["Fit Frame to Image" image-mode-fit-frame :active t + :help "Resize frame to match image"] + ["Fit to Window Height" image-transform-fit-to-height + :visible (eq image-type 'imagemagick) + :help "Resize image to match the window height"] + ["Fit to Window Width" image-transform-fit-to-width + :visible (eq image-type 'imagemagick) + :help "Resize image to match the window width"] + ["Rotate Image..." image-transform-set-rotation + :visible (eq image-type 'imagemagick) + :help "Rotate the image"] + "--" + ["Show Thumbnails" + (lambda () + (interactive) + (image-dired default-directory)) + :active default-directory + :help "Show thumbnails for all images in this directory"] + ["Next Image" image-next-file :active buffer-file-name + :help "Move to next image in this directory"] + ["Previous Image" image-previous-file :active buffer-file-name + :help "Move to previous image in this directory"] + "--" + ["Animate Image" image-toggle-animation :style toggle + :selected (let ((image (image-get-display-property))) + (and image (image-animate-timer image))) + :active image-multi-frame + :help "Toggle image animation"] + ["Loop Animation" + (lambda () (interactive) +;;; (make-variable-buffer-local 'image-animate-loop) + (setq image-animate-loop (not image-animate-loop)) + ;; FIXME this is a hacky way to make it affect a currently + ;; animating image. + (when (let ((image (image-get-display-property))) + (and image (image-animate-timer image))) + (image-toggle-animation) + (image-toggle-animation))) + :style toggle :selected image-animate-loop + :active image-multi-frame + :help "Animate images once, or forever?"] + ["Next Frame" image-next-frame :active image-multi-frame + :help "Show the next frame of this image"] + ["Previous Frame" image-previous-frame :active image-multi-frame + :help "Show the previous frame of this image"] + ["Goto Frame..." image-goto-frame :active image-multi-frame + :help "Show a specific frame of this image"] + )) map) "Mode keymap for `image-mode'.") @@ -384,15 +468,34 @@ to toggle between display as an image and display as text." (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) (msg1 (substitute-command-keys - "Type \\[image-toggle-display] to view the image as "))) + "Type \\[image-toggle-display] to view the image as ")) + animated) (cond ((null image) (message "%s" (concat msg1 "an image."))) - ((image-animated-p image) + ((setq animated (image-multi-frame-p image)) + (setq image-multi-frame t + mode-line-process + `(:eval + (concat " " + (propertize + (format "[%s/%s]" + (1+ (image-current-frame ',image)) + ,(car animated)) + 'help-echo "Frames +mouse-1: Next frame +mouse-3: Previous frame" + 'mouse-face 'mode-line-highlight + 'local-map + '(keymap + (mode-line + keymap + (down-mouse-1 . image-next-frame) + (down-mouse-3 . image-previous-frame))))))) (message "%s" - (concat msg1 "text, or " - (substitute-command-keys - "\\[image-toggle-animation] to animate.")))) + (concat msg1 "text. This image has multiple frames."))) +;;; (substitute-command-keys +;;; "\\[image-toggle-animation] to animate.")))) (t (message "%s" (concat msg1 "text.")))))) @@ -581,7 +684,7 @@ Otherwise it plays once, then stops." (cond ((null image) (error "No image is present")) - ((null (setq animation (image-animated-p image))) + ((null (setq animation (image-multi-frame-p image))) (message "No image animation.")) (t (let ((timer (image-animate-timer image))) @@ -595,6 +698,85 @@ Otherwise it plays once, then stops." (image-animate image index (if image-animate-loop t))))))))) +(defun image-goto-frame (n &optional relative) + "Show frame N of a multi-frame image. +Optional argument OFFSET non-nil means interpret N as relative to the +current frame. Frames are indexed from 1." + (interactive + (list (or current-prefix-arg + (read-number "Show frame number: ")))) + (let ((image (image-get-display-property))) + (cond + ((null image) + (error "No image is present")) + ((null image-multi-frame) + (message "No image animation.")) + (t + (image-show-frame image + (if relative + (+ n (image-current-frame image)) + (1- n))))))) + +(defun image-next-frame (&optional n) + "Switch to the next frame of a multi-frame image. +With optional argument N, switch to the Nth frame after the current one. +If N is negative, switch to the Nth frame before the current one." + (interactive "p") + (image-goto-frame n t)) + +(defun image-previous-frame (&optional n) + "Switch to the previous frame of a multi-frame image. +With optional argument N, switch to the Nth frame before the current one. +If N is negative, switch to the Nth frame after the current one." + (interactive "p") + (image-next-frame (- n))) + + +;;; 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 |