commit 5efc7b22cecc0cf1e7dd2bbbc26400dba35e33ea (HEAD, refs/remotes/origin/master) Author: Manuel Giraud Date: Thu Jul 27 23:26:30 2023 +0200 Fix image-dired-utils-tests after 83b6a8a5147 (bug#61394) diff --git a/test/lisp/image/image-dired-util-tests.el b/test/lisp/image/image-dired-util-tests.el index 1f3747a82b1..273a32d5dbb 100644 --- a/test/lisp/image/image-dired-util-tests.el +++ b/test/lisp/image/image-dired-util-tests.el @@ -57,20 +57,23 @@ image-dired-thumb-name/image-dired "jpg"))))) (ert-deftest image-dired-thumb-name/per-directory () - (let ((image-dired-thumbnail-storage 'per-directory)) - (should (file-name-absolute-p (image-dired-thumb-name "foo.jpg"))) - (should (file-name-absolute-p (image-dired-thumb-name "/tmp/foo.jpg"))) + (let ((image-dired-thumbnail-storage 'per-directory) + (rel-path "foo.jpg") + (abs-path "/tmp/foo.jpg") + (hash-name (concat (sha1 "foo.jpg") ".jpg"))) + (should (file-name-absolute-p (image-dired-thumb-name rel-path))) + (should (file-name-absolute-p (image-dired-thumb-name abs-path))) (should (equal - (file-name-nondirectory (image-dired-thumb-name "foo.jpg")) - (file-name-nondirectory (image-dired-thumb-name "/tmp/foo.jpg")))) + (file-name-nondirectory (image-dired-thumb-name rel-path)) + (file-name-nondirectory (image-dired-thumb-name abs-path)))) ;; The cdr below avoids the system dependency in the car of the ;; list returned by 'file-name-split': it's "" on Posix systems, ;; but the drive letter on MS-Windows. (should (equal (cdr (file-name-split - (image-dired-thumb-name "/tmp/foo.jpg"))) - '("tmp" ".image-dired" "foo.jpg.thumb.jpg"))) + (image-dired-thumb-name abs-path))) + (list "tmp" ".image-dired" hash-name))) (should (equal (file-name-nondirectory - (image-dired-thumb-name "foo.jpg")) - "foo.jpg.thumb.jpg")))) + (image-dired-thumb-name rel-path)) + hash-name)))) ;;; image-dired-util-tests.el ends here commit 36b6124d810679cc0f23282d51d9bf8b01f26011 Author: Eli Zaretskii Date: Fri Jul 28 09:31:25 2023 +0300 Fix userlock.el and filelock-tests in some rare cases * lisp/userlock.el (userlock--check-content-unchanged): Don't assume 'file-truename' of FILENAME is always non-nil. It could be nil if we are called from a temporary buffer where some Lisp program has forcibly set 'buffer-file-name'. (Bug#64821) * test/src/filelock-tests.el (filelock-tests--fixture): Set 'buffer-file-name' to the true name of the temporary file. Patch by Mattias Engdegård . (filelock-tests-detect-external-change): Quote the file names passed to shell commands. diff --git a/lisp/userlock.el b/lisp/userlock.el index 96de17d54fd..4623608f1db 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -141,8 +141,10 @@ userlock--check-content-unchanged ;; modtime in that buffer, to cater to use case where the ;; file is about to be written to from some buffer that ;; doesn't visit any file, like a temporary buffer. - (with-current-buffer (get-file-buffer (file-truename filename)) - (set-visited-file-modtime)) + (let ((buf (get-file-buffer (file-truename filename)))) + (when buf ; If we cannot find the visiting buffer, punt. + (with-current-buffer buf + (set-visited-file-modtime)))) 'unchanged))))) ;;;###autoload diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index 1f055cfebc6..c5e77f70bb2 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -38,8 +38,12 @@ filelock-tests--fixture Finally, delete the buffer and the test directory." (declare (debug (body))) `(ert-with-temp-directory temp-dir - (let ((name (concat (file-name-as-directory temp-dir) - "userfile")) + (let ((name + ;; Use file-truename for when 'temporary-file-directory' + ;; is a symlink, to make sure 'buffer-file-name' is set + ;; below to a real existing file. + (file-truename (concat (file-name-as-directory temp-dir) + "userfile"))) (create-lockfiles t)) (with-temp-buffer (setq buffer-file-name name @@ -184,7 +188,8 @@ filelock-tests-detect-external-change ;; Just changing the file modification on disk doesn't hurt, ;; because file contents in buffer and on disk look equal. - (shell-command (format "touch %s" (buffer-file-name))) + (shell-command (format "touch %s" + (shell-quote-argument (buffer-file-name)))) (insert "bar") (when cl (filelock-tests--should-be-locked)) @@ -198,7 +203,8 @@ filelock-tests-detect-external-change ;; Changing the file contents on disk hurts when buffer is ;; modified. There shall be a query, which we answer. ;; *Messages* buffer is checked for prompt. - (shell-command (format "echo bar >>%s" (buffer-file-name))) + (shell-command (format "echo bar >>%s" + (shell-quote-argument (buffer-file-name)))) (cl-letf (((symbol-function 'read-char-choice) (lambda (prompt &rest _) (message "%s" prompt) ?y))) (ert-with-message-capture captured-messages commit fd88b6cdd4b070622e46a87ab2d11dc69bd91b38 Author: Tassilo Horn Date: Fri Jul 28 07:07:45 2023 +0200 ; Make doc-viev-imenu-enabled default value a boolean again diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 847601872f5..2f3c453471d 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -216,7 +216,7 @@ doc-view-mupdf-use-svg :type 'boolean :version "30.1") -(defcustom doc-view-imenu-enabled (executable-find "mutool") +(defcustom doc-view-imenu-enabled (and (executable-find "mutool") t) "Whether to generate an imenu outline when \"mutool\" is available." :type 'boolean :version "29.1") commit 3443574a66dc05ec78b0f3b15fb7231ce228c713 Author: Eli Zaretskii Date: Thu Jul 27 19:09:33 2023 +0300 ; * lisp/tar-mode.el (tar-header-block-tokenize): Fix logic (bug#64686). diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 4e9843123b0..e4ea95343e0 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -364,112 +364,112 @@ tar-header-block-tokenize (if (and (null link-p) (null disable-slash) (string-match "/\\'" name)) (setq link-p 5)) ; directory - (if (member magic-str '("ustar " "ustar\0")) - (if (equal name "././@LongLink") - ;; Supposedly @LongLink is only used for GNUTAR - ;; format (i.e. "ustar ") but some POSIX Tar files - ;; (with "ustar\0") have been seen using it as well. - ;; This is a GNU Tar long-file-name header. - (let* ((size (tar-parse-octal-integer - string tar-size-offset tar-time-offset)) - ;; The long name is in the next 512-byte block. - ;; We've already moved POS there, when we - ;; computed STRING above. - (name (decode-coding-string - ;; -1 so as to strip the terminating 0 byte. - (buffer-substring pos (+ pos size -1)) coding)) - ;; Tokenize the header of the _real_ file entry, - ;; which is further 512 bytes into the archive. - (descriptor (tar-header-block-tokenize - (+ pos (tar-roundup-512 size)) coding - ;; Don't intuit directories from - ;; the trailing slash, because the - ;; truncated name might by chance end - ;; in a slash. - 'ignore-trailing-slash))) - ;; Fix the descriptor of the real file entry by using - ;; the information from the long name entry. - (cond - ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. - (setf (tar-header-name descriptor) name)) - ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. - (setf (tar-header-link-name descriptor) name)) - (t - (message "Unrecognized GNU Tar @LongLink format"))) - ;; Fix the "link-type" attribute, based on the long name. - (if (and (null (tar-header-link-type descriptor)) - (string-match "/\\'" name)) - (setf (tar-header-link-type descriptor) 5)) ; directory - (setf (tar-header-header-start descriptor) - (copy-marker (- pos 512) t)) - descriptor) - ;; Posix pax extended header. FIXME: support ?g as well. - (if (eq link-p (- ?x ?0)) - ;; Get whatever attributes are in the extended header, - (let* ((pax-attrs (tar-parse-pax-extended-header pos)) - (gid (pax-header-gid pax-attrs)) - (gname (pax-header-gname pax-attrs)) - (linkpath (pax-header-linkpath pax-attrs)) - (mtime (pax-header-mtime pax-attrs)) - (path (pax-header-path pax-attrs)) - (size (pax-header-size pax-attrs)) - (uid (pax-header-uid pax-attrs)) - (uname (pax-header-uname pax-attrs)) - ;; Tokenize the header of the _real_ file entry, - ;; which is further 512 bytes into the archive. - (descriptor - (tar-header-block-tokenize (+ pos 512) coding - 'ignore-trailing-slash))) - ;; Fix the descriptor of the real file entry by - ;; overriding some of the fields with the information - ;; from the extended header. - (if gid - (setf (tar-header-gid descriptor) gid)) - (if gname - (setf (tar-header-gname descriptor) gname)) - (if linkpath - (setf (tar-header-link-name descriptor) linkpath)) - (if mtime - (setf (tar-header-date descriptor) mtime)) - (if path - (setf (tar-header-name descriptor) path)) - (if size - (setf (tar-header-size descriptor) size)) - (if uid - (setf (tar-header-uid descriptor) uid)) - (if uname - (setf (tar-header-uname descriptor) uname)) - descriptor) - - (make-tar-header - (copy-marker pos nil) - name - (tar-parse-octal-integer string tar-mode-offset - tar-uid-offset) - (tar-parse-octal-integer string tar-uid-offset - tar-gid-offset) - (tar-parse-octal-integer string tar-gid-offset - tar-size-offset) - (tar-parse-octal-integer string tar-size-offset - tar-time-offset) - (tar-parse-octal-integer string tar-time-offset - tar-chk-offset) - (tar-parse-octal-integer string tar-chk-offset - tar-linkp-offset) - link-p - linkname - uname-valid-p - (when uname-valid-p - (decode-coding-string - (substring string tar-uname-offset uname-end) coding)) - (when uname-valid-p - (decode-coding-string - (substring string tar-gname-offset gname-end) coding)) - (tar-parse-octal-integer string tar-dmaj-offset - tar-dmin-offset) - (tar-parse-octal-integer string tar-dmin-offset - tar-prefix-offset) - )))))))) + (if (and (equal name "././@LongLink") + ;; Supposedly @LongLink is only used for GNUTAR + ;; format (i.e. "ustar ") but some POSIX Tar files + ;; (with "ustar\0") have been seen using it as well. + (member magic-str '("ustar " "ustar\0"))) + (let* ((size (tar-parse-octal-integer + string tar-size-offset tar-time-offset)) + ;; The long name is in the next 512-byte block. + ;; We've already moved POS there, when we + ;; computed STRING above. + (name (decode-coding-string + ;; -1 so as to strip the terminating 0 byte. + (buffer-substring pos (+ pos size -1)) coding)) + ;; Tokenize the header of the _real_ file entry, + ;; which is further 512 bytes into the archive. + (descriptor (tar-header-block-tokenize + (+ pos (tar-roundup-512 size)) coding + ;; Don't intuit directories from + ;; the trailing slash, because the + ;; truncated name might by chance end + ;; in a slash. + 'ignore-trailing-slash))) + ;; Fix the descriptor of the real file entry by using + ;; the information from the long name entry. + (cond + ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. + (setf (tar-header-name descriptor) name)) + ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. + (setf (tar-header-link-name descriptor) name)) + (t + (message "Unrecognized GNU Tar @LongLink format"))) + ;; Fix the "link-type" attribute, based on the long name. + (if (and (null (tar-header-link-type descriptor)) + (string-match "/\\'" name)) + (setf (tar-header-link-type descriptor) 5)) ; directory + (setf (tar-header-header-start descriptor) + (copy-marker (- pos 512) t)) + descriptor) + ;; Posix pax extended header. FIXME: support ?g as well. + (if (and (eq link-p (- ?x ?0)) + (member magic-str '("ustar " "ustar\0"))) + ;; Get whatever attributes are in the extended header, + (let* ((pax-attrs (tar-parse-pax-extended-header pos)) + (gid (pax-header-gid pax-attrs)) + (gname (pax-header-gname pax-attrs)) + (linkpath (pax-header-linkpath pax-attrs)) + (mtime (pax-header-mtime pax-attrs)) + (path (pax-header-path pax-attrs)) + (size (pax-header-size pax-attrs)) + (uid (pax-header-uid pax-attrs)) + (uname (pax-header-uname pax-attrs)) + ;; Tokenize the header of the _real_ file entry, + ;; which is further 512 bytes into the archive. + (descriptor + (tar-header-block-tokenize (+ pos 512) coding + 'ignore-trailing-slash))) + ;; Fix the descriptor of the real file entry by + ;; overriding some of the fields with the information + ;; from the extended header. + (if gid + (setf (tar-header-gid descriptor) gid)) + (if gname + (setf (tar-header-gname descriptor) gname)) + (if linkpath + (setf (tar-header-link-name descriptor) linkpath)) + (if mtime + (setf (tar-header-date descriptor) mtime)) + (if path + (setf (tar-header-name descriptor) path)) + (if size + (setf (tar-header-size descriptor) size)) + (if uid + (setf (tar-header-uid descriptor) uid)) + (if uname + (setf (tar-header-uname descriptor) uname)) + descriptor) + + (make-tar-header + (copy-marker pos nil) + name + (tar-parse-octal-integer string tar-mode-offset + tar-uid-offset) + (tar-parse-octal-integer string tar-uid-offset + tar-gid-offset) + (tar-parse-octal-integer string tar-gid-offset + tar-size-offset) + (tar-parse-octal-integer string tar-size-offset + tar-time-offset) + (tar-parse-octal-integer string tar-time-offset + tar-chk-offset) + (tar-parse-octal-integer string tar-chk-offset + tar-linkp-offset) + link-p + linkname + uname-valid-p + (when uname-valid-p + (decode-coding-string + (substring string tar-uname-offset uname-end) coding)) + (when uname-valid-p + (decode-coding-string + (substring string tar-gname-offset gname-end) coding)) + (tar-parse-octal-integer string tar-dmaj-offset + tar-dmin-offset) + (tar-parse-octal-integer string tar-dmin-offset + tar-prefix-offset) + ))))))) ;; Pseudo-field. (defun tar-header-data-end (descriptor) commit 024bd1f09099ae186442001a75e578638070e296 Author: Mattias Engdegård Date: Thu Jul 27 16:13:54 2023 +0200 Fix function help for advised aliases (bug#64797) * lisp/help-fns.el (help-fns--analyze-function): For aliases, use the base function name if at the end of the chain. This fixes a regression introduced in d30fde6b0cc. Reported by Michael Heerdegen. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b9388b45397..3dd5c790157 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1003,7 +1003,8 @@ help-fns--analyze-function (symbol-name function))))))) (real-def (cond ((and aliased (not (subrp def))) - (car (function-alias-p real-function))) + (or (car (function-alias-p real-function)) + real-function)) ((subrp def) (intern (subr-name def))) (t def)))) commit 4336d7e44af28c662714f76cd62b857942f61c09 Author: Mattias Engdegård Date: Thu Jul 27 09:55:43 2023 +0200 * lisp/emacs-lisp/byte-opt.el (byte-compile-trueconstp): Extend Add skip-chars-forward, skip-chars-backward, skip-syntax-forward, skip-syntax-backward, current-column, current-indentation, char-syntax, syntax-class-to-char, parse-partial-sexp, goto-char, forward-line, next-window, previous-window, minibuffer-window, selected-frame, selected-window, standard-case-table, standard-syntax-table, syntax-table, frame-first-window, frame-root-window and frame-selected-window as always-true functions. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3005d69ae88..c7d8531a870 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -786,6 +786,17 @@ byte-compile-trueconstp make-marker copy-marker point-marker mark-marker set-marker kbd key-description + skip-chars-forward skip-chars-backward + skip-syntax-forward skip-syntax-backward + current-column current-indentation + char-syntax syntax-class-to-char + parse-partial-sexp goto-char forward-line + next-window previous-window minibuffer-window + selected-frame selected-window + standard-case-table standard-syntax-table + syntax-table + frame-first-window frame-root-window + frame-selected-window always)) t) ((eq head 'if) commit 93eccb5e040c8fff4c4527819888e01683df5aaa Author: Mattias Engdegård Date: Thu Jul 27 11:51:26 2023 +0200 Better compilation of char-before, backward-char and backward-word Implement char-before, backward-char and backward-word as compiler macros instead of byte-compile handlers so that the source-level optimiser gets to simplify the result. In particular, this removes some branches. * lisp/emacs-lisp/bytecomp.el (byte-compile-char-before) (byte-compile-backward-char, byte-compile-backward-word): Remove. (bytecomp--char-before, bytecomp--backward-char) (bytecomp--backward-word): New. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 489a9724fc4..5b1d958e6c2 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4306,9 +4306,6 @@ byte-compile-min-max ;; more complicated compiler macros -(byte-defop-compiler char-before) -(byte-defop-compiler backward-char) -(byte-defop-compiler backward-word) (byte-defop-compiler list) (byte-defop-compiler concat) (byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to) @@ -4319,40 +4316,6 @@ function (byte-defop-compiler (/ byte-quo) byte-compile-quo) (byte-defop-compiler nconc) -;; Is this worth it? Both -before and -after are written in C. -(defun byte-compile-char-before (form) - (cond ((or (= 1 (length form)) - (and (= 2 (length form)) (not (nth 1 form)))) - (byte-compile-form '(char-after (1- (point))))) - ((= 2 (length form)) - (byte-compile-form (list 'char-after (if (numberp (nth 1 form)) - (1- (nth 1 form)) - `(1- (or ,(nth 1 form) - (point))))))) - (t (byte-compile-subr-wrong-args form "0-1")))) - -;; backward-... ==> forward-... with negated argument. -;; Is this worth it? Both -backward and -forward are written in C. -(defun byte-compile-backward-char (form) - (cond ((or (= 1 (length form)) - (and (= 2 (length form)) (not (nth 1 form)))) - (byte-compile-form '(forward-char -1))) - ((= 2 (length form)) - (byte-compile-form (list 'forward-char (if (numberp (nth 1 form)) - (- (nth 1 form)) - `(- (or ,(nth 1 form) 1)))))) - (t (byte-compile-subr-wrong-args form "0-1")))) - -(defun byte-compile-backward-word (form) - (cond ((or (= 1 (length form)) - (and (= 2 (length form)) (not (nth 1 form)))) - (byte-compile-form '(forward-word -1))) - ((= 2 (length form)) - (byte-compile-form (list 'forward-word (if (numberp (nth 1 form)) - (- (nth 1 form)) - `(- (or ,(nth 1 form) 1)))))) - (t (byte-compile-subr-wrong-args form "0-1")))) - (defun byte-compile-list (form) (let ((count (length (cdr form)))) (cond ((= count 0) @@ -5797,6 +5760,28 @@ bytecomp--check-memq-args (put 'remq 'compiler-macro #'bytecomp--check-memq-args) (put 'delq 'compiler-macro #'bytecomp--check-memq-args) +;; Implement `char-before', `backward-char' and `backward-word' in +;; terms of `char-after', `forward-char' and `forward-word' which have +;; their own byte-ops. + +(put 'char-before 'compiler-macro #'bytecomp--char-before) +(defun bytecomp--char-before (form &optional arg &rest junk-args) + (if junk-args + form ; arity error + `(char-after (1- (or ,arg (point)))))) + +(put 'backward-char 'compiler-macro #'bytecomp--backward-char) +(defun bytecomp--backward-char (form &optional arg &rest junk-args) + (if junk-args + form ; arity error + `(forward-char (- (or ,arg 1))))) + +(put 'backward-word 'compiler-macro #'bytecomp--backward-word) +(defun bytecomp--backward-word (form &optional arg &rest junk-args) + (if junk-args + form ; arity error + `(forward-word (- (or ,arg 1))))) + (provide 'byte-compile) (provide 'bytecomp) commit e055c635b0d73efe3826e418690a3d91eee69647 Merge: 42a911c61e6 83b6a8a5147 Author: Michael Albinus Date: Thu Jul 27 16:52:38 2023 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 42a911c61e67caa807750cd40887b729f09aaf52 Author: Andrew Tropin Date: Thu Jul 27 16:43:17 2023 +0200 notifications: Allow to use Icon Naming Specification for app-icon * doc/lispref/os.texi (Desktop Notifications): Extend meaning of :app-icon. * etc/NEWS: Allow to use Icon Naming Specification for app-icon in notifications-notify. * lisp/notifications.el (notifications-notify): Allow to use Icon Naming Specification for app-icon. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 4bcc9d5fea6..ebedfe82087 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2885,6 +2885,13 @@ Desktop Notifications @item :app-icon @var{icon-file} The file name of the notification icon. If set to @code{nil}, no icon is displayed. The default is @code{notifications-application-icon}. +If the value is a string, the function interprets it as a file name +and converts to absolute by using @code{expand-file-name}; if it is a +symbol, the function will use its name (which is useful when using the +Icon Naming Specification @footnote{For more information about icon +naming convention see +@uref{https://specifications.freedesktop.org/icon-naming-spec/icon-naming-spec-latest.html, +Icon Naming Specification}}). @item :actions (@var{key} @var{title} @var{key} @var{title} ...) A list of actions to be applied. @var{key} and @var{title} are both diff --git a/etc/NEWS b/etc/NEWS index d0dab755212..44ffbaf78f2 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -567,6 +567,16 @@ Similarly to buffer restoration by Desktop, 'recentf-mode' checking of the accessibility of remote files can now time out if 'remote-file-name-access-timeout' is set to a positive number. +** Notifications + ++++ +*** Allow to use Icon Naming Specification for app-icon +You can use a symbol as the value for ':app-icon' to provide icon name +without specifying a file, like this: + + (notifications-notify + :title "I am playing music" :app-icon 'multimedia-player) + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/notifications.el b/lisp/notifications.el index 984ddbec5e9..a694b38e52e 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -137,6 +137,12 @@ notifications-notify :app-icon The notification icon. Default is `notifications-application-icon'. Set to nil if you do not want any icon displayed. + If the value is a string, the function + interprets it as a file name and converts to + absolute by using `expand-file-name'; if it is a + symbol, the function will use its name (which is + useful when using the Icon Naming + Specification). :actions A list of actions in the form: (KEY TITLE KEY TITLE ...) where KEY and TITLE are both strings. @@ -304,7 +310,10 @@ notifications-notify notifications-application-name) :uint32 (or replaces-id 0) :string (if app-icon - (expand-file-name app-icon) + (if (stringp app-icon) + (expand-file-name app-icon) + ;; Convert symbol to string + (symbol-name app-icon)) ;; If app-icon is nil because user ;; requested it to be so, send the ;; empty string commit 83b6a8a514727ebba0c05e161f90d17270ddeccd Author: Manuel Giraud Date: Sat Feb 25 19:27:07 2023 +0100 New option 'image-dired-thumb-naming' (bug#61394) * lisp/image/image-dired.el (image-dired-thumb-naming): New user option to control thumbnail name. * lisp/image/image-dired-util.el (image-dired-thumb-name): Update to use new user option and compute contents SHA-1 if needed. (image-dired-contents-sha1): New function to compute the SHA-1 of the first 4KiB of a file. diff --git a/etc/NEWS b/etc/NEWS index d0dab755212..a8e7d97df7e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -567,6 +567,11 @@ Similarly to buffer restoration by Desktop, 'recentf-mode' checking of the accessibility of remote files can now time out if 'remote-file-name-access-timeout' is set to a positive number. +** Image Dired + +*** New user option 'image-dired-thumb-naming'. +You can now configure how a thumbnail is named using this option. + * New Modes and Packages in Emacs 30.1 diff --git a/lisp/image/image-dired-util.el b/lisp/image/image-dired-util.el index a80b3afc0f3..3f6880fc807 100644 --- a/lisp/image/image-dired-util.el +++ b/lisp/image/image-dired-util.el @@ -30,6 +30,7 @@ (eval-when-compile (require 'cl-lib)) (defvar image-dired-dir) +(defvar image-dired-thumb-naming) (defvar image-dired-thumbnail-storage) (defconst image-dired--thumbnail-standard-sizes @@ -57,42 +58,59 @@ image-dired-dir (message "Thumbnail directory created: %s" image-dired-dir)) image-dired-dir)) +(defun image-dired-contents-sha1 (filename) + "Compute the SHA-1 of the first 4KiB of FILENAME's contents." + (with-temp-buffer + (insert-file-contents-literally filename nil 0 4096) + (sha1 (current-buffer)))) + (defun image-dired-thumb-name (file) "Return absolute file name for thumbnail FILE. -Depending on the value of `image-dired-thumbnail-storage', the -file name of the thumbnail will vary: -- For `use-image-dired-dir', make a SHA1-hash of the image file's - directory name and add that to make the thumbnail file name - unique. -- For `per-directory' storage, just add a subdirectory. -- For `standard' storage, produce the file name according to the - Thumbnail Managing Standard. Among other things, an MD5-hash - of the image file's directory name will be added to the - filename. -See also `image-dired-thumbnail-storage'." +Depending on the value of `image-dired-thumbnail-storage' and +`image-dired-thumb-naming', the file name of the thumbnail will +vary: + +- If `image-dired-thumbnail-storage' is set to one of the value + of `image-dired--thumbnail-standard-sizes', produce the file + name according to the Thumbnail Managing Standard. Among other + things, an MD5-hash of the image file's directory name will be + added to the file name. + +- Otherwise `image-dired-thumbnail-storage' is used to set the + directory where to store the thumbnail. In this latter case + the name given to the thumbnail depends on the value of + `image-dired-thumb-naming'. + +See also `image-dired-thumbnail-storage' and +`image-dired-thumb-naming'." (let ((file (expand-file-name file))) - (cond ((memq image-dired-thumbnail-storage - image-dired--thumbnail-standard-sizes) - (let ((thumbdir (cl-case image-dired-thumbnail-storage - (standard "thumbnails/normal") - (standard-large "thumbnails/large") - (standard-x-large "thumbnails/x-large") - (standard-xx-large "thumbnails/xx-large")))) - (expand-file-name - ;; MD5 is mandated by the Thumbnail Managing Standard. - (concat (md5 (concat "file://" file)) ".png") - (expand-file-name thumbdir (xdg-cache-home))))) - ((or (eq 'image-dired image-dired-thumbnail-storage) - ;; Maintained for backwards compatibility: - (eq 'use-image-dired-dir image-dired-thumbnail-storage)) - (expand-file-name (format "%s.jpg" (sha1 file)) - (image-dired-dir))) - ((eq 'per-directory image-dired-thumbnail-storage) - (expand-file-name (format "%s.thumb.jpg" - (file-name-nondirectory file)) - (expand-file-name - ".image-dired" - (file-name-directory file))))))) + (if (memq image-dired-thumbnail-storage + image-dired--thumbnail-standard-sizes) + (let ((thumbdir (cl-case image-dired-thumbnail-storage + (standard "thumbnails/normal") + (standard-large "thumbnails/large") + (standard-x-large "thumbnails/x-large") + (standard-xx-large "thumbnails/xx-large")))) + (expand-file-name + ;; MD5 and PNG is mandated by the Thumbnail Managing + ;; Standard. + (concat (md5 (concat "file://" file)) ".png") + (expand-file-name thumbdir (xdg-cache-home)))) + (let ((name (if (eq 'sha1-contents image-dired-thumb-naming) + (image-dired-contents-sha1 file) + ;; Defaults to SHA-1 of file name + (if (eq 'per-directory image-dired-thumbnail-storage) + (sha1 (file-name-nondirectory file)) + (sha1 file))))) + (cond ((or (eq 'image-dired image-dired-thumbnail-storage) + ;; Maintained for backwards compatibility: + (eq 'use-image-dired-dir image-dired-thumbnail-storage)) + (expand-file-name (format "%s.jpg" name) (image-dired-dir))) + ((eq 'per-directory image-dired-thumbnail-storage) + (expand-file-name (format "%s.jpg" name) + (expand-file-name + ".image-dired" + (file-name-directory file))))))))) (defvar image-dired-thumbnail-buffer "*image-dired*" "Image-Dired's thumbnail buffer.") diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index b13b3e08ce2..96a0c2ef9bc 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -162,8 +162,27 @@ image-dired-dir `image-dired-thumbnail-storage'." :type 'directory) +(defcustom image-dired-thumb-naming 'sha1-filename + "How `image-dired' names thumbnail files. +When set to `sha1-filename' the name of thumbnail is built by +computing the SHA-1 of the full file name of the image. + +When set to `sha1-contents' the name of thumbnail is built by +computing the SHA-1 of first 4KiB of the image contents (See +`image-dired-contents-sha1'). + +In both case, a \"jpg\" extension is appended to save as JPEG. + +The value of this option is ignored if Image-Dired is customized +to use the Thumbnail Managing Standard. See +`image-dired-thumbnail-storage'." + :type '(choice :tag "How to name thumbnail files" + (const :tag "SHA-1 of the image file name" sha1-filename) + (const :tag "SHA-1 of the image contents" sha1-contents)) + :version "30.1") + (defcustom image-dired-thumbnail-storage 'image-dired - "How `image-dired' stores thumbnail files. + "Where `image-dired' stores thumbnail files. There are three ways that Image-Dired can store and generate thumbnails: @@ -189,6 +208,9 @@ image-dired-thumbnail-storage Set this user option to `per-directory'. +To control the naming of thumbnails for alternatives (2) and (3) +above, customize the value of `image-dired-thumb-naming'. + To control the default size of thumbnails for alternatives (2) and (3) above, customize the value of `image-dired-thumb-size'. @@ -197,7 +219,7 @@ image-dired-thumbnail-storage For more information on the Thumbnail Managing Standard, see: https://specifications.freedesktop.org/thumbnail-spec/thumbnail-spec-latest.html" - :type '(choice :tag "How to store thumbnail files" + :type '(choice :tag "Where to store thumbnail files" (const :tag "Use image-dired-dir" image-dired) (const :tag "Thumbnail Managing Standard (normal 128x128)" standard) commit 7ea3f39deec3d54914077455e70605a14eb7d200 Author: Eli Zaretskii Date: Thu Jul 27 15:34:38 2023 +0300 Avoid crashes due to invalid 'mode-line-format' * src/xdisp.c (display_mode_element, redisplay_window_error): Don't take XCAR of what can be Qnil. (Bug#64893) diff --git a/src/xdisp.c b/src/xdisp.c index e061b602e0d..aa49749edf9 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17644,6 +17644,7 @@ redisplay_window_error (Lisp_Object error_data) if (max_redisplay_ticks > 0 && CONSP (error_data) && EQ (XCAR (error_data), Qerror) + && CONSP (XCDR (error_data)) && STRINGP (XCAR (XCDR (error_data)))) Vdelayed_warnings_list = Fcons (list2 (XCAR (error_data), XCAR (XCDR (error_data))), @@ -27179,7 +27180,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, oprops = Fcopy_sequence (oprops); tem = props; - while (CONSP (tem)) + while (CONSP (tem) && CONSP (XCDR (tem))) { oprops = plist_put (oprops, XCAR (tem), XCAR (XCDR (tem))); commit 184fc9b0200cf991c250bb3d6b158eaea2ee7806 Author: Michael Albinus Date: Thu Jul 27 13:36:48 2023 +0200 Fix problem with null-device in Tramp * lisp/net/tramp-sh.el (tramp-sh-handle-expand-file-name): `null-device' could be nil. Reported by Richard Copley . diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3ab58c2722e..0cb953e2d80 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2715,7 +2715,8 @@ tramp-sh-handle-expand-file-name ;; there could be the false positive "/:". (if (or (and (eq system-type 'windows-nt) (string-match-p - (rx bol (| (: alpha ":") (: (literal null-device) eol))) name)) + (rx bol (| (: alpha ":") (: (literal (or null-device "")) eol))) + name)) (and (not (tramp-tramp-file-p name)) (not (tramp-tramp-file-p dir)))) (tramp-run-real-handler #'expand-file-name (list name dir)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 53a80c41680..8b574c4ce93 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -7049,5 +7049,7 @@ tramp-get-remote-null-device ;; "/ssh:user1@host:~user2". ;; ;; * Implement file name abbreviation for user and host names. +;; +;; * Implement user and host name completion for multi-hops. ;;; tramp.el ends here commit 2dc5f17c3ecf6864fdcb8ebae73c02a8d04c415a Author: Eli Zaretskii Date: Thu Jul 27 11:36:00 2023 +0300 Support Posix-standard pax extended header in tar files * lisp/tar-mode.el (pax-extended-attribute-record-regexp) (tar-attr-vector): New variables. (pax-gid-index, pax-gname-index, pax-linkpath-index) (pax-mtime-index, pax-path-index, pax-size-index, pax-uid-index) (pax-uname-index): New constants. (pax-header-gid, pax-header-gname, pax-header-linkpath) (pax-header-mtime, pax-header-path, pax-header-size) (pax-header-uid, pax-header-uname): New accessors to pax header. (pax-decode-string, tar-parse-pax-extended-header): New functions. (tar-header-block-tokenize): Recognize and handle Posix-standard pax extended header, and use its attributes instead of those in the standard tar header. (Bug#64686) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index c9206028e94..4e9843123b0 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -215,6 +215,99 @@ tar-roundup-512 "Round S up to the next multiple of 512." (ash (ash (+ s 511) -9) 9)) +;; Reference: +;; https://pubs.opengroup.org/onlinepubs/9699919799/utilities/pax.html#tag_20_92_13_02 +(defconst pax-extended-attribute-record-regexp + ;; We omit attributes that are "reserved" by Posix, since no + ;; processing has been defined for them. + "\\([0-9]+\\) \\(gid\\|gname\\|hdrcharset\\|linkpath\\|mtime\\|path\\|size\\|uid\\|uname\\)=" + "Regular expression for looking up extended attributes in a +Posix-standard pax extended header of a tar file. +Only attributes that `tar-mode' can grok are mentioned.") + +(defconst pax-gid-index 0) +(defconst pax-gname-index 1) +(defconst pax-linkpath-index 2) +(defconst pax-mtime-index 3) +(defconst pax-path-index 4) +(defconst pax-size-index 5) +(defconst pax-uid-index 6) +(defconst pax-uname-index 7) +(defsubst pax-header-gid (attr-vec) + (aref attr-vec pax-gid-index)) +(defsubst pax-header-gname (attr-vec) + (aref attr-vec pax-gname-index)) +(defsubst pax-header-linkpath (attr-vec) + (aref attr-vec pax-linkpath-index)) +(defsubst pax-header-mtime (attr-vec) + (aref attr-vec pax-mtime-index)) +(defsubst pax-header-path (attr-vec) + (aref attr-vec pax-path-index)) +(defsubst pax-header-size (attr-vec) + (aref attr-vec pax-size-index)) +(defsubst pax-header-uid (attr-vec) + (aref attr-vec pax-uid-index)) +(defsubst pax-header-uname (attr-vec) + (aref attr-vec pax-uid-index)) + +(defsubst pax-decode-string (str coding) + (if str + (decode-coding-string str coding) + str)) + +(defvar tar-attr-vector '[nil nil nil nil nil nil nil nil]) +(defun tar-parse-pax-extended-header (pos) + "Parse a pax external header of a Posix-format tar file." + (let ((end (+ pos 512)) + (result tar-attr-vector) + (coding 'utf-8-unix) + attr value record-len value-len) + (dotimes (i 8) + (aset result i nil)) + (goto-char pos) + (while (and (< pos end) + (re-search-forward pax-extended-attribute-record-regexp + end 'move)) + (setq record-len (string-to-number (match-string 1)) + attr (match-string 2) + value-len (- record-len + (length (match-string 1)) + 1 + (length (match-string 2)) + 2) + value (buffer-substring (point) (+ (point) value-len))) + (setq pos (goto-char (+ (point) value-len 1))) + (cond + ((equal attr "gid") + (aset result pax-gid-index value)) + ((equal attr "gname") + (aset result pax-gname-index value)) + ((equal attr "linkpath") + (aset result pax-linkpath-index value)) + ((equal attr "mtime") + (aset result pax-mtime-index (string-to-number value))) + ((equal attr "path") + (aset result pax-path-index value)) + ((equal attr "size") + (aset result pax-size-index value)) + ((equal attr "uid") + (aset result pax-uid-index value)) + ((equal attr "uname") + (aset result pax-uname-index value)) + ((equal attr "hdrcharset") + (setq coding (if (equal value "BINARY") 'no-conversion 'utf-8-unix)))) + (setq pos (+ pos (skip-chars-forward "\000")))) + ;; Decode string-valued attributes. + (aset result pax-gname-index + (pax-decode-string (aref result pax-gname-index) coding)) + (aset result pax-linkpath-index + (pax-decode-string (aref result pax-linkpath-index) coding)) + (aset result pax-path-index + (pax-decode-string (aref result pax-path-index) coding)) + (aset result pax-uname-index + (pax-decode-string (aref result pax-uname-index) coding)) + result)) + (defun tar-header-block-tokenize (pos coding &optional disable-slash) "Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, @@ -271,67 +364,112 @@ tar-header-block-tokenize (if (and (null link-p) (null disable-slash) (string-match "/\\'" name)) (setq link-p 5)) ; directory - (if (and (equal name "././@LongLink") - ;; Supposedly @LongLink is only used for GNUTAR - ;; format (i.e. "ustar ") but some POSIX Tar files - ;; (with "ustar\0") have been seen using it as well. - (member magic-str '("ustar " "ustar\0"))) - ;; This is a GNU Tar long-file-name header. - (let* ((size (tar-parse-octal-integer - string tar-size-offset tar-time-offset)) - ;; The long name is in the next 512-byte block. - ;; We've already moved POS there, when we computed - ;; STRING above. - (name (decode-coding-string - ;; -1 so as to strip the terminating 0 byte. - (buffer-substring pos (+ pos size -1)) coding)) - ;; Tokenize the header of the _real_ file entry, - ;; which is further 512 bytes into the archive. - (descriptor (tar-header-block-tokenize - (+ pos (tar-roundup-512 size)) coding - ;; Don't intuit directories from - ;; the trailing slash, because the - ;; truncated name might by chance end - ;; in a slash. - 'ignore-trailing-slash))) - ;; Fix the descriptor of the real file entry by using - ;; the information from the long name entry. - (cond - ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. - (setf (tar-header-name descriptor) name)) - ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. - (setf (tar-header-link-name descriptor) name)) - (t - (message "Unrecognized GNU Tar @LongLink format"))) - ;; Fix the "link-type" attribute, based on the long name. - (if (and (null (tar-header-link-type descriptor)) - (string-match "/\\'" name)) - (setf (tar-header-link-type descriptor) 5)) ; directory - (setf (tar-header-header-start descriptor) - (copy-marker (- pos 512) t)) - descriptor) - - (make-tar-header - (copy-marker pos nil) - name - (tar-parse-octal-integer string tar-mode-offset tar-uid-offset) - (tar-parse-octal-integer string tar-uid-offset tar-gid-offset) - (tar-parse-octal-integer string tar-gid-offset tar-size-offset) - (tar-parse-octal-integer string tar-size-offset tar-time-offset) - (tar-parse-octal-integer string tar-time-offset tar-chk-offset) - (tar-parse-octal-integer string tar-chk-offset tar-linkp-offset) - link-p - linkname - uname-valid-p - (when uname-valid-p - (decode-coding-string - (substring string tar-uname-offset uname-end) coding)) - (when uname-valid-p - (decode-coding-string - (substring string tar-gname-offset gname-end) coding)) - (tar-parse-octal-integer string tar-dmaj-offset tar-dmin-offset) - (tar-parse-octal-integer string tar-dmin-offset tar-prefix-offset) - )))))) + (if (member magic-str '("ustar " "ustar\0")) + (if (equal name "././@LongLink") + ;; Supposedly @LongLink is only used for GNUTAR + ;; format (i.e. "ustar ") but some POSIX Tar files + ;; (with "ustar\0") have been seen using it as well. + ;; This is a GNU Tar long-file-name header. + (let* ((size (tar-parse-octal-integer + string tar-size-offset tar-time-offset)) + ;; The long name is in the next 512-byte block. + ;; We've already moved POS there, when we + ;; computed STRING above. + (name (decode-coding-string + ;; -1 so as to strip the terminating 0 byte. + (buffer-substring pos (+ pos size -1)) coding)) + ;; Tokenize the header of the _real_ file entry, + ;; which is further 512 bytes into the archive. + (descriptor (tar-header-block-tokenize + (+ pos (tar-roundup-512 size)) coding + ;; Don't intuit directories from + ;; the trailing slash, because the + ;; truncated name might by chance end + ;; in a slash. + 'ignore-trailing-slash))) + ;; Fix the descriptor of the real file entry by using + ;; the information from the long name entry. + (cond + ((eq link-p (- ?L ?0)) ;GNUTYPE_LONGNAME. + (setf (tar-header-name descriptor) name)) + ((eq link-p (- ?K ?0)) ;GNUTYPE_LONGLINK. + (setf (tar-header-link-name descriptor) name)) + (t + (message "Unrecognized GNU Tar @LongLink format"))) + ;; Fix the "link-type" attribute, based on the long name. + (if (and (null (tar-header-link-type descriptor)) + (string-match "/\\'" name)) + (setf (tar-header-link-type descriptor) 5)) ; directory + (setf (tar-header-header-start descriptor) + (copy-marker (- pos 512) t)) + descriptor) + ;; Posix pax extended header. FIXME: support ?g as well. + (if (eq link-p (- ?x ?0)) + ;; Get whatever attributes are in the extended header, + (let* ((pax-attrs (tar-parse-pax-extended-header pos)) + (gid (pax-header-gid pax-attrs)) + (gname (pax-header-gname pax-attrs)) + (linkpath (pax-header-linkpath pax-attrs)) + (mtime (pax-header-mtime pax-attrs)) + (path (pax-header-path pax-attrs)) + (size (pax-header-size pax-attrs)) + (uid (pax-header-uid pax-attrs)) + (uname (pax-header-uname pax-attrs)) + ;; Tokenize the header of the _real_ file entry, + ;; which is further 512 bytes into the archive. + (descriptor + (tar-header-block-tokenize (+ pos 512) coding + 'ignore-trailing-slash))) + ;; Fix the descriptor of the real file entry by + ;; overriding some of the fields with the information + ;; from the extended header. + (if gid + (setf (tar-header-gid descriptor) gid)) + (if gname + (setf (tar-header-gname descriptor) gname)) + (if linkpath + (setf (tar-header-link-name descriptor) linkpath)) + (if mtime + (setf (tar-header-date descriptor) mtime)) + (if path + (setf (tar-header-name descriptor) path)) + (if size + (setf (tar-header-size descriptor) size)) + (if uid + (setf (tar-header-uid descriptor) uid)) + (if uname + (setf (tar-header-uname descriptor) uname)) + descriptor) + + (make-tar-header + (copy-marker pos nil) + name + (tar-parse-octal-integer string tar-mode-offset + tar-uid-offset) + (tar-parse-octal-integer string tar-uid-offset + tar-gid-offset) + (tar-parse-octal-integer string tar-gid-offset + tar-size-offset) + (tar-parse-octal-integer string tar-size-offset + tar-time-offset) + (tar-parse-octal-integer string tar-time-offset + tar-chk-offset) + (tar-parse-octal-integer string tar-chk-offset + tar-linkp-offset) + link-p + linkname + uname-valid-p + (when uname-valid-p + (decode-coding-string + (substring string tar-uname-offset uname-end) coding)) + (when uname-valid-p + (decode-coding-string + (substring string tar-gname-offset gname-end) coding)) + (tar-parse-octal-integer string tar-dmaj-offset + tar-dmin-offset) + (tar-parse-octal-integer string tar-dmin-offset + tar-prefix-offset) + )))))))) ;; Pseudo-field. (defun tar-header-data-end (descriptor) commit b936ff0963e69d30d77cec5323a95bc2385cf212 Author: Michael Albinus Date: Thu Jul 27 09:30:41 2023 +0200 Fix Tramp error on macOS * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Don't use an absolute ControlPath on macOS. (Bug#64880) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f2cbb74acd2..3ab58c2722e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4867,12 +4867,17 @@ tramp-ssh-controlmaster-options " -o ControlPath=" (if (eq tramp-use-connection-share 'suppress) "none" - ;; Hashed tokens are introduced in OpenSSH 6.7. - (expand-file-name - (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C") - "tramp.%%C" "tramp.%%r@%%h:%%p") - (or small-temporary-file-directory - tramp-compat-temporary-file-directory))) + ;; Hashed tokens are introduced in OpenSSH 6.7. On macOS + ;; we cannot use an absolute file name, it is too long. + ;; See Bug#19702. + (if (eq system-type 'darwin) + (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C") + "tramp.%%C" "tramp.%%r@%%h:%%p") + (expand-file-name + (if (tramp-ssh-option-exists-p vec "ControlPath=tramp.%C") + "tramp.%%C" "tramp.%%r@%%h:%%p") + (or small-temporary-file-directory + tramp-compat-temporary-file-directory)))) ;; ControlPersist option is introduced in OpenSSH 5.6. (when (and (not (eq tramp-use-connection-share 'suppress)) commit 5d245e9d0d85bc85bacd701d6fe82620816b2e1f Author: Eli Zaretskii Date: Thu Jul 27 10:28:43 2023 +0300 Fix image-dired-util-tests on MS-Windows * test/lisp/image/image-dired-util-tests.el (image-dired-thumb-name/image-dired) (image-dired-thumb-name/per-directory): Make these tests work on MS-Windows, where a file name such as "/foo/bar" gets added the drive letter when passed through 'expand-file-name'. diff --git a/test/lisp/image/image-dired-util-tests.el b/test/lisp/image/image-dired-util-tests.el index bd3d65bdd3a..1f3747a82b1 100644 --- a/test/lisp/image/image-dired-util-tests.el +++ b/test/lisp/image/image-dired-util-tests.el @@ -47,10 +47,11 @@ image-dired-thumb-name/image-dired (should (equal (file-name-directory (image-dired-thumb-name "foo.jpg")) (file-name-directory (image-dired-thumb-name "/tmp/foo.jpg")))) - (should (equal (file-name-nondirectory - ;; The checksum is based on the file name. - (image-dired-thumb-name "/some/path/foo.jpg")) - "dc4e6f7068157023e7f2e8362d15bdd2e3ca89e4.jpg")) + (should + (let* ((test-fn "/some/path/foo.jpg") + (thumb-fn (image-dired-thumb-name test-fn))) + (equal (file-name-nondirectory thumb-fn) + (concat (sha1 (expand-file-name test-fn)) ".jpg")))) (should (equal (file-name-extension (image-dired-thumb-name "foo.gif")) "jpg"))))) @@ -62,8 +63,12 @@ image-dired-thumb-name/per-directory (should (equal (file-name-nondirectory (image-dired-thumb-name "foo.jpg")) (file-name-nondirectory (image-dired-thumb-name "/tmp/foo.jpg")))) - (should (equal (file-name-split (image-dired-thumb-name "/tmp/foo.jpg")) - '("" "tmp" ".image-dired" "foo.jpg.thumb.jpg"))) + ;; The cdr below avoids the system dependency in the car of the + ;; list returned by 'file-name-split': it's "" on Posix systems, + ;; but the drive letter on MS-Windows. + (should (equal (cdr (file-name-split + (image-dired-thumb-name "/tmp/foo.jpg"))) + '("tmp" ".image-dired" "foo.jpg.thumb.jpg"))) (should (equal (file-name-nondirectory (image-dired-thumb-name "foo.jpg")) "foo.jpg.thumb.jpg"))))