From ae7d0e86b37eabc434c48f85f56df0a221e0e7c7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 30 May 2024 17:45:33 +0300 Subject: [PATCH] Support built-in thumbnail creation on MS-Windows * 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. --- etc/NEWS | 9 ++ lisp/image/image-dired-external.el | 85 ++++++++++-- lisp/image/image-dired.el | 12 +- src/emacs.c | 4 + src/w32image.c | 201 +++++++++++++++++++++++++++++ src/w32term.h | 3 + 6 files changed, 301 insertions(+), 13 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c9334e18e2d..3c672ffed8f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2818,6 +2818,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. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/image/image-dired-external.el b/lisp/image/image-dired-external.el index 8a73f518e6b..cdeeba4c367 100644 --- a/lisp/image/image-dired-external.el +++ b/lisp/image/image-dired-external.el @@ -187,9 +187,40 @@ and %v which is replaced by the tag value." ;;; 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)))) ;;; 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'. diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index ca808bcb5ab..1e970d60a96 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -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. diff --git a/src/emacs.c b/src/emacs.c index f122955884e..036bc1864e6 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -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 diff --git a/src/w32image.c b/src/w32image.c index 9010338a267..c81c3f0d3d1 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -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); +} diff --git a/src/w32term.h b/src/w32term.h index 3120c8bd71f..a19be1a9e6a 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -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