diff options
Diffstat (limited to 'lisp/image-mode.el')
| -rw-r--r-- | lisp/image-mode.el | 214 |
1 files changed, 143 insertions, 71 deletions
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 1eb7cd58c3d..ea5d7ff0f35 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -58,16 +58,25 @@ It is called with one argument, the initial WINPROPS.") "Non-nil to resize the image upon first display. Its value should be one of the following: - nil, meaning no resizing. - - t, meaning to fit the image to the window height and width. - - `fit-height', meaning to fit the image to the window height. - - `fit-width', meaning to fit the image to the window width. - - A number, which is a scale factor (the default size is 1)." + - t, meaning to scale the image down to fit in the window. + - `fit-window', meaning to fit the image to the window. + - A number, which is a scale factor (the default size is 1). + +Resizing will always preserve the aspect ratio of the image." :type '(choice (const :tag "No resizing" nil) - (other :tag "Fit height and width" t) - (const :tag "Fit height" fit-height) - (const :tag "Fit width" fit-width) + (const :tag "Fit to window" fit-window) + (other :tag "Scale down to fit window" t) (number :tag "Scale factor" 1)) - :version "27.1" + :version "29.1" + :group 'image) + +(defcustom image-auto-resize-max-scale-percent nil + "Max size (in percent) to scale up to when `image-auto-resize' is `fit-window'. +Can be either a number larger than 100, or nil, which means no +max size." + :type '(choice (const :tag "No max" nil) + natnum) + :version "29.1" :group 'image) (defcustom image-auto-resize-on-window-resize 1 @@ -82,12 +91,18 @@ resizing according to the value specified in `image-auto-resize'." (defvar-local image-transform-resize nil "The image resize operation. +Non-nil to resize the image upon first display. Its value should be one of the following: - nil, meaning no resizing. - - t, meaning to fit the image to the window height and width. + - t, meaning to scale the image down to fit in the window. + - `fit-window', meaning to fit the image to the window. + - A number, which is a scale factor (the default size is 1). + +There is also support for these values, obsolete since Emacs 29.1: - `fit-height', meaning to fit the image to the window height. - `fit-width', meaning to fit the image to the window width. - - A number, which is a scale factor (the default size is 1).") + +Resizing will always preserve the aspect ratio of the image.") (defvar-local image-transform-scale 1.0 "The scale factor of the image being displayed.") @@ -267,10 +282,17 @@ Stop if the top edge of the image is reached." (defun image-scroll-up (&optional n) "Scroll image in current window upward by N lines. Stop if the bottom edge of the image is reached. -If ARG is omitted or nil, scroll upward by a near full screen. + +Interactively, giving this command a numerical prefix will scroll +up by that many lines (and down by that many lines if the number +is negative). Without a prefix, scroll up by a full screen. +If given a `C-u -' prefix, scroll a full page down instead. + +If N is omitted or nil, scroll upward by a near full screen. A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -If ARG is the atom `-', scroll downward by nearly full screen. +A negative N means scroll downward. + +If N is the atom `-', scroll downward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." (interactive "P") (cond ((null n) @@ -288,10 +310,17 @@ When calling from a program, supply as argument a number, nil, or `-'." (defun image-scroll-down (&optional n) "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. + +Interactively, giving this command a numerical prefix will scroll +down by that many lines (and up by that many lines if the number +is negative). Without a prefix, scroll down by a full screen. +If given a `C-u -' prefix, scroll a full page up instead. + +If N 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. -Negative ARG means scroll upward. -If ARG is the atom `-', scroll upward by nearly full screen. +A negative N means scroll upward. + +If N is the atom `-', scroll upward by nearly full screen. When calling from a program, supply as argument a number, nil, or `-'." (interactive "P") (cond ((null n) @@ -404,42 +433,43 @@ 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)) (saved (frame-parameter frame 'image-mode-saved-params)) (window-configuration (current-window-configuration frame)) - (width (frame-width frame)) - (height (frame-height frame))) + (frame-width (frame-text-width frame)) + (frame-height (frame-text-height frame))) (with-selected-frame (or frame (selected-frame)) (if (and toggle saved - (= (caar saved) width) - (= (cdar saved) height)) + (= (caar saved) frame-width) + (= (cdar saved) frame-height)) (progn - (set-frame-width frame (car (nth 1 saved))) - (set-frame-height frame (cdr (nth 1 saved))) + (set-frame-width frame (car (nth 1 saved)) nil t) + (set-frame-height frame (cdr (nth 1 saved)) nil t) (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))))))) + (fit-frame-to-buffer frame) + ;; 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-text-width frame) + (frame-text-height frame)) + (cons frame-width frame-height) + window-configuration)))))) ;;; Image Mode setup +(defcustom image-text-based-formats '(svg xpm) + "List of image formats that use a plain text format. +For such formats, display a message that explains how to edit the +image as text, when opening such images in `image-mode'." + :type '(choice (const :tag "Disable completely" nil) + (repeat :tag "List of formats" sexp)) + :version "29.1" + :group 'image) + (defvar-local image-type nil "The image type for the current Image mode buffer.") @@ -455,8 +485,9 @@ call." ;; Transformation keys (define-key map "sf" 'image-mode-fit-frame) + (define-key map "sw" 'image-transform-fit-to-window) (define-key map "sh" 'image-transform-fit-to-height) - (define-key map "sw" 'image-transform-fit-to-width) + (define-key map "si" 'image-transform-fit-to-width) (define-key map "sb" 'image-transform-fit-both) (define-key map "ss" 'image-transform-set-scale) (define-key map "sr" 'image-transform-set-rotation) @@ -511,12 +542,10 @@ call." "--" ["Fit Frame to Image" image-mode-fit-frame :active t :help "Resize frame to match image"] - ["Fit Image to Window (Best Fit)" image-transform-fit-both - :help "Resize image to match the window height and width"] - ["Fit to Window Height" image-transform-fit-to-height - :help "Resize image to match the window height"] - ["Fit to Window Width" image-transform-fit-to-width - :help "Resize image to match the window width"] + ["Fit Image to Window" image-transform-fit-to-window + :help "Resize image to match the window height and width"] + ["Fit Image to Window (Scale down only)" image-transform-fit-both + :help "Scale image down to match the window height and width"] ["Zoom In" image-increase-size :help "Enlarge the image"] ["Zoom Out" image-decrease-size @@ -602,11 +631,14 @@ call." (put 'image-mode 'mode-class 'special) +(declare-function image-converter-initialize "image-converter.el") + ;;;###autoload (defun image-mode () "Major mode for image files. -You can use \\<image-mode-map>\\[image-toggle-display] or \\<image-mode-map>\\[image-toggle-hex-display] -to toggle between display as an image and display as text or hex. +You can use \\<image-mode-map>\\[image-toggle-display] or \ +\\[image-toggle-hex-display] to toggle between display +as an image and display as text or hex. Key bindings: \\{image-mode-map}" @@ -626,7 +658,12 @@ Key bindings: "Empty file" "(New file)") "Empty buffer")) - (image-mode--display))) + (image-mode--display) + ;; Ensure that we recognize externally parsed image formats in + ;; commands like `n'. + (when image-use-external-converter + (require 'image-converter) + (image-converter-initialize)))) (defun image-mode--display () (if (not (image-get-display-property)) @@ -680,12 +717,10 @@ Key bindings: (run-mode-hooks 'image-mode-hook) (let ((image (image-get-display-property)) - (msg1 (substitute-command-keys - "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as ")) - animated) + msg animated) (cond ((null image) - (message "%s" (concat msg1 "an image."))) + (setq msg "an image")) ((setq animated (image-multi-frame-p image)) (setq image-multi-frame t mode-line-process @@ -703,10 +738,13 @@ Key bindings: keymap (down-mouse-1 . image-next-frame) (down-mouse-3 . image-previous-frame))))))) - (message "%s" - (concat msg1 "text. This image has multiple frames."))) + (setq msg "text. This image has multiple frames")) (t - (message "%s" (concat msg1 "text or hex.")))))) + (setq msg "text"))) + (when (memq (plist-get (cdr image) :type) image-text-based-formats) + (message (substitute-command-keys + "Type \\[image-toggle-display] to view the image as %s") + msg)))) ;;;###autoload (define-minor-mode image-minor-mode @@ -753,11 +791,11 @@ on these modes." (image-mode-to-text) ;; Turn on hexl-mode (hexl-mode) - (message "%s" (concat - (substitute-command-keys - "Type \\[image-toggle-hex-display] or \\[image-toggle-display] to view the image as ") - (if (image-get-display-property) - "hex" "an image or text") "."))) + (message (substitute-command-keys + "Type \\[image-toggle-hex-display] or \ +\\[image-toggle-display] to view the image as %s") + (if (image-get-display-property) + "hex" "an image or text"))) (defun image-mode-as-text () "Set a non-image mode as major mode in combination with image minor mode. @@ -773,11 +811,10 @@ See commands `image-mode' and `image-minor-mode' for more information on these modes." (interactive) (image-mode-to-text) - (message "%s" (concat - (substitute-command-keys - "Type \\[image-toggle-display] or \\[image-toggle-hex-display] to view the image as ") - (if (image-get-display-property) - "text" "an image or hex") "."))) + (message (substitute-command-keys + "Type \\[image-toggle-display] to view the image as %s") + (if (image-get-display-property) + "text" "an image"))) (defun image-toggle-display-text () "Show the image file as text. @@ -805,6 +842,21 @@ Remove text properties that display the image." (defvar tar-superior-buffer) (declare-function image-flush "image.c" (spec &optional frame)) +(defun image--scale-within-limits-p (image) + "Return t if `fit-window' will scale image within the customized limits. +The limits are given by the user option +`image-auto-resize-max-scale-percent'." + (or (not image-auto-resize-max-scale-percent) + (let ((scale (/ image-auto-resize-max-scale-percent 100)) + (mw (plist-get (cdr image) :max-width)) + (mh (plist-get (cdr image) :max-height)) + ;; Note: `image-size' looks up and thus caches the + ;; untransformed image. There's no easy way to + ;; prevent that. + (size (image-size image t))) + (or (<= mw (* (car size) scale)) + (<= mh (* (cdr size) scale)))))) + (defun image-toggle-display-image () "Show the image of the image file. Turn the image data into a real image, but only if the whole file @@ -839,7 +891,8 @@ was inserted." filename)) ;; If we have a `fit-width' or a `fit-height', don't limit ;; the size of the image to the window size. - (edges (when (eq image-transform-resize t) + (edges (when (or (eq image-transform-resize t) + (eq image-transform-resize 'fit-window)) (window-inside-pixel-edges (get-buffer-window)))) (max-width (when edges (- (nth 2 edges) (nth 0 edges)))) @@ -886,6 +939,14 @@ was inserted." ;; Type hint. :format (and filename data-p)))) + ;; Handle `fit-window'. + (when (and (eq image-transform-resize 'fit-window) + (image--scale-within-limits-p image)) + (setq image + (cons (car image) + (plist-put (cdr image) :width + (plist-get (cdr image) :max-width))))) + ;; Discard any stale image data before looking it up again. (image-flush image) (setq image (append image (image-transform-properties image))) @@ -1149,8 +1210,9 @@ replacing the current Image mode buffer." "Return an alist of type/buffer for all \"parent\" buffers to image FILE. This is normally a list of Dired buffers, but can also be archive and tar mode buffers." - (let ((buffers nil) - (dir (file-name-directory file))) + (let* ((non-essential t) ; Do not block for remote buffers. + (buffers nil) + (dir (file-name-directory file))) (cond ((and (boundp 'tar-superior-buffer) tar-superior-buffer) @@ -1165,6 +1227,8 @@ tar mode buffers." (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (and (derived-mode-p 'dired-mode) + (equal (file-remote-p dir) + (file-remote-p default-directory)) (equal (file-truename dir) (file-truename default-directory))) (push (cons 'dired (current-buffer)) buffers)))) @@ -1496,21 +1560,29 @@ return value is suitable for appending to an image spec." (defun image-transform-fit-to-height () "Fit the current image to the height of the current window." (interactive) + (declare (obsolete nil "29.1")) (setq image-transform-resize 'fit-height) (image-toggle-display-image)) (defun image-transform-fit-to-width () "Fit the current image to the width of the current window." + (declare (obsolete nil "29.1")) (interactive) (setq image-transform-resize 'fit-width) (image-toggle-display-image)) (defun image-transform-fit-both () - "Fit the current image both to the height and width of the current window." + "Scale the current image down to fit in the current window." (interactive) (setq image-transform-resize t) (image-toggle-display-image)) +(defun image-transform-fit-to-window () + "Fit the current image to the height and width of the current window." + (interactive) + (setq image-transform-resize 'fit-window) + (image-toggle-display-image)) + (defun image-transform-set-rotation (rotation) "Prompt for an angle ROTATION, and rotate the image by that amount. ROTATION should be in degrees." |