1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

Fix misc problems with thumbnails on MS-Windows

* lisp/image/image-dired-external.el (image-dired-pngcrush-thumb):
Fix deletion of intermediate file.
(image-dired-cmd-pngcrush-options)
(image-dired-cmd-create-standard-thumbnail-options): Use %u for
file:// URI.
(image-dired--file-URI): New function.
(image-dired-create-thumb-1, image-dired-create-thumb-2)
(image-dired-set-exif-data): Use it to generate correct URI on
MS-Windows.

* src/w32image.c (Fw32image_create_thumbnail): Copy the file names
before mirroring their slashes.
This commit is contained in:
Eli Zaretskii 2024-06-01 16:43:18 +03:00
parent 7af5d6fc9a
commit d2dce51344
2 changed files with 30 additions and 13 deletions

View file

@ -103,21 +103,24 @@ It optimizes the compression of PNG images. It also adds PNG textual chunks
with the information required by the Thumbnail Managing Standard."
:type '(choice (const :tag "Not Set" nil) file))
;; Note: the "-text" arguments below are according to specification in
;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html#CREATION
(defcustom image-dired-cmd-pngcrush-options
`("-q"
"-text" "b" "Description" "Thumbnail of file://%f"
"-text" "b" "Software" ,(emacs-version)
"-text" "b" "Description" "Thumbnail of file://%u"
"-text" "b" "Software" ,(string-replace "\n" " " (emacs-version))
;; "-text b \"Thumb::Image::Height\" \"%oh\" "
;; "-text b \"Thumb::Image::Mimetype\" \"%mime\" "
;; "-text b \"Thumb::Image::Width\" \"%ow\" "
"-text" "b" "Thumb::MTime" "%m"
;; "-text b \"Thumb::Size\" \"%b\" "
"-text" "b" "Thumb::URI" "file://%f"
"-text" "b" "Thumb::URI" "file://%u"
"%q" "%t")
"Arguments for `image-dired-cmd-pngcrush-program'.
The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options', with \"%q\" for a
temporary file name (typically generated by pnqnq)."
`image-dired-cmd-create-thumbnail-options', with \"%q\" standing for a
temporary file name (typically generated by pnqnq),
and \"%u\" standing for a file URI corresponding to file in \"%f\"."
:version "26.1"
:type '(repeat (string :tag "Argument")))
@ -134,20 +137,22 @@ The value can use the same %-format specifiers as in
:type '(repeat (string :tag "Argument"))
:link '(url-link "man:optipng(1)"))
;; Note: the "-set" arguments below are according to specification in
;; https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html#CREATION
(defcustom image-dired-cmd-create-standard-thumbnail-options
(let ((opts (list
"-size" "%wx%h" "%f[0]"
"-set" "Thumb::MTime" "%m"
"-set" "Thumb::URI" "file://%f"
"-set" "Description" "Thumbnail of file://%f"
"-set" "Software" (emacs-version)
"-set" "Thumb::URI" "file://%u"
"-set" "Description" "Thumbnail of file://%u"
"-set" "Software" (string-replace "\n" " " (emacs-version))
"-thumbnail" "%wx%h>" "png:%t")))
(if (executable-find "gm") (cons "convert" opts) opts))
"Options for creating thumbnails according to the Thumbnail Managing Standard.
Used with `image-dired-cmd-create-thumbnail-program', if that is available.
The value can use the same %-format specifiers as in
`image-dired-cmd-create-thumbnail-options', with \"%m\" for file
modification time.
modification time and \"%u\" for the URI of the file in \"%f\".
On MS-Windows, if the `convert' command is not available, and
`w32image-create-thumbnail' is used instead, the textual chunks
specified by the \"-set\" options will not be injected, and instead
@ -196,6 +201,12 @@ and %v which is replaced by the tag value."
;;; Util functions
(defun image-dired--file-URI (file)
;; https://en.wikipedia.org/wiki/File_URI_scheme
(if (memq system-type '(windows-nt ms-dos))
(concat "/" file)
file))
(defun image-dired--probe-thumbnail-cmd (cmd)
"Check whether CMD is usable for thumbnail creation."
(cond
@ -327,11 +338,11 @@ on MS-Windows cannot have too many concurrent sub-processes.")
(message "command %S %s" (process-command process)
(string-replace "\n" "" status))
(message "command %S failed with status %s"
process status))
process status)))
(when (or (not (processp process))
(memq (process-status process) '(exit signal)))
(let ((temp (cdr (assq ?q spec))))
(delete-file temp))))))
(delete-file temp)))))
(proc
(if (eq system-type 'windows-nt)
;; See above for the reasons we don't use 'start-process'
@ -385,6 +396,7 @@ on MS-Windows cannot have too many concurrent sub-processes.")
(spec `((?s . ,size) (?w . ,size) (?h . ,size)
(?m . ,modif-time)
(?f . ,original-file)
(?u . ,(image-dired--file-URI original-file))
(?q . ,thumbnail-nq8-file)
(?t . ,thumbnail-file)))
(thumbnail-dir (file-name-directory thumbnail-file))
@ -471,6 +483,7 @@ file is created by Emacs itself."
(spec `((?s . ,size) (?w . ,size) (?h . ,size)
(?m . ,modif-time)
(?f . ,original-file)
(?u . ,(image-dired--file-URI original-file))
(?q . ,thumbnail-nq8-file)
(?t . ,thumbnail-file))))
(cond
@ -611,6 +624,7 @@ default value at the prompt."
(let ((spec
(list
(cons ?f (expand-file-name file))
(cons ?u (image-dired--file-URI (expand-file-name file)))
(cons ?t tag-name)
(cons ?v tag-value))))
(apply #'call-process image-dired-cmd-write-exif-data-program nil nil nil