commit 136495f178ccd36b23ffc347fe2b6680fd689e34 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Wed Aug 31 10:17:20 2022 +0800 Gently nudge Xt into always setting size hints * src/widget.c (update_wm_hints): Force a resource to change every time this function is called. (bug#57475) (EmacsFrameInitialize): Initialize new field. * src/widgetprv.h (EmacsFramePart): New field `size_switch'. * src/xterm.c (x_wm_set_size_hint): Don't change flags if flags is 0. diff --git a/src/widget.c b/src/widget.c index b125b4caee..5a75cdaca8 100644 --- a/src/widget.c +++ b/src/widget.c @@ -292,18 +292,20 @@ update_wm_hints (Widget wmshell, EmacsFrame ew) base_height = (wmshell->core.height - ew->core.height + (rounded_height - (char_height * ch))); - /* This is kind of sleazy, but I can't see how else to tell it to - make it mark the WM_SIZE_HINTS size as user specified. - */ -/* ((WMShellWidget) wmshell)->wm.size_hints.flags |= USSize;*/ + /* Ensure that Xt actually sets window manager hint flags specified + by the caller by making sure XtNminWidth (a relatively harmless + resource) always changes each time this function is invoked. */ + ew->emacs_frame.size_switch = !ew->emacs_frame.size_switch; XtVaSetValues (wmshell, XtNbaseWidth, (XtArgVal) base_width, XtNbaseHeight, (XtArgVal) base_height, XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw), XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch), - XtNminWidth, (XtArgVal) base_width, - XtNminHeight, (XtArgVal) base_height, + XtNminWidth, (XtArgVal) (base_width + + ew->emacs_frame.size_switch), + XtNminHeight, (XtArgVal) (base_height + + ew->emacs_frame.size_switch), NULL); } @@ -355,6 +357,8 @@ EmacsFrameInitialize (Widget request, Widget new, exit (1); } + ew->emacs_frame.size_switch = 1; + update_from_various_frame_slots (ew); set_frame_size (ew); } diff --git a/src/widgetprv.h b/src/widgetprv.h index 960f814e16..fe960326b0 100644 --- a/src/widgetprv.h +++ b/src/widgetprv.h @@ -49,6 +49,8 @@ typedef struct { Boolean visual_bell; /* flash instead of beep */ int bell_volume; /* how loud is beep */ + int size_switch; /* hack to make setting size + hints work correctly */ /* private state */ diff --git a/src/xterm.c b/src/xterm.c index 3c05bc7807..e8c56d68ea 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -27484,8 +27484,11 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) eassert (XtIsWMShell (f->output_data.x->widget)); shell = (WMShellWidget) f->output_data.x->widget; - shell->wm.size_hints.flags &= ~(PPosition | USPosition); - shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + if (flags) + { + shell->wm.size_hints.flags &= ~(PPosition | USPosition); + shell->wm.size_hints.flags |= flags & (PPosition | USPosition); + } if (user_position) { commit 5bedef8f87d2103e21342a06c4c1c9d7efe06621 Author: Po Lu Date: Wed Aug 31 09:44:13 2022 +0800 Fix bug#57476 * src/xterm.c (handle_one_xevent): Don't reset valuators on certain crossing events, for the benefit of xfwm4. (bug#57476) diff --git a/src/xterm.c b/src/xterm.c index e0a8e13b24..3c05bc7807 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -20771,8 +20771,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, any = x_any_window_to_frame (dpyinfo, enter->event); #ifdef HAVE_XINPUT2_1 - xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, - true); + /* xfwm4 selects for button events on the frame window, + resulting in passive grabs being generated along with + the delivery of emulated button events; this then + interferes with scrolling, since device valuators + will constantly be reset as the crossing events + related to those grabs arrive. The only way to + remedy this is to never reset scroll valuators on a + grab-related crossing event. (bug#57476) */ + if (enter->mode != XINotifyUngrab + && enter->mode != XINotifyGrab + && enter->mode != XINotifyPassiveGrab + && enter->mode != XINotifyPassiveUngrab) + xi_reset_scroll_valuators_for_device_id (dpyinfo, enter->deviceid, + true); #endif { @@ -20888,7 +20900,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, moves out of a frame (and not into one of its children, which we know about). */ #ifdef HAVE_XINPUT2_1 - if (leave->detail != XINotifyInferior && any) + if (leave->detail != XINotifyInferior && any + /* xfwm4 selects for button events on the frame + window, resulting in passive grabs being + generated along with the delivery of emulated + button events; this then interferes with + scrolling, since device valuators will constantly + be reset as the crossing events related to those + grabs arrive. The only way to remedy this is to + never reset scroll valuators on a grab-related + crossing event. (bug#57476) */ + && leave->mode != XINotifyUngrab + && leave->mode != XINotifyGrab + && leave->mode != XINotifyPassiveUngrab + && leave->mode != XINotifyPassiveGrab) xi_reset_scroll_valuators_for_device_id (dpyinfo, leave->deviceid, false); #endif commit a28ede3a61a70cf83dfcba6c9d314fbb051a3a94 Author: Stefan Monnier Date: Tue Aug 30 17:55:03 2022 -0400 t-mouse.el: Make sure we apply the setting to new terminals * lisp/t-mouse.el (gpm-mouse-tty-setup): New function. (gpm-mouse-mode): Use it as well as `tty-setup-hook`. * lisp/term/linux.el (terminal-init-linux): Remove gpm-specific code, not neded any more. diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index cdfc30c879..7a4e7f330e 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -62,6 +62,9 @@ (gpm-mouse-stop)) (set-terminal-parameter nil 'gpm-mouse-active nil)) +(defun gpm-mouse-tty-setup () + (if gpm-mouse-mode (gpm-mouse-enable) (gpm-mouse-disable))) + ;;;###autoload (define-minor-mode gpm-mouse-mode "Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). @@ -80,7 +83,9 @@ GPM. This is due to limitations in GPM and the Linux kernel." (terminal-parameter terminal 'gpm-mouse-active)))) ;; Simulate selecting a terminal by selecting one of its frames ;-( (with-selected-frame (car (frames-on-display-list terminal)) - (if gpm-mouse-mode (gpm-mouse-enable) (gpm-mouse-disable)))))) + (gpm-mouse-tty-setup)))) + (when gpm-mouse-mode + (add-hook 'tty-setup-hook #'gpm-mouse-tty-setup))) (provide 't-mouse) diff --git a/lisp/term/linux.el b/lisp/term/linux.el index ab5a6d8698..60bf91fcf5 100644 --- a/lisp/term/linux.el +++ b/lisp/term/linux.el @@ -15,8 +15,6 @@ ;; Compositions confuse cursor movement. (setq-default auto-composition-mode "linux") - (ignore-errors (when gpm-mouse-mode (require 't-mouse) (gpm-mouse-enable))) - ;; Don't translate ESC TAB to backtab as directed ;; by ncurses-6.3. (define-key input-decode-map "\e\t" nil) commit 1feec84b0f9f100547d428315c74a542228667e4 Author: Stefan Kangas Date: Tue Aug 30 21:31:17 2022 +0200 ; Minor doc fix in Viper * lisp/emulation/viper-macs.el (viper-repeat-from-history-key): Minor doc fix. diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 06130afa7d..9c2aae1fe9 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -66,9 +66,8 @@ The previous command is accessible, as usual, via `.'. The command before this can be invoked as ` 1', and the command before that, and the command before that one is accessible as ` 2'. -The notation for these keys is borrowed from XEmacs. Basically, -a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., -`(meta control f1)'." +Basically, a key is a symbol, e.g., `a', `\\1', `f2', etc., or a +list, e.g., `(meta control f1)'." :type 'sexp :group 'viper) commit 292703d64b95156881a5a4d0ba59902a84d4734c Author: Stefan Kangas Date: Tue Aug 30 19:35:14 2022 +0200 ; * lisp/doc-view.el (doc-view): Fix punctuation. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 29da3b4297..aa0f9fd383 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -153,7 +153,7 @@ "In-buffer document viewer. The viewer handles PDF, PostScript, DVI, DJVU, ODF, EPUB, CBZ, FB2, XPS and OXPS files, if the appropriate converter programs -are available (see Info node `(emacs)Document View')" +are available (see Info node `(emacs)Document View')." :link '(function-link doc-view) :version "22.2" :group 'applications commit e1c4ed9a3e70d4ed7162a77103d034deef428452 Author: Eli Zaretskii Date: Tue Aug 30 20:20:40 2022 +0300 ; Improve doc string of 'describe-char-fold-equivalences' * lisp/char-fold.el (describe-char-fold-equivalences): Autoload it. Doc fix. diff --git a/lisp/char-fold.el b/lisp/char-fold.el index ce395ddaab..4e3aa058fc 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -428,12 +428,15 @@ BOUND NOERROR COUNT are passed to `re-search-backward'." (re-search-backward (char-fold-to-regexp string) bound noerror count)) +;;;###autoload (defun describe-char-fold-equivalences (char &optional lax) - "Display characters equivalent to CHAR. -Prompt for CHAR. With no input, i.e. when CHAR is nil, by default + "Display characters equivalent to CHAR under character-folding. +Prompt for CHAR (using `read-char-by-name', which see for how can +you specify the character). With no input, i.e. when CHAR is nil, describe all available character equivalences of `char-fold-to-regexp'. -Interactively, a prefix arg means also include partially matching -ligatures." +Optional argument LAX (interactively, the prefix argument), if +non-nil, means also include partially matching ligatures and +non-canonical equivalences." (interactive (list (ignore-errors (read-char-by-name "Character (Unicode name or hex, default all): ")) commit 7804536e4e6dd7fa57d38b9b6c6835ae316bff50 Author: Juri Linkov Date: Tue Aug 30 20:09:20 2022 +0300 Fix 744ed0ceeed7472a160fea7154939cf641205577 from bug#57082 (bug#57176) * lisp/outline.el (outline-minor-mode-highlight-buffer): Handle 'append'. (outline-minor-mode): Call outline--fix-up-all-buttons when font-lock is used. * lisp/textmodes/emacs-news-mode.el (emacs-news--mode-common): Fix regexp. diff --git a/lisp/outline.el b/lisp/outline.el index 3250b62f1e..857ac9562f 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -427,15 +427,14 @@ outline font-lock faces to those of major mode." (goto-char (point-min)) (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$"))) (while (re-search-forward regexp nil t) - (let ((overlay (make-overlay (match-beginning 0) - (match-end 0)))) + (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'outline-overlay t) - (when (or (eq outline-minor-mode-highlight 'override) + ;; FIXME: Is it possible to override all underlying face attributes? + (when (or (memq outline-minor-mode-highlight '(append override)) (and (eq outline-minor-mode-highlight t) - (goto-char (match-beginning 0)) - (not (get-text-property (point) 'face)))) + (not (get-text-property (match-beginning 0) 'face)))) (overlay-put overlay 'face (outline-font-lock-face))) - (when (and (outline--use-buttons-p) (outline-on-heading-p)) + (when (outline--use-buttons-p) (outline--insert-open-button))) (goto-char (match-end 0)))))) @@ -452,10 +451,12 @@ See the command `outline-mode' for more information on this mode." (if outline-minor-mode (progn (when outline-minor-mode-highlight - (when (and global-font-lock-mode (font-lock-specified-p major-mode)) - (font-lock-add-keywords nil outline-font-lock-keywords t) - (font-lock-flush)) - (outline-minor-mode-highlight-buffer)) + (if (and global-font-lock-mode (font-lock-specified-p major-mode)) + (progn + (font-lock-add-keywords nil outline-font-lock-keywords t) + (font-lock-flush) + (outline--fix-up-all-buttons)) + (outline-minor-mode-highlight-buffer))) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook (lambda () (outline-minor-mode -1)) diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 022e17c934..6bf96deacc 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -73,9 +73,11 @@ (defun emacs-news--mode-common () (setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t)) - (setq-local outline-regexp "\\(:? +\\)?\\(\\*+\\) " + ;; This `outline-regexp' matches leading spaces inserted + ;; by the current implementation of `outline-minor-mode-use-buttons'. + (setq-local outline-regexp "\\(?: +\\)?\\(\\*+\\) " + outline-level (lambda () (length (match-string 1))) outline-minor-mode-cycle t - outline-level (lambda () (length (match-string 2))) outline-minor-mode-highlight 'append) (outline-minor-mode) (emacs-etc--hide-local-variables)) commit e1e60e51bf324aaa2137075827c4d08a331a7bef Author: Mattias Engdegård Date: Tue Aug 30 16:44:51 2022 +0200 Accept bignum arguments in `take` and `ntake` * src/fns.c (Ftake, Fntake): Accept any integer as first argument, for completeness. * test/src/fns-tests.el (fns--take-ntake): Add test cases. diff --git a/src/fns.c b/src/fns.c index 7e78bba3a0..07102256fe 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1563,7 +1563,15 @@ If N is zero or negative, return nil. If N is greater or equal to the length of LIST, return LIST (or a copy). */) (Lisp_Object n, Lisp_Object list) { - CHECK_FIXNUM (n); + if (BIGNUMP (n)) + { + if (mpz_sgn (*xbignum_val (n)) < 0) + return Qnil; + CHECK_LIST (list); + return list; + } + if (!FIXNUMP (n)) + wrong_type_argument (Qintegerp, n); EMACS_INT m = XFIXNUM (n); if (m <= 0) return Qnil; @@ -1594,7 +1602,15 @@ If N is greater or equal to the length of LIST, return LIST unmodified. Otherwise, return LIST after truncating it. */) (Lisp_Object n, Lisp_Object list) { - CHECK_FIXNUM (n); + if (BIGNUMP (n)) + { + if (mpz_sgn (*xbignum_val (n)) < 0) + return Qnil; + CHECK_LIST (list); + return list; + } + if (!FIXNUMP (n)) + wrong_type_argument (Qintegerp, n); EMACS_INT m = XFIXNUM (n); if (m <= 0) return Qnil; diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index a84cce3ad4..4ef428af03 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -1412,6 +1412,14 @@ (should (equal (take 5 list) '(a b c b c))) (should (equal (take 10 list) '(a b c b c b c b c b))) - (should (equal (ntake 10 list) '(a b))))) + (should (equal (ntake 10 list) '(a b)))) + + ;; Bignum N argument. + (let ((list (list 'a 'b 'c))) + (should (equal (take (+ most-positive-fixnum 1) list) '(a b c))) + (should (equal (take (- most-negative-fixnum 1) list) nil)) + (should (equal (ntake (+ most-positive-fixnum 1) list) '(a b c))) + (should (equal (ntake (- most-negative-fixnum 1) list) nil)) + (should (equal list '(a b c))))) ;;; fns-tests.el ends here commit 5cf7b1ada96c2e209580d086d15b1bbe5b345657 Author: Mattias Engdegård Date: Tue Aug 30 11:57:29 2022 +0200 ; * src/lread.c (invalid_radix_integer): Use a local buffer. diff --git a/src/lread.c b/src/lread.c index bb37606481..d64a4fad3a 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2905,20 +2905,18 @@ digit_to_number (int character, int base) return digit < base ? digit : -1; } -/* Size of the fixed-size buffer used during reading. - It should be at least big enough for `invalid_radix_integer' but - can usefully be much bigger than that. */ -enum { stackbufsize = 1024 }; - static void -invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS (stackbufsize)], - Lisp_Object readcharfun) +invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun) { - int n = snprintf (stackbuf, stackbufsize, "integer, radix %"pI"d", radix); - eassert (n < stackbufsize); - invalid_syntax (stackbuf, readcharfun); + char buf[64]; + int n = snprintf (buf, sizeof buf, "integer, radix %"pI"d", radix); + eassert (n < sizeof buf); + invalid_syntax (buf, readcharfun); } +/* Size of the fixed-size buffer used during reading. */ +enum { stackbufsize = 1024 }; + /* Read an integer in radix RADIX using READCHARFUN to read characters. RADIX must be in the interval [2..36]. Use STACKBUF for temporary storage as needed. Value is the integer read. @@ -2976,7 +2974,7 @@ read_integer (Lisp_Object readcharfun, int radix, UNREAD (c); if (valid != 1) - invalid_radix_integer (radix, stackbuf, readcharfun); + invalid_radix_integer (radix, readcharfun); *p = '\0'; return unbind_to (count, string_to_number (read_buffer, radix, NULL)); @@ -3989,7 +3987,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) { /* #NrDIGITS -- radix-N number */ if (n < 0 || n > 36) - invalid_radix_integer (n, stackbuf, readcharfun); + invalid_radix_integer (n, readcharfun); obj = read_integer (readcharfun, n, stackbuf); break; } commit 3e5716dba3ea203a4dc8be794a6b2dee13d5ecc4 Author: Eli Zaretskii Date: Tue Aug 30 16:12:37 2022 +0300 ; * etc/NEWS: Clarify wording of "C-x v v" entry. diff --git a/etc/NEWS b/etc/NEWS index a40954a837..8d251448d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1583,11 +1583,16 @@ info node. This command only works for the Emacs and Emacs Lisp manuals. This command marks files based on a regexp. If given a prefix argument, unmark instead. -*** 'C-x v v' on a diff buffer commits it as a patch. -You can create a diff buffer by e.g. 'C-x v D' ('vc-root-diff'), -then remove unnecessary hunks, and commit only part of your changes -by typing 'C-x v v' in that diff buffer. Currently this works only -with Git. +--- +*** 'C-x v v' in a diffs buffer allows to commit only some of the changes. +This command is intended to allow you to commit only some of the +changes you have in your working tree. Begin by creating a buffer +with the changes against the last commit, e.g. with 'C-x v D' +('vc-root-diff'). Then edit the diffs to remove the hunks you don't +want to commit. Finally, type 'C-x v v' in that diff buffer to commit +only part of your changes, those whose hunks were left in the buffer. + +Currently this feature works only with the Git as 'vc-backend'. --- *** 'C-x v v' on an unregistered file will now use the most specific backend. commit 0bf5463f8147ea9143d286d5a9df7c8421a1ac4b Author: Po Lu Date: Tue Aug 30 19:27:39 2022 +0800 Fix junk data being returned with incremental selection transfers * src/xselect.c (receive_incremental_selection): New arg REAL_BYTES_RET. Set it to the actual size instead of using the size of the array after it was grown by xpalloc. (x_get_window_property_as_lisp_data): Adjust call to receive_incremental_selection. diff --git a/src/xselect.c b/src/xselect.c index bab0400540..74d762f305 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -1567,7 +1567,8 @@ receive_incremental_selection (struct x_display_info *dpyinfo, unsigned char **data_ret, ptrdiff_t *size_bytes_ret, Atom *type_ret, int *format_ret, - unsigned long *size_ret) + unsigned long *size_ret, + ptrdiff_t *real_bytes_ret) { ptrdiff_t offset = 0; struct prop_location *wait_object; @@ -1622,7 +1623,8 @@ receive_incremental_selection (struct x_display_info *dpyinfo, if (tmp_size_bytes == 0) /* we're done */ { - TRACE0 ("Done reading incrementally"); + TRACE1 ("Done reading incrementally; total bytes: %"pD"d", + *size_bytes_ret); if (! waiting_for_other_props_on_window (display, window)) XSelectInput (display, window, STANDARD_EVENT_SET); @@ -1652,6 +1654,19 @@ receive_incremental_selection (struct x_display_info *dpyinfo, memcpy ((*data_ret) + offset, tmp_data, tmp_size_bytes); offset += tmp_size_bytes; + /* *size_bytes_ret is not really the size of the data inside the + buffer; it is the size of the buffer allocated by xpalloc. + + This matters when the cardinal specified in the INCR property + (a _lower bound_ on the size of the selection data) is + smaller than the actual selection contents, which can happen + when programs are streaming selection data from a file + descriptor. In that case, we used to return junk if xpalloc + decided to grow the buffer by more than the provided + increment; to avoid that, store the actual size of the + selection data in *real_bytes_ret. */ + *real_bytes_ret += tmp_size_bytes; + /* Use xfree, not XFree, because x_get_window_property calls xmalloc itself. */ xfree (tmp_data); @@ -1674,10 +1689,14 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, int actual_format; unsigned long actual_size; unsigned char *data = 0; - ptrdiff_t bytes = 0; + ptrdiff_t bytes = 0, array_bytes; Lisp_Object val; Display *display = dpyinfo->display; + /* array_bytes is only used as an argument to xpalloc. The actual + size of the data inside the buffer is inside bytes. */ + array_bytes = 0; + TRACE0 ("Reading selection data"); x_get_window_property (display, window, property, &data, &bytes, @@ -1718,10 +1737,15 @@ x_get_window_property_as_lisp_data (struct x_display_info *dpyinfo, calls xmalloc itself. */ xfree (data); unblock_input (); + + /* Clear bytes again. Previously, receive_incremental_selection + would set this to min_size_bytes, but that is now done to + array_bytes instead. */ + bytes = 0; receive_incremental_selection (dpyinfo, window, property, target_type, - min_size_bytes, &data, &bytes, + min_size_bytes, &data, &array_bytes, &actual_type, &actual_format, - &actual_size); + &actual_size, &bytes); } if (!for_multiple) commit db6e574567350f8cf2eec698ea82e62dcd9d27a6 Author: Gerd Möllmann Date: Tue Aug 30 12:54:29 2022 +0200 ; Ignore test/gmo.h in .gitignore diff --git a/.gitignore b/.gitignore index 0ecbcd061f..eb77b2388f 100644 --- a/.gitignore +++ b/.gitignore @@ -330,3 +330,4 @@ manual/ # Ignore a directory used by dap-mode. .vscode +/test/gmp.h commit 8954fcb93bb271f5147b19671d1bf87d88d8047a Author: Mattias Engdegård Date: Tue Aug 30 11:20:42 2022 +0200 ; * src/lread.c (read0): Fix specpdl off-by-one bug in last change. diff --git a/src/lread.c b/src/lread.c index 15bbf46f78..bb37606481 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3702,11 +3702,13 @@ read0 (Lisp_Object readcharfun, bool locate_syms) char *read_buffer = stackbuf; ptrdiff_t read_buffer_size = sizeof stackbuf; char *heapbuf = NULL; - specpdl_ref count = SPECPDL_INDEX (); + specpdl_ref base_pdl = SPECPDL_INDEX (); ptrdiff_t base_sp = rdstack.sp; record_unwind_protect_intmax (read_stack_reset, base_sp); + specpdl_ref count = SPECPDL_INDEX (); + bool uninterned_symbol; bool skip_shorthand; @@ -4354,7 +4356,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) } } - return unbind_to (count, obj); + return unbind_to (base_pdl, obj); } commit 57ba65e047de2495500ba375070a896913cce267 Author: Lars Ingebrigtsen Date: Tue Aug 30 10:53:11 2022 +0200 Fix char-fold compilation warning * lisp/char-fold.el (require): Get string-join definition. diff --git a/lisp/char-fold.el b/lisp/char-fold.el index e4c7c3c41e..ce395ddaab 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -24,6 +24,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (eval-and-compile (put 'char-fold-table 'char-table-extra-slots 1) (defconst char-fold--default-override nil) commit a998591522416c2aebee8daf4ca35a5b4b7177bb Author: Juri Linkov Date: Tue Aug 30 10:28:34 2022 +0300 * lisp/char-fold.el (describe-char-fold-equivalences): New command. (char-fold--no-regexp): New internal variable. (char-fold--make-table): Use it to skip translation to regexp. Suggested by Robert Pluim . https://lists.gnu.org/archive/html/emacs-devel/2022-07/msg00864.html diff --git a/etc/NEWS b/etc/NEWS index b27f0760d1..a40954a837 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1518,6 +1518,9 @@ with 'C-s C-s', but also after typing a character. Non-nil means that the default definitions of equivalent characters are overridden. +*** New command 'describe-char-fold-equivalences'. +It displays character equivalences used by `char-fold-to-regexp'. + +++ *** New command 'isearch-emoji-by-name'. It is bound to 'C-x 8 e RET' during an incremental search. The diff --git a/lisp/char-fold.el b/lisp/char-fold.el index 05ae52cae0..e4c7c3c41e 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -48,6 +48,7 @@ (eval-and-compile + (defvar char-fold--no-regexp nil) (defun char-fold--make-table () (let* ((equiv (make-char-table 'char-fold-table)) (equiv-multi (make-char-table 'char-fold-table)) @@ -201,11 +202,14 @@ symmetric))) ;; Convert the lists of characters we compiled into regexps. - (map-char-table - (lambda (char decomp-list) - (let ((re (regexp-opt (cons (char-to-string char) decomp-list)))) - (aset equiv char re))) - equiv) + (unless char-fold--no-regexp + ;; Non-nil `char-fold--no-regexp' unoptimized for regexp + ;; is used by `describe-char-fold-equivalences'. + (map-char-table + (lambda (char decomp-list) + (let ((re (regexp-opt (cons (char-to-string char) decomp-list)))) + (aset equiv char re))) + equiv)) equiv))) (defconst char-fold-table @@ -421,6 +425,58 @@ BOUND NOERROR COUNT are passed to `re-search-backward'." (interactive "sSearch: ") (re-search-backward (char-fold-to-regexp string) bound noerror count)) + +(defun describe-char-fold-equivalences (char &optional lax) + "Display characters equivalent to CHAR. +Prompt for CHAR. With no input, i.e. when CHAR is nil, by default +describe all available character equivalences of `char-fold-to-regexp'. +Interactively, a prefix arg means also include partially matching +ligatures." + (interactive (list (ignore-errors + (read-char-by-name + "Character (Unicode name or hex, default all): ")) + current-prefix-arg)) + (require 'help-fns) + (let ((help-buffer-under-preparation t)) + (help-setup-xref (list #'describe-char-fold-equivalences) + (called-interactively-p 'interactive)) + (let* ((equivalences nil) + (char-fold--no-regexp t) + (table (char-fold--make-table)) + (extra (char-table-extra-slot table 0))) + (if (not char) + (map-char-table + (lambda (char list) + (when lax + (setq list (append list (mapcar (lambda (entry) + (cdr entry)) + (aref extra char))))) + (setq equivalences (cons (cons char list) + equivalences))) + table) + (setq equivalences (aref table char)) + (when lax + (setq equivalences (append equivalences + (mapcar (lambda (entry) + (cdr entry)) + (aref extra char))))) + (setq equivalences (cons (char-to-string char) equivalences))) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (if char + (insert (mapconcat + (lambda (c) + (format "%s: \?\\N{%s}\n" + c + (or (get-char-code-property (string-to-char c) 'name) + (get-char-code-property (string-to-char c) 'old-name)))) + equivalences)) + (insert "A list of char-fold equivalences for `char-fold-to-regexp':\n\n") + (setq-local bidi-paragraph-direction 'left-to-right) + (dolist (equiv (nreverse equivalences)) + (insert (format "%c: %s\n" (car equiv) + (string-join (cdr equiv) " ")))))))))) + (provide 'char-fold) ;;; char-fold.el ends here