]> git.eshelyaron.com Git - emacs.git/commitdiff
Support built-in thumbnail creation on MS-Windows
authorEli Zaretskii <eliz@gnu.org>
Thu, 30 May 2024 14:45:33 +0000 (17:45 +0300)
committerEshel Yaron <me@eshelyaron.com>
Thu, 30 May 2024 18:14:27 +0000 (20:14 +0200)
* src/w32image.c (get_encoder_clsid, Fw32image_create_thumbnail)
(globals_of_w32image, syms_of_w32image): New functions.
* src/emacs.c (main): Call 'syms_of_w32image' and
'globals_of_w32image'.
* src/w32term.h (syms_of_w32image, globals_of_w32image): Add
prototypes.

* lisp/image/image-dired.el
(image-dired-thumbnail-display-external): Add a fallback for
MS-Windows.
* lisp/image/image-dired-external.el
(image-dired--probe-thumbnail-cmd): New function.
(image-dired--check-executable-exists): Call it to verify that
"convert" is indeed an Imagemagick program.  New argument FUNC
specifies a function that can be used as an alternative to running
EXECUTABLE.
(image-dired-create-thumb-1): Don't call
'image-dired--check-executable-exists' here, ...
(image-dired-thumb-queue-run): ...call it here, with
'w32image-create-thumbnail' as the alternative function.  If on
MS-Windows and no "convert" command, call
'image-dired-create-thumb-2' instead.
(image-dired-create-thumb-2): New function.

* etc/NEWS: Announce the thumbnail support.

(cherry picked from commit ae7d0e86b37eabc434c48f85f56df0a221e0e7c7)

etc/NEWS
lisp/image/image-dired-external.el
lisp/image/image-dired.el
src/emacs.c
src/w32image.c
src/w32term.h

index 494f1ecc063241b581a3a50a4f7a2557110526f6..2b28d3c12a5ce9c94be9a42e01ba8a53767ca8dc 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2952,6 +2952,15 @@ title bars' and scroll bars' appearance.  If the new user option
 will disregard the system's Dark mode and will always use the default
 Light mode.
 
+---
+*** You can now use Image-Dired even if 'convert' command is not installed.
+If you don't have GraphicsMagick or ImageMagick installed, and thus the
+'gm convert'/'convert' command is not available, Emacs on MS-Windows
+will now use its own function 'w32image-create-thumbnail' to create
+thumbnail images and show them in the thumbnail buffer.  Unlike with
+using 'convert', this fallback method is synchronous, so Emacs will wait
+until all the thumbnails are created and displayed, before showing them.
+
 \f
 ----------------------------------------------------------------------
 This file is part of GNU Emacs.
index 8a73f518e6ba95064fc65529f652a5b0647866ef..cdeeba4c367915af5199f5042d4659f132eb6aab 100644 (file)
@@ -187,9 +187,40 @@ and %v which is replaced by the tag value."
 \f
 ;;; Util functions
 
-(defun image-dired--check-executable-exists (executable)
-  (unless (executable-find (symbol-value executable))
-    (error "Executable %S not found" executable)))
+(defun image-dired--probe-thumbnail-cmd (cmd)
+  "Check whether CMD is usable for thumbnail creation."
+  (cond
+   ;; MS-Windows has an incompatible 'convert' command.  Make sure this
+   ;; is the one we expect, from ImageMagick.  FIXME: Should we do this
+   ;; also on systems other than MS-Windows?
+   ((and (memq system-type '(windows-nt cygwin ms-dos))
+         (member (downcase (file-name-nondirectory cmd))
+                 '("convert" "convert.exe")))
+    (with-temp-buffer
+      (let (process-file-side-effects)
+        (and (equal (condition-case nil
+                        ;; Implementation note: 'process-file' below
+                        ;; returns non-zero status when convert.exe is
+                        ;; the Windows command, because we quote the
+                        ;; "/?" argument, and Windows is not smart
+                        ;; enough to process quoted options correctly.
+                       (apply #'process-file cmd nil t nil '("/?"))
+                     (error nil))
+                   0)
+            (progn
+              (goto-char (point-min))
+              (looking-at-p "Version: ImageMagick"))))))
+   (t t)))
+
+(defun image-dired--check-executable-exists (executable &optional func)
+  "If program EXECUTABLE does not exist or cannot be used, signal an error.
+But if optional argument FUNC (which must be a symbol) names a known
+function, consider that function to be an alternative to running EXECUTABLE."
+  (let ((cmd (symbol-value executable)))
+    (or (and (executable-find cmd)
+             (image-dired--probe-thumbnail-cmd cmd))
+        (and func (fboundp func) 'function)
+        (error "Executable %S not found or not pertinent" executable))))
 
 \f
 ;;; Creating thumbnails
@@ -286,8 +317,6 @@ and remove the cached thumbnail files between each trial run.")
 
 (defun image-dired-create-thumb-1 (original-file thumbnail-file)
   "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE."
-  (image-dired--check-executable-exists
-   'image-dired-cmd-create-thumbnail-program)
   (let* ((size (number-to-string (image-dired--thumb-size)))
          (modif-time (format-time-string
                       "%s" (file-attribute-modification-time
@@ -354,15 +383,51 @@ and remove the cached thumbnail files between each trial run.")
                   (image-dired-optipng-thumb spec)))))))
     process))
 
+(defun image-dired-create-thumb-2 (original-file thumbnail-file)
+  "For ORIGINAL-FILE, create thumbnail image named THUMBNAIL-FILE.
+This is like `image-dired-create-thumb-1', but used when the thumbnail
+file is created by Emacs itself."
+  (let ((size (image-dired--thumb-size))
+        (thumbnail-dir (file-name-directory thumbnail-file)))
+    (when (not (file-exists-p thumbnail-dir))
+      (with-file-modes #o700
+        (make-directory thumbnail-dir t))
+      (message "Thumbnail directory created: %s" thumbnail-dir))
+    (image-dired-debug "Creating thumbnail for %s" original-file)
+    (if (null (w32image-create-thumbnail original-file thumbnail-file
+                                         (file-name-extension thumbnail-file)
+                                         size size))
+        (message "Failed to create a thumbnail for %s"
+                 (abbreviate-file-name original-file))
+      (clear-image-cache thumbnail-file)
+      ;; FIXME: Add PNG optimization like image-dired-create-thumb-1 does.
+      )
+    ;; Trigger next in queue once a thumbnail has been created.
+    (image-dired-thumb-queue-run)))
+
 (defun image-dired-thumb-queue-run ()
   "Run a queued job if one exists and not too many jobs are running.
 Queued items live in `image-dired-queue'.
 Number of simultaneous jobs is limited by `image-dired-queue-active-limit'."
-  (while (and image-dired-queue
-              (< image-dired-queue-active-jobs
-                 image-dired-queue-active-limit))
-    (cl-incf image-dired-queue-active-jobs)
-    (apply #'image-dired-create-thumb-1 (pop image-dired-queue))))
+  (if (not (eq (image-dired--check-executable-exists
+                'image-dired-cmd-create-thumbnail-program
+                'w32image-create-thumbnail)
+               'function))
+      ;; We have a usable gm/convert command; queue thethumbnail jobs.
+      (while (and image-dired-queue
+                  (< image-dired-queue-active-jobs
+                     image-dired-queue-active-limit))
+        (cl-incf image-dired-queue-active-jobs)
+        (apply #'image-dired-create-thumb-1 (pop image-dired-queue)))
+    ;; We are on MS-Windows and need to generate thumbnails by our
+    ;; lonesome selves.
+    (if image-dired-queue
+        (let* ((job (pop image-dired-queue))
+               (orig-file (car job))
+               (thumb-file (cadr job)))
+          (run-with-timer 0.05 nil
+                          #'image-dired-create-thumb-2
+                          orig-file thumb-file)))))
 
 (defun image-dired-create-thumb (original-file thumbnail-file)
   "Add a job for generating ORIGINAL-FILE thumbnail to `image-dired-queue'.
index ca808bcb5ab8ec69e011225cbeb8e30c9c148752..1e970d60a96a989cadce8d1a907b21332f4cf33c 100644 (file)
@@ -1248,9 +1248,15 @@ The viewer command is specified by `image-dired-external-viewer'."
         (message "No thumbnail at point")
       (if (not file)
           (message "No original file name found")
-        (apply #'start-process "image-dired-thumb-external" nil
-               (append (string-split image-dired-external-viewer " ")
-                       (list file)))))))
+        (cond
+         ((stringp image-dired-external-viewer)
+          (apply #'start-process "image-dired-thumb-external" nil
+                 (append (string-split image-dired-external-viewer " ")
+                         (list file))))
+         ((eq system-type 'windows-nt)
+          (w32-shell-execute "open" file))
+         (t
+          (error "`image-dired-external-viewer' does not name an image viewer program")))))))
 
 (defun image-dired-display-image (file &optional _ignored)
   "Display image FILE in the image buffer window.
index f122955884eceb0ef25710738cda78b3ef04cbdb..036bc1864e65d5cbdd36de1f0c7d327586c5f52a 100644 (file)
@@ -2358,6 +2358,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
 #ifdef HAVE_WINDOW_SYSTEM
       syms_of_fringe ();
       syms_of_image ();
+#ifdef HAVE_NTGUI
+      syms_of_w32image ();
+#endif /* HAVE_NTGUI */
 #endif /* HAVE_WINDOW_SYSTEM */
 #ifdef HAVE_X_WINDOWS
       syms_of_xterm ();
@@ -2495,6 +2498,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
       globals_of_w32font ();
       globals_of_w32fns ();
       globals_of_w32menu ();
+      globals_of_w32image ();
 #endif  /* HAVE_NTGUI */
 
 #if defined WINDOWSNT || defined HAVE_NTGUI
index 9010338a26759eaf4265631c638826b50d0d30ab..c81c3f0d3d1a08de6171f87bdd3442170231354e 100644 (file)
@@ -65,6 +65,16 @@ typedef GpStatus (WINGDIPAPI *GdipCreateHBITMAPFromBitmap_Proc)
 typedef GpStatus (WINGDIPAPI *GdipDisposeImage_Proc) (GpImage *);
 typedef GpStatus (WINGDIPAPI *GdipGetImageHeight_Proc) (GpImage *, UINT *);
 typedef GpStatus (WINGDIPAPI *GdipGetImageWidth_Proc) (GpImage *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageEncodersSize_Proc) (UINT *, UINT *);
+typedef GpStatus (WINGDIPAPI *GdipGetImageEncoders_Proc)
+ (UINT, UINT, ImageCodecInfo *);
+typedef GpStatus (WINGDIPAPI *GdipLoadImageFromFile_Proc)
+ (GDIPCONST WCHAR *,GpImage **);
+typedef GpStatus (WINGDIPAPI *GdipGetImageThumbnail_Proc)
+ (GpImage *, UINT, UINT, GpImage**, GetThumbnailImageAbort, VOID *);
+typedef GpStatus (WINGDIPAPI *GdipSaveImageToFile_Proc)
+ (GpImage *, GDIPCONST WCHAR *, GDIPCONST CLSID *,
+ GDIPCONST EncoderParameters *);
 
 GdiplusStartup_Proc fn_GdiplusStartup;
 GdiplusShutdown_Proc fn_GdiplusShutdown;
@@ -81,6 +91,11 @@ GdipCreateHBITMAPFromBitmap_Proc fn_GdipCreateHBITMAPFromBitmap;
 GdipDisposeImage_Proc fn_GdipDisposeImage;
 GdipGetImageHeight_Proc fn_GdipGetImageHeight;
 GdipGetImageWidth_Proc fn_GdipGetImageWidth;
+GdipGetImageEncodersSize_Proc fn_GdipGetImageEncodersSize;
+GdipGetImageEncoders_Proc fn_GdipGetImageEncoders;
+GdipLoadImageFromFile_Proc fn_GdipLoadImageFromFile;
+GdipGetImageThumbnail_Proc fn_GdipGetImageThumbnail;
+GdipSaveImageToFile_Proc fn_GdipSaveImageToFile;
 
 static bool
 gdiplus_init (void)
@@ -161,6 +176,26 @@ gdiplus_init (void)
       if (!fn_SHCreateMemStream)
        return false;
     }
+  fn_GdipGetImageEncodersSize = (GdipGetImageEncodersSize_Proc)
+    get_proc_addr (gdiplus_lib, "GdipGetImageEncodersSize");
+  if (!fn_GdipGetImageEncodersSize)
+    return false;
+  fn_GdipGetImageEncoders = (GdipGetImageEncoders_Proc)
+    get_proc_addr (gdiplus_lib, "GdipGetImageEncoders");
+  if (!fn_GdipGetImageEncoders)
+    return false;
+  fn_GdipLoadImageFromFile = (GdipLoadImageFromFile_Proc)
+    get_proc_addr (gdiplus_lib, "GdipLoadImageFromFile");
+  if (!fn_GdipLoadImageFromFile)
+    return false;
+  fn_GdipGetImageThumbnail = (GdipGetImageThumbnail_Proc)
+    get_proc_addr (gdiplus_lib, "GdipGetImageThumbnail");
+  if (!fn_GdipGetImageThumbnail)
+    return false;
+  fn_GdipSaveImageToFile = (GdipSaveImageToFile_Proc)
+    get_proc_addr (gdiplus_lib, "GdipSaveImageToFile");
+  if (!fn_GdipSaveImageToFile)
+    return false;
 
   return true;
 }
@@ -180,6 +215,11 @@ gdiplus_init (void)
 # undef GdipDisposeImage
 # undef GdipGetImageHeight
 # undef GdipGetImageWidth
+# undef GdipGetImageEncodersSize
+# undef GdipGetImageEncoders
+# undef GdipLoadImageFromFile
+# undef GdipGetImageThumbnail
+# undef GdipSaveImageToFile
 
 # define GdiplusStartup fn_GdiplusStartup
 # define GdiplusShutdown fn_GdiplusShutdown
@@ -196,6 +236,11 @@ gdiplus_init (void)
 # define GdipDisposeImage fn_GdipDisposeImage
 # define GdipGetImageHeight fn_GdipGetImageHeight
 # define GdipGetImageWidth fn_GdipGetImageWidth
+# define GdipGetImageEncodersSize fn_GdipGetImageEncodersSize
+# define GdipGetImageEncoders fn_GdipGetImageEncoders
+# define GdipLoadImageFromFile fn_GdipLoadImageFromFile
+# define GdipGetImageThumbnail fn_GdipGetImageThumbnail
+# define GdipSaveImageToFile fn_GdipSaveImageToFile
 
 #endif /* WINDOWSNT */
 
@@ -476,3 +521,159 @@ w32_load_image (struct frame *f, struct image *img,
     }
   return 1;
 }
+
+struct cached_encoder {
+  int num;
+  char *type;
+  CLSID clsid;
+};
+
+static struct cached_encoder last_encoder;
+
+struct thumb_type_data {
+  const char *ext;
+  const wchar_t *mime;
+};
+
+static struct thumb_type_data thumb_types [] =
+  {
+    /* jpg and png are at the front because 'image-dired-thumb-name'
+       uses them in most cases. */
+    {"jpg", L"image/jpeg"},
+    {"png", L"image/png"},
+    {"bmp", L"image/bmp"},
+    {"jpeg", L"image/jpeg"},
+    {"gif", L"image/gif"},
+    {"tiff", L"image/tiff"},
+    {NULL, NULL}
+  };
+
+
+static int
+get_encoder_clsid(const char *type, CLSID *clsid)
+{
+  /* A simple cache based on the assumptions that many thumbnails will
+     be generated using the same TYPE.  */
+  if (last_encoder.type && stricmp (type, last_encoder.type) == 0)
+    {
+      *clsid = last_encoder.clsid;
+      return last_encoder.num;
+    }
+
+  const wchar_t *format = NULL;
+  struct thumb_type_data *tp = thumb_types;
+  for ( ; tp->ext; tp++)
+    {
+      if (stricmp (type, tp->ext) == 0)
+       {
+         format = tp->mime;
+         break;
+       }
+    }
+  if (!format)
+    return -1;
+
+  unsigned num = 0;
+  unsigned size = 0;
+  ImageCodecInfo *image_codec_info = NULL;
+
+  GdipGetImageEncodersSize (&num, &size);
+  if(size == 0)
+    return -1;
+
+  image_codec_info = xmalloc (size);
+  GdipGetImageEncoders (num, size, image_codec_info);
+
+  for (int j = 0; j < num; ++j)
+    {
+      if (wcscmp (image_codec_info[j].MimeType, format) == 0 )
+       {
+         if (last_encoder.type)
+           xfree (last_encoder.type);
+         last_encoder.type = xstrdup (tp->ext);
+         last_encoder.clsid = image_codec_info[j].Clsid;
+         last_encoder.num = j;
+          *clsid = image_codec_info[j].Clsid;
+          xfree (image_codec_info);
+          return j;
+       }
+    }
+
+  xfree (image_codec_info);
+  return -1;
+}
+
+DEFUN ("w32image-create-thumbnail", Fw32image_create_thumbnail,
+       Sw32image_create_thumbnail, 5, 5, 0,
+       doc: /* Create a HEIGHT by WIDTH thumnail file THUMB-FILE for image INPUT-FILE.
+TYPE is the image type to use for the thumbnail file, a string.  It is
+usually identical to the file-name extension of THUMB-FILE, but without
+the leading period, and both "jpeg" and "jpg" can be used for JPEG.
+TYPE is matched case-insensitively against supported types.  Currently,
+the supported TYPEs are BMP, JPEG, GIF, TIFF, and PNG; any other type
+will cause the function to fail.
+Return non-nil if thumbnail creation succeeds, nil otherwise.  */)
+  (Lisp_Object input_file, Lisp_Object thumb_file, Lisp_Object type,
+   Lisp_Object height, Lisp_Object width)
+{
+  /* Sanity checks.  */
+  CHECK_STRING (input_file);
+  CHECK_STRING (thumb_file);
+  CHECK_STRING (type);
+  CHECK_FIXNAT (height);
+  CHECK_FIXNAT (width);
+
+  if (!gdiplus_started)
+    {
+      if (!gdiplus_startup ())
+       return Qnil;
+    }
+
+  /* Create an image by reading from INPUT_FILE.  */
+  wchar_t input_file_w[MAX_PATH];
+  input_file = ENCODE_FILE (Fexpand_file_name (input_file, Qnil));
+  unixtodos_filename (SSDATA (input_file));
+  filename_to_utf16 (SSDATA (input_file), input_file_w);
+  GpImage *file_image;
+  GpStatus status = GdipLoadImageFromFile (input_file_w, &file_image);
+
+  if (status == Ok)
+    {
+      /* Create a thumbnail for the image.  */
+      GpImage *thumb_image;
+      status = GdipGetImageThumbnail (file_image,
+                                     XFIXNAT (width), XFIXNAT (height),
+                                     &thumb_image, NULL, NULL);
+      GdipDisposeImage (file_image);
+      CLSID thumb_clsid;
+      if (status == Ok
+         /* Get the GUID of the TYPE's encoder. */
+         && get_encoder_clsid (SSDATA (type), &thumb_clsid) >= 0)
+       {
+         /* Save the thumbnail image to a file of specified TYPE.  */
+         wchar_t thumb_file_w[MAX_PATH];
+         thumb_file = ENCODE_FILE (Fexpand_file_name (thumb_file, Qnil));
+         unixtodos_filename (SSDATA (thumb_file));
+         filename_to_utf16 (SSDATA (thumb_file), thumb_file_w);
+         status = GdipSaveImageToFile (thumb_image, thumb_file_w,
+                                       &thumb_clsid, NULL);
+         GdipDisposeImage (thumb_image);
+       }
+      else if (status == Ok)   /* no valid encoder */
+       status = InvalidParameter;
+    }
+  return (status == Ok) ? Qt : Qnil;
+}
+
+void
+syms_of_w32image (void)
+{
+  defsubr (&Sw32image_create_thumbnail);
+}
+
+void
+globals_of_w32image (void)
+{
+  /* This is only needed in an unexec build.  */
+  memset (&last_encoder, 0, sizeof last_encoder);
+}
index 3120c8bd71f7efc60edc0d737c0a58be2e5d785f..a19be1a9e6a604c1925fd9fe7cfec0c9f672164c 100644 (file)
@@ -909,6 +909,9 @@ extern void globals_of_w32menu (void);
 extern void globals_of_w32fns (void);
 extern void globals_of_w32notify (void);
 
+extern void syms_of_w32image (void);
+extern void globals_of_w32image (void);
+
 extern void w32_init_main_thread (void);
 
 #ifdef CYGWIN