Automatically scale images up on high-density screens

* doc/lispref/display.texi (ImageMagick Images): Mention :scale.
(Defining Images): Mention image-scaling-factor.

* lisp/image.el (image-compute-scaling-factor): New function
(bug#22172).
(create-image): Use it.
(image-scaling-factor): New variable.

* src/image.c (compute_image_size): Take :scale into account.

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 323895927a9933c18521f5a3e62833eb6620f704..c8e7e4fa5c154e026223ed8a0dce9810f44c9243 100644 (file)
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -5198,6 +5198,14 @@ and if @code{:height} is set it will have precedence over
 wish.  @code{:max-width} and @code{:max-height} will always preserve
 the aspect ratio.
 
+@item :scale @var{scale}
+This should be a number, where values higher than 1 means to increase
+the size, and lower means to decrease the size.  For instance, a value
+of 0.25 will make the image a quarter size of what it originally was.
+If the scaling makes the image larger than specified by
+@code{:max-width} or @code{:max-height}, the resulting size will not
+exceed those two values.
+
 @item :format @var{type}
 The value, @var{type}, should be a symbol specifying the type of the
 image data, as found in @code{image-format-suffixes}.  This is used
@@ -5384,6 +5392,13 @@ Here is an example of using @code{image-load-path-for-library}:
 @end example
 @end defun
 
+@vindex image-scaling-factor
+Images are automatically scaled when created based on the
+@code{image-scaling-factor} variable.  The value is either a floating
+point number (where numbers higher than 1 means to increase the size
+and lower means to shrink the size), or the symbol @code{auto}, which
+will compute a scaling factor based on the font pixel size.
+
 @node Showing Images
 @subsection Showing Images
 @cindex show image

diff --git a/etc/NEWS b/etc/NEWS
index ad9a50c274d38a6ce567c1649d82d4fdd7cb34f0..fd56f0c317ac0847b23b87072d88e2b711d41c30 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -768,6 +768,11 @@ there are now top-level domains added all the time.  Message will no
 longer warn about sending emails to top-level domains it hasn't heard
 about.
 
++++
+** Images are automatically scaled before displaying based on the
+`image-scaling-factor' variable (if Emacs supports scaling the images
+in question).
+
 +++
 ** In Show Paren Mode, a parenthesis can be highlighted when point
 stands inside it, and certain parens can be highlighted when point is

diff --git a/lisp/image.el b/lisp/image.el
index 663afa7764ee2380db7b83b2d5c2351f429780db..82a10a31113048ce7e68b5d49c0ed151268eb770 100644 (file)
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -126,6 +126,18 @@ Subdirectories are not automatically included in the search."
   :type '(repeat (choice directory variable))
   :initialize 'custom-initialize-delay)
 
+(defcustom image-scaling-factor 'auto
+  "When displaying images, apply this scaling factor before displaying.
+This is not supported for all image types, and is mostly useful
+when you have a high-resolution monitor.
+The value is either a floating point number (where numbers higher
+than 1 means to increase the size and lower means to shrink the
+size), or the symbol `auto', which will compute a scaling factor
+based on the font pixel size."
+  :type '(choice number
+                 (const :tag "Automatically compute" auto))
+  :group 'image
+  :version "25.2")
 
 (defun image-load-path-for-library (library image &optional path no-error)
   "Return a suitable search path for images used by LIBRARY.
@@ -409,8 +421,25 @@ Image file names that are not absolute are searched for in the
   (setq type (image-type file-or-data type data-p))
   (when (image-type-available-p type)
     (append (list 'image :type type (if data-p :data :file) file-or-data)
+            (and (not (plist-get props :scale))
+                 (list :scale
+                       (image-compute-scaling-factor image-scaling-factor)))
            props)))
 
+(defun image-compute-scaling-factor (scaling)
+  (cond
+   ((numberp image-scaling-factor)
+    image-scaling-factor)
+   ((eq image-scaling-factor 'auto)
+    (let ((width (/ (float (window-width nil t)) (window-width))))
+      ;; If we assume that a typical character is 10 pixels in width,
+      ;; then we should scale all images according to how wide they
+      ;; are.  But don't scale images down.
+      (if (< width 10)
+          1
+        (/ (float width) 10))))
+   (t
+    (error "Invalid scaling factor %s" image-scaling-factor))))
 
 ;;;###autoload
 (defun put-image (image pos &optional string area)

diff --git a/src/image.c b/src/image.c
index 144fe30a7466497eb0905331cd982e8c13ebf978..bc5863f919c93b6e6e2fd92c4fdcec528f1732cd 100644 (file)
--- a/src/image.c
+++ b/src/image.c
@@ -8073,6 +8073,7 @@ compute_image_size (size_t width, size_t height,
 {
   Lisp_Object value;
   int desired_width, desired_height;
+  double scale = 1;
 
   /* If width and/or height is set in the display spec assume we want
      to scale to those values.  If either h or w is unspecified, the
@@ -8083,6 +8084,12 @@ compute_image_size (size_t width, size_t height,
   value = image_spec_value (spec, QCheight, NULL);
   desired_height = NATNUMP (value) ? min (XFASTINT (value), INT_MAX) : -1;
 
+  value = image_spec_value (spec, QCscale, NULL);
+  if (NATNUMP (value))
+    scale = extract_float (value);
+  width = width * scale;
+  height = height * scale;
+
   if (desired_width == -1)
     {
       value = image_spec_value (spec, QCmax_width, NULL);
@@ -8132,6 +8139,13 @@ compute_image_size (size_t width, size_t height,
     /* h known, calculate w.  */
     desired_width = scale_image_size (desired_height, height, width);
 
+  /* We have no width/height settings, so just apply the scale. */
+  if (desired_width == -1 && desired_height == -1)
+    {
+      desired_width = width;
+      desired_height = height;
+    }
+
   *d_width = desired_width;
   *d_height = desired_height;
 }
@@ -9795,6 +9809,7 @@ non-numeric, there is no explicit limit on the size of images.  */);
   DEFSYM (QCcrop, ":crop");
   DEFSYM (QCrotation, ":rotation");
   DEFSYM (QCmatrix, ":matrix");
+  DEFSYM (QCscale, ":scale");
   DEFSYM (QCcolor_adjustment, ":color-adjustment");
   DEFSYM (QCmask, ":mask");