commit c3499b8ddc357544a58917bfd3846f88caf5d97c (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Fri Oct 29 22:07:27 2021 +0300 ; Fix a recent change in image.c * src/image.c (DGifSavedExtensionToGCB): Define only for GIFLIB >= 5. diff --git a/src/image.c b/src/image.c index 6ab9670e4b..1c31bdd3d9 100644 --- a/src/image.c +++ b/src/image.c @@ -8277,8 +8277,8 @@ DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *)); # else DEF_DLL_FN (GifFileType *, DGifOpen, (void *, InputFunc, int *)); DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *, int *)); -DEF_DLL_FN (int, DGifSavedExtensionToGCB, (GifFileType *, int, - GraphicsControlBlock *)); +DEF_DLL_FN (int, DGifSavedExtensionToGCB, + (GifFileType *, int, GraphicsControlBlock *)); # endif # if HAVE_GIFERRORSTRING DEF_DLL_FN (char const *, GifErrorString, (int)); @@ -8309,14 +8309,18 @@ init_gif_functions (void) # undef DGifOpen # undef DGifOpenFileName # undef DGifSlurp -# undef DGifSavedExtensionToGCB +# if GIFLIB_MAJOR >= 5 +# undef DGifSavedExtensionToGCB +# endif # undef GifErrorString # define DGifCloseFile fn_DGifCloseFile # define DGifOpen fn_DGifOpen # define DGifOpenFileName fn_DGifOpenFileName # define DGifSlurp fn_DGifSlurp -# define DGifSavedExtensionToGCB fn_DGifSavedExtensionToGCB +# if GIFLIB_MAJOR >= 5 +# define DGifSavedExtensionToGCB fn_DGifSavedExtensionToGCB +# endif # define GifErrorString fn_GifErrorString # endif /* WINDOWSNT */ commit d9abc45ab53dbed31a5853087a7be21e804d9668 Author: Stefan Kangas Date: Fri Oct 29 20:20:46 2021 +0200 * src/image.c: Fix building with giflib on MS-Windows. diff --git a/src/image.c b/src/image.c index 376a53e967..6ab9670e4b 100644 --- a/src/image.c +++ b/src/image.c @@ -8277,6 +8277,8 @@ DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *)); # else DEF_DLL_FN (GifFileType *, DGifOpen, (void *, InputFunc, int *)); DEF_DLL_FN (GifFileType *, DGifOpenFileName, (const char *, int *)); +DEF_DLL_FN (int, DGifSavedExtensionToGCB, (GifFileType *, int, + GraphicsControlBlock *)); # endif # if HAVE_GIFERRORSTRING DEF_DLL_FN (char const *, GifErrorString, (int)); @@ -8294,6 +8296,9 @@ init_gif_functions (void) LOAD_DLL_FN (library, DGifSlurp); LOAD_DLL_FN (library, DGifOpen); LOAD_DLL_FN (library, DGifOpenFileName); +# if GIFLIB_MAJOR >= 5 + LOAD_DLL_FN (library, DGifSavedExtensionToGCB); +# endif # if HAVE_GIFERRORSTRING LOAD_DLL_FN (library, GifErrorString); # endif @@ -8304,12 +8309,14 @@ init_gif_functions (void) # undef DGifOpen # undef DGifOpenFileName # undef DGifSlurp +# undef DGifSavedExtensionToGCB # undef GifErrorString # define DGifCloseFile fn_DGifCloseFile # define DGifOpen fn_DGifOpen # define DGifOpenFileName fn_DGifOpenFileName # define DGifSlurp fn_DGifSlurp +# define DGifSavedExtensionToGCB fn_DGifSavedExtensionToGCB # define GifErrorString fn_GifErrorString # endif /* WINDOWSNT */ commit 4dd8b2c0861f23a70aaff9d55e35efd5de370ed3 Merge: faa2a990c9 986fe634e2 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 986fe634e2 (origin/emacs-28) Make message/rfc822 on buttons work agai... commit faa2a990c980bfdedbc76520083f1228806f3df2 Merge: 65e71d9a8a 52e7049b58 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 Merge from origin/emacs-28 52e7049b58 * lisp/loadup.el: Unbreak build. 91e7df281e Move lisp/shorthands.el to lisp/emacs-lisp/shorthands.el 00103154e0 Some Tramp changes, mainly in tramp-tests.el commit 65e71d9a8aac231be71992d1011641acab1c1e14 Merge: 1216743042 9436943fb1 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 9436943fb1 ; * doc/emacs/custom.texi (Connection Variables): Fix typo... commit 12167430428af9b9f4f60342914554e862bbc9ad Merge: 3808498440 08de838531 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 Merge from origin/emacs-28 08de838531 ; Improve commentary in the last change 3da9fa875b Make hieroglyphs display correctly with existing fonts 928e05f2d6 Clarify "default face attributes" in the ELisp manual 5dbb04e0eb Make `C-u RET' work again d72fefdeab Fix typos in the manual and in a comment commit 38084984403d60bc2fe53f0875767684bb39fdfe Merge: af22a0a083 bea843dee1 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: bea843dee1 Avoid assertion violations in 'lookup-key' commit af22a0a083304b898edf82a2c8a3d06f8a71eab7 Merge: 18b455f823 f52fa1c150 Author: Glenn Morris Date: Fri Oct 29 09:20:05 2021 -0700 Merge from origin/emacs-28 f52fa1c150 image-dired: Unreverse accidentally reversed menus # Conflicts: # lisp/image-dired.el commit 18b455f823173d9187b9a2e43c6ef1182f47fea2 Merge: 502a00b8b9 0f8417d597 Author: Glenn Morris Date: Fri Oct 29 09:19:51 2021 -0700 ; Merge from origin/emacs-28 The following commit was skipped: 0f8417d597 Be more allowing when looking for menu-bar items commit 502a00b8b91d68ee6cbd0dfec40ac409ec08e67a Merge: 288e8bba81 7e2b973d60 Author: Glenn Morris Date: Fri Oct 29 09:19:51 2021 -0700 Merge from origin/emacs-28 7e2b973d60 * lisp/textmodes/text-mode.el (text-mode-context-menu): Re... da6d889e90 ; * etc/NEWS: Use active voice for 'repeat-mode', etc. e3171e7e86 Allow automatic use of color fonts for emoji on macOS # Conflicts: # etc/NEWS commit 986fe634e2cc8c1f3b6a894c06f7673f37331e6f Author: Lars Ingebrigtsen Date: Fri Oct 29 18:08:12 2021 +0200 Make message/rfc822 on buttons work again in Gnus * lisp/gnus/gnus-art.el (gnus-article-mode): Set mm-inline-message-prepare-function buffer-locally so that it works both when inlining rfc822 and hitting the MIME button (bug#51388). (gnus-mime--inline-message): Factor out into own function. (gnus-mime-display-single): From here. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cdef73135c..cce0fc32b7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4507,6 +4507,9 @@ commands: (gnus-set-default-directory) (buffer-disable-undo) (setq show-trailing-whitespace nil) + ;; Arrange a callback from `mm-inline-message' if we're + ;; displaying a message/rfc822 part. + (setq-local mm-inline-message-prepare-function #'gnus-mime--inline-message) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -6042,31 +6045,29 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-mixed (handles) (mapcar #'gnus-mime-display-part handles)) +(defun gnus-mime--inline-message (handle charset) + (let ((handles + (let (gnus-article-mime-handles + ;; disable prepare hook + gnus-article-prepare-hook + (gnus-newsgroup-charset + ;; mm-uu might set it. + (unless (eq charset 'gnus-decoded) + (or charset gnus-newsgroup-charset)))) + (let ((gnus-original-article-buffer + (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) + (gnus-article-prepare-display) + gnus-article-mime-handles))) + (when handles + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles))))) + (defun gnus-mime-display-single (handle) (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) - ;; Arrange a callback from `mm-inline-message' if we're - ;; displaying a message/rfc822 part. - (mm-inline-message-prepare-function - (lambda (charset) - (let ((handles - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - ;; mm-uu might set it. - (unless (eq charset 'gnus-decoded) - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer - (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - gnus-article-mime-handles))) - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles)))))) display text gnus-displaying-mime) (catch 'ignored diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 56d05c8fa9..d2a6d2cf5d 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -451,7 +451,7 @@ This is only used if `mm-inline-large-images' is set to (defvar mm-inline-message-prepare-function nil "Function called by `mm-inline-message' to do client specific setup. -It is called with one parameter -- the charset.") +It is called with two parameters -- the MIME handle and the charset.") (defun mm-inline-message (handle) "Insert HANDLE (a message/rfc822 part) into the current buffer. @@ -471,7 +471,7 @@ after inserting the part." (narrow-to-region b b) (mm-insert-part handle) (when mm-inline-message-prepare-function - (funcall mm-inline-message-prepare-function charset)) + (funcall mm-inline-message-prepare-function handle charset)) (goto-char (point-min)) (unless bolp (insert "\n")) commit 288e8bba81d9921a9b34627e6641afa74e41b49d Author: Stefan Kangas Date: Fri Oct 29 17:44:29 2021 +0200 Prefer giflib 5 macros to magic numbers * src/image.c (DISPOSAL_UNSPECIFIED, DISPOSE_DO_NOT) (DISPOSE_BACKGROUND, DISPOSE_PREVIOUS, NO_TRANSPARENT_COLOR) [GIFLIB_MAJOR < 5]: Macro defined (for old versions of giflib). (gif_load): Replace magic numbers with giflib 5 macros for disposal and transparency_color_index. diff --git a/src/image.c b/src/image.c index cf0ea6ab39..376a53e967 100644 --- a/src/image.c +++ b/src/image.c @@ -8249,6 +8249,11 @@ gif_image_p (Lisp_Object object) /* Giflib before 5.0 didn't define these macros. */ # ifndef GIFLIB_MAJOR # define GIFLIB_MAJOR 4 +# define DISPOSAL_UNSPECIFIED 0 /* No disposal specified. */ +# define DISPOSE_DO_NOT 1 /* Leave image in place. */ +# define DISPOSE_BACKGROUND 2 /* Set area too background color. */ +# define DISPOSE_PREVIOUS 3 /* Restore to previous content. */ +# define NO_TRANSPARENT_COLOR -1 # endif /* GifErrorString is declared to return char const * when GIFLIB_MAJOR @@ -8574,8 +8579,8 @@ gif_load (struct frame *f, struct image *img) /* From gif89a spec: 1 = "keep in place", 2 = "restore to background". Treat any other value like 2. */ - int disposal = 0; - int transparency_color_index = -1; + int disposal = DISPOSAL_UNSPECIFIED; + int transparency_color_index = NO_TRANSPARENT_COLOR; #if GIFLIB_MAJOR < 5 /* Find the Graphic Control Extension block for this sub-image. @@ -8602,14 +8607,15 @@ gif_load (struct frame *f, struct image *img) /* We can't "keep in place" the first subimage. */ if (j == 0) - disposal = 2; + disposal = DISPOSE_BACKGROUND; - /* For disposal == 0, the spec says "No disposal specified. The - decoder is not required to take any action." In practice, it - seems we need to treat this like "keep in place", see e.g. + /* For disposal == 0 (DISPOSAL_UNSPECIFIED), the spec says + "No disposal specified. The decoder is not required to take + any action." In practice, it seems we need to treat this + like "keep in place" (DISPOSE_DO_NOT), see e.g. https://upload.wikimedia.org/wikipedia/commons/3/37/Clock.gif */ - if (disposal == 0) - disposal = 1; + if (disposal == DISPOSAL_UNSPECIFIED) + disposal = DISPOSE_DO_NOT; gif_color_map = subimage->ImageDesc.ColorMap; if (!gif_color_map) @@ -8648,7 +8654,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; x++) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, row + subimg_top, pixel_colors[c]); @@ -8662,7 +8668,7 @@ gif_load (struct frame *f, struct image *img) for (x = 0; x < subimg_width; ++x) { int c = raster[y * subimg_width + x]; - if (transparency_color_index != c || disposal != 1) + if (transparency_color_index != c || disposal != DISPOSE_DO_NOT) { PUT_PIXEL (ximg, x + subimg_left, y + subimg_top, pixel_colors[c]); commit f9282e1d724f1cb2e239f946957fdf02aa15dcc5 Author: Stefan Kangas Date: Fri Oct 29 17:11:23 2021 +0200 Don't parse GCB block by hand with giflib 5 or later * src/image.c (gif_load): If GIFLIB_MAJOR > 5, use DGifSavedExtensionToGCB instead of parsing the Graphic Control Extension block by hand. diff --git a/src/image.c b/src/image.c index 99533bbd1b..cf0ea6ab39 100644 --- a/src/image.c +++ b/src/image.c @@ -8567,13 +8567,17 @@ gif_load (struct frame *f, struct image *img) char *, which invites problems with bytes >= 0x80. */ struct SavedImage *subimage = gif->SavedImages + j; unsigned char *raster = (unsigned char *) subimage->RasterBits; - int transparency_color_index = -1; - int disposal = 0; int subimg_width = subimage->ImageDesc.Width; int subimg_height = subimage->ImageDesc.Height; int subimg_top = subimage->ImageDesc.Top; int subimg_left = subimage->ImageDesc.Left; + /* From gif89a spec: 1 = "keep in place", 2 = "restore + to background". Treat any other value like 2. */ + int disposal = 0; + int transparency_color_index = -1; + +#if GIFLIB_MAJOR < 5 /* Find the Graphic Control Extension block for this sub-image. Extract the disposal method and transparency color. */ for (i = 0; i < subimage->ExtensionBlockCount; i++) @@ -8584,13 +8588,17 @@ gif_load (struct frame *f, struct image *img) && extblock->ByteCount == 4 && extblock->Bytes[0] & 1) { - /* From gif89a spec: 1 = "keep in place", 2 = "restore - to background". Treat any other value like 2. */ disposal = (extblock->Bytes[0] >> 2) & 7; transparency_color_index = (unsigned char) extblock->Bytes[3]; break; } } +#else + GraphicsControlBlock gcb; + DGifSavedExtensionToGCB (gif, j, &gcb); + disposal = gcb.DisposalMode; + transparency_color_index = gcb.TransparentColor; +#endif /* We can't "keep in place" the first subimage. */ if (j == 0) commit 52e7049b5818c2f71dba66b9e05d9798a2051864 Author: Glenn Morris Date: Fri Oct 29 16:41:11 2021 +0100 * lisp/loadup.el: Unbreak build. diff --git a/lisp/loadup.el b/lisp/loadup.el index 3a55d2c805..e8ecb67d56 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -354,7 +354,7 @@ (load "electric") (load "paren") -(load "shorthands") +(load "emacs-lisp/shorthands") (load "emacs-lisp/eldoc") (load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway) commit 16995fa7c234bda25f9c19b7284842b1ea2febc6 Author: Lars Ingebrigtsen Date: Fri Oct 29 17:26:53 2021 +0200 Make message/rfc822 on buttons work again in Gnus * lisp/gnus/gnus-art.el (gnus-article-mode): Set mm-inline-message-prepare-function buffer-locally so that it works both when inlining rfc822 and hitting the MIME button (bug#51388). (gnus-mime--inline-message): Factor out into own function. (gnus-mime-display-single): From here. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 930c739a73..6b33680871 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4506,6 +4506,10 @@ commands: (gnus-set-default-directory) (buffer-disable-undo) (setq show-trailing-whitespace nil) + ;; Arrange a callback from `mm-inline-message' if we're + ;; displaying a message/rfc822 part. + (setq-local mm-inline-message-prepare-function + #'gnus-mime--inline-message-function) (mm-enable-multibyte)) (defun gnus-article-setup-buffer () @@ -6041,31 +6045,29 @@ If nil, don't show those extra buttons." (defun gnus-mime-display-mixed (handles) (mapcar #'gnus-mime-display-part handles)) +(defun gnus-mime--inline-message-function (handle charset) + (let ((handles + (let (gnus-article-mime-handles + ;; disable prepare hook + gnus-article-prepare-hook + (gnus-newsgroup-charset + ;; mm-uu might set it. + (unless (eq charset 'gnus-decoded) + (or charset gnus-newsgroup-charset)))) + (let ((gnus-original-article-buffer + (mm-handle-buffer handle))) + (run-hooks 'gnus-article-decode-hook)) + (gnus-article-prepare-display) + gnus-article-mime-handles))) + (when handles + (setq gnus-article-mime-handles + (mm-merge-handles gnus-article-mime-handles handles))))) + (defun gnus-mime-display-single (handle) (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) (not-attachment t) - ;; Arrange a callback from `mm-inline-message' if we're - ;; displaying a message/rfc822 part. - (mm-inline-message-prepare-function - (lambda (charset) - (let ((handles - (let (gnus-article-mime-handles - ;; disable prepare hook - gnus-article-prepare-hook - (gnus-newsgroup-charset - ;; mm-uu might set it. - (unless (eq charset 'gnus-decoded) - (or charset gnus-newsgroup-charset)))) - (let ((gnus-original-article-buffer - (mm-handle-buffer handle))) - (run-hooks 'gnus-article-decode-hook)) - (gnus-article-prepare-display) - gnus-article-mime-handles))) - (when handles - (setq gnus-article-mime-handles - (mm-merge-handles gnus-article-mime-handles handles)))))) display text gnus-displaying-mime) (catch 'ignored diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 56d05c8fa9..d2a6d2cf5d 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -451,7 +451,7 @@ This is only used if `mm-inline-large-images' is set to (defvar mm-inline-message-prepare-function nil "Function called by `mm-inline-message' to do client specific setup. -It is called with one parameter -- the charset.") +It is called with two parameters -- the MIME handle and the charset.") (defun mm-inline-message (handle) "Insert HANDLE (a message/rfc822 part) into the current buffer. @@ -471,7 +471,7 @@ after inserting the part." (narrow-to-region b b) (mm-insert-part handle) (when mm-inline-message-prepare-function - (funcall mm-inline-message-prepare-function charset)) + (funcall mm-inline-message-prepare-function handle charset)) (goto-char (point-min)) (unless bolp (insert "\n")) commit 8ada213b878daff6a821f2d583bafe9e1819d895 Author: Morgan J. Smith Date: Fri Oct 29 15:30:10 2021 +0200 Add some gnus-short-group-name tests * test/lisp/gnus/gnus-group-tests.el (gnus-short-group-name): Add some gnus-short-group-name tests (bug#51450). diff --git a/test/lisp/gnus/gnus-group-tests.el b/test/lisp/gnus/gnus-group-tests.el new file mode 100644 index 0000000000..ee1e01be4b --- /dev/null +++ b/test/lisp/gnus/gnus-group-tests.el @@ -0,0 +1,52 @@ +;;; gnus-group-tests.el --- Tests for gnus-group.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'gnus-group) +(require 'ert) + +(ert-deftest gnus-short-group-name () + (map-apply + (lambda (input expected) + (should (string-equal (gnus-short-group-name input) expected))) + '(("nnimap+email@example.com:archives/2020/03" . "email@example:a/2/03") + ("nndiary+diary:birthdays" . "diary:birthdays") + ("nnimap+email@example.com:test" . "email@example:test") + ("nnimap+email@example.com:234" . "email@example:234") + + ;; This is a very aggressive shortening of the left hand side. + ("nnimap+email@banana.salesman.example.com:234" . "email@banana:234") + ("nntp+some.where.edu:soc.motss" . "some:s.motss") + ("nntp+news.gmane.org:gmane.emacs.gnus.general" . "news:g.e.g.general") + ("nntp+news.gnus.org:gmane.text.docbook.apps" . "news:g.t.d.apps") + + ;; nnimap groups. + ("nnimap+email@example.com:[Invoices]/Bananas" . "email@example:I/Bananas") + ("nnimap+email@banana.salesman.example.com:[Invoices]/Bananas" + . "email@banana:I/Bananas") + + ;; The "n" from "nnspool" is perhaps not optimal. + ("nnspool+alt.binaries.pictures.furniture" . "n.b.p.furniture")))) + +;;; gnus-group-tests.el ends here commit 7f312f0be6b4cd2b46f37c61609fe9ff6315a848 Author: Lars Ingebrigtsen Date: Fri Oct 29 15:29:17 2021 +0200 Shorten Gnus groups with [foo] in the name better * lisp/gnus/gnus.el (gnus-short-group-name): Shorten groups with [] in the names better (bug#51450). diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 6644cc4d81..dbbbb71e57 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -3785,6 +3785,8 @@ just the host name." (setq foreign server group (substring group (+ 1 colon)))) (setq foreign (concat foreign ":"))) + ;; Remove braces from name (common in IMAP groups). + (setq group (replace-regexp-in-string "[][]+" "" group)) ;; Collapse group name leaving LEVELS uncollapsed elements (let* ((slist (split-string group "/")) (slen (length slist)) commit 6523df43e6e5436b26a4a94e21427e410a6ba31d Author: Stefan Kangas Date: Fri Oct 29 15:07:29 2021 +0200 * src/image.c (gif_load): Minor simplification. diff --git a/src/image.c b/src/image.c index f78ad044ab..99533bbd1b 100644 --- a/src/image.c +++ b/src/image.c @@ -8382,7 +8382,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file); - return 0; + return false; } Lisp_Object encoded_file = ENCODE_FILE (file); @@ -8405,8 +8405,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open `%s'", file); - - return 0; + return false; } } else @@ -8414,7 +8413,7 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (specified_data)) { image_error ("Invalid image data `%s'", specified_data); - return 0; + return false; } /* Read from memory! */ @@ -8438,7 +8437,7 @@ gif_load (struct frame *f, struct image *img) else #endif image_error ("Cannot open memory source `%s'", img->spec); - return 0; + return false; } } @@ -8446,8 +8445,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, gif->SWidth, gif->SHeight)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Read entire contents. */ @@ -8458,8 +8456,7 @@ gif_load (struct frame *f, struct image *img) image_error ("Error reading `%s'", img->spec); else image_error ("Error reading GIF data"); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Which sub-image are we to display? */ @@ -8470,8 +8467,7 @@ gif_load (struct frame *f, struct image *img) { image_error ("Invalid image number `%s' in image `%s'", image_number, img->spec); - gif_close (gif, NULL); - return 0; + goto gif_error; } } @@ -8488,8 +8484,7 @@ gif_load (struct frame *f, struct image *img) if (!check_image_size (f, width, height)) { image_size_error (); - gif_close (gif, NULL); - return 0; + goto gif_error; } /* Check that the selected subimages fit. It's not clear whether @@ -8506,18 +8501,14 @@ gif_load (struct frame *f, struct image *img) && 0 <= subimg_left && subimg_left <= width - subimg_width)) { image_error ("Subimage does not fit in image"); - gif_close (gif, NULL); - return 0; + goto gif_error; } } /* Create the X image and pixmap. */ Emacs_Pix_Container ximg; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, 0)) - { - gif_close (gif, NULL); - return 0; - } + goto gif_error; /* Clear the part of the screen image not covered by the image. Full animated GIF support requires more here (see the gif89 spec, @@ -8733,7 +8724,11 @@ gif_load (struct frame *f, struct image *img) /* Put ximg into the image. */ image_put_x_image (f, img, ximg, 0); - return 1; + return true; + + gif_error: + gif_close (gif, NULL); + return false; } #endif /* HAVE_GIF */ commit 91e7df281ee628eb56e7d016093a751f4e04366f Author: Lars Ingebrigtsen Date: Fri Oct 29 14:37:08 2021 +0200 Move lisp/shorthands.el to lisp/emacs-lisp/shorthands.el diff --git a/lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el similarity index 100% rename from lisp/shorthands.el rename to lisp/emacs-lisp/shorthands.el commit 00103154e080966d52e1a277f8523815b6ea60d7 Author: Michael Albinus Date: Fri Oct 29 14:06:47 2021 +0200 Some Tramp changes, mainly in tramp-tests.el * doc/misc/tramp.texi (External packages): Don't use Tramp internals. * lisp/net/tramp-gvfs.el (tramp-gvfs-handler-mounted-unmounted): Protect `tramp-make-tramp-file-name' call. * lisp/net/tramp.el (tramp-make-tramp-file-name): Set advertised calling conventions. * test/lisp/net/tramp-tests.el (tramp-test18-file-attributes): Adapt test. (tramp--test-supports-processes-p): New defun. (tramp-test28-process-file, tramp-test29-start-file-process) (tramp-test30-make-process, tramp-test32-shell-command) (tramp-test32-shell-command-dont-erase-buffer) (tramp-test34-explicit-shell-file-name, tramp-test35-exec-path) (tramp-test44-asynchronous-requests): Use it. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 4e95b1211f..a17a8d67e5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5329,6 +5329,12 @@ handlers. @node External packages @section Integrating with external Lisp packages + +In general, it is not recommended to use @value{tramp} functions and +variables not described in this manual. They might change their +signature and/or semantics without any announcement. + + @subsection File name completion @vindex non-essential diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index ebe57a8bce..7e226398d1 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1866,7 +1866,11 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and port (tramp-file-name-port v))))) (when (member method tramp-gvfs-methods) (with-parsed-tramp-file-name - (tramp-make-tramp-file-name method user domain host port "") nil + ;; This must be changed when we throw the old signature + ;; away in Emacs 27.1 and higher. + (with-no-warnings + (tramp-make-tramp-file-name method user domain host port "")) + nil (tramp-message v 6 "%s %s" signal-name (tramp-gvfs-stringify-dbus-message mount-info)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 372e0a2cb7..b152584c1f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1758,6 +1758,9 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME &optional HOP)." tramp-postfix-host-format localname))) +(set-advertised-calling-convention + #'tramp-make-tramp-file-name '(vec &optional localname hop) "27.1") + (defun tramp-make-tramp-hop-name (vec) "Construct a Tramp hop name from VEC." (replace-regexp-in-string diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d50111d404..47ef46f8ec 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3385,17 +3385,16 @@ This tests also `access-file', `file-readable-p', (tramp-get-remote-gid tramp-test-vec 'integer))) (delete-file tmp-name1)) - (when (and (tramp--test-supports-set-file-modes-p) - ;; A file is always accessible for user "root". - (not (zerop (tramp-compat-file-attribute-user-id - (file-attributes - tramp-test-temporary-file-directory))))) + (when (tramp--test-supports-set-file-modes-p) (write-region "foo" nil tmp-name1) - (set-file-modes tmp-name1 0) - (should-error - (access-file tmp-name1 "error") - :type 'file-error) - (set-file-modes tmp-name1 #o777) + ;; A file is always accessible for user "root". + (when (not (zerop (tramp-compat-file-attribute-user-id + (file-attributes tmp-name1)))) + (set-file-modes tmp-name1 0) + (should-error + (access-file tmp-name1 "error") + :type 'file-error) + (set-file-modes tmp-name1 #o777)) (delete-file tmp-name1)) (should-error (access-file tmp-name1 "error") @@ -4443,8 +4442,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `process-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-processes-p)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4524,8 +4522,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `start-file-process'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-processes-p)) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((default-directory tramp-test-temporary-file-directory) @@ -4704,8 +4701,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." "Check `make-process'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-processes-p)) ;; `make-process' supports file name handlers since Emacs 27. (skip-unless (tramp--test-emacs27-p)) @@ -5008,11 +5004,11 @@ INPUT, if non-nil, is a string sent to the process." "Check `shell-command'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) - (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (when (tramp--test-adb-p) + (skip-unless (tramp--test-emacs27-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -5110,8 +5106,7 @@ INPUT, if non-nil, is a string sent to the process." :tags '(:expensive-test :unstable) (skip-unless (tramp--test-enabled)) (skip-unless nil) - (skip-unless (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-command-dont-erase-buffer' wasn't working properly. (skip-unless (tramp--test-emacs27-p)) @@ -5432,11 +5427,11 @@ Use direct async.") "Check that connection-local `explicit-shell-file-name' is set." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) - (tramp--test-sh-p) (tramp--test-sshfs-p))) - (skip-unless (not (tramp--test-crypt-p))) + (when (tramp--test-adb-p) + (skip-unless (tramp--test-emacs27-p))) ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -5491,6 +5486,7 @@ Use direct async.") (ert-deftest tramp-test35-exec-path () "Check `exec-path' and `executable-find'." (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-supports-processes-p)) (skip-unless (tramp--test-supports-set-file-modes-p)) ;; Since Emacs 27.1. (skip-unless (fboundp 'exec-path)) @@ -6270,6 +6266,11 @@ This requires restrictions of file name syntax." This requires restrictions of file name syntax." (tramp-smb-file-name-p tramp-test-temporary-file-directory)) +(defun tramp--test-supports-processes-p () + "Return whether the method under test supports external processes." + (and (or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sshfs-p)) + (not (tramp--test-crypt-p)))) + (defun tramp--test-supports-set-file-modes-p () "Return whether the method under test supports setting file modes." ;; "smb" does not unless the SMB server supports "posix" extensions. @@ -6801,13 +6802,14 @@ process sentinels. They shall not disturb each other." :tags (if (getenv "EMACS_EMBA_CI") '(:expensive-test :unstable) '(:expensive-test)) (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-supports-processes-p)) ;; Prior Emacs 27, `shell-file-name' was hard coded as "/bin/sh" for ;; remote processes in Emacs. That doesn't work for tramp-adb.el. - (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) - (tramp--test-sh-p))) - (skip-unless (not (tramp--test-crypt-p))) + (when (tramp--test-adb-p) + (skip-unless (tramp--test-emacs27-p))) (skip-unless (not (tramp--test-docker-p))) (skip-unless (not (tramp--test-telnet-p))) + (skip-unless (not (tramp--test-sshfs-p))) (skip-unless (not (tramp--test-windows-nt-p))) (with-timeout commit 9436943fb1af959aa313e0149255539679090b15 Author: Michael Albinus Date: Fri Oct 29 14:05:36 2021 +0200 ; * doc/emacs/custom.texi (Connection Variables): Fix typo. Don't merge diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 73dfe03898..60e2d0aa87 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1507,7 +1507,7 @@ criteria, identifying a remote machine: This code declares two different profiles, @code{remote-ksh} and @code{remote-bash}. The profile @code{remote-ksh} is applied to all buffers which have a remote default directory matching the regexp -@code{"remotemachine} as host name. Such a criteria can also +@code{"remotemachine"} as host name. Such a criteria can also discriminate for the properties @code{:protocol} (this is the Tramp method) or @code{:user} (a remote user name). The @code{nil} criteria matches all buffers with a remote default directory. commit 08de83853176bfeec9828863711d52a0d7e9416b Author: Eli Zaretskii Date: Fri Oct 29 10:41:33 2021 +0300 ; Improve commentary in the last change * lisp/language/misc-lang.el: Minor copyedits of the commentary regarding Egyptian hieroglyph support. diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index de4f092dc1..c8a4821abf 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -193,14 +193,19 @@ thin (i.e. 1-dot width) space." #x13437 (list (vector "\U00013437[\U00013000-\U0001343F]+" 0 #'egyptian-shape-grouping))) - ;; As of late 2021, Egyptian Hieroglyph Format Controls are not yet - ;; supported in existing fonts and shaping engines, but some fonts - ;; do provide ligatures with which texts in Egyptian Hieroglyphs are - ;; correctly displayed. If and when these format controls are - ;; supported, the five lines below (which cancel the effect of the - ;; above lines) can be removed, and the entry in etc/HELLO can be + ;; "Normal" hieroglyphs, for fonts that don't support the above + ;; controls, but do shape sequences of hieroglyphs without the + ;; controls. + ;; FIXME: As of late 2021, Egyptian Hieroglyph Format Controls are + ;; not yet supported in existing fonts and/or shaping engines, but + ;; some fonts do provide ligatures with which texts in Egyptian + ;; Hieroglyphs are correctly displayed. If and when these format + ;; controls are supported, as described in section 11.4 "Egyptian + ;; Hieroglyphs" of the Unicode Standard, the five lines below (which + ;; allow composition of hieroglyphs without formatting controls + ;; around) can be removed, and the entry in etc/HELLO can be ;; restored to: - ;; Egyptian Hieroglyphs (π“‚‹π“°π“€π“ˆ–π“†Žπ“…“π“π“°π“Š–) π“…“π“Š΅π“°π“·π“π“Šͺ𓐸, π“‡π“‡‹π“‚»π“˜π“‡‹ + ;; Egyptian Hieroglyphs (π“‚‹π“°π“€π“ˆ–π“†Žπ“…“π“π“°π“Š–) π“…“π“Š΅π“°π“·π“π“Šͺ𓐸, π“‡π“‡‹π“‚»π“˜π“‡‹ (set-char-table-range composition-function-table '(#x13000 . #x1342E) commit 3da9fa875bbfceee41df38d9f97e06013484a791 Author: Gregory Heytings Date: Thu Oct 28 20:58:02 2021 +0000 Make hieroglyphs display correctly with existing fonts * etc/HELLO: Remove hieroglyph format control characters. * lisp/language/misc-lang.el: Add a rule to compose Egyptian hieroglyphs even without Unicode format control characters. diff --git a/etc/HELLO b/etc/HELLO index 577c2828de..8bd489fb40 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -38,7 +38,7 @@ Czech (čeΕ‘tina) DobrΓ½ den Danish (dansk) Hej / Goddag / HallΓΈj Dutch (Nederlands) Hallo / Dag Efik /ΛˆΙ›fΙͺk/ MΙ”kΙ”m -Egyptian Hieroglyphs (π“‚‹π“°π“€π“ˆ–π“†Žπ“…“π“π“°π“Š–) π“…“π“Š΅π“°π“·π“π“Šͺ𓐸, π“‡π“‡‹π“‚»π“˜π“‡‹ +Egyptian Hieroglyphs (π“‚‹π“€π“ˆ–π“†Žπ“…“β€Œπ“π“Š–) π“…“π“Š΅π“π“Šͺ, π“‡π“‡‹π“‚»π“˜π“‡‹ Emacs emacs --no-splash -f view-hello-file Emoji πŸ‘‹ English /ˈΙͺΕ‹Ι‘lΙͺΚƒ/ Hello diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index a2ca678b2b..de4f092dc1 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -192,7 +192,20 @@ thin (i.e. 1-dot width) space." composition-function-table #x13437 (list (vector "\U00013437[\U00013000-\U0001343F]+" - 0 #'egyptian-shape-grouping)))) + 0 #'egyptian-shape-grouping))) + ;; As of late 2021, Egyptian Hieroglyph Format Controls are not yet + ;; supported in existing fonts and shaping engines, but some fonts + ;; do provide ligatures with which texts in Egyptian Hieroglyphs are + ;; correctly displayed. If and when these format controls are + ;; supported, the five lines below (which cancel the effect of the + ;; above lines) can be removed, and the entry in etc/HELLO can be + ;; restored to: + ;; Egyptian Hieroglyphs (π“‚‹π“°π“€π“ˆ–π“†Žπ“…“π“π“°π“Š–) π“…“π“Š΅π“°π“·π“π“Šͺ𓐸, π“‡π“‡‹π“‚»π“˜π“‡‹ + (set-char-table-range + composition-function-table + '(#x13000 . #x1342E) + (list (vector "[\U00013000-\U0001342E]+" + 0 #'font-shape-gstring)))) (provide 'misc-lang) commit 928e05f2d63564284eb51a7102f96439c1b87d9f Author: Eli Zaretskii Date: Fri Oct 29 10:10:01 2021 +0300 Clarify "default face attributes" in the ELisp manual * doc/lispref/display.texi (Defining Faces): Add index entries for face symbol properties. (Attribute Functions): Clarify "default face attribute values" wrt 'face-all-attributes' and 'face-attribute'. (Bug#51465) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 4500795e45..e5ba85db9f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2750,6 +2750,11 @@ terminal must match one of the @var{value}s specified for it in :group 'basic-faces) @end example +@kindex face-defface-spec @r{(face symbol property)} +@kindex saved-face @r{(face symbol property)} +@kindex customized-face @r{(face symbol property)} +@kindex theme-face @r{(face symbol property)} +@kindex face-documentation @r{(face symbol property)} Internally, Emacs stores each face's default spec in its @code{face-defface-spec} symbol property (@pxref{Symbol Properties}). The @code{saved-face} property stores any face spec saved by the user @@ -2806,9 +2811,12 @@ This function returns the value of the @var{attribute} attribute for If @var{frame} is omitted or @code{nil}, that means the selected frame (@pxref{Input Focus}). If @var{frame} is @code{t}, this function -returns the value of the specified attribute for newly-created frames -(this is normally @code{unspecified}, unless you have specified some -value using @code{set-face-attribute}; see below). +returns the value of the specified attribute for newly-created frames, +i.e.@: the value of the attribute before applying the face spec in the +face's @code{defface} definition (@pxref{Defining Faces}) or the spec +set by @code{face-spec-set}. This default value of @var{attribute} is +normally @code{unspecified}, unless you have specified some other +value using @code{set-face-attribute}; see below. If @var{inherit} is @code{nil}, only attributes directly defined by @var{face} are considered, so the return value may be @@ -2858,7 +2866,12 @@ elements of the result are name-value pairs of the form @w{@code{(@var{attr-name} . @var{attr-value})}}. Optional argument @var{frame} specifies the frame whose definition of @var{face} to return; if omitted or @code{nil}, the returned value describes the -default attributes of @var{face} for newly created frames. +default attributes of @var{face} for newly created frames, i.e.@: the +values these attributes have before applying the face spec in the +face's @code{defface} definition or the spec set by +@code{face-spec-set}. These default values of the attributes are +normally @code{unspecified}, unless you have specified some other +value using @code{set-face-attribute}; see below. @end defun @defun merge-face-attribute attribute value1 value2 @@ -2876,7 +2889,7 @@ for all frames. This function is mostly intended for internal usage. @defun set-face-attribute face frame &rest arguments This function sets one or more attributes of @var{face} for -@var{frame}. The attributes specifies in this way override the face +@var{frame}. The attributes specified in this way override the face spec(s) belonging to @var{face}. The extra arguments @var{arguments} specify the attributes to set, and @@ -2893,9 +2906,10 @@ sets the attribute @code{:weight} to @code{bold} and the attribute If @var{frame} is @code{t}, this function sets the default attributes -for newly created frames. If @var{frame} is @code{nil}, this function -sets the attributes for all existing frames, as well as for newly -created frames. +for newly created frames; they will effectively override the attribute +values specified by @code{defface}. If @var{frame} is @code{nil}, +this function sets the attributes for all existing frames, as well as +for newly created frames. @end defun The following commands and functions mostly provide compatibility commit aaed8d4a81ed43a7154bca3c9fe624436a9d386a Author: Eli Zaretskii Date: Fri Oct 29 09:23:54 2021 +0300 Fix bootstrapping broken by a recent change * src/keymap.c (Flookup_key): Avoid crashes during bootstrap when uni-lowercase.el is not available yet. diff --git a/src/keymap.c b/src/keymap.c index 2e98b05919..5ff13ba1d5 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1295,6 +1295,9 @@ recognize the default bindings, just as `read-key-sequence' does. */) if (NILP (unicode_case_table)) { unicode_case_table = uniprop_table (intern ("lowercase")); + /* uni-lowercase.el might be unavailable during bootstrap. */ + if (NILP (unicode_case_table)) + return found; staticpro (&unicode_case_table); } commit 0aa9f478e962e3e2d146871fa37267709404c52e Author: akater Date: Thu Oct 28 23:53:11 2021 +0200 Indent cl-flet-like forms correctly in incomplete expressions * lisp/emacs-lisp/lisp-mode.el (lisp--local-defform-body-p): Support incomplete sexps * test/lisp/progmodes/elisp-mode-resources/flet.erts: Add tests for incomplete sexps (bug#9622). diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 5dfb1fae35..15afdef025 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1114,56 +1114,46 @@ is the buffer position of the start of the containing expression." STATE is the `parse-partial-sexp' state for current position." (when-let ((start-of-innermost-containing-list (nth 1 state))) (let* ((parents (nth 9 state)) - (second-cons-after (cddr parents)) - second-order-parent) + (first-cons-after (cdr parents)) + (second-cons-after (cdr first-cons-after)) + first-order-parent second-order-parent) (while second-cons-after (when (= start-of-innermost-containing-list (car second-cons-after)) - (setq second-order-parent (car parents) + (setq second-order-parent (pop parents) + first-order-parent (pop parents) ;; Leave the loop. second-cons-after nil)) (pop second-cons-after) (pop parents)) (when second-order-parent - (save-excursion - (goto-char (1+ second-order-parent)) - (and (when-let ((head (ignore-errors - ;; FIXME: This does not distinguish - ;; between reading nil and a read error. - ;; We don't care but still, better fix this. - (read (current-buffer))))) - (memq head '( cl-flet cl-labels cl-macrolet cl-flet* - cl-symbol-macrolet))) - ;; Now we must check that we are - ;; in the second element of the flet-like form. - ;; It would be easier if `parse-partial-sexp' also recorded - ;; relative positions of subsexps in supersexps - ;; but it doesn't so we check manually. - ;; - ;; First, we must be looking at list now. - (ignore-errors (when (= (scan-lists (point) 1 0) - (scan-sexps (point) 1)) - ;; Looking at list; descend into it: - (down-list 1) - t)) - ;; In Wishful Lisp, the following form would be - ;; (cl-member start-of-innermost-containing-list - ;; (points-at-beginning-of-lists-at-this-level) - ;; :test #'=) - (cl-loop - with pos = (ignore-errors - ;; The first local definition may be indented - ;; with whitespace following open paren. - (goto-char (scan-lists (point) 1 0)) - (goto-char (scan-lists (point) -1 0)) - (point)) - while pos - do (if (= start-of-innermost-containing-list pos) - (cl-return t) - (setq pos (ignore-errors - (goto-char (scan-lists (point) 2 0)) - (goto-char (scan-lists (point) -1 0)) - (point))))))))))) + (let (local-definitions-starting-point) + (and (save-excursion + (goto-char (1+ second-order-parent)) + (when-let ((head (ignore-errors + ;; FIXME: This does not distinguish + ;; between reading nil and a read error. + ;; We don't care but still, better fix this. + (read (current-buffer))))) + (when (memq head '( cl-flet cl-labels cl-macrolet cl-flet* + cl-symbol-macrolet)) + ;; In what follows, we rely on (point) returning non-nil. + (setq local-definitions-starting-point + (progn + (parse-partial-sexp + (point) first-order-parent nil + ;; From docstring of `parse-partial-sexp': + ;; Fourth arg non-nil means stop + ;; when we come to any character + ;; that starts a sexp. + t) + (point)))))) + (ignore-errors + ;; We rely on `backward-up-list' working + ;; even when sexp is incomplete β€œto the right”. + (backward-up-list 2) + t) + (= local-definitions-starting-point (point)))))))) (defun lisp-indent-function (indent-point state) "This function is the normal value of the variable `lisp-indent-function'. diff --git a/test/lisp/progmodes/elisp-mode-resources/flet.erts b/test/lisp/progmodes/elisp-mode-resources/flet.erts index 447cf08cc2..7c4a0f304e 100644 --- a/test/lisp/progmodes/elisp-mode-resources/flet.erts +++ b/test/lisp/progmodes/elisp-mode-resources/flet.erts @@ -220,3 +220,124 @@ Name: flet15 h i))) =-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-1 +Code: (lambda () (emacs-lisp-mode) (setq indent-tabs-mode nil) (newline nil t)) +Point-Char: | + +=-= +(let ((x (and y| +=-= +(let ((x (and y + | +=-=-= + +Name: flet-indentation-incomplete-sexp-no-side-effects-2 + +=-= +(let ((x| +=-= +(let ((x + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-1 +Point-Char: | + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-2 +Point-Char: | + +=-= +(cl-flet((f(x)| +=-= +(cl-flet((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-3 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-whitespace-5 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-1 + +=-= +(cl-flet((f (x)| +=-= +(cl-flet((f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-2 + +=-= +(cl-flet ((f(x)| +=-= +(cl-flet ((f(x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-3 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-4 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-5 + +=-= +(cl-flet( (f (x)| +=-= +(cl-flet( (f (x) + | +=-=-= + +Name: flet-indentation-incomplete-sexp-missing-and-excessive-whitespace-6 + +=-= +(cl-flet( (f(x)| +=-= +(cl-flet( (f(x) + | +=-=-= commit 5dbb04e0ebd2a007b4827138faae2ac0edc06350 Author: Lars Ingebrigtsen Date: Thu Oct 28 23:38:29 2021 +0200 Make `C-u RET' work again * lisp/simple.el (newline): Fix regression introduced by d1aacceae9 (bug#51459). diff --git a/lisp/simple.el b/lisp/simple.el index e3657cc079..94a459b779 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -590,7 +590,7 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." (interactive "*P\np") (barf-if-buffer-read-only) (when (and arg - (< arg 0)) + (< (prefix-numeric-value arg) 0)) (error "Repetition argument has to be non-negative")) ;; Call self-insert so that auto-fill, abbrev expansion etc. happen. ;; Set last-command-event to tell self-insert what to insert. commit d72fefdeabf2da7668aebc7ec0ff8008d63247a9 Author: Jan Synacek Date: Thu Oct 28 23:32:59 2021 +0200 Fix typos in the manual and in a comment * lisp/minibuffer.el (completion-pcm--hilit-commonality): * doc/lispintro/emacs-lisp-intro.texi (Mode Line): Fix typos (bug#51434). Copyright-paperwork-exempt: yes diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 391b6d9c59..308153f923 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17843,7 +17843,7 @@ xmodmap -e "keysym Alt_L = Meta_L Alt_L" Finally, a feature I really like: a modified mode line. When I work over a network, I forget which machine I am using. Also, -I tend to I lose track of where I am, and which line point is on. +I tend to lose track of where I am, and which line point is on. So I reset my mode line to look like this: diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index bc21f027b6..ca82b4a9e6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3579,12 +3579,13 @@ between 0 and 1, and with faces `completions-common-part', ;; "hole" in the middle of the string is indicated by ;; "-". Note that there are no "holes" near the edges ;; of the string. The completion score is a number - ;; bound by ]0..1]: the higher the better and only a - ;; perfect match (pattern equals string) will have - ;; score 1. The formula takes the form of a quotient. - ;; For the numerator, we use the number of +, i.e. the - ;; length of the pattern. For the denominator, it - ;; first computes + ;; bound by (0..1] (i.e., larger than (but not equal + ;; to) zero, and smaller or equal to one): the higher + ;; the better and only a perfect match (pattern equals + ;; string) will have score 1. The formula takes the + ;; form of a quotient. For the numerator, we use the + ;; number of +, i.e. the length of the pattern. For + ;; the denominator, it first computes ;; ;; hole_i_contrib = 1 + (Li-1)^(1/tightness) ;; commit 2671ea0de8e90e20241fe0441f4f8b79eeccdb12 Author: Stefan Kangas Date: Wed Oct 13 00:04:23 2021 +0200 Be more allowing when looking for menu-bar items * src/keymap.c (lookup_key_1): Factor out function from Flookup_key. (Flookup_key): Be case insensitive, and treat spaces as dashes, when looking for Qmenu_bar items. (Bug#50752) * test/src/keymap-tests.el (keymap-lookup-key/mixed-case) (keymap-lookup-key/mixed-case-multibyte) (keymap-lookup-keymap/with-spaces) (keymap-lookup-keymap/with-spaces-multibyte) (keymap-lookup-keymap/with-spaces-multibyte-lang-env): New tests. diff --git a/etc/NEWS b/etc/NEWS index f006fa530f..cc452211b6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -426,6 +426,18 @@ This returns the width of a string in pixels. This can be useful when dealing with variable pitch fonts and glyphs that have widths that aren't integer multiples of the default font. +--- +** 'lookup-key' is more allowing when searching for extended menu items. +In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking +for a menu item '[menu-bar Foo-Bar]', first try to find an exact +match, then look for the lowercased '[menu-bar foo-bar]'. + +This has been extended, so that when looking for a menu item with a +symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for +an exact match, then the lowercased '[menu-bar foo\ bar]' and finally +'[menu-bar foo-bar]'. This further improves backwards-compatibility +when converting menus to use 'easy-menu-define'. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/src/keymap.c b/src/keymap.c index 8b521a89df..2e98b05919 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -65,6 +65,9 @@ static Lisp_Object exclude_keys; /* Pre-allocated 2-element vector for Fcommand_remapping to use. */ static Lisp_Object command_remapping_vector; +/* Char table for the backwards-compatibility part in Flookup_key. */ +static Lisp_Object unicode_case_table; + /* Hash table used to cache a reverse-map to speed up calls to where-is. */ static Lisp_Object where_is_cache; /* Which keymaps are reverse-stored in the cache. */ @@ -1209,27 +1212,8 @@ remapping in all currently active keymaps. */) return FIXNUMP (command) ? Qnil : command; } -/* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function. */ - -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* Look up key sequence KEY in KEYMAP. Return the definition. -A value of nil means undefined. See doc of `define-key' -for kinds of definitions. - -A number as value means KEY is "too long"; -that is, characters or symbols in it except for the last one -fail to be a valid sequence of prefix characters in KEYMAP. -The number is how many characters at the front of KEY -it takes to reach a non-prefix key. -KEYMAP can also be a list of keymaps. - -Normally, `lookup-key' ignores bindings for t, which act as default -bindings, used when nothing else in the keymap applies; this makes it -usable as a general function for probing keymaps. However, if the -third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will -recognize the default bindings, just as `read-key-sequence' does. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +static Lisp_Object +lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) { bool t_ok = !NILP (accept_default); @@ -1271,6 +1255,141 @@ recognize the default bindings, just as `read-key-sequence' does. */) } } +/* Value is number if KEY is too long; nil if valid but has no definition. */ +/* GC is possible in this function. */ + +DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, + doc: /* Look up key sequence KEY in KEYMAP. Return the definition. +A value of nil means undefined. See doc of `define-key' +for kinds of definitions. + +A number as value means KEY is "too long"; +that is, characters or symbols in it except for the last one +fail to be a valid sequence of prefix characters in KEYMAP. +The number is how many characters at the front of KEY +it takes to reach a non-prefix key. +KEYMAP can also be a list of keymaps. + +Normally, `lookup-key' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will +recognize the default bindings, just as `read-key-sequence' does. */) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +{ + Lisp_Object found = lookup_key_1 (keymap, key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + return found; + + /* Menu definitions might use mixed case symbols (notably in old + versions of `easy-menu-define'), or use " " instead of "-". + The rest of this function is about accepting these variations for + backwards-compatibility. (Bug#50752) */ + + /* Just skip everything below unless this is a menu item. */ + if (!VECTORP (key) || !(ASIZE (key) > 0) + || !EQ (AREF (key, 0), Qmenu_bar)) + return found; + + /* Initialize the unicode case table, if it wasn't already. */ + if (NILP (unicode_case_table)) + { + unicode_case_table = uniprop_table (intern ("lowercase")); + staticpro (&unicode_case_table); + } + + ptrdiff_t key_len = ASIZE (key); + Lisp_Object new_key = make_vector (key_len, Qnil); + + /* Try both the Unicode case table, and the buffer local one. + Otherwise, we will fail for e.g. the "Turkish" language + environment where 'I' does not downcase to 'i'. */ + Lisp_Object tables[2] = {unicode_case_table, Fcurrent_case_table ()}; + for (int tbl_num = 0; tbl_num < 2; tbl_num++) + { + /* First, let's try converting all symbols like "Foo-Bar-Baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + Lisp_Object key_item = Fsymbol_name (AREF (key, i)); + Lisp_Object new_item; + if (!STRING_MULTIBYTE (key_item)) + new_item = Fdowncase (key_item); + else + { + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (key_item), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + unsigned char *p = dst; + ptrdiff_t j_char = 0, j_byte = 0; + + while (j_char < size) + { + int ch = fetch_string_char_advance (key_item, &j_char, &j_byte); + Lisp_Object ch_conv = CHAR_TABLE_REF (tables[tbl_num], ch); + if (!NILP (ch_conv)) + CHAR_STRING (XFIXNUM (ch_conv), p); + else + CHAR_STRING (ch, p); + p = dst + j_byte; + } + new_item = make_multibyte_string ((char *) dst, + SCHARS (key_item), + SBYTES (key_item)); + SAFE_FREE (); + } + ASET (new_key, i, Fintern (new_item, Qnil)); + } + + /* Check for match. */ + found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; + + /* If we still don't have a match, let's convert any spaces in + our lowercased string into dashes, e.g. "foo bar baz" to + "foo-bar-baz". */ + for (int i = 0; i < key_len; i++) + { + Lisp_Object lc_key = Fsymbol_name (AREF (new_key, i)); + + /* If there are no spaces in this symbol, just skip it. */ + if (!strstr (SSDATA (lc_key), " ")) + continue; + + USE_SAFE_ALLOCA; + ptrdiff_t size = SCHARS (lc_key), n; + if (INT_MULTIPLY_WRAPV (size, MAX_MULTIBYTE_LENGTH, &n)) + n = PTRDIFF_MAX; + unsigned char *dst = SAFE_ALLOCA (n); + + /* We can walk the string data byte by byte, because UTF-8 + encoding ensures that no other byte of any multibyte + sequence will ever include a 7-bit byte equal to an ASCII + single-byte character. */ + memcpy (dst, SSDATA (lc_key), SBYTES (lc_key)); + for (int i = 0; i < SBYTES (lc_key); ++i) + { + if (dst[i] == ' ') + dst[i] = '-'; + } + Lisp_Object + new_it = make_multibyte_string ((char *) dst, SCHARS (lc_key), SBYTES (lc_key)); + ASET (new_key, i, Fintern (new_it, Qnil)); + SAFE_FREE (); + } + + /* Check for match. */ + found = lookup_key_1 (keymap, new_key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + break; + } + + return found; +} + /* Make KEYMAP define event C as a keymap (i.e., as a prefix). Assume that currently it does not define C at all. Return the keymap. */ diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 13f47b45f8..fc4dce0182 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -124,6 +124,49 @@ ;; (ert-deftest keymap-lookup-key/accept-default () ;; ...) +(ert-deftest keymap-lookup-key/mixed-case () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar foo bar] 'foo) + (should (eq (lookup-key map [menu-bar foo bar]) 'foo)) + (should (eq (lookup-key map [menu-bar Foo Bar]) 'foo))) + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))) + +(ert-deftest keymap-lookup-key/mixed-case-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + ;; (downcase "ÅÀâ") => "Γ₯Àâ" + (define-key map [menu-bar Γ₯Àâ bar] 'foo) + (should (eq (lookup-key map [menu-bar Γ₯Àâ bar]) 'foo)) + (should (eq (lookup-key map [menu-bar ÅÀâ Bar]) 'foo)) + ;; (downcase "Ξ“") => "Ξ³" + (define-key map [menu-bar Ξ³ bar] 'baz) + (should (eq (lookup-key map [menu-bar Ξ³ bar]) 'baz)) + (should (eq (lookup-key map [menu-bar Ξ“ Bar]) 'baz)))) + +(ert-deftest keymap-lookup-keymap/with-spaces () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar foo-bar] 'foo) + (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar Γ₯Àâ-bar] 'foo) + (should (eq (lookup-key map [menu-bar ÅÀâ\ Bar]) 'foo)))) + +(ert-deftest keymap-lookup-keymap/with-spaces-multibyte-lang-env () + "Backwards compatibility behaviour (Bug#50752)." + (let ((lang-env current-language-environment)) + (set-language-environment "Turkish") + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo))) + (set-language-environment lang-env))) + (ert-deftest describe-buffer-bindings/header-in-current-buffer () "Header should be inserted into the current buffer. https://debbugs.gnu.org/39149#31" commit 64cc31b5c80ab165c4e565ff8943919d832ebd2f Author: Eli Zaretskii Date: Thu Oct 28 21:19:34 2021 +0300 ; * src/keyboard.c (readable_events): Fix a thinko. diff --git a/src/keyboard.c b/src/keyboard.c index 6aecebf405..5d4bb6ee8f 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -3472,10 +3472,10 @@ readable_events (int flags) #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && #endif - ((input_pending_p_filter_events + ((!input_pending_p_filter_events && (event->kind == FOCUS_IN_EVENT || event->kind == FOCUS_OUT_EVENT)) - || (!input_pending_p_filter_events + || (input_pending_p_filter_events && is_ignored_event (event)))) #ifdef USE_TOOLKIT_SCROLL_BARS && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) commit bea843dee19f2ac69f0d7a753d3bd917760a0344 Author: Eli Zaretskii Date: Thu Oct 28 20:52:41 2021 +0300 Avoid assertion violations in 'lookup-key' * src/keymap.c (Flookup_key): Don't call ASIZE unless KEY is a vector. This avoids assertion violations when KEY is a string. diff --git a/src/keymap.c b/src/keymap.c index f7529f808b..50f896d17c 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1253,8 +1253,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) /* Menu definitions might use mixed case symbols (notably in old versions of `easy-menu-define'). We accept this variation for backwards-compatibility. (Bug#50752) */ - ptrdiff_t key_len = ASIZE (key); - if (VECTORP (key) && key_len > 0 && EQ (AREF (key, 0), Qmenu_bar)) + ptrdiff_t key_len = VECTORP (key) ? ASIZE (key) : 0; + if (key_len > 0 && EQ (AREF (key, 0), Qmenu_bar)) { Lisp_Object new_key = make_vector (key_len, Qnil); for (int i = 0; i < key_len; ++i) commit 09f3ac60cc99dcb56632c55f0dfd0fbeadc60dc0 Author: Alan Mackenzie Date: Thu Oct 28 17:04:06 2021 +0000 Put missing c-keep-region-active's into the source code * lisp/progmodes/cc-cmds.el (c-beginning-of-defun): Insert c-keep-region-active when (< arg 0). (c-forward-conditional): Insert c-keep-region-active. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index a9a52636b7..5024972804 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1896,16 +1896,18 @@ defun." (if (< arg 0) (c-while-widening-to-decl-block (< (setq arg (- (c-forward-to-nth-EOF-\;-or-} (- arg) where))) 0))) - ;; Move forward to the next opening brace.... - (when (and (= arg 0) - (progn - (c-while-widening-to-decl-block - (not (c-syntactic-re-search-forward "{" nil 'eob))) - (eq (char-before) ?{))) - (backward-char) - ;; ... and backward to the function header. - (c-beginning-of-decl-1) - t)) + (prog1 + ;; Move forward to the next opening brace.... + (when (and (= arg 0) + (progn + (c-while-widening-to-decl-block + (not (c-syntactic-re-search-forward "{" nil 'eob))) + (eq (char-before) ?{))) + (backward-char) + ;; ... and backward to the function header. + (c-beginning-of-decl-1) + t) + (c-keep-region-active))) ;; Move backward to the opening brace of a function, making successively ;; larger portions of the buffer visible as necessary. @@ -3413,7 +3415,8 @@ to call `c-scan-conditionals' directly instead." (interactive "p") (let ((new-point (c-scan-conditionals count target-depth with-else))) (push-mark) - (goto-char new-point))) + (goto-char new-point)) + (c-keep-region-active)) (defun c-scan-conditionals (count &optional target-depth with-else) "Scan forward across COUNT preprocessor conditionals. commit 9c95a4fa55a4b6956a16dee9144a68db571d7e2c Author: Jim Porter Date: Thu Oct 28 18:44:39 2021 +0200 Make comint-term-environment connection-aware (bug#51426) * lisp/comint.el (comint-term-environment): Make it connection-aware. * doc/emacs/misc.texi (Shell Options): Document the above change, and explain how this interacts with 'system-uses-terminfo'. * etc/NEWS: Announce the above change. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 5123a716dc..f66b69cdd7 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1497,14 +1497,20 @@ directory stack if they are not already on it underlying shell, of course. @vindex comint-terminfo-terminal +@vindex system-uses-terminfo @vindex TERM@r{, environment variable, in sub-shell} Comint mode sets the @env{TERM} environment variable to a safe default value, but this value disables some useful features. For example, color is disabled in applications that use @env{TERM} to determine if color is supported. Therefore, Emacs provides an option -@code{comint-terminfo-terminal}, which you can set to a terminal that -is present in your system's terminfo database, in order to take -advantage of advanced features of that terminal. +@code{comint-terminfo-terminal} to let you choose a terminal with more +advanced features, as defined in your system's terminfo database. +Emacs will use this option as the value for @env{TERM} so long as +@code{system-uses-terminfo} is non-nil. + +Both @code{comint-terminfo-terminal} and @code{system-uses-terminfo} +can be declared as connection-local variables to adjust these options +to match what a remote system expects (@pxref{Connection Variables}). @node Terminal emulator @subsection Emacs Terminal Emulator diff --git a/etc/NEWS b/etc/NEWS index 4f48cfbd88..f006fa530f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -120,6 +120,14 @@ When non-nil, if the point is in a closing delimiter and the opening delimiter is offscreen, shows some context around the opening delimiter in the echo area. +** Comint + ++++ +*** 'comint-term-environment' is now aware of connection-local variables. +The user option 'comint-terminfo-terminal' and variable +'system-uses-terminfo' can now be set as connection-local variables to +change the terminal used on a remote host. + * Changes in Specialized Modes and Packages in Emacs 29.1 diff --git a/lisp/comint.el b/lisp/comint.el index e925b3a4b6..c114bdf758 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -889,12 +889,13 @@ series of processes in the same Comint buffer. The hook ;; and there is no way for us to define it here. ;; Some programs that use terminfo get very confused ;; if TERM is not a valid terminal type. - (if (and (boundp 'system-uses-terminfo) system-uses-terminfo) - (list (format "TERM=%s" comint-terminfo-terminal) - "TERMCAP=" - (format "COLUMNS=%d" (window-width))) - (list "TERM=emacs" - (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width))))) + (with-connection-local-variables + (if system-uses-terminfo + (list (format "TERM=%s" comint-terminfo-terminal) + "TERMCAP=" + (format "COLUMNS=%d" (window-width))) + (list "TERM=emacs" + (format "TERMCAP=emacs:co#%d:tc=unknown:" (window-width)))))) (defun comint-nonblank-p (str) "Return non-nil if STR contains non-whitespace syntax." commit 802e9b1b453506174c94f72c504fb4b83e85828e Author: Eli Zaretskii Date: Thu Oct 28 18:47:41 2021 +0300 Ignore more events in input-pending-p * src/keyboard.c (readable_events) (kbd_buffer_store_buffered_event): Use 'is_ignored_event' to decide whether the input event is to be ignored. (is_ignored_event): New function. (syms_of_keyboard) : New variable. Patch from Aaron Jensen . diff --git a/src/keyboard.c b/src/keyboard.c index 6e8a1e3657..6aecebf405 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -375,6 +375,7 @@ static void timer_resume_idle (void); static void deliver_user_signal (int); static char *find_user_signal_name (int); static void store_user_signal_events (void); +static bool is_ignored_event (union buffered_input_event *); /* Advance or retreat a buffered input event pointer. */ @@ -3446,8 +3447,13 @@ readable_events (int flags) if (flags & READABLE_EVENTS_DO_TIMERS_NOW) timer_check (); - /* If the buffer contains only FOCUS_IN/OUT_EVENT events, and - READABLE_EVENTS_FILTER_EVENTS is set, report it as empty. */ + /* READABLE_EVENTS_FILTER_EVENTS is meant to be used only by + input-pending-p and similar callers, which aren't interested in + some input events. If this flag is set, and + input-pending-p-filter-events is non-nil, ignore events in + while-no-input-ignore-events. If the flag is set and + input-pending-p-filter-events is nil, ignore only + FOCUS_IN/OUT_EVENT events. */ if (kbd_fetch_ptr != kbd_store_ptr) { /* See https://lists.gnu.org/r/emacs-devel/2005-05/msg00297.html @@ -3466,8 +3472,11 @@ readable_events (int flags) #ifdef USE_TOOLKIT_SCROLL_BARS (flags & READABLE_EVENTS_FILTER_EVENTS) && #endif - (event->kind == FOCUS_IN_EVENT - || event->kind == FOCUS_OUT_EVENT)) + ((input_pending_p_filter_events + && (event->kind == FOCUS_IN_EVENT + || event->kind == FOCUS_OUT_EVENT)) + || (!input_pending_p_filter_events + && is_ignored_event (event)))) #ifdef USE_TOOLKIT_SCROLL_BARS && !((flags & READABLE_EVENTS_IGNORE_SQUEEZABLES) && (event->kind == SCROLL_BAR_CLICK_EVENT @@ -3649,29 +3658,10 @@ kbd_buffer_store_buffered_event (union buffered_input_event *event, #endif /* subprocesses */ } - Lisp_Object ignore_event; - - switch (event->kind) - { - case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; - case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; - case HELP_EVENT: ignore_event = Qhelp_echo; break; - case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; - case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; - case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; -#ifdef USE_FILE_NOTIFY - case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; -#endif -#ifdef HAVE_DBUS - case DBUS_EVENT: ignore_event = Qdbus_event; break; -#endif - default: ignore_event = Qnil; break; - } - /* If we're inside while-no-input, and this event qualifies as input, set quit-flag to cause an interrupt. */ if (!NILP (Vthrow_on_input) - && NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events))) + && !is_ignored_event (event)) Vquit_flag = Vthrow_on_input; } @@ -11629,6 +11619,31 @@ init_while_no_input_ignore_events (void) return events; } +static bool +is_ignored_event (union buffered_input_event *event) +{ + Lisp_Object ignore_event; + + switch (event->kind) + { + case FOCUS_IN_EVENT: ignore_event = Qfocus_in; break; + case FOCUS_OUT_EVENT: ignore_event = Qfocus_out; break; + case HELP_EVENT: ignore_event = Qhelp_echo; break; + case ICONIFY_EVENT: ignore_event = Qiconify_frame; break; + case DEICONIFY_EVENT: ignore_event = Qmake_frame_visible; break; + case SELECTION_REQUEST_EVENT: ignore_event = Qselection_request; break; +#ifdef USE_FILE_NOTIFY + case FILE_NOTIFY_EVENT: ignore_event = Qfile_notify; break; +#endif +#ifdef HAVE_DBUS + case DBUS_EVENT: ignore_event = Qdbus_event; break; +#endif + default: ignore_event = Qnil; break; + } + + return !NILP (Fmemq (ignore_event, Vwhile_no_input_ignore_events)); +} + static void syms_of_keyboard_for_pdumper (void); void @@ -12539,6 +12554,14 @@ bound to a command, Emacs will use the lower case binding. Setting this variable to nil inhibits this behaviour. */); translate_upper_case_key_bindings = true; + DEFVAR_BOOL ("input-pending-p-filter-events", + input_pending_p_filter_events, + doc: /* If non-nil, `input-pending-p' ignores some input events. +If this variable is non-nil (the default), `input-pending-p' and +other similar functions ignore input events in `while-no-input-ignore-events'. +This flag may eventually be removed once this behavior is deemed safe. */); + input_pending_p_filter_events = true; + pdumper_do_now_and_after_load (syms_of_keyboard_for_pdumper); } commit f52fa1c1503e86c9388f0f6ceb1ef6780ee7f30b Author: Stefan Kangas Date: Thu Oct 28 12:54:07 2021 +0200 image-dired: Unreverse accidentally reversed menus * lisp/image-dired.el (image-dired-thumbnail-mode-map) (image-dired-display-image-mode-map, image-dired-minor-mode-map): In Emacs 26.1 (commits b905454680c7 and bed0373855ea), the menus were converted to use 'easy-menu-define', but they were reversed in the process. Unreverse the menus. (Bug#51446) diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 9985e5a54b..329085c823 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1547,33 +1547,33 @@ You probably want to use this together with (easy-menu-define nil map "Menu for `image-dired-thumbnail-mode'." '("Image-Dired" - ["Quit" quit-window] - ["Delete thumbnail from buffer" image-dired-delete-char] - ["Delete marked images" image-dired-delete-marked] - ["Remove tag from current or marked thumbnails" - image-dired-tag-thumbnail-remove] - ["Tag current or marked thumbnails" image-dired-tag-thumbnail] - ["Comment thumbnail" image-dired-comment-thumbnail] - ["Refresh thumb" image-dired-refresh-thumb] - ["Dynamic line up" image-dired-line-up-dynamic] - ["Line up thumbnails" image-dired-line-up] - - ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] - ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] - ["Rotate original left" image-dired-rotate-original-left] - ["Rotate original right" image-dired-rotate-original-right] + ["Display image" image-dired-display-thumbnail-original-image] + ["Display in external viewer" image-dired-thumbnail-display-external] - ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking] + ["Mark original" image-dired-mark-thumb-original-file] + ["Unmark original" image-dired-unmark-thumb-original-file] + ["Flag original for deletion" image-dired-flag-thumb-original-file] - ["Jump to dired buffer" image-dired-jump-original-dired-buffer] ["Track original" image-dired-track-original-file] + ["Jump to dired buffer" image-dired-jump-original-dired-buffer] - ["Flag original for deletion" image-dired-flag-thumb-original-file] - ["Unmark original" image-dired-unmark-thumb-original-file] - ["Mark original" image-dired-mark-thumb-original-file] + ["Toggle movement tracking on/off" image-dired-toggle-movement-tracking] - ["Display in external viewer" image-dired-thumbnail-display-external] - ["Display image" image-dired-display-thumbnail-original-image])) + ["Rotate original right" image-dired-rotate-original-right] + ["Rotate original left" image-dired-rotate-original-left] + ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] + ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] + + ["Line up thumbnails" image-dired-line-up] + ["Dynamic line up" image-dired-line-up-dynamic] + ["Refresh thumb" image-dired-refresh-thumb] + ["Comment thumbnail" image-dired-comment-thumbnail] + ["Tag current or marked thumbnails" image-dired-tag-thumbnail] + ["Remove tag from current or marked thumbnails" + image-dired-tag-thumbnail-remove] + ["Delete marked images" image-dired-delete-marked] + ["Delete thumbnail from buffer" image-dired-delete-char] + ["Quit" quit-window])) map) "Keymap for `image-dired-thumbnail-mode'.") @@ -1606,9 +1606,9 @@ You probably want to use this together with (easy-menu-define nil map "Menu for `image-dired-display-image-mode-map'." '("Image-Dired" - ["Quit" quit-window] + ["Display original, full size" image-dired-display-current-image-full] ["Display original, sized to fit" image-dired-display-current-image-sized] - ["Display original, full size" image-dired-display-current-image-full])) + ["Quit" quit-window])) map) "Keymap for `image-dired-display-image-mode'.") @@ -1675,25 +1675,25 @@ Resized or in full-size." (easy-menu-define nil map "Menu for `image-dired-minor-mode'." '("Image-dired" - ["Copy with EXIF file name" image-dired-copy-with-exif-file-name] - ["Comment files" image-dired-dired-comment-files] - ["Mark tagged files" image-dired-mark-tagged-files] - ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] + ["Display thumb for next file" image-dired-next-line-and-display] + ["Display thumb for previous file" image-dired-previous-line-and-display] + ["Mark and display next" image-dired-mark-and-display-next] - ["Toggle movement tracking" image-dired-toggle-movement-tracking] - ["Toggle append browsing" image-dired-toggle-append-browsing] - ["Toggle display properties" image-dired-toggle-dired-display-properties] + ["Create thumbnails for marked files" image-dired-create-thumbs] - ["Display in external viewer" image-dired-dired-display-external] - ["Display image" image-dired-dired-display-image] - ["Display this thumbnail" image-dired-display-thumb] ["Display thumbnails append" image-dired-display-thumbs-append] + ["Display this thumbnail" image-dired-display-thumb] + ["Display image" image-dired-dired-display-image] + ["Display in external viewer" image-dired-dired-display-external] - ["Create thumbnails for marked files" image-dired-create-thumbs] + ["Toggle display properties" image-dired-toggle-dired-display-properties] + ["Toggle append browsing" image-dired-toggle-append-browsing] + ["Toggle movement tracking" image-dired-toggle-movement-tracking] - ["Mark and display next" image-dired-mark-and-display-next] - ["Display thumb for previous file" image-dired-previous-line-and-display] - ["Display thumb for next file" image-dired-next-line-and-display])) + ["Jump to thumbnail buffer" image-dired-jump-thumbnail-buffer] + ["Mark tagged files" image-dired-mark-tagged-files] + ["Comment files" image-dired-dired-comment-files] + ["Copy with EXIF file name" image-dired-copy-with-exif-file-name])) map) "Keymap for `image-dired-minor-mode'.") commit 0f8417d597cbcb136b1e1c2326c701d83c5a2da9 Author: Stefan Kangas Date: Thu Oct 28 12:30:42 2021 +0200 Be more allowing when looking for menu-bar items Don't merge to master. This is a safe-for-release fix for Bug#50752. * src/keymap.c (lookup_key_1): Factor out function from Flookup_key. (Flookup_key): Be case insensitive when looking for Qmenu_bar items. (Bug#50752) * test/src/keymap-tests.el (keymap-lookup-key/mixed-case) (keymap-lookup-key/mixed-case-multibyte): New tests. diff --git a/etc/NEWS b/etc/NEWS index a2b7baf1ad..9f1a00134d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4343,6 +4343,14 @@ The new optional "," parameter has been added, and ** 'parse-time-string' can now parse ISO 8601 format strings. These have a format like "2020-01-15T16:12:21-08:00". +--- +** 'lookup-key' is more allowing when searching for extended menu items. +When looking for a menu item '[menu-bar Foo-Bar]', first try to find +an exact match, then look for the lowercased '[menu-bar foo-bar]'. +It will only try to downcase ASCII characters in the range "A-Z". +This improves backwards-compatibility when converting menus to use +'easy-menu-define'. + --- ** 'make-network-process', 'make-serial-process' ':coding' behavior change. Previously, passing ':coding nil' to either of these functions would diff --git a/src/keymap.c b/src/keymap.c index 940a6f492e..f7529f808b 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1183,27 +1183,8 @@ remapping in all currently active keymaps. */) return FIXNUMP (command) ? Qnil : command; } -/* Value is number if KEY is too long; nil if valid but has no definition. */ -/* GC is possible in this function. */ - -DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* Look up key sequence KEY in KEYMAP. Return the definition. -A value of nil means undefined. See doc of `define-key' -for kinds of definitions. - -A number as value means KEY is "too long"; -that is, characters or symbols in it except for the last one -fail to be a valid sequence of prefix characters in KEYMAP. -The number is how many characters at the front of KEY -it takes to reach a non-prefix key. -KEYMAP can also be a list of keymaps. - -Normally, `lookup-key' ignores bindings for t, which act as default -bindings, used when nothing else in the keymap applies; this makes it -usable as a general function for probing keymaps. However, if the -third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will -recognize the default bindings, just as `read-key-sequence' does. */) - (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +static Lisp_Object +lookup_key_1 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) { bool t_ok = !NILP (accept_default); @@ -1243,6 +1224,63 @@ recognize the default bindings, just as `read-key-sequence' does. */) } } +/* Value is number if KEY is too long; nil if valid but has no definition. */ +/* GC is possible in this function. */ + +DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, + doc: /* Look up key sequence KEY in KEYMAP. Return the definition. +A value of nil means undefined. See doc of `define-key' +for kinds of definitions. + +A number as value means KEY is "too long"; +that is, characters or symbols in it except for the last one +fail to be a valid sequence of prefix characters in KEYMAP. +The number is how many characters at the front of KEY +it takes to reach a non-prefix key. +KEYMAP can also be a list of keymaps. + +Normally, `lookup-key' ignores bindings for t, which act as default +bindings, used when nothing else in the keymap applies; this makes it +usable as a general function for probing keymaps. However, if the +third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will +recognize the default bindings, just as `read-key-sequence' does. */) + (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default) +{ + Lisp_Object found = lookup_key_1 (keymap, key, accept_default); + if (!NILP (found) && !NUMBERP (found)) + return found; + + /* Menu definitions might use mixed case symbols (notably in old + versions of `easy-menu-define'). We accept this variation for + backwards-compatibility. (Bug#50752) */ + ptrdiff_t key_len = ASIZE (key); + if (VECTORP (key) && key_len > 0 && EQ (AREF (key, 0), Qmenu_bar)) + { + Lisp_Object new_key = make_vector (key_len, Qnil); + for (int i = 0; i < key_len; ++i) + { + Lisp_Object sym = Fsymbol_name (AREF (key, i)); + USE_SAFE_ALLOCA; + unsigned char *dst = SAFE_ALLOCA (SBYTES (sym) + 1); + memcpy (dst, SSDATA (sym), SBYTES (sym)); + /* We can walk the string data byte by byte, because UTF-8 + encoding ensures that no other byte of any multibyte + sequence will ever include a 7-bit byte equal to an ASCII + single-byte character. */ + for (int j = 0; j < SBYTES (sym); ++j) + if (dst[j] >= 'A' && dst[j] <= 'Z') + dst[j] += 'a' - 'A'; /* Convert to lower case. */ + ASET (new_key, i, Fintern (make_multibyte_string ((char *) dst, + SCHARS (sym), + SBYTES (sym)), + Qnil)); + SAFE_FREE (); + } + found = lookup_key_1 (keymap, new_key, accept_default); + } + return found; +} + /* Make KEYMAP define event C as a keymap (i.e., as a prefix). Assume that currently it does not define C at all. Return the keymap. */ diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index 68b42c346c..1943e719ab 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -124,6 +124,16 @@ ;; (ert-deftest keymap-lookup-key/accept-default () ;; ...) +(ert-deftest keymap-lookup-key/mixed-case () + "Backwards compatibility behaviour (Bug#50752)." + (let ((map (make-keymap))) + (define-key map [menu-bar foo bar] 'foo) + (should (eq (lookup-key map [menu-bar foo bar]) 'foo)) + (should (eq (lookup-key map [menu-bar Foo Bar]) 'foo))) + (let ((map (make-keymap))) + (define-key map [menu-bar i-bar] 'foo) + (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))) + (ert-deftest describe-buffer-bindings/header-in-current-buffer () "Header should be inserted into the current buffer. https://debbugs.gnu.org/39149#31" commit cb949963570ad0dbe272109f0245ca21029e2e5c Author: Stefan Kangas Date: Thu Oct 28 02:10:09 2021 +0200 Do interactive mode tagging in image-dired.el * lisp/image-dired.el (image-dired-restore-window-configuration) (image-dired-next-line, image-dired-previous-line) (image-dired-mark-thumb-original-file) (image-dired-unmark-thumb-original-file) (image-dired-flag-thumb-original-file) (image-dired-toggle-mark-thumb-original-file) (image-dired-jump-original-dired-buffer) (image-dired-delete-char, image-dired-refresh-thumb) (image-dired-display-next-thumbnail-original) (image-dired-display-previous-thumbnail-original): Do interactive tagging; these will only work in 'image-dired-thumbnail-mode'. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index fd3507a6d4..53bead350c 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1046,7 +1046,7 @@ calling `image-dired-restore-window-configuration'." "Restore window configuration. Restore any changes to the window configuration made by calling `image-dired-dired-with-window-configuration'." - (interactive) + (interactive nil image-dired-thumbnail-mode) (if image-dired-saved-window-configuration (set-window-configuration image-dired-saved-window-configuration) (message "No saved window configuration"))) @@ -1416,7 +1416,7 @@ image." (defun image-dired-next-line () "Move to next line and display properties." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line 1) (move-to-column goal-column)) @@ -1430,7 +1430,7 @@ image." (defun image-dired-previous-line () "Move to previous line and display properties." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((goal-column (current-column))) (forward-line -1) (move-to-column goal-column)) @@ -1524,25 +1524,25 @@ Dired." (defun image-dired-mark-thumb-original-file () "Mark original image file in associated Dired buffer." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-modify-mark-on-thumb-original-file 'mark) (image-dired-forward-image)) (defun image-dired-unmark-thumb-original-file () "Unmark original image file in associated Dired buffer." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-modify-mark-on-thumb-original-file 'unmark) (image-dired-forward-image)) (defun image-dired-flag-thumb-original-file () "Flag original image file for deletion in associated Dired buffer." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-modify-mark-on-thumb-original-file 'flag) (image-dired-forward-image)) (defun image-dired-toggle-mark-thumb-original-file () "Toggle mark on original image file in associated Dired buffer." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-modify-mark-on-thumb-original-file 'toggle)) (defun image-dired-unmark-all-marks () @@ -1557,7 +1557,7 @@ Do this in the Dired buffer and update this thumbnail buffer." "Jump to the Dired buffer associated with the current image file. You probably want to use this together with `image-dired-track-original-file'." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((buf (image-dired-associated-dired-buffer)) window frame) (setq window (image-dired-get-buffer-window buf)) @@ -1882,7 +1882,7 @@ Ask user for number of images to show and the delay in between." (defun image-dired-delete-char () "Remove current thumbnail from thumbnail buffer and line up." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let ((inhibit-read-only t)) (delete-char 1) (when (= (following-char) ?\s) @@ -2101,7 +2101,7 @@ With prefix argument ARG, display image in its original size." (defun image-dired-refresh-thumb () "Force creation of new image for current thumbnail." - (interactive) + (interactive nil image-dired-thumbnail-mode) (let* ((file (image-dired-original-file-name)) (thumb (expand-file-name (image-dired-thumb-name file)))) (clear-image-cache (expand-file-name thumb)) @@ -2236,13 +2236,13 @@ function. The result is a couple of new files in (defun image-dired-display-next-thumbnail-original () "In thumbnail buffer, move to next thumbnail and display the image." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-forward-image) (image-dired-display-thumbnail-original-image)) (defun image-dired-display-previous-thumbnail-original () "Move to previous thumbnail and display image." - (interactive) + (interactive nil image-dired-thumbnail-mode) (image-dired-backward-image) (image-dired-display-thumbnail-original-image)) commit bc4937539e48e5c9bdf17383744c5e0b560699ad Author: Stefan Kangas Date: Thu Oct 28 01:59:01 2021 +0200 image-dired: Make thumbnail rotation commands obsolete * lisp/image-dired.el (image-dired-cmd-rotate-thumbnail-program) (image-dired-cmd-rotate-thumbnail-options) (image-dired-rotate-thumbnail) (image-dired-rotate-thumbnail-left) (image-dired-rotate-thumbnail-right): Make obsolete in favor of 'image-dired-refresh-thumb' and 'image-rotate'. It makes no sense to have destructive thumbnail rotation commands now that Emacs can rotate thumbnails in memory, and it is very fast to just generate a new one reflecting the rotation of the original. (image-dired-thumbnail-mode-map): Remove menu entries and key bindings for above obsolete commands. The rotate right keybinding had already been made ineffective by the local keymap added by 'insert-image'. diff --git a/etc/NEWS b/etc/NEWS index e475a49b98..4f48cfbd88 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -201,7 +201,7 @@ To improve security, if an sql product has ':password-in-comint' set to t, a password supplied via the minibuffer will be sent in-process, as opposed to via the command-line. -** Image Dired +** Image-Dired --- *** Reduce dependency on external "exiftool" command. @@ -242,6 +242,12 @@ as it used to be, back when entering a large directory could lock up Emacs for tens of seconds. In addition, you can now customize this option to nil to disable this confirmation completely. +--- +*** Make 'image-dired-rotate-thumbnail-(left|right)' obsolete. +Instead, use 'M-x image-dired-refresh-thumb' to generate a new +thumbnail, or 'M-x image-rotate' to rotate the thumbnail without +updating the thumbnail file. + ** Dired --- diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 122d8a5d9a..fd3507a6d4 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -376,25 +376,6 @@ Available format specifiers are the same as in :version "26.1" :type '(repeat (string :tag "Argument"))) -(defcustom image-dired-cmd-rotate-thumbnail-program - (if (executable-find "gm") "gm" "mogrify") - "Executable used to rotate thumbnail. -Used together with `image-dired-cmd-rotate-thumbnail-options'." - :type 'file - :version "29.1") - -(defcustom image-dired-cmd-rotate-thumbnail-options - (let ((opts '("-rotate" "%d" "%t"))) - (if (executable-find "gm") (cons "mogrify" opts) opts)) - "Arguments of command used to rotate thumbnail image. -Used with `image-dired-cmd-rotate-thumbnail-program'. -Available format specifiers are: %d which is replaced by the -number of (positive) degrees to rotate the image, normally 90 or 270 -\(for 90 degrees right and left), %t which is replaced by the file name -of the thumbnail file." - :version "29.1" - :type '(repeat (string :tag "Argument"))) - (defcustom image-dired-cmd-rotate-original-program "jpegtran" "Executable used to rotate original image. @@ -1651,8 +1632,6 @@ You probably want to use this together with (define-key map "\C-m" 'image-dired-display-thumbnail-original-image) (define-key map [C-return] 'image-dired-thumbnail-display-external) - (define-key map "l" 'image-dired-rotate-thumbnail-left) - (define-key map "r" 'image-dired-rotate-thumbnail-right) (define-key map "L" 'image-dired-rotate-original-left) (define-key map "R" 'image-dired-rotate-original-right) @@ -1698,8 +1677,6 @@ You probably want to use this together with ["Dynamic line up" image-dired-line-up-dynamic] ["Line up thumbnails" image-dired-line-up] - ["Rotate thumbnail left" image-dired-rotate-thumbnail-left] - ["Rotate thumbnail right" image-dired-rotate-thumbnail-right] ["Rotate original left" image-dired-rotate-original-left] ["Rotate original right" image-dired-rotate-original-right] @@ -2122,30 +2099,6 @@ With prefix argument ARG, display image in its original size." "Return non-nil if there is an `image-dired' thumbnail at point." (get-text-property (point) 'image-dired-thumbnail)) -(defun image-dired-rotate-thumbnail (degrees) - "Rotate thumbnail DEGREES degrees." - (image-dired--check-executable-exists - 'image-dired-cmd-rotate-thumbnail-program) - (if (not (image-dired-image-at-point-p)) - (message "No thumbnail at point") - (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) - (thumb (expand-file-name file)) - (spec (list (cons ?d degrees) (cons ?t thumb)))) - (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil - (mapcar (lambda (arg) (format-spec arg spec)) - image-dired-cmd-rotate-thumbnail-options)) - (clear-image-cache thumb)))) - -(defun image-dired-rotate-thumbnail-left () - "Rotate thumbnail left (counter clockwise) 90 degrees." - (interactive) - (image-dired-rotate-thumbnail "270")) - -(defun image-dired-rotate-thumbnail-right () - "Rotate thumbnail counter right (clockwise) 90 degrees." - (interactive) - (image-dired-rotate-thumbnail "90")) - (defun image-dired-refresh-thumb () "Force creation of new image for current thumbnail." (interactive) @@ -2912,6 +2865,56 @@ by the image file name and %t which is replaced by the tag name." (setq tag-value (buffer-substring (point-min) (point-max))))) tag-value)) +(defcustom image-dired-cmd-rotate-thumbnail-program + (if (executable-find "gm") "gm" "mogrify") + "Executable used to rotate thumbnail. +Used together with `image-dired-cmd-rotate-thumbnail-options'." + :type 'file + :version "29.1") +(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-program nil "29.1") + +(defcustom image-dired-cmd-rotate-thumbnail-options + (let ((opts '("-rotate" "%d" "%t"))) + (if (executable-find "gm") (cons "mogrify" opts) opts)) + "Arguments of command used to rotate thumbnail image. +Used with `image-dired-cmd-rotate-thumbnail-program'. +Available format specifiers are: %d which is replaced by the +number of (positive) degrees to rotate the image, normally 90 or 270 +\(for 90 degrees right and left), %t which is replaced by the file name +of the thumbnail file." + :version "29.1" + :type '(repeat (string :tag "Argument"))) +(make-obsolete-variable 'image-dired-cmd-rotate-thumbnail-options nil "29.1") + +(defun image-dired-rotate-thumbnail (degrees) + "Rotate thumbnail DEGREES degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (image-dired--check-executable-exists + 'image-dired-cmd-rotate-thumbnail-program) + (if (not (image-dired-image-at-point-p)) + (message "No thumbnail at point") + (let* ((file (image-dired-thumb-name (image-dired-original-file-name))) + (thumb (expand-file-name file)) + (spec (list (cons ?d degrees) (cons ?t thumb)))) + (apply #'call-process image-dired-cmd-rotate-thumbnail-program nil nil nil + (mapcar (lambda (arg) (format-spec arg spec)) + image-dired-cmd-rotate-thumbnail-options)) + (clear-image-cache thumb)))) + +(defun image-dired-rotate-thumbnail-left () + "Rotate thumbnail left (counter clockwise) 90 degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (interactive) + (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail)) + (image-dired-rotate-thumbnail "270"))) + +(defun image-dired-rotate-thumbnail-right () + "Rotate thumbnail counter right (clockwise) 90 degrees." + (declare (obsolete image-dired-refresh-thumb "29.1")) + (interactive) + (with-suppressed-warnings ((obsolete image-dired-rotate-thumbnail)) + (image-dired-rotate-thumbnail "90"))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;; TEST-SECTION ;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; commit 722a9080db719f6297eaa85f1a8c384e421a69dc Author: Stefan Kangas Date: Wed Oct 27 22:10:04 2021 +0200 ; * lisp/image-dired.el: Be more consistent with spelling. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 250a76ba12..122d8a5d9a 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -100,7 +100,7 @@ ;; * WARNING: The "database" format used might be changed so keep a ;; backup of `image-dired-db-file' when testing new versions. ;; -;; * `image-dired-display-image-mode' does not support animation +;; * `image-dired-display-image-mode' does not support animation. ;; ;; TODO ;; ==== @@ -131,14 +131,14 @@ ;; it probably needs rewriting `image-dired-display-thumbs' to be more general. ;; ;; * Find some way of toggling on and off really nice keybindings in -;; dired (for example, using C-n or instead of C-S-n). +;; Dired (for example, using C-n or instead of C-S-n). ;; Richard suggested that we could keep C-t as prefix for -;; image-dired commands as it is currently not used in dired. He +;; image-dired commands as it is currently not used in Dired. He ;; also suggested that `dired-next-line' and `dired-previous-line' ;; figure out if image-dired is enabled in the current buffer and, ;; if it is, call `image-dired-dired-next-line' and `image-dired-dired-previous-line', ;; respectively. Update: This is partly done; some bindings have -;; now been added to dired. +;; now been added to Dired. ;; ;; * Enhanced gallery creation with basic CSS-support and pagination ;; of tag pages with many pictures. @@ -172,7 +172,7 @@ (defcustom image-dired-dir (locate-user-emacs-file "image-dired/") "Directory where thumbnail images are stored. -The value of this option will be ignored if Image Dired is +The value of this option will be ignored if Image-Dired is customized to use the Thumbnail Managing Standard; they will be saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See `image-dired-thumbnail-storage'." @@ -180,7 +180,7 @@ saved in \"$XDG_CACHE_HOME/thumbnails/\" instead. See (defcustom image-dired-thumbnail-storage 'use-image-dired-dir "How `image-dired' stores thumbnail files. -There are two ways that Image Dired can store and generate +There are two ways that Image-Dired can store and generate thumbnails. If you set this variable to one of the two following values, they will be stored in the JPEG format: @@ -457,7 +457,7 @@ Used by `image-dired-gallery-generate' to leave out \"hidden\" images." This is the default size for both `image-dired-thumb-width' and `image-dired-thumb-height'. -The value of this option will be ignored if Image Dired is +The value of this option will be ignored if Image-Dired is customized to use the Thumbnail Managing Standard; the standard sizes will be used instead. See `image-dired-thumbnail-storage'." :type 'integer) @@ -1137,7 +1137,7 @@ If the number of image files in DIR exceeds `image-dired-show-all-from-dir-max-files', ask for confirmation before creating the thumbnail buffer. If that variable is nil, never ask for confirmation." - (interactive "DImage Dired: ") + (interactive "DImage-Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) (let ((files (dired-get-marked-files nil nil nil t))) @@ -2256,7 +2256,7 @@ default value at the prompt." (defun image-dired-copy-with-exif-file-name () "Copy file with unique name to main image directory. -Copy current or all marked files in dired to a new file in your +Copy current or all marked files in Dired to a new file in your main image directory, using a file name generated by `image-dired-get-exif-file-name'. A typical usage for this if when copying images from a digital camera into the image directory. commit 75ebbc6a27e28227ab4a6b9f5ba114056478f885 Author: Stefan Kangas Date: Wed Oct 27 21:04:10 2021 +0200 image-dired: Don't show thumbnails if there are no image files * lisp/image-dired.el (image-dired-show-all-from-dir): Don't show thumbnail buffer if there are no image files. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 1239821b01..250a76ba12 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -1140,18 +1140,19 @@ never ask for confirmation." (interactive "DImage Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) - (let ((files (dired-get-marked-files))) - (if (or (not image-dired-show-all-from-dir-max-files) - (<= (length files) image-dired-show-all-from-dir-max-files) - (and (> (length files) image-dired-show-all-from-dir-max-files) - (y-or-n-p - (format - "Directory contains more than %d image files. Proceed? " - image-dired-show-all-from-dir-max-files)))) - (progn - (image-dired-display-thumbs) - (pop-to-buffer image-dired-thumbnail-buffer)) - (message "Canceled.")))) + (let ((files (dired-get-marked-files nil nil nil t))) + (cond ((and (null (cdr files))) + (message "No image files in directory")) + ((or (not image-dired-show-all-from-dir-max-files) + (<= (length (cdr files)) image-dired-show-all-from-dir-max-files) + (and (> (length (cdr files)) image-dired-show-all-from-dir-max-files) + (y-or-n-p + (format + "Directory contains more than %d image files. Proceed?" + image-dired-show-all-from-dir-max-files)))) + (image-dired-display-thumbs) + (pop-to-buffer image-dired-thumbnail-buffer)) + (t (message "Image-Dired canceled"))))) ;;;###autoload (defalias 'image-dired 'image-dired-show-all-from-dir) commit c70fdcdd114659d5358256938013c22a70b18f07 Author: Stefan Kangas Date: Wed Oct 27 20:39:10 2021 +0200 Increase image-dired-show-all-from-dir-max-files to 500 * lisp/image-dired.el (image-dired-show-all-from-dir-max-files): Increase default to 500 to ask for confirmation much less frequently. The old value was added before we had asynchronous generation of thumbnails, when a large number of files would lock up Emacs. Asking for confirmation could probably be disabled completely these days, but let's be conservative and set it to some large number of files for which some users might want to see a prompt. It can't hurt. (image-dired-show-all-from-dir): Never warn if above variable is nil. (image-dired-bookmark-jump): Let-bind above variable to nil instead of 'most-positive-fixnum'. * doc/emacs/dired.texi (Image-Dired): Don't mention the above variable, as it is no longer important enough to deserve the space. * etc/NEWS: Announce the above change. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 9cdd4b805e..387ccdf4a5 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1509,8 +1509,7 @@ image-dired}. This prompts for a directory; specify one that has image files. This creates thumbnails for all the images in that directory, and displays them all in the thumbnail buffer. The thumbnails are generated in the background and are loaded as they -become available. This command asks for confirmation if the number of -image files exceeds @code{image-dired-show-all-from-dir-max-files}. +become available. With point in the thumbnail buffer, you can type @key{RET} (@code{image-dired-display-thumbnail-original-image}) to display a diff --git a/etc/NEWS b/etc/NEWS index 2106a62c8f..e475a49b98 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -233,6 +233,15 @@ The command 'bookmark-set' (bound to 'C-x r m') is now supported in the thumbnail view, and will create a bookmark that opens the current directory in Image-Dired. ++++ +*** 'image-dired-show-all-from-dir-max-files' has been increased to 500. +This option controls asking for confirmation when starting Image-Dired +in a directory with many files. However, Image-Dired creates +thumbnails in the background these days, so this is not as important +as it used to be, back when entering a large directory could lock up +Emacs for tens of seconds. In addition, you can now customize this +option to nil to disable this confirmation completely. + ** Dired --- diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 2eddf3c9e0..1239821b01 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -573,11 +573,15 @@ Used by `image-dired-copy-with-exif-file-name'." :type 'string :version "29.1") -(defcustom image-dired-show-all-from-dir-max-files 100 +(defcustom image-dired-show-all-from-dir-max-files 500 "Maximum number of files in directory before prompting. -If there are more files than this in a selected directory, the -`image-dired-show-all-from-dir' command will show a prompt." - :type 'integer + +If there are more image files than this in a selected directory, +the `image-dired-show-all-from-dir' command will ask for +confirmation before creating the thumbnail buffer. If this +variable is nil, it will never ask." + :type '(choice integer + (const :tag "Disable warning" nil)) :version "29.1") (defvar image-dired-debug nil @@ -1125,15 +1129,20 @@ thumbnail buffer to be selected." ;;;###autoload (defun image-dired-show-all-from-dir (dir) - "Make a preview buffer for all images in DIR and display it. -If the number of files in DIR matching `image-file-name-regexp' -exceeds `image-dired-show-all-from-dir-max-files', a warning will be -displayed." + "Make a thumbnail buffer for all images in DIR and display it. +Any file matching `image-file-name-regexp' is considered an image +file. + +If the number of image files in DIR exceeds +`image-dired-show-all-from-dir-max-files', ask for confirmation +before creating the thumbnail buffer. If that variable is nil, +never ask for confirmation." (interactive "DImage Dired: ") (dired dir) (dired-mark-files-regexp (image-file-name-regexp)) (let ((files (dired-get-marked-files))) - (if (or (<= (length files) image-dired-show-all-from-dir-max-files) + (if (or (not image-dired-show-all-from-dir-max-files) + (<= (length files) image-dired-show-all-from-dir-max-files) (and (> (length files) image-dired-show-all-from-dir-max-files) (y-or-n-p (format @@ -2844,7 +2853,7 @@ tags to their respective image file. Internal function used by (defun image-dired-bookmark-jump (bookmark) "Default bookmark handler for Image-Dired buffers." ;; User already cached thumbnails, so disable any checking. - (let ((image-dired-show-all-from-dir-max-files most-positive-fixnum)) + (let ((image-dired-show-all-from-dir-max-files nil)) (image-dired (bookmark-prop-get bookmark 'location)) ;; TODO: Go to the bookmarked file, if it exists. ;; (bookmark-prop-get bookmark 'image-dired-file) commit c22b735f0c6261b485f0f2afa10ec4c598550b5b Author: Stefan Monnier Date: Wed Oct 27 14:03:43 2021 -0400 (string-pixel-width): Rewrite to avoid side effects * src/xdisp.c (Fwindow_text_pixel_size): Allow `window` to be a buffer. * lisp/emacs-lisp/subr-x.el (string-pixel-width): Simplify accordingly. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index f2060814f2..00668d4743 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -446,13 +446,8 @@ is inserted before adjusting the number of empty lines." "Return the width of STRING in pixels." (with-temp-buffer (insert string) - (save-window-excursion - ;; Avoid errors if the selected window is a dedicated one, - ;; and they just want to insert a document into it. - (set-window-dedicated-p nil nil) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point)))))) + (car (window-text-pixel-size + (current-buffer) (point-min) (point))))) (provide 'subr-x) diff --git a/src/xdisp.c b/src/xdisp.c index bbe7e2701b..aa01db210b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -10628,10 +10628,12 @@ in_display_vector_p (struct it *it) DEFUN ("window-text-pixel-size", Fwindow_text_pixel_size, Swindow_text_pixel_size, 0, 6, 0, doc: /* Return the size of the text of WINDOW's buffer in pixels. -WINDOW must be a live window and defaults to the selected one. The +WINDOW can be any live window and defaults to the selected one. The return value is a cons of the maximum pixel-width of any text line and the pixel-height of all the text lines in the accessible portion of buffer text. +WINDOW can also be a buffer, in which case the selected window is used, +and the function behaves as if that window was displaying this buffer. This function exists to allow Lisp programs to adjust the dimensions of WINDOW to the buffer text it needs to display. @@ -10675,8 +10677,9 @@ include the height of any of these, if present, in the return value. */) (Lisp_Object window, Lisp_Object from, Lisp_Object to, Lisp_Object x_limit, Lisp_Object y_limit, Lisp_Object mode_lines) { - struct window *w = decode_live_window (window); - Lisp_Object buffer = w->contents; + struct window *w = BUFFERP (window) ? XWINDOW (selected_window) + : decode_live_window (window); + Lisp_Object buffer = BUFFERP (window) ? window : w->contents; struct buffer *b; struct it it; struct buffer *old_b = NULL; commit 7e2b973d60cfd30f1828fabd8d9f33127f24e54a Author: Juri Linkov Date: Wed Oct 27 20:32:23 2021 +0300 * lisp/textmodes/text-mode.el (text-mode-context-menu): Rename recently added. diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 3243bd31c4..478cf62268 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -95,7 +95,7 @@ inherit all the commands defined in this map.") :style toggle :selected (memq 'turn-on-auto-fill text-mode-hook)])) -(defun text-mode-menu (menu click) +(defun text-mode-context-menu (menu click) "Populate MENU with text selection commands at CLICK." (when (thing-at-mouse click 'word) @@ -127,7 +127,7 @@ You can thus get the full benefit of adaptive filling Turning on Text mode runs the normal hook `text-mode-hook'." (setq-local text-mode-variant t) (setq-local require-final-newline mode-require-final-newline) - (add-hook 'context-menu-functions 'text-mode-menu 10 t)) + (add-hook 'context-menu-functions 'text-mode-context-menu 10 t)) (define-derived-mode paragraph-indent-text-mode text-mode "Parindent" "Major mode for editing text, with leading spaces starting a paragraph. commit da6d889e9072cdbca19e817c7b278ee322dc4786 Author: Juri Linkov Date: Wed Oct 27 20:30:59 2021 +0300 ; * etc/NEWS: Use active voice for 'repeat-mode', etc. diff --git a/etc/NEWS b/etc/NEWS index 96104ad868..a2b7baf1ad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -50,7 +50,7 @@ when using Cairo. Use 'ftcrhb' if your Emacs was built with HarfBuzz text shaping support, and 'ftcr' otherwise. You can determine this by checking 'system-configuration-features'. The 'ftcr' backend will still be available when HarfBuzz is supported, but will not be used by -default. We strongly recommend building with HarBuzz support. 'x' is +default. We strongly recommend building with HarfBuzz support. 'x' is still a valid backend. --- @@ -222,12 +222,13 @@ groups. +++ ** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'. -When this mode is enabled, clicking 'down-mouse-3' anywhere in the buffer -pops up a menu whose contents depends on surrounding context near the -mouse click. You can change the order of the default sub-menus in the -context menu by customizing the user option 'context-menu-functions'. -You can also invoke the context menu by pressing 'S-' or, -on macOS, by clicking 'C-down-mouse-1'. +When this mode is enabled, clicking 'down-mouse-3' (usually, the +right mouse button) anywhere in the buffer pops up a menu whose +contents depends on surrounding context near the mouse click. +You can change the order of the default sub-menus in the context menu +by customizing the user option 'context-menu-functions'. You can also +invoke the context menu by pressing 'S-' or, on macOS, by +clicking 'C-down-mouse-1'. +++ ** A new keymap for buffer actions has been added. @@ -438,7 +439,8 @@ nor t. *** New user option 'read-minibuffer-restore-windows'. When customized to nil, it uses 'minibuffer-restore-windows' in 'minibuffer-exit-hook' to remove only the window showing the -"*Completions*" buffer. +"*Completions*" buffer, but keeps all other windows created +while the minibuffer was active. --- *** New variable 'redisplay-adhoc-scroll-in-resize-mini-windows'. @@ -470,7 +472,7 @@ both modes are on). +++ *** The prefix key 'C-x t t' can be used to display a buffer in a new tab. Typing 'C-x t t' before a command will cause the buffer shown by that -command to be displayed in a new tab. 'C-x t t" is bound to the +command to be displayed in a new tab. 'C-x t t' is bound to the command 'other-tab-prefix'. +++ @@ -3238,7 +3240,7 @@ instead of 'C-x o C-x o' to switch windows, 'C-x { { } } ^ ^ v v' to resize the selected window interactively, 'M-g n n p p' to navigate next-error matches. Any other key exits this temporarily enabled transient mode that supports shorter keys, and then after exiting from -this mode the default key binding is used for the last typed key. +this mode, the last typed key uses the default key binding. The user option 'repeat-exit-key' defines an additional key usable to exit the mode like 'isearch-exit' ('RET'). commit e3171e7e860f77156873f13161a8833a210bae37 Author: Robert Pluim Date: Wed Oct 27 18:46:45 2021 +0200 Allow automatic use of color fonts for emoji on macOS * src/macfont.m (macfont_list): Don't exclude color fonts when the fontspec has an 'emoji' script specification. diff --git a/src/macfont.m b/src/macfont.m index d86f09f485..78ed5d53f3 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2415,8 +2415,12 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no continue; /* Don't use a color bitmap font unless its family is - explicitly specified. */ - if ((sym_traits & kCTFontTraitColorGlyphs) && NILP (family)) + explicitly specified or we're looking for a font for + emoji. */ + if ((sym_traits & kCTFontTraitColorGlyphs) + && NILP (family) + && !EQ (CDR_SAFE (assq_no_quit (QCscript, AREF (spec, FONT_EXTRA_INDEX))), + Qemoji)) continue; if (j > 0 commit 9559cc85e834a270b7627b3766df814946cd314a Author: Lars Ingebrigtsen Date: Wed Oct 27 17:49:30 2021 +0200 Revert "Add tentative key bindings for the three emoji commands" This reverts commit e678067cb5c4a642ef3fab1cc5046a34a4ae35d1. Applied to the wrong branch. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index c5f41e734f..81aabfb57d 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -576,16 +576,6 @@ using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single character based on its Unicode name or code-point; see @ref{Inserting Text}. -@cindex emoji - There are specialized commands for inserting emojis, and these can -be found on the @kbd{C-x 8 e} submap. @kbd{C-x 8 e e} -(@code{emoji-insert}) will let you navigate through different emoji -categories and then choose one. @kbd{C-x 8 e l} (@code{emoji-list}) -will pop up a new buffer and list all the emojis; clicking (or using -@kbd{RET}) on an emoji will insert it in the original buffer. -Finally, @kbd{C-x 8 e s} (@code{emoji-search}) will allow you to -search for an emoji based on its name. - @node Select Input Method @section Selecting an Input Method diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 7cc8ea3c6e..be4a4eb0cb 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3258,11 +3258,5 @@ as names, not numbers." (define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) -(define-key ctl-x-map "8e" - (define-keymap - "e" #'emoji-insert - "i" #'emoji-insert - "s" #'emoji-search - "l" #'emoji-list)) ;;; mule-cmds.el ends here commit e678067cb5c4a642ef3fab1cc5046a34a4ae35d1 Author: Lars Ingebrigtsen Date: Wed Oct 27 17:48:20 2021 +0200 Add tentative key bindings for the three emoji commands diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 81aabfb57d..c5f41e734f 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -576,6 +576,16 @@ using @kbd{C-x 8 @key{RET}} (@code{insert-char}) to insert a single character based on its Unicode name or code-point; see @ref{Inserting Text}. +@cindex emoji + There are specialized commands for inserting emojis, and these can +be found on the @kbd{C-x 8 e} submap. @kbd{C-x 8 e e} +(@code{emoji-insert}) will let you navigate through different emoji +categories and then choose one. @kbd{C-x 8 e l} (@code{emoji-list}) +will pop up a new buffer and list all the emojis; clicking (or using +@kbd{RET}) on an emoji will insert it in the original buffer. +Finally, @kbd{C-x 8 e s} (@code{emoji-search}) will allow you to +search for an emoji based on its name. + @node Select Input Method @section Selecting an Input Method diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index be4a4eb0cb..7cc8ea3c6e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -3258,5 +3258,11 @@ as names, not numbers." (define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) +(define-key ctl-x-map "8e" + (define-keymap + "e" #'emoji-insert + "i" #'emoji-insert + "s" #'emoji-search + "l" #'emoji-list)) ;;; mule-cmds.el ends here commit edcf9edc8c038dc501c9e7f30b41a4fa776d0503 Merge: 7c6f7dc99b 2bdd5732aa Author: Glenn Morris Date: Wed Oct 27 07:59:28 2021 -0700 Merge from origin/emacs-28 2bdd5732aa (origin/emacs-28) ; * etc/NEWS: Fix last change. 492b927909 Fix help commands for menu-bar menus 9589be772d ; * etc/NEWS: Fix typos. d353fc4a00 ; Explain why "kinds of atom" isn't a typo 47a3750162 ; * etc/NEWS: Improve wording of the Emoji entry. b814712796 ; Checkdoc fixes in image-dired.el e45b3fc521 Improve function documentation with text from XDG BDS spec 284c77eeb6 * lisp/transient.el: Update to package version 0.3.7. 40400e6977 ; Revert parts of "Use string-replace instead of replace-r... 214c2e268c ; Revert parts of "Use string-search instead of string-mat... # Conflicts: # etc/NEWS commit 7c6f7dc99bc036639bd1b64b412e8c3d3e0c044c Author: Lars Ingebrigtsen Date: Wed Oct 27 16:50:40 2021 +0200 Simplify string-pixel-width * lisp/emacs-lisp/subr-x.el (string-pixel-width): Simplify -- save-window-excursion saves dedication status (and the code was buggy). diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 6f01209574..f2060814f2 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -447,18 +447,12 @@ is inserted before adjusting the number of empty lines." (with-temp-buffer (insert string) (save-window-excursion - (let ((dedicated (window-dedicated-p))) - ;; Avoid errors if the selected window is a dedicated one, - ;; and they just want to insert a document into it. - (unwind-protect - (progn - (when dedicated - (set-window-dedicated-p nil nil)) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point)))) - (when dedicated - (set-window-dedicated-p nil dedicated))))))) + ;; Avoid errors if the selected window is a dedicated one, + ;; and they just want to insert a document into it. + (set-window-dedicated-p nil nil) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point)))))) (provide 'subr-x) commit 2bdd5732aaef336681476d83bb87d76f6750d34d Author: Eli Zaretskii Date: Wed Oct 27 17:13:59 2021 +0300 ; * etc/NEWS: Fix last change. diff --git a/etc/NEWS b/etc/NEWS index 7af1ecf5cb..96104ad868 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -163,9 +163,6 @@ this: (set-fontset-font t 'emoji '("My New Emoji Font" . "iso10646-1") nil 'prepend) -where "My New Emoji Font" should be replaced by the actual name of the -font you want to use. - The Emoji characters are now assigned to a special script, 'emoji', so as to make it easier to customize fontsets for Emoji display, as in the above example. (Previously, the Emoji characters were assigned to commit 713e19a60adde301e5d7edc79f92bbb1b25b71a8 Author: Lars Ingebrigtsen Date: Wed Oct 27 16:13:30 2021 +0200 Fix parsing of erts files * lisp/emacs-lisp/ert.el (ert-test-erts-file): Fix progress through a test file (bug#51409). diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 57655403c2..efc1825017 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2670,10 +2670,11 @@ TRANSFORM will be called to get from before to after." (insert-file-contents file) (let ((gen-specs (list (cons 'dummy t) (cons 'code transform)))) - ;; The start of the "before" part starts with a form feed and then - ;; the name of the test. + ;; Find the start of a test. (while (re-search-forward "^=-=\n" nil t) - (setq gen-specs (ert-test--erts-test gen-specs file)))))) + (setq gen-specs (ert-test--erts-test gen-specs file)) + ;; Search to the end of the test. + (re-search-forward "^=-=-=\n"))))) (defun ert-test--erts-test (gen-specs file) (let* ((file-buffer (current-buffer)) commit 5b61f2defe2e6332a242849bf63862053551a4c1 Author: Lars Ingebrigtsen Date: Wed Oct 27 16:04:31 2021 +0200 Harden ert-resource-directory against errors * lisp/emacs-lisp/ert-x.el (ert-resource-directory): Be more resilient -- don't bug out if called from a file that's not visiting a directory. diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 3fc57d5182..a492ef5093 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -368,17 +368,17 @@ variable `ert-resource-directory-format'. Before formatting, the file name will be trimmed using `string-trim' with arguments `ert-resource-directory-trim-left-regexp' and `ert-resource-directory-trim-right-regexp'." - `(let* ((testfile ,(or (macroexp-file-name) - buffer-file-name)) - (default-directory (file-name-directory testfile))) - (file-truename - (if (file-accessible-directory-p "resources/") - (expand-file-name "resources/") - (expand-file-name - (format ert-resource-directory-format - (string-trim testfile - ert-resource-directory-trim-left-regexp - ert-resource-directory-trim-right-regexp))))))) + `(when-let ((testfile ,(or (macroexp-file-name) + buffer-file-name))) + (let ((default-directory (file-name-directory testfile))) + (file-truename + (if (file-accessible-directory-p "resources/") + (expand-file-name "resources/") + (expand-file-name + (format ert-resource-directory-format + (string-trim testfile + ert-resource-directory-trim-left-regexp + ert-resource-directory-trim-right-regexp)))))))) (defmacro ert-resource-file (file) "Return absolute file name of resource (test data) file named FILE. commit 158932894b68f58a4417d2fe400dfb593e1067a0 Author: Jim Porter Date: Wed Oct 27 15:54:42 2021 +0200 Be more efficient when checking for a matching client in server.el lisp/server.el (server-handle-delete-frame): Use 'seq-some' to determine if another frame for the current client exists. (server-kill-emacs-query-function): Use 'seq-some' to determine if another live client exists (bug#51420). diff --git a/lisp/server.el b/lisp/server.el index 5306a54776..d998656237 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -485,11 +485,11 @@ If CLIENT is non-nil, add a description of it to the logged message." (when (and (frame-live-p frame) proc ;; See if this is the last frame for this client. - (>= 1 (let ((frame-num 0)) - (dolist (f (frame-list)) - (when (eq proc (frame-parameter f 'client)) - (setq frame-num (1+ frame-num)))) - frame-num))) + (not (seq-some + (lambda (f) + (and (not (eq frame f)) + (eq proc (frame-parameter f 'client)))) + (frame-list)))) (server-log (format "server-handle-delete-frame, frame %s" frame) proc) (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. @@ -1580,13 +1580,13 @@ specifically for the clients and did not exist before their request for it." (server-buffer-done (current-buffer)))) (defun server-kill-emacs-query-function () - "Ask before exiting Emacs if it has live clients." - (or (not (let (live-client) - (dolist (proc server-clients) - (when (memq t (mapcar #'buffer-live-p - (process-get proc 'buffers))) - (setq live-client t))) - live-client)) + "Ask before exiting Emacs if it has live clients. +A \"live client\" is a client with at least one live buffer +associated with it." + (or (not (seq-some (lambda (proc) + (seq-some #'buffer-live-p + (process-get proc 'buffers))) + server-clients)) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) (defun server-kill-buffer () commit 03366de3948225476545d891c584f7d30c497bd0 Author: Lars Ingebrigtsen Date: Wed Oct 27 15:41:18 2021 +0200 Add new function 'string-pixel-width' * doc/lispref/display.texi (Size of Displayed Text): Mention it. * lisp/emacs-lisp/shortdoc.el (string): Mention it. * lisp/emacs-lisp/subr-x.el (string-pixel-width): New function. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 92932af9ba..c9a9f7a2d5 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2008,7 +2008,8 @@ The return value is an approximation: it only considers the values returned by @code{char-width} for the constituent characters, always takes a tab character as taking @code{tab-width} columns, ignores display properties and fonts, etc. For these reasons, we recommend -using @code{window-text-pixel-size}, described below, instead. +using @code{window-text-pixel-size} or @code{string-pixel-width}, +described below, instead. @end defun @defun truncate-string-to-width string width &optional start-column padding ellipsis ellipsis-text-property @@ -2190,6 +2191,11 @@ though when this function is run from an idle timer with a delay of zero seconds. @end defun +@defun string-pixel-width string +This is a convenience function that uses @code{window-text-pixel-size} +to compute the width of @var{string} (in pixels). +@end defun + @defun line-pixel-height This function returns the height in pixels of the line at point in the selected window. The value includes the line spacing of the line diff --git a/etc/NEWS b/etc/NEWS index 093c8ac963..2106a62c8f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -397,6 +397,12 @@ syntax. This function returns t if point is on a valid image, and nil otherwise. ++++ +** New function 'string-pixel-width'. +This returns the width of a string in pixels. This can be useful when +dealing with variable pitch fonts and glyphs that have widths that +aren't integer multiples of the default font. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index 8f65437207..817dfa6b71 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -242,7 +242,14 @@ There can be any number of :example/:result elements." :eval (number-to-string 42)) "Data About Strings" (length - :eval (length "foo")) + :eval (length "foo") + :eval (length "avocado: πŸ₯‘")) + (string-width + :eval (string-width "foo") + :eval (string-width "avocado: πŸ₯‘")) + (string-pixel-width + :eval (string-pixel-width "foo") + :eval (string-pixel-width "avocado: πŸ₯‘")) (string-search :eval (string-search "bar" "foobarzot")) (assoc-string diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 8d6bb19fd4..6f01209574 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -441,6 +441,25 @@ is inserted before adjusting the number of empty lines." ((< (- (point) start) lines) (insert (make-string (- lines (- (point) start)) ?\n)))))) +;;;###autoload +(defun string-pixel-width (string) + "Return the width of STRING in pixels." + (with-temp-buffer + (insert string) + (save-window-excursion + (let ((dedicated (window-dedicated-p))) + ;; Avoid errors if the selected window is a dedicated one, + ;; and they just want to insert a document into it. + (unwind-protect + (progn + (when dedicated + (set-window-dedicated-p nil nil)) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point)))) + (when dedicated + (set-window-dedicated-p nil dedicated))))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/subr.el b/lisp/subr.el index 86460d9da6..39676249cd 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6734,5 +6734,4 @@ string will be displayed only if BODY takes longer than TIMEOUT seconds. (lambda () ,@body))) - ;;; subr.el ends here commit 3fac3120f8ba7941bac89fa90f30140492fdf0eb Author: Miha RihtarΕ‘ič Date: Tue Oct 26 10:54:54 2021 +0200 Allow matching non-.git gitlab and gitea URLs in bug-reference * lisp/progmodes/bug-reference.el (bug-reference--build-forge-setup-entry): Allow matching non-.git gitlab and gitea URLs, with and without slashes (bug#51316). diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 993d670917..d7092a37d4 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -287,7 +287,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'gitlab)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) @@ -304,7 +304,7 @@ via the internet it might also be http.") (cl-defmethod bug-reference--build-forge-setup-entry (host-domain (_forge-type (eql 'gitea)) protocol) `(,(concat "[/@]" (regexp-quote host-domain) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "[/:]\\([.A-Za-z0-9_/-]+?\\)\\(?:\\.git\\)?/?\\'") "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) diff --git a/test/lisp/progmodes/bug-reference-tests.el b/test/lisp/progmodes/bug-reference-tests.el index 7a355509a1..7a3ab5fbda 100644 --- a/test/lisp/progmodes/bug-reference-tests.el +++ b/test/lisp/progmodes/bug-reference-tests.el @@ -26,12 +26,26 @@ (require 'bug-reference) (require 'ert) -(defun test--get-github-entry (protocol) +(defun test--get-github-entry (url) (and (string-match (car (bug-reference--build-forge-setup-entry - "github.com" 'github protocol)) - protocol) - (match-string 1 protocol))) + "github.com" 'github "https")) + url) + (match-string 1 url))) + +(defun test--get-gitlab-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitlab.com" 'gitlab "https")) + url) + (match-string 1 url))) + +(defun test--get-gitea-entry (url) + (and (string-match + (car (bug-reference--build-forge-setup-entry + "gitea.com" 'gitea "https")) + url) + (match-string 1 url))) (ert-deftest test-github-entry () (should @@ -59,4 +73,56 @@ (test--get-github-entry "https://github.com/magit/magit/") "magit/magit"))) +(ert-deftest test-gitlab-entry () + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "git@gitlab.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitlab-entry "https://gitlab.com/magit/magit/") + "magit/magit"))) + +(ert-deftest test-gitea-entry () + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid.git") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "git@gitea.com:larsmagne/csid") + "larsmagne/csid")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit.git/") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit") + "magit/magit")) + (should + (equal + (test--get-gitea-entry "https://gitea.com/magit/magit/") + "magit/magit"))) + ;;; bug-reference-tests.el ends here commit 65cd2d90b7a894c184f45bfff52b7c6200ebc639 Author: Eli Zaretskii Date: Wed Oct 27 16:14:55 2021 +0300 ; * src/atimer.c (init_atimer): Fix a typo in a comment. diff --git a/src/atimer.c b/src/atimer.c index 802f3c6a59..ab47bbf968 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -584,9 +584,10 @@ init_atimer (void) timerfd_create (CLOCK_REALTIME, TFD_NONBLOCK | TFD_CLOEXEC)); # endif /* We're starting the alarms even if we have timerfd, because - timerfd events do not fired while Emacs Lisp is busy. This might - or might not mean that the timerfd code doesn't really give us - anything and should be removed, see discussion in bug#19776. */ + timerfd events do not fire while Emacs Lisp is busy and doesn't + call thread_select. This might or might not mean that the + timerfd code doesn't really give us anything and should be + removed, see discussion in bug#19776. */ struct sigevent sigev; sigev.sigev_notify = SIGEV_SIGNAL; sigev.sigev_signo = SIGALRM; commit 492b92790951a50c7a67ae7d112fae9dfa9f3e86 Author: Eli Zaretskii Date: Wed Oct 27 16:09:47 2021 +0300 Fix help commands for menu-bar menus * lisp/help.el (help--analyze-key): Fix "C-h c" and "C-h k" on menu-bar menu items. (Bug#51421) diff --git a/lisp/help.el b/lisp/help.el index 92e22aecb5..d22f50de8a 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -701,7 +701,13 @@ in the selected window." ;; is selected from the context menu that should describe KEY ;; at the position of mouse click that opened the context menu. ;; When no mouse was involved, don't use `mouse-set-point'. - (defn (if buffer (key-binding key t) + (defn (if (or buffer + ;; Clicks on the menu bar produce "event" that + ;; is just '(menu-bar)', for which + ;; `mouse-set-point' is not useful. + (and (not (windowp (posn-window (event-start event)))) + (not (framep (posn-window (event-start event)))))) + (key-binding key t) (save-excursion (mouse-set-point event) (key-binding key t))))) ;; Handle the case where we faked an entry in "Select and Paste" menu. (when (and (eq defn nil) commit 4107549a614a9977cdec4cb7a1d5eaec72a3380f Author: Lars Ingebrigtsen Date: Wed Oct 27 14:58:08 2021 +0200 Always start the SIGALRM atimers * src/atimer.c (init_atimer): Always start the SIGALRM alarms, even if we're using timerfd (bug#19776). See long, long discussion in the bug report for why this is necessary. diff --git a/src/atimer.c b/src/atimer.c index 9b198675ab..802f3c6a59 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -583,15 +583,16 @@ init_atimer (void) timerfd = (egetenv ("EMACS_IGNORE_TIMERFD") || have_buggy_timerfd () ? -1 : timerfd_create (CLOCK_REALTIME, TFD_NONBLOCK | TFD_CLOEXEC)); # endif - if (timerfd < 0) - { - struct sigevent sigev; - sigev.sigev_notify = SIGEV_SIGNAL; - sigev.sigev_signo = SIGALRM; - sigev.sigev_value.sival_ptr = &alarm_timer; - alarm_timer_ok - = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; - } + /* We're starting the alarms even if we have timerfd, because + timerfd events do not fired while Emacs Lisp is busy. This might + or might not mean that the timerfd code doesn't really give us + anything and should be removed, see discussion in bug#19776. */ + struct sigevent sigev; + sigev.sigev_notify = SIGEV_SIGNAL; + sigev.sigev_signo = SIGALRM; + sigev.sigev_value.sival_ptr = &alarm_timer; + alarm_timer_ok + = timer_create (CLOCK_REALTIME, &sigev, &alarm_timer) == 0; #endif free_atimers = stopped_atimers = atimers = NULL; commit 14d835a2985379bae1540927fa422c5e35cfb792 Author: Lars Ingebrigtsen Date: Wed Oct 27 14:56:50 2021 +0200 Redisplay after changing to the hourglass mouse pointer * src/xterm.c (x_show_hourglass): Do a redisplay after changing to the hourglass pointer -- otherwise it won't be displayed until a keyboard/mouse event arrives (bug#19776). diff --git a/src/xterm.c b/src/xterm.c index 961c61c245..aa1a1a5eed 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4126,6 +4126,7 @@ x_show_hourglass (struct frame *f) XMapRaised (dpy, x->hourglass_window); XFlush (dpy); + redisplay_preserve_echo_area (21); } } } commit 9589be772d7c2b497711097d2a806ef767037591 Author: Michael Albinus Date: Wed Oct 27 14:11:09 2021 +0200 ; * etc/NEWS: Fix typos. diff --git a/etc/NEWS b/etc/NEWS index 5c8a58ef10..7af1ecf5cb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -146,7 +146,7 @@ of files visited via 'C-x C-f' and other commands. ** Emacs now supports Unicode Standard version 14.0. +++ -** Improved support for Emoji +** Improved support for Emoji. On capable systems, Emacs now correctly displays Emoji and Emoji sequences by default, provided that a suitable font is available to Emacs. With a few exceptions, all of the Emoji sequences specified by @@ -155,8 +155,8 @@ colorful glyph. This is achieved by changes in the Emacs font configuration, and by additional character-composition rules for the Emoji codepoints that follow from the Unicode-defined sequences. -If your system lacks a suitable font, we recommend to install Noto -Color Emoji; Emacs will use it automatically if it's installed. If +If your system lacks a suitable font, we recommend to install "Noto +Color Emoji"; Emacs will use it automatically if it's installed. If you prefer to use another font for Emoji, customize your fontset like this: commit d353fc4a005472f6ac4ac3d530cee18a51c00243 Author: Eli Zaretskii Date: Wed Oct 27 14:33:42 2021 +0300 ; Explain why "kinds of atom" isn't a typo * doc/lispintro/emacs-lisp-intro.texi (Lisp Atoms): Add a comment explaining why "kinds of atom" isn't a typo. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 6ecd552ebb..391b6d9c59 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -1162,6 +1162,10 @@ computer. Often, people use the term @dfn{expression} indiscriminately. (Also, in many texts, the word @dfn{form} is used as a synonym for expression.) +@c This and the next paragraph say ``kinds of atom'', but that is not +@c a typo, just slightly ``old-fashioned wording which adds a fillip +@c of interest to it'', and ``is more elegant writing'', according to +@c RMS. Incidentally, the atoms that make up our universe were named such when they were thought to be indivisible; but it has been found that physical atoms are not indivisible. Parts can split off an atom or it can commit 47a3750162b9e7015d96c60d7fa979876f0e63f4 Author: Eli Zaretskii Date: Wed Oct 27 14:32:18 2021 +0300 ; * etc/NEWS: Improve wording of the Emoji entry. diff --git a/etc/NEWS b/etc/NEWS index 7f9797e1fa..5c8a58ef10 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -146,41 +146,37 @@ of files visited via 'C-x C-f' and other commands. ** Emacs now supports Unicode Standard version 14.0. +++ -** New character script 'emoji' has been created. -Various blocks of codepoints have been split out of the 'symbol' -script into their own 'emoji' script to allow easier specification of -their treatment. Which codepoints are treated as emoji is derived -from the Unicode specifications. Also, Emacs will now use "Noto Color -Emoji" by default for that script. Use: +** Improved support for Emoji +On capable systems, Emacs now correctly displays Emoji and Emoji +sequences by default, provided that a suitable font is available to +Emacs. With a few exceptions, all of the Emoji sequences specified by +Unicode 14.0 are automatically composed and displayed as a single +colorful glyph. This is achieved by changes in the Emacs font +configuration, and by additional character-composition rules for the +Emoji codepoints that follow from the Unicode-defined sequences. + +If your system lacks a suitable font, we recommend to install Noto +Color Emoji; Emacs will use it automatically if it's installed. If +you prefer to use another font for Emoji, customize your fontset like +this: (set-fontset-font t 'emoji '("My New Emoji Font" . "iso10646-1") nil 'prepend) -to change the font used. +where "My New Emoji Font" should be replaced by the actual name of the +font you want to use. -+++ -** Zero Width Joiner (ZWJ) and emoji sequences are now composed. -Emacs can now compose (almost) all the Unicode-14 ZWJ and emoji -sequences (if a suitable font is installed) so that they are displayed -as single glyphs instead of multiple ones. "Noto Color Emoji" is one -such suitable font. - -+++ -** Composition of emoji has been improved. -If autocomposition is triggered by an emoji character, then the emoji -font is now used to check if composition can be performed, rather than -the font of the first character of the string being composed. This -allows e.g. - - 'Emoji codepoint' + VS-16 - -to be displayed using the emoji font even if 'Emoji codepoint' does -not have emoji presentation by default. +The Emoji characters are now assigned to a special script, 'emoji', so +as to make it easier to customize fontsets for Emoji display, as in +the above example. (Previously, the Emoji characters were assigned to +the 'symbol' script, together with other symbol and punctuation +characters.) +++ ** 'glyphless-char-display-control' now applies to Variation Selectors. VS-1 through VS-16 are now displayed as 'thin-space' by default when -not composed. +not composed with previous characters (typically, as part of Emoji +sequences). +++ ** New command 'execute-extended-command-for-buffer'. commit b81471279696e591ab91eb4eb10e9544f9f903ac Author: Stefan Kangas Date: Wed Oct 27 04:53:41 2021 +0200 ; Checkdoc fixes in image-dired.el diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 2c289646ed..9985e5a54b 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -45,7 +45,7 @@ ;; currently keep all my 2000+ images in the same directory) and ;; browsing the thumbnail buffer was slow too. image-dired.el will not ;; create thumbnails until they are needed and the browsing is done -;; quickly and easily in dired. I copied a great deal of ideas and +;; quickly and easily in Dired. I copied a great deal of ideas and ;; code from there though... :) ;; ;; `image-dired' stores the thumbnail files in `image-dired-dir' @@ -157,7 +157,7 @@ (require 'wid-edit)) (defgroup image-dired nil - "Use dired to browse your images as thumbnails, and more." + "Use Dired to browse your images as thumbnails, and more." :prefix "image-dired-" :link '(info-link "(emacs) Image-Dired") :group 'multimedia) @@ -494,18 +494,18 @@ This value can be toggled using `image-dired-toggle-append-browsing'." :type 'boolean) (defcustom image-dired-dired-disp-props t - "If non-nil, display properties for dired file when browsing. + "If non-nil, display properties for Dired file when browsing. Used by `image-dired-next-line-and-display', `image-dired-previous-line-and-display' and `image-dired-mark-and-display-next'. If the database file is large, this can slow down image browsing in -dired and you might want to turn it off." +Dired and you might want to turn it off." :type 'boolean) (defcustom image-dired-display-properties-format "%b: %f (%t): %c" "Display format for thumbnail properties. -%b is replaced with associated dired buffer name, %f with file name -\(without path) of original image file, %t with the list of tags and %c -with the comment." +%b is replaced with associated Dired buffer name, %f with file +name (without path) of original image file, %t with the list of +tags and %c with the comment." :type 'string) (defcustom image-dired-external-viewer @@ -804,7 +804,8 @@ Queued items live in `image-dired-queue'." (apply #'image-dired-create-thumb-1 (pop image-dired-queue)))) (defun image-dired-create-thumb (original-file thumbnail-file) - "Add a job for generating thumbnail to `image-dired-queue'." + "Add a job for generating ORIGINAL-FILE thumbnail to `image-dired-queue'. +The new file will be named THUMBNAIL-FILE." (setq image-dired-queue (nconc image-dired-queue (list (list original-file thumbnail-file)))) @@ -828,7 +829,7 @@ thumbnail." ;;;###autoload (defun image-dired-dired-toggle-marked-thumbs (&optional arg) - "Toggle thumbnails in front of file names in the dired buffer. + "Toggle thumbnails in front of file names in the Dired buffer. If no marked file could be found, insert or hide thumbnails on the current line. ARG, if non-nil, specifies the files to use instead of the marked files. If ARG is an integer, use the next ARG (or @@ -859,7 +860,7 @@ previous -ARG, if ARG<0) files." 'image-dired-dired-after-readin-hook nil t)) (defun image-dired-dired-after-readin-hook () - "Relocate existing thumbnail overlays in dired buffer after reverting. + "Relocate existing thumbnail overlays in Dired buffer after reverting. Move them to their corresponding files if they still exist. Otherwise, delete overlays." (mapc (lambda (overlay) @@ -872,7 +873,7 @@ Otherwise, delete overlays." (overlays-in (point-min) (point-max)))) (defun image-dired-next-line-and-display () - "Move to next dired line and display thumbnail image." + "Move to next Dired line and display thumbnail image." (interactive) (dired-next-line 1) (image-dired-display-thumbs @@ -881,7 +882,7 @@ Otherwise, delete overlays." (image-dired-dired-display-properties))) (defun image-dired-previous-line-and-display () - "Move to previous dired line and display thumbnail image." + "Move to previous Dired line and display thumbnail image." (interactive) (dired-previous-line 1) (image-dired-display-thumbs @@ -900,7 +901,7 @@ Otherwise, delete overlays." "off"))) (defun image-dired-mark-and-display-next () - "Mark current file in dired and display next thumbnail image." + "Mark current file in Dired and display next thumbnail image." (interactive) (dired-mark 1) (image-dired-display-thumbs @@ -951,12 +952,12 @@ Otherwise, delete overlays." Convenience command that: - - Opens dired in folder DIR + - Opens Dired in folder DIR - Splits windows in most useful (?) way - - Set `truncate-lines' to t + - Sets `truncate-lines' to t After the command has finished, you would typically mark some -image files in dired and type +image files in Dired and type \\[image-dired-display-thumbs] (`image-dired-display-thumbs'). If called with prefix argument ARG, skip splitting of windows. @@ -1011,7 +1012,7 @@ point (this is useful if you have marked some files but want to show another one). Recommended usage is to split the current frame horizontally so that -you have the dired buffer in the left window and the +you have the Dired buffer in the left window and the `image-dired-thumbnail-buffer' buffer in the right window. With optional argument APPEND, append thumbnail to thumbnail buffer @@ -1160,7 +1161,7 @@ FILE-TAGS is an alist in the following form: ;;;###autoload (defun image-dired-tag-files (arg) - "Tag marked file(s) in dired. With prefix ARG, tag file at point." + "Tag marked file(s) in Dired. With prefix ARG, tag file at point." (interactive "P") (let ((tag (completing-read "Tags to add (separate tags with a semicolon): " @@ -1221,7 +1222,7 @@ With prefix argument ARG, remove tag from file at point." (abbreviate-file-name f)))) (defun image-dired-associated-dired-buffer () - "Get associated dired buffer at point." + "Get associated Dired buffer at point." (get-text-property (point) 'associated-dired-buffer)) (defun image-dired-get-buffer-window (buf) @@ -1232,7 +1233,7 @@ With prefix argument ARG, remove tag from file at point." nil t)) (defun image-dired-track-original-file () - "Track the original file in the associated dired buffer. + "Track the original file in the associated Dired buffer. See documentation for `image-dired-toggle-movement-tracking'. Interactive use only useful if `image-dired-track-movement' is nil." (interactive) @@ -1247,7 +1248,7 @@ Interactive use only useful if `image-dired-track-movement' is nil." (defun image-dired-toggle-movement-tracking () "Turn on and off `image-dired-track-movement'. -Tracking of the movements between thumbnail and dired buffer so that +Tracking of the movements between thumbnail and Dired buffer so that they are \"mirrored\" in the dired buffer. When this is on, moving around in the thumbnail or dired buffer will find the matching position in the other buffer." @@ -1256,7 +1257,7 @@ position in the other buffer." (message "Tracking %s" (if image-dired-track-movement "on" "off"))) (defun image-dired-track-thumbnail () - "Track current dired file's thumb in `image-dired-thumbnail-buffer'. + "Track current Dired file's thumb in `image-dired-thumbnail-buffer'. This is almost the same as what `image-dired-track-original-file' does, but the other way around." (let ((file (dired-get-filename)) @@ -1369,7 +1370,7 @@ image." (defun image-dired-format-properties-string (buf file props comment) "Format display properties. -BUF is the associated dired buffer, FILE is the original image file +BUF is the associated Dired buffer, FILE is the original image file name, PROPS is a stringified list of tags and COMMENT is the image file's comment." (format-spec @@ -1403,10 +1404,10 @@ comment." (looking-at-p dired-re-mark))) (defun image-dired-modify-mark-on-thumb-original-file (command) - "Modify mark in dired buffer. -COMMAND is one of `mark' for marking file in dired, `unmark' for -unmarking file in dired or `flag' for flagging file for delete in -dired." + "Modify mark in Dired buffer. +COMMAND is one of `mark' for marking file in Dired, `unmark' for +unmarking file in Dired or `flag' for flagging file for delete in +Dired." (let ((file-name (image-dired-original-file-name)) (dired-buf (image-dired-associated-dired-buffer))) (if (not (and dired-buf file-name)) @@ -1424,30 +1425,30 @@ dired." (image-dired-thumb-update-marks)))))) (defun image-dired-mark-thumb-original-file () - "Mark original image file in associated dired buffer." + "Mark original image file in associated Dired buffer." (interactive) (image-dired-modify-mark-on-thumb-original-file 'mark) (image-dired-forward-image)) (defun image-dired-unmark-thumb-original-file () - "Unmark original image file in associated dired buffer." + "Unmark original image file in associated Dired buffer." (interactive) (image-dired-modify-mark-on-thumb-original-file 'unmark) (image-dired-forward-image)) (defun image-dired-flag-thumb-original-file () - "Flag original image file for deletion in associated dired buffer." + "Flag original image file for deletion in associated Dired buffer." (interactive) (image-dired-modify-mark-on-thumb-original-file 'flag) (image-dired-forward-image)) (defun image-dired-toggle-mark-thumb-original-file () - "Toggle mark on original image file in associated dired buffer." + "Toggle mark on original image file in associated Dired buffer." (interactive) (image-dired-modify-mark-on-thumb-original-file 'toggle)) (defun image-dired-jump-original-dired-buffer () - "Jump to the dired buffer associated with the current image file. + "Jump to the Dired buffer associated with the current image file. You probably want to use this together with `image-dired-track-original-file'." (interactive) @@ -1633,7 +1634,7 @@ You probably want to use this together with (define-derived-mode image-dired-thumbnail-mode special-mode "image-dired-thumbnail" - "Browse and manipulate thumbnail images using dired. + "Browse and manipulate thumbnail images using Dired. Use `image-dired-minor-mode' to get a nice setup." (buffer-disable-undo) (add-hook 'file-name-at-point-functions 'image-dired-file-name-at-point nil t)) @@ -1698,7 +1699,7 @@ Resized or in full-size." ;;;###autoload (define-minor-mode image-dired-minor-mode - "Setup easy-to-use keybindings for the commands to be used in dired mode. + "Setup easy-to-use keybindings for the commands to be used in Dired mode. Note that n, p and and will be hijacked and bound to `image-dired-dired-x-line'." :keymap image-dired-minor-mode-map) @@ -1710,7 +1711,7 @@ Note that n, p and and will be hijacked and bound to (declare-function clear-image-cache "image.c" (&optional filter)) (defun image-dired-create-thumbs (&optional arg) - "Create thumbnail images for all marked files in dired. + "Create thumbnail images for all marked files in Dired. With prefix argument ARG, create thumbnails even if they already exist \(i.e. use this to refresh your thumbnails)." (interactive "P") @@ -1879,7 +1880,7 @@ Ask user how many thumbnails should be displayed per row." nil t)) (defun image-dired-associated-dired-buffer-window () - "Return window where associated dired buffer is visible." + "Return window where associated Dired buffer is visible." (let (buf) (if (image-dired-image-at-point-p) (progn @@ -2216,7 +2217,7 @@ FILE-COMMENTS is an alist on the following form: ;;;###autoload (defun image-dired-dired-comment-files () - "Add comment to current or marked files in dired." + "Add comment to current or marked files in Dired." (interactive) (let ((comment (image-dired-read-comment))) (image-dired-write-comments @@ -2268,7 +2269,7 @@ A `tag' is a keyword, a piece of meta data, associated with an image file and stored in image-dired's database file. This command lets you input a regexp and this will be matched against all tags on all image files in the database file. The files that have a -matching tag will be marked in the dired buffer." +matching tag will be marked in the Dired buffer." (interactive) (image-dired-sane-db-file) (let ((tag (read-string "Mark tagged files (regexp): ")) @@ -2297,7 +2298,7 @@ matching tag will be marked in the dired buffer." (defun image-dired-mouse-display-image (event) "Use mouse EVENT, call `image-dired-display-image' to display image. -Track this in associated dired buffer if `image-dired-track-movement' is +Track this in associated Dired buffer if `image-dired-track-movement' is non-nil." (interactive "e") (mouse-set-point event) @@ -2312,7 +2313,7 @@ non-nil." (defun image-dired-mouse-select-thumbnail (event) "Use mouse EVENT to select thumbnail image. -Track this in associated dired buffer if `image-dired-track-movement' is +Track this in associated Dired buffer if `image-dired-track-movement' is non-nil." (interactive "e") (mouse-set-point event) @@ -2322,7 +2323,7 @@ non-nil." (image-dired-display-thumb-properties)) (defun image-dired-thumb-file-marked-p () - "Check if file is marked in associated dired buffer." + "Check if file is marked in associated Dired buffer." (let ((file-name (image-dired-original-file-name)) (dired-buf (image-dired-associated-dired-buffer))) (when (and dired-buf file-name) @@ -2358,18 +2359,18 @@ non-nil." (forward-char))))))) (defun image-dired-mouse-toggle-mark-1 () - "Toggle dired mark for current thumbnail. -Track this in associated dired buffer if `image-dired-track-movement' is -non-nil." + "Toggle Dired mark for current thumbnail. +Track this in associated Dired buffer if +`image-dired-track-movement' is non-nil." (when image-dired-track-movement (image-dired-track-original-file)) (image-dired-toggle-mark-thumb-original-file)) (defun image-dired-mouse-toggle-mark (event) - "Use mouse EVENT to toggle dired mark for thumbnail. + "Use mouse EVENT to toggle Dired mark for thumbnail. Toggle marks of all thumbnails in region, if it's active. -Track this in associated dired buffer if `image-dired-track-movement' is -non-nil." +Track this in associated Dired buffer if +`image-dired-track-movement' is non-nil." (interactive "e") (if (use-region-p) (let ((end (region-end))) @@ -2385,7 +2386,7 @@ non-nil." (image-dired-thumb-update-marks)) (defun image-dired-dired-display-properties () - "Display properties for dired file in the echo area." + "Display properties for Dired file in the echo area." (interactive) (let* ((file (dired-get-filename)) (file-name (file-name-nondirectory file)) commit e45b3fc521acca47abdd2b9e491b9fbbd8d3e677 Author: Stefan Kangas Date: Tue Oct 26 23:17:29 2021 +0200 Improve function documentation with text from XDG BDS spec * lisp/xdg.el (xdg-config-home, xdg-cache-home, xdg-data-home) (xdg-runtime-dir, xdg-config-dirs, xdg-data-dirs): Copy in the text from the XDG Base Directory Specification to better explain what these functions return. diff --git a/lisp/xdg.el b/lisp/xdg.el index 1f9fa6795e..db890f9494 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -50,30 +50,84 @@ ,env)))) (defun xdg-config-home () - "Return the base directory for user specific configuration files." + "Return the base directory for user specific configuration files. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_CONFIG_HOME defines the base directory relative to + which user-specific configuration files should be stored. + If $XDG_CONFIG_HOME is either not set or empty, a default + equal to $HOME/.config should be used.\"" (xdg--dir-home "XDG_CONFIG_HOME" "~/.config")) (defun xdg-cache-home () - "Return the base directory for user specific cache files." + "Return the base directory for user specific cache files. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_CACHE_HOME defines the base directory relative to + which user-specific non-essential data files should be + stored. If $XDG_CACHE_HOME is either not set or empty, a + default equal to $HOME/.cache should be used.\"" (xdg--dir-home "XDG_CACHE_HOME" "~/.cache")) (defun xdg-data-home () - "Return the base directory for user specific data files." + "Return the base directory for user specific data files. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_DATA_HOME defines the base directory relative to which + user-specific data files should be stored. If $XDG_DATA_HOME is + either not set or empty, a default equal to $HOME/.local/share + should be used.\"" (xdg--dir-home "XDG_DATA_HOME" "~/.local/share")) (defun xdg-runtime-dir () - "Return the value of $XDG_RUNTIME_DIR." + "Return the value of $XDG_RUNTIME_DIR. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_RUNTIME_DIR defines the base directory relative to + which user-specific non-essential runtime files and other + file objects (such as sockets, named pipes, ...) should be + stored.\"" (getenv "XDG_RUNTIME_DIR")) (defun xdg-config-dirs () - "Return the config directory search path as a list." + "Return the config directory search path as a list. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_CONFIG_DIRS defines the preference-ordered set of base + directories to search for configuration files in addition to + the $XDG_CONFIG_HOME base directory. The directories in + $XDG_CONFIG_DIRS should be seperated with a colon ':'. + + \"If $XDG_CONFIG_DIRS is either not set or empty, a value equal to + /etc/xdg should be used.\"" (let ((env (getenv "XDG_CONFIG_DIRS"))) (if (or (null env) (string= env "")) '("/etc/xdg") (parse-colon-path env)))) (defun xdg-data-dirs () - "Return the data directory search path as a list." + "Return the data directory search path as a list. + +According to the XDG Base Directory Specification version +0.8 (8th May 2021): + + \"$XDG_DATA_DIRS defines the preference-ordered set of base + directories to search for data files in addition to the + $XDG_DATA_HOME base directory. The directories in + $XDG_DATA_DIRS should be seperated with a colon ':'. + + \"If $XDG_DATA_DIRS is either not set or empty, a value equal + to /usr/local/share/:/usr/share/ should be used.\"" (let ((env (getenv "XDG_DATA_DIRS"))) (if (or (null env) (string= env "")) '("/usr/local/share/" "/usr/share/") commit 284c77eeb60bf21d8811f011902cd56f4aeaddca Author: Jonas Bernoulli Date: Mon Oct 25 20:19:52 2021 +0200 * lisp/transient.el: Update to package version 0.3.7. diff --git a/lisp/transient.el b/lisp/transient.el index c1b82377f6..d0ba854dd5 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -7,7 +7,7 @@ ;; Keywords: bindings ;; Package-Requires: ((emacs "25.1")) -;; Package-Version: 0.3.6 +;; Package-Version: 0.3.7 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -54,6 +54,7 @@ (require 'cl-lib) (require 'eieio) +(require 'edmacro) (require 'format-spec) (require 'seq) @@ -74,7 +75,7 @@ (define-obsolete-function-alias 'define-infix-command 'transient-define-infix "Transient 0.3.0") (define-obsolete-function-alias 'define-infix-argument - 'transient-define-argument "Transient 0.3.0") + #'transient-define-argument "Transient 0.3.0") (define-obsolete-variable-alias 'current-transient-prefix 'transient-current-prefix "Transient 0.3.0") @@ -148,34 +149,46 @@ features are available: (defcustom transient-display-buffer-action '(display-buffer-in-side-window (side . bottom) - (inhibit-same-window . t)) + (dedicated . t) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) "The action used to display the transient popup buffer. The transient popup buffer is displayed in a window using - \(display-buffer buf transient-display-buffer-action) + (display-buffer BUFFER transient-display-buffer-action) The value of this option has the form (FUNCTION . ALIST), where FUNCTION is a function or a list of functions. Each such -function should accept two arguments: a buffer to display and -an alist of the same form as ALIST. See `display-buffer' for -details. +function should accept two arguments: a buffer to display and an +alist of the same form as ALIST. See info node `(elisp)Choosing +Window' for details. The default is: (display-buffer-in-side-window (side . bottom) - (inhibit-same-window . t)) + (dedicated . t) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) This displays the window at the bottom of the selected frame. -Another useful value is (display-buffer-below-selected). This -is what `magit-popup' used by default. For more alternatives -see info node `(elisp)Display Action Functions'. +Another useful FUNCTION is `display-buffer-below-selected', which +is what `magit-popup' used by default. For more alternatives see +info node `(elisp)Display Action Functions' and info node +`(elisp)Buffer Display Action Alists'. + +Note that the buffer that was current before the transient buffer +is shown should remain the current buffer. Many suffix commands +act on the thing at point, if appropriate, and if the transient +buffer became the current buffer, then that would change what is +at point. To that effect `inhibit-same-window' ensures that the +selected window is not used to show the transient buffer. It may be possible to display the window in another frame, but whether that works in practice depends on the window-manager. If the window manager selects the new window (Emacs frame), -then it doesn't work. +then that unfortunately changes which buffer is current. If you change the value of this option, then you might also want to change the value of `transient-mode-line-format'." @@ -569,7 +582,7 @@ If `transient-save-history' is nil, then do nothing." (transient-save-history))) (unless noninteractive - (add-hook 'kill-emacs-hook 'transient-maybe-save-history)) + (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) ;;; Classes ;;;; Prefix @@ -910,7 +923,7 @@ keyword. (put ',name 'transient--suffix (,(or class 'transient-switch) :command ',name ,@slots))))) -(defalias 'transient-define-argument 'define-infix-command +(defalias 'transient-define-argument #'transient-define-infix "Define NAME as a transient infix command. Only use this alias to define an infix command that actually @@ -1061,7 +1074,8 @@ example, sets a variable use `transient-define-infix' instead. (put cmd 'transient--infix-command (transient--default-infix-command)) ;; This is not an anonymous infix argument. - (error "Suffix %s is not defined or autoloaded as a command" cmd))))) + (when (transient--use-suffix-p obj) + (error "Suffix %s is not defined or autoloaded as a command" cmd)))))) (defun transient--derive-shortarg (arg) (save-match-data @@ -1415,14 +1429,14 @@ then just return it. Otherwise return the symbol whose (defvar transient-base-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "ESC ESC ESC") 'transient-quit-all) - (define-key map (kbd "C-g") 'transient-quit-one) - (define-key map (kbd "C-q") 'transient-quit-all) - (define-key map (kbd "C-z") 'transient-suspend) - (define-key map (kbd "C-v") 'transient-scroll-up) - (define-key map (kbd "C-M-v") 'transient-scroll-down) - (define-key map [next] 'transient-scroll-up) - (define-key map [prior] 'transient-scroll-down) + (define-key map (kbd "ESC ESC ESC") #'transient-quit-all) + (define-key map (kbd "C-g") #'transient-quit-one) + (define-key map (kbd "C-q") #'transient-quit-all) + (define-key map (kbd "C-z") #'transient-suspend) + (define-key map (kbd "C-v") #'transient-scroll-up) + (define-key map (kbd "C-M-v") #'transient-scroll-down) + (define-key map [next] #'transient-scroll-up) + (define-key map [prior] #'transient-scroll-down) map) "Parent of other keymaps used by Transient. @@ -1442,14 +1456,14 @@ to `transient-predicate-map'.") (defvar transient-map (let ((map (make-sparse-keymap))) (set-keymap-parent map transient-base-map) - (define-key map (kbd "C-p") 'universal-argument) - (define-key map (kbd "C--") 'negative-argument) - (define-key map (kbd "C-t") 'transient-show) - (define-key map (kbd "?") 'transient-help) - (define-key map (kbd "C-h") 'transient-help) + (define-key map (kbd "C-u") #'universal-argument) + (define-key map (kbd "C--") #'negative-argument) + (define-key map (kbd "C-t") #'transient-show) + (define-key map (kbd "?") #'transient-help) + (define-key map (kbd "C-h") #'transient-help) ;; Also bound to "C-x p" and "C-x n" in transient-common-commands. - (define-key map (kbd "C-M-p") 'transient-history-prev) - (define-key map (kbd "C-M-n") 'transient-history-next) + (define-key map (kbd "C-M-p") #'transient-history-prev) + (define-key map (kbd "C-M-n") #'transient-history-next) map) "Top-level keymap used by all transients. @@ -1459,16 +1473,16 @@ to `transient-predicate-map'. Also see `transient-base-map'.") (defvar transient-edit-map (let ((map (make-sparse-keymap))) (set-keymap-parent map transient-base-map) - (define-key map (kbd "?") 'transient-help) - (define-key map (kbd "C-h") 'transient-help) - (define-key map (kbd "C-x l") 'transient-set-level) + (define-key map (kbd "?") #'transient-help) + (define-key map (kbd "C-h") #'transient-help) + (define-key map (kbd "C-x l") #'transient-set-level) map) "Keymap that is active while a transient in is in \"edit mode\".") (defvar transient-sticky-map (let ((map (make-sparse-keymap))) (set-keymap-parent map transient-base-map) - (define-key map (kbd "C-g") 'transient-quit-seq) + (define-key map (kbd "C-g") #'transient-quit-seq) map) "Keymap that is active while an incomplete key sequence is active.") @@ -1503,36 +1517,36 @@ to `transient-predicate-map'. Also see `transient-base-map'.") (defvar transient-predicate-map (let ((map (make-sparse-keymap))) - (define-key map [handle-switch-frame] 'transient--do-suspend) - (define-key map [transient-suspend] 'transient--do-suspend) - (define-key map [transient-help] 'transient--do-stay) - (define-key map [transient-set-level] 'transient--do-stay) - (define-key map [transient-history-prev] 'transient--do-stay) - (define-key map [transient-history-next] 'transient--do-stay) - (define-key map [universal-argument] 'transient--do-stay) - (define-key map [negative-argument] 'transient--do-stay) - (define-key map [digit-argument] 'transient--do-stay) - (define-key map [transient-quit-all] 'transient--do-quit-all) - (define-key map [transient-quit-one] 'transient--do-quit-one) - (define-key map [transient-quit-seq] 'transient--do-stay) - (define-key map [transient-show] 'transient--do-stay) - (define-key map [transient-update] 'transient--do-stay) - (define-key map [transient-toggle-common] 'transient--do-stay) - (define-key map [transient-set] 'transient--do-call) - (define-key map [transient-save] 'transient--do-call) - (define-key map [describe-key-briefly] 'transient--do-stay) - (define-key map [describe-key] 'transient--do-stay) - (define-key map [transient-scroll-up] 'transient--do-stay) - (define-key map [transient-scroll-down] 'transient--do-stay) - (define-key map [mwheel-scroll] 'transient--do-stay) - (define-key map [scroll-bar-toolkit-scroll] 'transient--do-stay) - (define-key map [transient-noop] 'transient--do-noop) - (define-key map [transient-mouse-push-button] 'transient--do-move) - (define-key map [transient-push-button] 'transient--do-move) - (define-key map [transient-backward-button] 'transient--do-move) - (define-key map [transient-forward-button] 'transient--do-move) - (define-key map [transient-isearch-backward] 'transient--do-move) - (define-key map [transient-isearch-forward] 'transient--do-move) + (define-key map [handle-switch-frame] #'transient--do-suspend) + (define-key map [transient-suspend] #'transient--do-suspend) + (define-key map [transient-help] #'transient--do-stay) + (define-key map [transient-set-level] #'transient--do-stay) + (define-key map [transient-history-prev] #'transient--do-stay) + (define-key map [transient-history-next] #'transient--do-stay) + (define-key map [universal-argument] #'transient--do-stay) + (define-key map [negative-argument] #'transient--do-stay) + (define-key map [digit-argument] #'transient--do-stay) + (define-key map [transient-quit-all] #'transient--do-quit-all) + (define-key map [transient-quit-one] #'transient--do-quit-one) + (define-key map [transient-quit-seq] #'transient--do-stay) + (define-key map [transient-show] #'transient--do-stay) + (define-key map [transient-update] #'transient--do-stay) + (define-key map [transient-toggle-common] #'transient--do-stay) + (define-key map [transient-set] #'transient--do-call) + (define-key map [transient-save] #'transient--do-call) + (define-key map [describe-key-briefly] #'transient--do-stay) + (define-key map [describe-key] #'transient--do-stay) + (define-key map [transient-scroll-up] #'transient--do-stay) + (define-key map [transient-scroll-down] #'transient--do-stay) + (define-key map [mwheel-scroll] #'transient--do-stay) + (define-key map [scroll-bar-toolkit-scroll] #'transient--do-stay) + (define-key map [transient-noop] #'transient--do-noop) + (define-key map [transient-mouse-push-button] #'transient--do-move) + (define-key map [transient-push-button] #'transient--do-move) + (define-key map [transient-backward-button] #'transient--do-move) + (define-key map [transient-forward-button] #'transient--do-move) + (define-key map [transient-isearch-backward] #'transient--do-move) + (define-key map [transient-isearch-forward] #'transient--do-move) map) "Base keymap used to map common commands to their transient behavior. @@ -1606,22 +1620,23 @@ of the corresponding object.") (sym (transient--suffix-symbol cmd))) (cond ((oref obj inapt) - (define-key map (vector sym) 'transient--do-warn-inapt)) + (define-key map (vector sym) #'transient--do-warn-inapt)) ((slot-boundp obj 'transient) (define-key map (vector sym) (let ((do (oref obj transient))) (pcase do - (`t (if sub-prefix - 'transient--do-replace - 'transient--do-stay)) + (`t (cond (sub-prefix #'transient--do-replace) + ((cl-typep obj 'transient-infix) + #'transient--do-stay) + (t #'transient--do-call))) (`nil 'transient--do-exit) (_ do))))) ((not (lookup-key transient-predicate-map (vector sym))) (define-key map (vector sym) (if sub-prefix - 'transient--do-replace + #'transient--do-replace (or (oref transient--prefix transient-suffix) - 'transient--do-exit))))))) + #'transient--do-exit))))))) map)) (defun transient--make-redisplay-map () @@ -1649,7 +1664,7 @@ of the corresponding object.") (listp def) (keymapp def)) (define-key topmap (vconcat transient--redisplay-key (list key)) - 'transient-update))) + #'transient-update))) (if transient--redisplay-key (lookup-key transient--transient-map (vconcat transient--redisplay-key)) transient--transient-map)) @@ -1678,7 +1693,7 @@ EDIT may be non-nil." (transient--pop-keymap 'transient--redisplay-map) (setq name (oref transient--prefix command)) (setq params (list :scope (oref transient--prefix scope)))) - (transient--transient-map + (transient--prefix ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" ;; of an outer prefix. Unlike the usual `transient--do-replace', ;; these predicates fail to clean up after the outer prefix. @@ -1953,8 +1968,10 @@ value. Otherwise return CHILDREN as is." (defun transient--delete-window () (when (window-live-p transient--window) (let ((buf (window-buffer transient--window))) - (with-demoted-errors "Error while exiting transient: %S" - (delete-window transient--window)) + ;; Only delete the window if it never showed another buffer. + (unless (eq (car (window-parameter transient--window 'quit-restore)) 'other) + (with-demoted-errors "Error while exiting transient: %S" + (delete-window transient--window))) (kill-buffer buf)))) (defun transient--export () @@ -2093,8 +2110,8 @@ value. Otherwise return CHILDREN as is." (defun transient--emergency-exit () "Exit the current transient command after an error occurred. -When no transient is active (i.e. when `transient--prefix') is -nil, then do nothing." +When no transient is active (i.e. when `transient--prefix' is +nil) then do nothing." (transient--debug 'emergency-exit) (when transient--prefix (setq transient--stack nil) @@ -2171,17 +2188,17 @@ to `transient--do-warn'." (setq this-command 'transient-popup-navigation-help)) transient--stay) -(put 'transient--do-stay 'transient-color 'transient-blue) -(put 'transient--do-noop 'transient-color 'transient-blue) -(put 'transient--do-warn 'transient-color 'transient-blue) -(put 'transient--do-warn-inapt 'transient-color 'transient-blue) -(put 'transient--do-call 'transient-color 'transient-blue) -(put 'transient--do-exit 'transient-color 'transient-red) -(put 'transient--do-replace 'transient-color 'transient-red) -(put 'transient--do-suspend 'transient-color 'transient-red) -(put 'transient--do-quit-one 'transient-color 'transient-red) -(put 'transient--do-quit-all 'transient-color 'transient-red) -(put 'transient--do-move 'transient-color 'transient-blue) +(put 'transient--do-stay 'transient-color 'transient-red) +(put 'transient--do-noop 'transient-color 'transient-red) +(put 'transient--do-warn 'transient-color 'transient-red) +(put 'transient--do-warn-inapt 'transient-color 'transient-red) +(put 'transient--do-call 'transient-color 'transient-red) +(put 'transient--do-exit 'transient-color 'transient-blue) +(put 'transient--do-replace 'transient-color 'transient-blue) +(put 'transient--do-suspend 'transient-color 'transient-blue) +(put 'transient--do-quit-one 'transient-color 'transient-blue) +(put 'transient--do-quit-all 'transient-color 'transient-blue) +(put 'transient--do-move 'transient-color 'transient-red) ;;; Commands @@ -2209,7 +2226,18 @@ to `transient--do-warn'." (propertize "?" 'face 'transient-key) (propertize (symbol-name (transient--suffix-symbol this-original-command)) - 'face 'font-lock-warning-face))) + 'face 'font-lock-warning-face)) + (unless (and transient--transient-map + (memq transient--transient-map overriding-terminal-local-map)) + (let ((transient--prefix (or transient--prefix 'sic))) + (transient--emergency-exit)) + (view-lossage) + (other-window 1) + (display-warning 'transient "Inconsistent transient state detected. +This should never happen. +Please open an issue and post the shown command log. +This is a heisenbug, so any additional details might help. +Thanks!" :error))) (defun transient-toggle-common () "Toggle whether common commands are always shown." @@ -2407,14 +2435,14 @@ Non-infix suffix commands usually don't have a value." (cl-defmethod transient-init-value :around ((obj transient-prefix)) "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to objects class." +Otherwise call the primary method according to object's class." (if (slot-boundp obj 'init-value) (funcall (oref obj init-value) obj) (cl-call-next-method obj))) (cl-defmethod transient-init-value :around ((obj transient-infix)) "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to objects class." +Otherwise call the primary method according to object's class." (if (slot-boundp obj 'init-value) (funcall (oref obj init-value) obj) (cl-call-next-method obj))) @@ -2595,13 +2623,12 @@ stand-alone command." (cl-block nil (while t (let ((str (read-from-minibuffer prompt initial-input nil nil history))) - (cond ((string-equal str "") - (cl-return nil)) - ((string-match-p (if include-zero - "\\`\\(0\\|[1-9][0-9]*\\)\\'" - "\\`[1-9][0-9]*\\'") - str) - (cl-return str)))) + (when (or (string-equal str "") + (string-match-p (if include-zero + "\\`\\(0\\|[1-9][0-9]*\\)\\'" + "\\`[1-9][0-9]*\\'") + str)) + (cl-return str))) (message "Please enter a natural number (%s zero)." (if include-zero "including" "excluding")) (sit-for 1))))) @@ -2670,7 +2697,10 @@ prompt." (oref obj argument-regexp)))) (if-let ((sic (and value arg transient--unset-incompatible)) (spec (oref transient--prefix incompatible)) - (incomp (remove arg (cl-find-if (lambda (elt) (member arg elt)) spec)))) + (incomp (cl-mapcan (lambda (rule) + (and (member arg rule) + (remove arg rule))) + spec))) (progn (cl-call-next-method obj value) (dolist (arg incomp) @@ -2703,7 +2733,7 @@ If the current command was invoked from the transient prefix command PREFIX, then return the active infix arguments. If the current command was not invoked from PREFIX, then return the set, saved or default value for PREFIX." - (delq nil (mapcar 'transient-infix-value (transient-suffixes prefix)))) + (delq nil (mapcar #'transient-infix-value (transient-suffixes prefix)))) (defun transient-suffixes (prefix) "Return the suffix objects of the transient prefix command PREFIX." @@ -2714,11 +2744,12 @@ the set, saved or default value for PREFIX." (transient--init-suffixes prefix))))) (defun transient-get-value () - (delq nil (mapcar (lambda (obj) - (and (or (not (slot-exists-p obj 'unsavable)) - (not (oref obj unsavable))) - (transient-infix-value obj))) - transient-current-suffixes))) + (transient--with-emergency-exit + (delq nil (mapcar (lambda (obj) + (and (or (not (slot-exists-p obj 'unsavable)) + (not (oref obj unsavable))) + (transient-infix-value obj))) + transient-current-suffixes)))) (cl-defgeneric transient-infix-value (obj) "Return the value of the suffix object OBJ. @@ -2860,16 +2891,11 @@ have a history of their own.") (setq transient--showp t) (let ((buf (get-buffer-create transient--buffer-name)) (focus nil)) - (unless (window-live-p transient--window) - (setq transient--window - (display-buffer buf transient-display-buffer-action))) - (with-selected-window transient--window + (with-current-buffer buf (when transient-enable-popup-navigation - (setq focus (button-get (point) 'command))) + (setq focus (or (button-get (point) 'command) + (transient--heading-at-point)))) (erase-buffer) - (set-window-hscroll transient--window 0) - (set-window-dedicated-p transient--window t) - (set-window-parameter transient--window 'no-other-window t) (setq window-size-fixed t) (when (bound-and-true-p tab-line-format) (setq tab-line-format nil)) @@ -2896,14 +2922,26 @@ have a history of their own.") 'transient-separator))) (insert (propertize "__" 'face face 'display '(space :height (1)))) (insert (propertize "\n" 'face face 'line-height t)))) - (let ((window-resize-pixelwise t) - (window-size-fixed nil)) - (fit-window-to-buffer nil nil 1)) (goto-char (point-min)) (when transient-force-fixed-pitch (transient--force-fixed-pitch)) (when transient-enable-popup-navigation - (transient--goto-button focus))))) + (transient--goto-button focus))) + (unless (window-live-p transient--window) + (setq transient--window + (display-buffer buf transient-display-buffer-action))) + (when (window-live-p transient--window) + (with-selected-window transient--window + (magit--fit-window-to-buffer transient--window))))) + +(defun magit--fit-window-to-buffer (window) + (let ((window-resize-pixelwise t) + (window-size-fixed nil)) + (if (eq (car (window-parameter window 'quit-restore)) 'other) + ;; Grow but never shrink window that previously displayed + ;; another buffer and is going to display that again. + (fit-window-to-buffer window nil (window-height window)) + (fit-window-to-buffer window nil 1)))) (defun transient--insert-groups () (let ((groups (cl-mapcan (lambda (group) @@ -2946,7 +2984,7 @@ have a history of their own.") (mapcar (lambda (column) (transient--maybe-pad-keys column group) - (let ((rows (mapcar 'transient-format (oref column suffixes)))) + (let ((rows (mapcar #'transient-format (oref column suffixes)))) (when-let ((desc (transient-format-description column))) (push desc rows)) rows)) @@ -3249,12 +3287,13 @@ Show the first one that is specified." (cl-defmethod transient-show-help ((obj transient-suffix)) "Show the command doc-string." - (if (eq this-original-command 'transient-help) + (if (eq this-command 'transient-help) (if-let ((manpage (oref transient--prefix man-page))) (transient--show-manpage manpage) (transient--describe-function (oref transient--prefix command))) (if-let ((prefix (get (transient--suffix-command obj) 'transient--prefix)) - (manpage (oref prefix man-page))) + (manpage (oref prefix man-page)) + (- (not (eq this-command (oref transient--prefix command))))) (transient--show-manpage manpage) (transient--describe-function this-original-command)))) @@ -3366,9 +3405,9 @@ Suffixes on levels %s and %s are unavailable.\n" (defvar transient-resume-mode-map (let ((map (make-sparse-keymap))) - (define-key map [remap Man-quit] 'transient-resume) - (define-key map [remap Info-exit] 'transient-resume) - (define-key map [remap quit-window] 'transient-resume) + (define-key map [remap Man-quit] #'transient-resume) + (define-key map [remap Info-exit] #'transient-resume) + (define-key map [remap quit-window] #'transient-resume) map) "Keymap for `transient-resume-mode'. @@ -3395,19 +3434,20 @@ resumes the suspended transient.") ;; Yes, I know that this is wrong(tm). ;; Unfortunately it is also necessary. (setq this-original-command command) + (transient--pre-command) (call-interactively command)))) (defvar transient-popup-navigation-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "") 'transient-noop) - (define-key map (kbd "") 'transient-mouse-push-button) - (define-key map (kbd "RET") 'transient-push-button) - (define-key map (kbd "") 'transient-backward-button) - (define-key map (kbd "C-p") 'transient-backward-button) - (define-key map (kbd "") 'transient-forward-button) - (define-key map (kbd "C-n") 'transient-forward-button) - (define-key map (kbd "C-r") 'transient-isearch-backward) - (define-key map (kbd "C-s") 'transient-isearch-forward) + (define-key map (kbd "") #'transient-noop) + (define-key map (kbd "") #'transient-mouse-push-button) + (define-key map (kbd "RET") #'transient-push-button) + (define-key map (kbd "") #'transient-backward-button) + (define-key map (kbd "C-p") #'transient-backward-button) + (define-key map (kbd "") #'transient-forward-button) + (define-key map (kbd "C-n") #'transient-forward-button) + (define-key map (kbd "C-r") #'transient-isearch-backward) + (define-key map (kbd "C-s") #'transient-isearch-forward) map)) (defun transient-mouse-push-button (&optional pos) @@ -3436,22 +3476,32 @@ See `forward-button' for information about N." (forward-button n t))) (defun transient--goto-button (command) - (if (not command) - (forward-button 1) + (cond + ((stringp command) + (when (re-search-forward (concat "^" (regexp-quote command)) nil t) + (goto-char (match-beginning 0)))) + (command (while (and (ignore-errors (forward-button 1)) (not (eq (button-get (button-at (point)) 'command) command)))) (unless (eq (button-get (button-at (point)) 'command) command) (goto-char (point-min)) - (forward-button 1)))) + (forward-button 1))))) + +(defun transient--heading-at-point () + (and (eq (get-text-property (point) 'face) 'transient-heading) + (let ((beg (line-beginning-position))) + (buffer-substring-no-properties + beg (next-single-property-change + beg 'face nil (line-end-position)))))) ;;;; Popup Isearch (defvar transient--isearch-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map isearch-mode-map) - (define-key map [remap isearch-exit] 'transient-isearch-exit) - (define-key map [remap isearch-cancel] 'transient-isearch-cancel) - (define-key map [remap isearch-abort] 'transient-isearch-abort) + (define-key map [remap isearch-exit] #'transient-isearch-exit) + (define-key map [remap isearch-cancel] #'transient-isearch-cancel) + (define-key map [remap isearch-abort] #'transient-isearch-abort) map)) (defun transient-isearch-backward (&optional regexp-p) @@ -3537,14 +3587,14 @@ search instead." (funcall fn arg-mode) (transient--resume-override t))) -(advice-add 'edebug--recursive-edit :around 'transient--edebug--recursive-edit) +(advice-add 'edebug--recursive-edit :around #'transient--edebug--recursive-edit) (defun transient--abort-edebug () (when (bound-and-true-p edebug-active) (transient--emergency-exit))) -(advice-add 'abort-recursive-edit :before 'transient--abort-edebug) -(advice-add 'top-level :before 'transient--abort-edebug) +(advice-add 'abort-recursive-edit :before #'transient--abort-edebug) +(advice-add 'top-level :before #'transient--abort-edebug) (defun transient--edebug-command-p () (and (bound-and-true-p edebug-active) @@ -3558,12 +3608,12 @@ search instead." (defun transient--suspend-which-key-mode () (when (bound-and-true-p which-key-mode) (which-key-mode -1) - (add-hook 'transient-exit-hook 'transient--resume-which-key-mode))) + (add-hook 'transient-exit-hook #'transient--resume-which-key-mode))) (defun transient--resume-which-key-mode () (unless transient--prefix (which-key-mode 1) - (remove-hook 'transient-exit-hook 'transient--resume-which-key-mode))) + (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode))) (defun transient-bind-q-to-quit () "Modify some keymaps to bind \"q\" to the appropriate quit command. @@ -3583,10 +3633,10 @@ that does that. Of course \"Q\" may already be bound to something else, so that function binds \"M-q\" to that command instead. Of course \"M-q\" may already be bound to something else, but we stop there." - (define-key transient-base-map "q" 'transient-quit-one) - (define-key transient-sticky-map "q" 'transient-quit-seq) + (define-key transient-base-map "q" #'transient-quit-one) + (define-key transient-sticky-map "q" #'transient-quit-seq) (setq transient-substitute-key-function - 'transient-rebind-quit-commands)) + #'transient-rebind-quit-commands)) (defun transient-rebind-quit-commands (obj) "See `transient-bind-q-to-quit'." commit 40400e69771eb955c80d64092256bd65466a7b14 Author: Jonas Bernoulli Date: Mon Oct 25 20:16:54 2021 +0200 ; Revert parts of "Use string-replace instead of replace-regexp-in-string" "transient.el" is also distributed as a separate package, which supports Emacs versions as old as 25.1 (see "Package-Requires"). diff --git a/lisp/transient.el b/lisp/transient.el index 2adb4c573e..c1b82377f6 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -3064,18 +3064,18 @@ Optional support for popup buttons is also implemented here." ((equal (seq-take seq len) transient--redisplay-key) (let ((pre (key-description (vconcat (seq-take seq len)))) (suf (key-description (vconcat (seq-drop seq len))))) - (setq pre (string-replace "RET" "C-m" pre)) - (setq pre (string-replace "TAB" "C-i" pre)) - (setq suf (string-replace "RET" "C-m" suf)) - (setq suf (string-replace "TAB" "C-i" suf)) + (setq pre (replace-regexp-in-string "RET" "C-m" pre t)) + (setq pre (replace-regexp-in-string "TAB" "C-i" pre t)) + (setq suf (replace-regexp-in-string "RET" "C-m" suf t)) + (setq suf (replace-regexp-in-string "TAB" "C-i" suf t)) ;; We use e.g. "-k" instead of the more correct "- k", ;; because the former is prettier. If we did that in ;; the definition, then we want to drop the space that ;; is reinserted above. False-positives are possible ;; for silly bindings like "-C-c C-c". (unless (string-match-p " " key) - (setq pre (string-replace " " "" pre)) - (setq suf (string-replace " " "" suf))) + (setq pre (replace-regexp-in-string " " "" pre)) + (setq suf (replace-regexp-in-string " " "" suf))) (concat (propertize pre 'face 'default) (and (string-prefix-p (concat pre " ") key) " ") (transient--colorize-key suf cmd) commit 214c2e268c8422a13c463a1d45be9fb2fe63d0fe Author: Jonas Bernoulli Date: Mon Oct 25 20:15:28 2021 +0200 ; Revert parts of "Use string-search instead of string-match[-p]" "transient.el" is also distributed as a separate package, which supports Emacs versions as old as 25.1 (see "Package-Requires"). diff --git a/lisp/transient.el b/lisp/transient.el index 77bf41deba..2adb4c573e 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -3073,7 +3073,7 @@ Optional support for popup buttons is also implemented here." ;; the definition, then we want to drop the space that ;; is reinserted above. False-positives are possible ;; for silly bindings like "-C-c C-c". - (unless (string-search " " key) + (unless (string-match-p " " key) (setq pre (string-replace " " "" pre)) (setq suf (string-replace " " "" suf))) (concat (propertize pre 'face 'default)