commit 1b77f1981d8aa107becf571939f01ae04ed16873 (HEAD, refs/remotes/origin/master) Author: Po Lu Date: Tue Sep 20 03:00:10 2022 +0000 Remove intern calls with a static string from haiku*.c * src/haikufns.c (Fx_show_tip, syms_of_haikufns): * src/haikufont.c (haikufont_maybe_handle_special_family) (syms_of_haikufont): * src/haikuterm.c (haiku_term_init, syms_of_haikuterm): Replace intern with real predefined symbols. diff --git a/src/haikufns.c b/src/haikufns.c index aaa4e86622..711202c5df 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -2636,8 +2636,7 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, start_timer: /* Let the tip disappear after timeout seconds. */ - tip_timer = call3 (intern ("run-at-time"), timeout, Qnil, - intern ("x-hide-tip")); + tip_timer = call3 (Qrun_at_time, timeout, Qnil, Qx_hide_tip); return unbind_to (count, Qnil); } @@ -3149,6 +3148,9 @@ syms_of_haikufns (void) DEFSYM (Qcancel_timer, "cancel-timer"); DEFSYM (Qassq_delete_all, "assq-delete-all"); + DEFSYM (Qrun_at_time, "run-at-time"); + DEFSYM (Qx_hide_tip, "x-hide-tip"); + DEFSYM (Qalways, "always"); DEFSYM (Qnot_useful, "not-useful"); DEFSYM (Qwhen_mapped, "when-mapped"); diff --git a/src/haikufont.c b/src/haikufont.c index 3e7f6f86dc..4af9ff9d77 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -370,7 +370,7 @@ haikufont_maybe_handle_special_family (Lisp_Object family, BFont_populate_fixed_family (ptn); return 1; } - else if (EQ (family, intern ("Sans Serif"))) + else if (EQ (family, QSans_Serif)) { BFont_populate_plain_family (ptn); return 1; @@ -1320,6 +1320,7 @@ syms_of_haikufont_for_pdumper (void) void syms_of_haikufont (void) { + DEFSYM (QSans_Serif, "Sans Serif"); DEFSYM (Qfontsize, "fontsize"); DEFSYM (Qfixed, "fixed"); DEFSYM (Qplain, "plain"); diff --git a/src/haikuterm.c b/src/haikuterm.c index df1c39974f..b0832059ba 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -4349,7 +4349,7 @@ haiku_term_init (void) emacs_abort (); color_file = Fexpand_file_name (build_string ("rgb.txt"), - Fsymbol_value (intern ("data-directory"))); + Fsymbol_value (Qdata_directory)); color_map = Fx_load_color_file (color_file); if (NILP (color_map)) @@ -4634,6 +4634,8 @@ syms_of_haikuterm (void) DEFSYM (Qoption, "option"); DEFSYM (Qcommand, "command"); + DEFSYM (Qdata_directory, "data-directory"); + DEFVAR_LISP ("haiku-meta-keysym", Vhaiku_meta_keysym, doc: /* Which key Emacs uses as the meta modifier. This is either one of the symbols `shift', `control', `command', and commit 132d5cb0a3ec94afbb49772631861e00160ffffb Author: F. Jason Park Date: Tue Sep 6 19:09:54 2022 -0700 Bury new ERC buffers by default * lisp/erc/erc.el (erc-join-buffer): Change default value to `bury'. (erc-setup-buffer): Make `window-noselect' behave more like its description and abstain from ever replacing the current buffer. * test/lisp/erc/erc-scenarios-base-reconnect.el (erc-scenarios-common-base-reconnect-options): Update helper to handle new default value for option `erc-join-buffer'. (erc-scenarios-base-reconnect-options--buffer): Update and rename function `erc-scenarios-base-reconnect-options--default'. (erc-scenarios-base-reconnect-options--default): Update and rename function `erc-scenarios-base-reconnect-options--bury'. * etc/ERC-NEWS: Update existing display-buffers section for 5.5. (Bug#51753) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 075a677a9d..988eb1e09c 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -59,9 +59,17 @@ which, when present, becomes the first argument passed to the "USER" IRC command. The traditional way of setting this globally, via 'erc-email-userid', is still honored. -** Additional display options for updated buffers. -Additional flexibility is now available for controlling the behavior -of newly created target buffers, especially during reconnection. +** Changes to display options for new ERC buffers. +The default value for the option 'erc-join-buffer', which determines +how new buffers are displayed, has been changed to 'bury' for security +reasons. Although the old value of 'buffer' is still accessible, +along with its original behavior, users wanting a safer alternative +can now opt for an improved 'window-noselect' instead. It still +offers the same pronounced visual cue when connecting and joining but +now avoids any hijacking of the active window as well. + +Beyond this, additional flexibility is now available for controlling +the behavior of newly created target buffers during reconnection. ** Improved handling of multiline prompt input. This means better detection and handling of intervening and trailing diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2715121d3e..20f22c896f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1651,7 +1651,7 @@ Defaults to the server buffer." "IRC port to use for encrypted connections if it cannot be \ detected otherwise.") -(defcustom erc-join-buffer 'buffer +(defcustom erc-join-buffer 'bury "Determines how to display a newly created IRC buffer. The available choices are: @@ -1662,6 +1662,7 @@ The available choices are: `bury' - bury it in a new buffer, `buffer' - in place of the current buffer, any other value - in place of the current buffer." + :package-version '(ERC . "5.4.1") ; FIXME increment upon publishing to ELPA :group 'erc-buffers :type '(choice (const :tag "Split window and select" window) (const :tag "Split window, don't select" window-noselect) @@ -2148,7 +2149,7 @@ removed from the list will be disabled." (display-buffer buffer) (switch-to-buffer-other-window buffer))) ('window-noselect - (display-buffer buffer)) + (display-buffer buffer '(nil (inhibit-same-window . t)))) ('bury nil) ('frame diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el b/test/lisp/erc/erc-scenarios-base-reconnect.el index 30d692058d..49298dc594 100644 --- a/test/lisp/erc/erc-scenarios-base-reconnect.el +++ b/test/lisp/erc/erc-scenarios-base-reconnect.el @@ -99,10 +99,11 @@ (funcall test) + ;; A manual /JOIN command tells ERC we're done auto-reconnecting (with-current-buffer "FooNet" (erc-cmd-JOIN "#spam")) - (erc-d-t-wait-for 5 "Channel #spam shown when autojoined" - (eq (window-buffer) (get-buffer "#spam"))) + (erc-d-t-ensure-for 1 "Newly joined chan ignores `erc-reconnect-display'" + (not (eq (window-buffer) (get-buffer "#spam")))) (ert-info ("Wait for auto reconnect") (with-current-buffer erc-server-buffer @@ -114,43 +115,43 @@ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#spam")) (funcall expect 10 "her elves come here anon"))))) -(ert-deftest erc-scenarios-base-reconnect-options--default () +(ert-deftest erc-scenarios-base-reconnect-options--buffer () :tags '(:expensive-test) - (should (eq erc-join-buffer 'buffer)) + (should (eq erc-join-buffer 'bury)) (should-not erc-reconnect-display) ;; FooNet (the server buffer) is not switched to because it's ;; already current (but not shown) when `erc-open' is called. See ;; related conditional guard towards the end of that function. - (erc-scenarios-common--base-reconnect-options - (lambda () - (pop-to-buffer-same-window "*Messages*") + (let ((erc-reconnect-display 'buffer)) + (erc-scenarios-common--base-reconnect-options + (lambda () + (pop-to-buffer-same-window "*Messages*") - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) - (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" - (eq (window-buffer) (get-buffer "#chan")))))) + (erc-d-t-wait-for 5 "Channel #chan shown when autojoined" + (eq (window-buffer) (get-buffer "#chan"))))))) -(ert-deftest erc-scenarios-base-reconnect-options--bury () +(ert-deftest erc-scenarios-base-reconnect-options--default () :tags '(:expensive-test) - (should (eq erc-join-buffer 'buffer)) + (should (eq erc-join-buffer 'bury)) (should-not erc-reconnect-display) - (let ((erc-reconnect-display 'bury)) - (erc-scenarios-common--base-reconnect-options + (erc-scenarios-common--base-reconnect-options - (lambda () - (pop-to-buffer-same-window "*Messages*") + (lambda () + (pop-to-buffer-same-window "*Messages*") - (erc-d-t-ensure-for 1 "Server buffer not shown" - (not (eq (window-buffer) (get-buffer "FooNet")))) + (erc-d-t-ensure-for 1 "Server buffer not shown" + (not (eq (window-buffer) (get-buffer "FooNet")))) - (erc-d-t-ensure-for 3 "Channel #chan not shown" - (not (eq (window-buffer) (get-buffer "#chan")))) + (erc-d-t-ensure-for 3 "Channel #chan not shown" + (not (eq (window-buffer) (get-buffer "#chan")))) - (eq (window-buffer) (messages-buffer)))))) + (eq (window-buffer) (messages-buffer))))) ;; Upon reconnecting, playback for channel and target buffers is ;; routed correctly. Autojoin is irrelevant here, but for the commit 01de334c78ee3a887aa15a65d670ae8a63f0a5b2 Author: F. Jason Park Date: Wed Jul 6 19:57:11 2022 -0700 Offer to regexp-quote new items in erc-match commands * lisp/erc/erc-match.el (erc-match-quote-when-adding) Add new option to quote new items added to match lists. (erc-add-entry-to-list): Add optional `alt' parameter indicating whether to flip the behavior indicated by `erc-match-quote-when-adding'. (erc-add-pal, erc-add-fool, erc-add-keyword, erc-add-dangerous-host): Pass universal arg to `erc-add-entry-to-list' as `alt' argument. (erc-match-pal-p, erc-match-fool-p, erc-match-keyword-p, erc-match-dangerous-host-p): Don't bother matching when list is nil. * lisp/erc/erc.el (erc-list-match (lst str): Join input list as regexp union instead of looping over items. * etc/ERC-NEWS: Update misc-UX section for 5.5. * test/lisp/erc/erc-match-tests.el: New file. (Bug#56450) diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 7f95cdd39a..075a677a9d 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -77,6 +77,12 @@ now collapse into an alternate form designated by the option but can be fine-tuned via the repurposed, formerly abandoned option 'erc-hide-prompt'. +Certain commands provided by the 'erc-match' module, such as +'erc-add-keyword', 'erc-add-pal', and others, now optionally ask +whether to 'regexp-quote' the current input. A new option, +'erc-match-quote-when-adding', has been added to allow for retaining +the old behavior, if desired. + A bug has been fixed affecting users of the Soju bouncer: outgoing messages during periods of heavy traffic no longer disappear. diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 7c9174ff66..6b9aa47d86 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -240,6 +240,15 @@ server and other miscellaneous functions." :version "24.3" :type 'boolean) +(defcustom erc-match-quote-when-adding 'ask + "Whether to `regexp-quote' when adding to a match list interactively. +When the value is a boolean, the opposite behavior will be made +available via universal argument." + :package-version '(ERC . "5.4.1") ; FIXME increment on next release + :type '(choice (const ask) + (const t) + (const nil))) + ;; Internal variables: ;; This is exactly the same as erc-button-syntax-table. Should we @@ -290,7 +299,7 @@ Note that this is the default face to use if ;; Functions: -(defun erc-add-entry-to-list (list prompt &optional completions) +(defun erc-add-entry-to-list (list prompt &optional completions alt) "Add an entry interactively to a list. LIST must be passed as a symbol The query happens using PROMPT. @@ -299,7 +308,16 @@ Completion is performed on the optional alist COMPLETIONS." prompt completions (lambda (x) - (not (erc-member-ignore-case (car x) (symbol-value list))))))) + (not (erc-member-ignore-case (car x) (symbol-value list)))))) + quoted) + (setq quoted (regexp-quote entry)) + (when (pcase erc-match-quote-when-adding + ('ask (unless (string= quoted entry) + (y-or-n-p + (format "Use regexp-quoted form (%s) instead? " quoted)))) + ('t (not alt)) + ('nil alt)) + (setq entry quoted)) (if (erc-member-ignore-case entry (symbol-value list)) (error "\"%s\" is already on the list" entry) (set list (cons entry (symbol-value list)))))) @@ -327,10 +345,11 @@ car is the string." (symbol-value list)))))) ;;;###autoload -(defun erc-add-pal () +(defun erc-add-pal (&optional arg) "Add pal interactively to `erc-pals'." - (interactive) - (erc-add-entry-to-list 'erc-pals "Add pal: " (erc-get-server-nickname-alist))) + (interactive "P") + (erc-add-entry-to-list 'erc-pals "Add pal: " + (erc-get-server-nickname-alist) arg)) ;;;###autoload (defun erc-delete-pal () @@ -339,11 +358,11 @@ car is the string." (erc-remove-entry-from-list 'erc-pals "Delete pal: ")) ;;;###autoload -(defun erc-add-fool () +(defun erc-add-fool (&optional arg) "Add fool interactively to `erc-fools'." - (interactive) + (interactive "P") (erc-add-entry-to-list 'erc-fools "Add fool: " - (erc-get-server-nickname-alist))) + (erc-get-server-nickname-alist) arg)) ;;;###autoload (defun erc-delete-fool () @@ -352,10 +371,10 @@ car is the string." (erc-remove-entry-from-list 'erc-fools "Delete fool: ")) ;;;###autoload -(defun erc-add-keyword () +(defun erc-add-keyword (&optional arg) "Add keyword interactively to `erc-keywords'." - (interactive) - (erc-add-entry-to-list 'erc-keywords "Add keyword: ")) + (interactive "P") + (erc-add-entry-to-list 'erc-keywords "Add keyword: " nil arg)) ;;;###autoload (defun erc-delete-keyword () @@ -364,10 +383,10 @@ car is the string." (erc-remove-entry-from-list 'erc-keywords "Delete keyword: ")) ;;;###autoload -(defun erc-add-dangerous-host () +(defun erc-add-dangerous-host (&optional arg) "Add dangerous-host interactively to `erc-dangerous-hosts'." - (interactive) - (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: ")) + (interactive "P") + (erc-add-entry-to-list 'erc-dangerous-hosts "Add dangerous-host: " nil arg)) ;;;###autoload (defun erc-delete-dangerous-host () @@ -388,19 +407,19 @@ NICKUSERHOST will be ignored." (defun erc-match-pal-p (nickuserhost _msg) "Check whether NICKUSERHOST is in `erc-pals'. MSG will be ignored." - (and nickuserhost + (and nickuserhost erc-pals (erc-list-match erc-pals nickuserhost))) (defun erc-match-fool-p (nickuserhost msg) "Check whether NICKUSERHOST is in `erc-fools' or MSG is directed at a fool." - (and msg nickuserhost + (and msg nickuserhost erc-fools (or (erc-list-match erc-fools nickuserhost) (erc-match-directed-at-fool-p msg)))) (defun erc-match-keyword-p (_nickuserhost msg) "Check whether any keyword of `erc-keywords' matches for MSG. NICKUSERHOST will be ignored." - (and msg + (and msg erc-keywords (erc-list-match (mapcar (lambda (x) (if (listp x) @@ -412,7 +431,7 @@ NICKUSERHOST will be ignored." (defun erc-match-dangerous-host-p (nickuserhost _msg) "Check whether NICKUSERHOST is in `erc-dangerous-hosts'. MSG will be ignored." - (and nickuserhost + (and nickuserhost erc-dangerous-hosts (erc-list-match erc-dangerous-hosts nickuserhost))) (defun erc-match-directed-at-fool-p (msg) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 84c5850361..2715121d3e 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -6284,9 +6284,7 @@ The addressed target is the string before the first colon in MSG." (defun erc-list-match (lst str) "Return non-nil if any regexp in LST matches STR." - (memq nil (mapcar (lambda (regexp) - (not (string-match regexp str))) - lst))) + (and lst (string-match (string-join lst "\\|") str))) ;; other "toggles" diff --git a/test/lisp/erc/erc-match-tests.el b/test/lisp/erc/erc-match-tests.el new file mode 100644 index 0000000000..cd7598703b --- /dev/null +++ b/test/lisp/erc/erc-match-tests.el @@ -0,0 +1,193 @@ +;;; erc-match-tests.el --- Tests for erc-match. -*- lexical-binding:t -*- + +;; Copyright (C) 2022 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 'ert-x) +(require 'erc-match) + + +(ert-deftest erc-add-entry-to-list () + (let ((erc-pals '("z")) + (erc-match-quote-when-adding 'ask)) + + (ert-info ("Default (ask)") + (ert-simulate-keys "\t\ry\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) nil) + (should (equal (pop erc-pals) "\\."))) + + (ert-info ("Inverted") + (ert-simulate-keys "\t\ry\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) nil) + (should (equal (pop erc-pals) "\\.")))) + + (ert-info ("Skipped") + (ert-simulate-keys "\t\r" + (erc-add-entry-to-list 'erc-pals "?" '(("x")) nil) + (should (equal (pop erc-pals) "x"))))) + + (ert-info ("Verbatim") + (setq erc-match-quote-when-adding nil) + (ert-simulate-keys "\t\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) nil) + (should (equal (pop erc-pals) "."))) + + (ert-info ("Inverted") + (ert-simulate-keys "\t\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) t) + (should (equal (pop erc-pals) "\\."))))) + + (ert-info ("Quoted") + (setq erc-match-quote-when-adding t) + (ert-simulate-keys "\t\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) nil) + (should (equal (pop erc-pals) "\\."))) + + (ert-info ("Inverted") + (ert-simulate-keys "\t\r" + (erc-add-entry-to-list 'erc-pals "?" '((".")) t) + (should (equal (pop erc-pals) "."))))) + + (should (equal erc-pals '("z"))))) + +(ert-deftest erc-pals () + (with-temp-buffer + (setq erc-server-process (start-process "true" (current-buffer) "true") + erc-server-users (make-hash-table :test #'equal)) + (set-process-query-on-exit-flag erc-server-process nil) + (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]")) + (erc-add-server-user "tester" (make-erc-server-user :nickname "tester")) + + (let ((erc-match-quote-when-adding t) + erc-pals calls rvs) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest r) (push r calls) (pop rvs)))) + + (ert-info ("`erc-add-pal'") + (push "foo[m]" rvs) + (ert-simulate-command '(erc-add-pal)) + (should (equal (cadr (pop calls)) '(("tester") ("foo[m]")))) + (should (equal erc-pals '("foo\\[m]")))) + + (ert-info ("`erc-match-pal-p'") + (should (erc-match-pal-p "FOO[m]!~u@example.net" nil))) + + (ert-info ("`erc-delete-pal'") + (push "foo\\[m]" rvs) + (ert-simulate-command '(erc-delete-pal)) + (should (equal (cadr (pop calls)) '(("foo\\[m]")))) + (should-not erc-pals)) + + (ert-info ("`erc-add-pal' verbatim") + (push "foo[m]" rvs) + (ert-simulate-command '(erc-add-pal (4))) + (should (equal (cadr (pop calls)) '(("tester") ("foo[m]")))) + (should (equal erc-pals '("foo[m]")))))))) + +(ert-deftest erc-fools () + (with-temp-buffer + (setq erc-server-process (start-process "true" (current-buffer) "true") + erc-server-users (make-hash-table :test #'equal)) + (set-process-query-on-exit-flag erc-server-process nil) + (erc-add-server-user "FOO[m]" (make-erc-server-user :nickname "foo[m]")) + (erc-add-server-user "tester" (make-erc-server-user :nickname "tester")) + + (let ((erc-match-quote-when-adding t) + erc-fools calls rvs) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest r) (push r calls) (pop rvs)))) + + (ert-info ("`erc-add-fool'") + (push "foo[m]" rvs) + (ert-simulate-command '(erc-add-fool)) + (should (equal (cadr (pop calls)) '(("tester") ("foo[m]")))) + (should (equal erc-fools '("foo\\[m]")))) + + (ert-info ("`erc-match-fool-p'") + (should (erc-match-fool-p "FOO[m]!~u@example.net" "")) + (should (erc-match-fool-p "tester!~u@example.net" "FOO[m]: die"))) + + (ert-info ("`erc-delete-fool'") + (push "foo\\[m]" rvs) + (ert-simulate-command '(erc-delete-fool)) + (should (equal (cadr (pop calls)) '(("foo\\[m]")))) + (should-not erc-fools)) + + (ert-info ("`erc-add-fool' verbatim") + (push "foo[m]" rvs) + (ert-simulate-command '(erc-add-fool (4))) + (should (equal (cadr (pop calls)) '(("tester") ("foo[m]")))) + (should (equal erc-fools '("foo[m]")))))))) + +(ert-deftest erc-keywords () + (let ((erc-match-quote-when-adding t) + erc-keywords calls rvs) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest r) (push r calls) (pop rvs)))) + + (ert-info ("`erc-add-keyword'") + (push "[cit. needed]" rvs) + (ert-simulate-command '(erc-add-keyword)) + (should (equal (cadr (pop calls)) nil)) + (should (equal erc-keywords '("\\[cit\\. needed]")))) + + (ert-info ("`erc-match-keyword-p'") + (should (erc-match-keyword-p nil "is pretty [cit. needed]"))) + + (ert-info ("`erc-delete-keyword'") + (push "\\[cit\\. needed]" rvs) + (ert-simulate-command '(erc-delete-keyword)) + (should (equal (cadr (pop calls)) '(("\\[cit\\. needed]")))) + (should-not erc-keywords)) + + (ert-info ("`erc-add-keyword' verbatim") + (push "[...]" rvs) + (ert-simulate-command '(erc-add-keyword (4))) + (should (equal (cadr (pop calls)) nil)) + (should (equal erc-keywords '("[...]"))))))) + +(ert-deftest erc-dangerous-hosts () + (let ((erc-match-quote-when-adding t) + erc-dangerous-hosts calls rvs) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest r) (push r calls) (pop rvs)))) + + (ert-info ("`erc-add-dangerous-host'") + (push "example.net" rvs) + (ert-simulate-command '(erc-add-dangerous-host)) + (should (equal (cadr (pop calls)) nil)) + (should (equal erc-dangerous-hosts '("example\\.net")))) + + (ert-info ("`erc-match-dangerous-host-p'") + (should (erc-match-dangerous-host-p "FOO[m]!~u@example.net" nil))) + + (ert-info ("`erc-delete-dangerous-host'") + (push "example\\.net" rvs) + (ert-simulate-command '(erc-delete-dangerous-host)) + (should (equal (cadr (pop calls)) '(("example\\.net")))) + (should-not erc-dangerous-hosts)) + + (ert-info ("`erc-add-dangerous-host' verbatim") + (push "example.net" rvs) + (ert-simulate-command '(erc-add-dangerous-host (4))) + (should (equal (cadr (pop calls)) nil)) + (should (equal erc-dangerous-hosts '("example.net"))))))) + +;;; erc-match-tests.el ends here commit 7df5b4deb8b13a25e0708bb5339540cea0683e2e Author: F. Jason Park Date: Fri Sep 2 21:57:57 2022 -0700 Don't record undo history in erc-protocol buffers * lisp/erc/erc.el (erc-log-irc-protocol): Disable undo history. diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 151d75e7ce..84c5850361 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2571,7 +2571,8 @@ workaround." (with-current-buffer (get-buffer-create "*erc-protocol*") (save-excursion (goto-char (point-max)) - (let ((inhibit-read-only t)) + (let ((buffer-undo-list t) + (inhibit-read-only t)) (insert (if outbound (concat ts esid " >> " string) ;; Cope with multi-line messages commit e98465e5418497a925e795c358231a4d70d6e5ff Author: F. Jason Park Date: Wed Aug 17 00:00:53 2022 -0700 Stabilize channels variant of erc-reuse-buffers test * lisp/erc/erc-networks.el (erc-networks--id-sort-buffers): Use `buffer-local-value' instead of `with-current-buffer'. * test/lisp/erc/erc-scenarios-base-reuse-buffers.el (erc-scenarios-common--base-reuse-buffers-channel-buffers): Wait for buffers to be created by server-initiated JOINs. (erc-scenarios-base-reuse-buffers-channel-buffers--disabled): Remove `:unstable' tag. * test/lisp/erc-tests.el (erc-ring-previous-command): Remove unnecessary `goto-char'. diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index c54b12fcb0..2c8f8fb72b 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -996,8 +996,8 @@ Rename the current buffer if its NID has grown." "Return a list of target BUFFERS, newest to oldest." (sort buffers (lambda (a b) - (> (with-current-buffer a (erc-networks--id-ts erc-networks--id)) - (with-current-buffer b (erc-networks--id-ts erc-networks--id)))))) + (> (erc-networks--id-ts (buffer-local-value 'erc-networks--id a)) + (erc-networks--id-ts (buffer-local-value 'erc-networks--id b)))))) ;;;; Buffer association diff --git a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el index f134f3ffb6..8e7e939d04 100644 --- a/test/lisp/erc/erc-scenarios-base-reuse-buffers.el +++ b/test/lisp/erc/erc-scenarios-base-reuse-buffers.el @@ -131,43 +131,38 @@ Adapted from scenario clash-of-chans/uniquify described in Bug#48598: (get-buffer (format "127.0.0.1:%d/127.0.0.1" port))) (server-buffer-bar (get-buffer (format "127.0.0.1:%d/127.0.0.1<2>" port))) - (chan-buffer-foo (get-buffer "#chan/127.0.0.1")) - (chan-buffer-bar (get-buffer "#chan/127.0.0.1<2>")) - (server-process-foo (with-current-buffer server-buffer-foo - erc-server-process)) - (server-process-bar (with-current-buffer server-buffer-bar - erc-server-process))) + (server-process-foo + (buffer-local-value 'erc-server-process server-buffer-foo)) + (server-process-bar + (buffer-local-value 'erc-server-process server-buffer-bar))) (ert-info ("Unique #chan buffers exist") - (let ((chan-bufs (erc-scenarios-common-buflist "#chan")) - (known (list chan-buffer-bar chan-buffer-foo))) - (should (memq (pop chan-bufs) known)) - (should (memq (pop chan-bufs) known)) - (should-not chan-bufs))) + (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1<2>")) + (erc-d-t-wait-for 3 (get-buffer "#chan/127.0.0.1"))) (ert-info ("#chan@foonet is exclusive and not contaminated") - (with-current-buffer chan-buffer-foo + (with-current-buffer "#chan/127.0.0.1" (funcall expect 1 "") (erc-d-t-absent-for 0.1 "") (funcall expect 1 "strength to climb") (should (eq erc-server-process server-process-foo)))) (ert-info ("#chan@barnet is exclusive and not contaminated") - (with-current-buffer chan-buffer-bar + (with-current-buffer "#chan/127.0.0.1<2>" (funcall expect 1 "") (erc-d-t-absent-for 0.1 "") (funcall expect 1 "the loudest noise") (should (eq erc-server-process server-process-bar)))) (ert-info ("Part #chan@foonet") - (with-current-buffer chan-buffer-foo + (with-current-buffer "#chan/127.0.0.1" (erc-d-t-search-for 1 "shake my sword") (erc-cmd-PART "#chan") (funcall expect 3 "You have left channel #chan") (erc-cmd-JOIN "#chan"))) (ert-info ("Part #chan@barnet") - (with-current-buffer chan-buffer-bar + (with-current-buffer "#chan/127.0.0.1<2>" (funcall expect 10 "Arm it in rags") (should (erc-get-channel-user (erc-current-nick))) (erc-cmd-PART "#chan") @@ -179,7 +174,7 @@ Adapted from scenario clash-of-chans/uniquify described in Bug#48598: (get-buffer "#chan/127.0.0.1<3>")) (ert-info ("Activity continues in new, -suffixed #chan@foonet buffer") - (with-current-buffer chan-buffer-foo + (with-current-buffer "#chan/127.0.0.1" (should-not (erc-get-channel-user (erc-current-nick)))) (with-current-buffer "#chan/127.0.0.1<3>" (should (erc-get-channel-user (erc-current-nick))) @@ -194,7 +189,7 @@ Adapted from scenario clash-of-chans/uniquify described in Bug#48598: (get-buffer "#chan/127.0.0.1<4>")) (ert-info ("Activity continues in new, -suffixed #chan@barnet buffer") - (with-current-buffer chan-buffer-bar + (with-current-buffer "#chan/127.0.0.1<2>" (should-not (erc-get-channel-user (erc-current-nick)))) (with-current-buffer "#chan/127.0.0.1<4>" (funcall expect 2 "You have joined channel #chan") @@ -221,12 +216,12 @@ Adapted from scenario clash-of-chans/uniquify described in Bug#48598: (ert-info ("Buffers are exempt from shortening") (kill-buffer "#chan/127.0.0.1<4>") (kill-buffer "#chan/127.0.0.1<3>") - (kill-buffer chan-buffer-bar) + (kill-buffer "#chan/127.0.0.1<2>") (should-not (get-buffer "#chan")) - (should chan-buffer-foo)))) + (should (get-buffer "#chan/127.0.0.1"))))) (ert-deftest erc-scenarios-base-reuse-buffers-channel-buffers--disabled () - :tags '(:expensive-test :unstable) + :tags '(:expensive-test) (with-suppressed-warnings ((obsolete erc-reuse-buffers)) (should erc-reuse-buffers) (let ((erc-scenarios-common-dialog "base/reuse-buffers/channel") diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 55efe2fd2d..b2ed29e80e 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -522,7 +522,7 @@ (erc-send-current-line) (should (ring-p erc-input-ring)) (should (zerop (ring-member erc-input-ring "/one"))) ; equal - (should (save-excursion (forward-line -1) (goto-char (pos-bol)) + (should (save-excursion (forward-line -1) (looking-at-p "[*]+ echo: one"))) (should-not erc-input-ring-index) (erc-bol) commit 33fdb1daa354e5045e6e4a798db18d2ba1fbc38b Author: F. Jason Park Date: Sun Sep 18 14:42:01 2022 -0700 ; Tag some ERC test-server tests as being :unstable * test/lisp/erc/resources/base/assoc/samenet/chester.eld: Relax timeout. * test/lisp/erc/resources/base/assoc/samenet/tester.eld: Relax timeout. * test/lisp/erc/resources/base/assoc/samenet/tester2.eld: Relax timeout. * test/lisp/erc/resources/base/netid/samenet/chester.eld: Relax timeout. * test/lisp/erc/resources/base/netid/samenet/tester.eld: Relax timeout. * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-run-linger, erc-d-run-linger-fail, erc-d-run-linger-direct): Mark some tests as being unstable. diff --git a/test/lisp/erc/resources/base/assoc/samenet/chester.eld b/test/lisp/erc/resources/base/assoc/samenet/chester.eld index f1aed2836c..0132de677c 100644 --- a/test/lisp/erc/resources/base/assoc/samenet/chester.eld +++ b/test/lisp/erc/resources/base/assoc/samenet/chester.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK chester")) ((user 1 "USER user 0 * :chester") (0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester") diff --git a/test/lisp/erc/resources/base/assoc/samenet/tester.eld b/test/lisp/erc/resources/base/assoc/samenet/tester.eld index cd9cacbe5d..995fab00f7 100644 --- a/test/lisp/erc/resources/base/assoc/samenet/tester.eld +++ b/test/lisp/erc/resources/base/assoc/samenet/tester.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") diff --git a/test/lisp/erc/resources/base/assoc/samenet/tester2.eld b/test/lisp/erc/resources/base/assoc/samenet/tester2.eld index 67c3a94a26..33a05fe261 100644 --- a/test/lisp/erc/resources/base/assoc/samenet/tester2.eld +++ b/test/lisp/erc/resources/base/assoc/samenet/tester2.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") diff --git a/test/lisp/erc/resources/base/netid/samenet/chester.eld b/test/lisp/erc/resources/base/netid/samenet/chester.eld index 8c2448733c..7b4bfee9c9 100644 --- a/test/lisp/erc/resources/base/netid/samenet/chester.eld +++ b/test/lisp/erc/resources/base/netid/samenet/chester.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK chester")) ((user 1 "USER user 0 * :chester") (0 ":irc.foonet.org 001 chester :Welcome to the foonet IRC Network chester") diff --git a/test/lisp/erc/resources/base/netid/samenet/tester.eld b/test/lisp/erc/resources/base/netid/samenet/tester.eld index 76312a7a14..f41b041db4 100644 --- a/test/lisp/erc/resources/base/netid/samenet/tester.eld +++ b/test/lisp/erc/resources/base/netid/samenet/tester.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index 357bc48b08..a4befd96b5 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -673,7 +673,7 @@ nonzero for this to work." (cadr (pop errors)))))) (ert-deftest erc-d-run-linger () - :tags '(:expensive-test) + :tags '(:unstable :expensive-test) (erc-d-tests-with-server (dumb-s _) linger (with-current-buffer (erc-d-t-wait-for 6 (get-buffer "#chan")) (erc-d-t-search-for 2 "hey")) @@ -683,7 +683,7 @@ nonzero for this to work." (erc-d-t-search-for 3 "Lingered for 1.00 seconds")))) (ert-deftest erc-d-run-linger-fail () - :tags '(:expensive-test) + :tags '(:unstable :expensive-test) (let ((erc-server-flood-penalty 0.1) errors) (erc-d-tests-with-failure-spy @@ -696,7 +696,7 @@ nonzero for this to work." (should (string-match-p "Match failed.*hi" (cadr (pop errors)))))) (ert-deftest erc-d-run-linger-direct () - :tags '(:expensive-test) + :tags '(:unstable :expensive-test) (let* ((dumb-server (erc-d-run "localhost" t 'linger-multi-a 'linger-multi-b)) (port (process-contact dumb-server :service)) commit bd40ec5d57c0787530ebac1e14352a34fe235844 Author: Stefan Monnier Date: Mon Sep 19 16:19:44 2022 -0400 * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda): Fix bug#57903 Fall back to old slower calling convention in dynbound code (bug#56596). diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 0560ddda26..3fd85bcb88 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -425,11 +425,13 @@ the specializer used will be the one returned by BODY." ;; only called with explicit arguments. (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)) (λ-lift (mapcar #'car uses-cnm))) - (if (not uses-cnm) - (cons nil - `#'(lambda (,@args) - ,@(car parsed-body) - ,nbody)) + (cond + ((not uses-cnm) + (cons nil + `#'(lambda (,@args) + ,@(car parsed-body) + ,nbody))) + (lexical-binding (cons 'curried `#'(lambda (,nm) ;Called when constructing the effective method. (let ((,nmp (if (cl--generic-isnot-nnm-p ,nm) @@ -465,7 +467,20 @@ the specializer used will be the one returned by BODY." ;; A destructuring-bind would do the trick ;; as well when/if it's more efficient. (apply (lambda (,@λ-lift ,@args) ,nbody) - ,@λ-lift ,arglist))))))))) + ,@λ-lift ,arglist))))))) + (t + (cons t + `#'(lambda (,cnm ,@args) + ,@(car parsed-body) + ,(macroexp-warn-and-return + "cl-defmethod used without lexical-binding" + (if (not (assq nmp uses-cnm)) + nbody + `(let ((,nmp (lambda () + (cl--generic-isnot-nnm-p ,cnm)))) + ,nbody)) + 'lexical t))))) + )) (f (error "Unexpected macroexpansion result: %S" f)))))) (put 'cl-defmethod 'function-documentation commit 4b84f44015ca4d77500a22058be9e205343ad36d Author: Juri Linkov Date: Mon Sep 19 23:12:17 2022 +0300 * lisp/outline.el (outline-open): Revert 'text' back to " open ". (outline-close): Revert 'text' back to " close ". (outline-close-rtl): Remove 'text' since it's inherited from the parent 'outline-close'. diff --git a/lisp/outline.el b/lisp/outline.el index ab37e398e9..3aebc25e13 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -315,7 +315,7 @@ Note that this feature is meant to be used in editing buffers." '((image "outline-open.svg" "outline-open.pbm" :height 15) (emoji "🔽") (symbol " ▼ ") - (text " v ")) + (text " open ")) "Icon used for buttons for opened sections in outline buffers." :version "29.1" :help-echo "Close this section") @@ -324,7 +324,7 @@ Note that this feature is meant to be used in editing buffers." '((image "outline-close.svg" "outline-close.pbm" :height 15) (emoji "▶️") (symbol " ▶ ") - (text " > ")) + (text " close ")) "Icon used for buttons for closed sections in outline buffers." :version "29.1" :help-echo "Open this section") @@ -332,8 +332,7 @@ Note that this feature is meant to be used in editing buffers." (define-icon outline-close-rtl outline-close '((image "outline-close.svg" "outline-close.pbm" :height 15 :rotation 180) (emoji "◀️") - (symbol " ◀ ") - (text " < ")) + (symbol " ◀ ")) "Right-to-left icon used for buttons in closed outline sections." :version "29.1") commit 8c159a26575b84708257840fc500632e182ed798 Author: Gregory Heytings Date: Mon Sep 19 15:52:36 2022 +0000 Improve advices on build failures. * Makefile.in: Mention "make extraclean; make". Mention mailing the bugtracker among the possible choices. Fix typo. diff --git a/Makefile.in b/Makefile.in index d118ba6821..1cc695482d 100644 --- a/Makefile.in +++ b/Makefile.in @@ -383,20 +383,25 @@ actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis # You might try to: # - run "make bootstrap", which might fix the problem # - run "make V=1", which displays the full commands invoked by make, -#   to further investigate the problem +# ​ to further investigate the problem # ADVICE-ON-FAILURE-END:all # ADVICE-ON-FAILURE-BEGIN:bootstrap # You might try to: -# - run "make bootstrap configure=default", to rebuild Emacs with the -#   default configuration options, which might fix the problem +# - run "make extraclean" and run "make" again (or, equivalently, run +# ​ "make bootstrap configure=default"), to rebuild Emacs with the +# ​ default configuration options, which might fix the problem # - run "git clean -fdx" and run "make bootstrap" again, which might -#   fix the problem if "git boostrap configure=default" did not -#   !BEWARE! "git clean -fdx" deletes all files that are not under -#   !BEWARE! version control, which means that all changes to such -#   !BEWARE! files will be lost and cannot be restored later +# ​ fix the problem if "make bootstrap configure=default" did not +# ​ !BEWARE! "git clean -fdx" deletes all files that are not under +# ​ !BEWARE! version control, which means that all changes to such +# ​ !BEWARE! files will be lost and cannot be restored later # - run "make V=1", which displays the full commands invoked by make, -#   to further investigate the problem +# ​ to further investigate the problem +# - report the problem and ask for help by sending an email to +# ​ bug-gnu-emacs@gnu.org, mentioning at least the build error +# ​ message, the platform, and the repository revision displayed by +# ​ "git rev-parse HEAD" # ADVICE-ON-FAILURE-END:bootstrap advice-on-failure: commit 0a15956f495338b4f2260c7676a6040436a90645 Author: Juri Linkov Date: Mon Sep 19 22:35:51 2022 +0300 * lisp/outline.el (outline-minor-mode-use-margins): New user option. (outline--use-margins, outline--use-buttons, outline--use-rtl): New buffer-local internal variables. (outline-open, outline-close): Move :ascent center to default of define-icon. Use ASCII-art for text. Fix docstring and help-echo. (outline-close-rtl, outline-open-in-margins) (outline-close-in-margins, outline-close-rtl-in-margins): New icon definitions. (outline-minor-mode-highlight-buffer): Remove outline--insert-open-button since initial outline--fix-up-all-buttons is added now to outline-minor-mode. (outline-minor-mode): Set buffer-local outline--use-buttons, outline--use-margins and outline--use-rtl. Show/hide margins for outline--use-margins. Add hook after-change-functions for editable buffers. Move outline--fix-up-all-buttons for both cases: font-lock and non-font-lock. (outline--use-buttons-p): Remove function. (outline--make-button-overlay): Use outline--use-rtl icon outline-close-rtl. (outline--make-margin-overlay): New function. (outline--insert-open-button, outline--insert-close-button): Add optional arg 'use-margins'. (outline--fix-up-all-buttons): Call outline--insert-close-button and outline--insert-open-button with arg outline--use-margins. (outline-cycle-buffer): Remove outline--fix-up-all-buttons that is already called from outline-flag-region. * lisp/emacs-lisp/icons.el (icons--create): Handle keywords :rotation and :ascent with the default value 'center (bug#57813). * doc/emacs/text.texi (Outline Mode): Mention outline-minor-mode-use-margins. diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index fa8eaf0924..35dce18d02 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1003,6 +1003,11 @@ addition to ellipsis to show that a section is hidden. Using @kbd{RET} (or clicking on the button with a mouse) will toggle displaying the section. +@vindex outline-minor-mode-use-margins + If @code{outline-minor-mode-use-margins} is non-@code{nil}, Outline +minor mode will use the window margins in addition to ellipsis to show +that a section is hidden. + @vindex outline-minor-mode-cycle If the @code{outline-minor-mode-cycle} user option is non-@code{nil}, the @kbd{TAB} and @kbd{S-@key{TAB}} keys are enabled on the diff --git a/etc/NEWS b/etc/NEWS index ee333a84e4..821da805ca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -962,7 +962,14 @@ or is itself too long. *** New user option 'outline-minor-mode-use-buttons'. If non-nil, Outline Minor Mode will use buttons to hide/show outlines in addition to the ellipsis. The default is nil in editing modes, but -non-nil in 'special-mode' and its derivatives. +non-nil in 'help-mode' and its derivatives. + ++++ +*** New user option 'outline-minor-mode-use-margins'. +If non-nil, Outline Minor Mode will use the window margins to +hide/show outlines in addition to the ellipsis. The default is +non-nil in 'special-mode' and its derivatives, and it can be used in +editing modes. ** Windows @@ -1489,8 +1496,8 @@ characters instead of just 'SPC' and 'TAB'. This mode adds some highlighting, fixes the 'M-q' command, and has commands for doing maintenance of the Emacs NEWS files. In addition, this mode turns on 'outline-minor-mode', and thus displays -customizable icons (see 'icon-preference') on heading lines. To -disable these icons, customize 'outline-minor-mode-use-buttons' to a +customizable icons (see 'icon-preference') in the margins. To +disable these icons, customize 'outline-minor-mode-use-margins' to a nil value. --- diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el index ff4f20c207..ccc3657793 100644 --- a/lisp/emacs-lisp/icons.el +++ b/lisp/emacs-lisp/icons.el @@ -202,7 +202,11 @@ present if the icon is represented by an image." :height (if (eq height 'line) (window-default-line-height) height) - :scale 1 :ascent 'center) + :scale 1 + :rotation (plist-get keywords :rotation) + :ascent (if (plist-member keywords :ascent) + (plist-get keywords :ascent) + 'center)) (create-image file)))))) (cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords) diff --git a/lisp/outline.el b/lisp/outline.el index e3fbd8b327..ab37e398e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -292,25 +292,65 @@ buffers (yet) -- that will be amended in a future version." :safe #'booleanp :version "29.1") +(defvar-local outline--use-buttons nil + "Non-nil when buffer displays clickable buttons on the headings.") + +(defvar-local outline--use-rtl nil + "Non-nil when direction of clickable buttons is right-to-left.") + +(defcustom outline-minor-mode-use-margins '(derived-mode . special-mode) + "Whether to display clickable buttons in the margins. +The value should be a `buffer-match-p' condition. + +These buttons can be used to hide and show the body under the heading. +Note that this feature is meant to be used in editing buffers." + :type 'buffer-predicate + :safe #'booleanp + :version "29.1") + +(defvar-local outline--use-margins nil + "Non-nil when buffer displays clickable buttons in the margins.") + (define-icon outline-open nil - '((image "outline-open.svg" "outline-open.pbm" - :height 15 :ascent center) + '((image "outline-open.svg" "outline-open.pbm" :height 15) (emoji "🔽") (symbol " ▼ ") - (text " open ")) - "Icon used for buttons for opening a section in outline buffers." + (text " v ")) + "Icon used for buttons for opened sections in outline buffers." :version "29.1" - :help-echo "Open this section") + :help-echo "Close this section") (define-icon outline-close nil - '((image "outline-close.svg" "outline-close.pbm" - :height 15 :ascent center) + '((image "outline-close.svg" "outline-close.pbm" :height 15) (emoji "▶️") (symbol " ▶ ") - (text " close ")) - "Icon used for buttons for closing a section in outline buffers." + (text " > ")) + "Icon used for buttons for closed sections in outline buffers." :version "29.1" - :help-echo "Close this section") + :help-echo "Open this section") + +(define-icon outline-close-rtl outline-close + '((image "outline-close.svg" "outline-close.pbm" :height 15 :rotation 180) + (emoji "◀️") + (symbol " ◀ ") + (text " < ")) + "Right-to-left icon used for buttons in closed outline sections." + :version "29.1") + +(define-icon outline-open-in-margins outline-open + '((image "outline-open.svg" "outline-open.pbm" :height 10)) + "Icon used for buttons for opened sections in margins." + :version "29.1") + +(define-icon outline-close-in-margins outline-close + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90)) + "Icon used for buttons for closed sections in margins." + :version "29.1") + +(define-icon outline-close-rtl-in-margins outline-close-rtl + '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90)) + "Right-to-left icon used for closed sections in margins." + :version "29.1") (defvar outline-level #'outline-level @@ -439,9 +479,7 @@ outline font-lock faces to those of major mode." (when (or (memq outline-minor-mode-highlight '(append override)) (and (eq outline-minor-mode-highlight t) (not (get-text-property (match-beginning 0) 'face)))) - (overlay-put overlay 'face (outline-font-lock-face))) - (when (outline--use-buttons-p) - (outline--insert-open-button))) + (overlay-put overlay 'face (outline-font-lock-face)))) (goto-char (match-end 0)))))) ;;;###autoload @@ -456,13 +494,37 @@ See the command `outline-mode' for more information on this mode." (key-description outline-minor-mode-prefix) outline-mode-prefix-map) (if outline-minor-mode (progn + (cond + ((buffer-match-p outline-minor-mode-use-margins (current-buffer)) + (setq-local outline--use-margins t)) + ((buffer-match-p outline-minor-mode-use-buttons (current-buffer)) + (setq-local outline--use-buttons t))) + (when (and (or outline--use-buttons outline--use-margins) + (eq (current-bidi-paragraph-direction) 'right-to-left)) + (setq-local outline--use-rtl t)) + (when outline--use-margins + (if outline--use-rtl + (setq-local right-margin-width (1+ right-margin-width)) + (setq-local left-margin-width (1+ left-margin-width))) + (setq-local fringes-outside-margins t) + ;; Force display of margins + (set-window-buffer nil (window-buffer))) + (when (or outline--use-buttons outline--use-margins) + (add-hook 'after-change-functions + (lambda (beg end _len) + (when outline--use-buttons + (remove-overlays beg end 'outline-button t)) + (when outline--use-margins + (remove-overlays beg end 'outline-margin t)) + (outline--fix-up-all-buttons beg end)) + nil t)) (when outline-minor-mode-highlight (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)) + (font-lock-flush)) (outline-minor-mode-highlight-buffer))) + (outline--fix-up-all-buttons) ;; Turn off this mode if we change major modes. (add-hook 'change-major-mode-hook (lambda () (outline-minor-mode -1)) @@ -476,16 +538,19 @@ See the command `outline-mode' for more information on this mode." (font-lock-remove-keywords nil outline-font-lock-keywords)) (remove-overlays nil nil 'outline-overlay t) (font-lock-flush)) + (when outline--use-margins + (if outline--use-rtl + (setq-local right-margin-width (1- right-margin-width)) + (setq-local left-margin-width (1- left-margin-width))) + (setq-local fringes-outside-margins nil) + ;; Force removal of margins + (set-window-buffer nil (window-buffer))) (setq line-move-ignore-invisible nil) ;; Cause use of ellipses for invisible text. (remove-from-invisibility-spec '(outline . t)) ;; When turning off outline mode, get rid of any outline hiding. (outline-show-all))) -(defun outline--use-buttons-p () - (and outline-minor-mode - (buffer-match-p outline-minor-mode-use-buttons (current-buffer)))) - (defvar-local outline-heading-alist () "Alist associating a heading for every possible level. Each entry is of the form (HEADING . LEVEL). @@ -1000,8 +1065,11 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'follow-link 'mouse-face) (overlay-put o 'mouse-face 'highlight) (overlay-put o 'outline-button t)) - (let ((icon - (icon-elements (if (eq type 'close) 'outline-close 'outline-open))) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl + 'outline-close) + 'outline-open))) (inhibit-read-only t)) ;; In editing buffers we use overlays only, but in other buffers ;; we use a mix of text properties, text and overlays to make @@ -1015,10 +1083,40 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'face (plist-get icon 'face)))) o)) -(defun outline--insert-open-button () +(defun outline--make-margin-overlay (type) + (let ((o (seq-find (lambda (o) + (overlay-get o 'outline-margin)) + (overlays-at (point))))) + (unless o + (setq o (make-overlay (point) (1+ (point)))) + (overlay-put o 'follow-link 'mouse-face) + (overlay-put o 'mouse-face 'highlight) + (overlay-put o 'outline-margin t)) + (let ((icon (icon-elements (if (eq type 'close) + (if outline--use-rtl + 'outline-close-rtl-in-margins + 'outline-close-in-margins) + 'outline-open-in-margins))) + (inhibit-read-only t)) + (overlay-put + o 'before-string + (propertize " " 'display + `((margin ,(if outline--use-rtl + 'right-margin 'left-margin)) + ,(or (plist-get icon 'image) + (plist-get icon 'string)))))) + o)) + +(defun outline--insert-open-button (&optional use-margins) (with-silent-modifications (save-excursion - (beginning-of-line) + (beginning-of-line) + (if use-margins + (let ((o (outline--make-margin-overlay 'open))) + (overlay-put o 'help-echo "Click to hide") + (overlay-put o 'keymap + (define-keymap + "" #'outline-hide-subtree))) (when (derived-mode-p 'special-mode) (let ((inhibit-read-only t)) (insert " ") @@ -1028,12 +1126,19 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap "RET" #'outline-hide-subtree - "" #'outline-hide-subtree)))))) + "" #'outline-hide-subtree + " " #'outline-hide-subtree))))))) -(defun outline--insert-close-button () +(defun outline--insert-close-button (&optional use-margins) (with-silent-modifications (save-excursion - (beginning-of-line) + (beginning-of-line) + (if use-margins + (let ((o (outline--make-margin-overlay 'close))) + (overlay-put o 'help-echo "Click to show") + (overlay-put o 'keymap + (define-keymap + "" #'outline-show-subtree))) (when (derived-mode-p 'special-mode) (let ((inhibit-read-only t)) (insert " ") @@ -1043,10 +1148,11 @@ If non-nil, EVENT should be a mouse event." (overlay-put o 'keymap (define-keymap "RET" #'outline-show-subtree - "" #'outline-show-subtree)))))) + "" #'outline-show-subtree + " " #'outline-show-subtree))))))) (defun outline--fix-up-all-buttons (&optional from to) - (when (outline--use-buttons-p) + (when (or outline--use-buttons outline--use-margins) (when from (save-excursion (goto-char from) @@ -1057,8 +1163,8 @@ If non-nil, EVENT should be a mouse event." (outline-end-of-heading) (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline)) (overlays-at (point)))) - (outline--insert-close-button) - (outline--insert-open-button))) + (outline--insert-close-button outline--use-margins) + (outline--insert-open-button outline--use-margins))) (or from (point-min)) (or to (point-max))))) (define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1") @@ -1627,8 +1733,7 @@ With a prefix argument, show headings up to that LEVEL." (t (outline-show-all) (setq outline--cycle-buffer-state 'show-all) - (message "Show all"))) - (outline--fix-up-all-buttons))) + (message "Show all"))))) (defvar-keymap outline-navigation-repeat-map commit c6d3d97bf5a75e0c4a653f3cc380371f890f4fb3 Merge: 0e5eb6ec8c d6b25b84bc Author: Michael Albinus Date: Mon Sep 19 21:15:06 2022 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit d6b25b84bc8cde6b8d396b073945c8340e6ca40d Author: Matthias Meulien Date: Mon Sep 19 20:47:00 2022 +0200 Minor touch-ups of some recent OSC stuff * lisp/comint.el (comint-osc-handlers): (comint-osc-hyperlink-map): Use defvaralias (bug#57821). * lisp/osc.el: Fix some comments. diff --git a/etc/NEWS b/etc/NEWS index 723bdd7c75..ee333a84e4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2450,7 +2450,9 @@ Adding the new function 'osc-compilation-filter' to sequences in compilation buffers. By default, all sequences are filtered out. -A handler for OSC 2, the command to set a window title, is provided. +The list of handlers (already covering OSC 7 and 8) has been extended +with a handler for OSC 2, the command to set a window title. + +++ *** New user option 'project-vc-include-untracked'. diff --git a/lisp/comint.el b/lisp/comint.el index afaa27c2c0..b2a04ea55a 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3916,11 +3916,11 @@ REGEXP-GROUP is the regular expression group in REGEXP to use." ;; sequences. ;; Aliases defined for reverse compatibility -(defalias 'comint-osc-handlers 'osc-handlers) +(defvaralias 'comint-osc-handlers 'osc-handlers) (defalias 'comint-osc-directory-tracker 'osc-directory-tracker) (defalias 'comint-osc-hyperlink-handler 'osc-hyperlink-handler) (defalias 'comint-osc-hyperlink 'osc-hyperlink) -(defalias 'comint-osc-hyperlink-map 'osc-hyperlink-map) +(defvaralias 'comint-osc-hyperlink-map 'osc-hyperlink-map) (defun comint-osc-process-output (_) "Interpret OSC escape sequences in comint output. diff --git a/lisp/osc.el b/lisp/osc.el index 8f4cd630ba..14f7fe6a4f 100644 --- a/lisp/osc.el +++ b/lisp/osc.el @@ -22,14 +22,14 @@ ;;; Commentary: -;; Interpretation of OSC (Operating System Commands) escape -;; sequences. Handlers for OSC 2, 7 and 8 (for window title, current -;; directory and hyperlinks respectively) are provided. +;; Interpretation of OSC (Operating System Commands) escape sequences. +;; Handlers for OSC 2, 7 and 8 (for window title, current directory +;; and hyperlinks respectively) are provided. ;; The function `osc-compilation-filter' can be added to ;; `compilation-filter-hook' to collect OSC sequences in compilation -;; buffers. The variable `osc-for-compilation-buffer' tells what to do -;; with collected sequences. +;; buffers. The variable `osc-for-compilation-buffer' tells what to +;; do with collected sequences. ;;; Code: commit 0275b3a63168f66f3d1a5e8ac96200533519aa27 Author: Mauro Aranda Date: Mon Sep 19 20:36:53 2022 +0200 perl-mode: / is a regexp match if there's nothing before it * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): A "/" that starts the first statement is a regexp match. (Bug#997) * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-bug-997): New test. diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 70cb460568..bd8f4ecd1c 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -280,6 +280,7 @@ (backward-sexp 1) (member (buffer-substring (point) end) perl--syntax-exp-intro-keywords))) + (bobp) (memq (char-before) '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))) nil ;; A division sign instead of a regexp-match. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index db3feec93a..66039d6fc7 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -723,6 +723,18 @@ created by CPerl mode, so skip it for Perl mode." ;;; Tests for issues reported in the Bug Tracker +(ert-deftest cperl-test-bug-997 () + "Test that we distinguish a regexp match when there's nothing before it." + (let ((code "# some comment\n\n/fontify me/;\n")) + (with-temp-buffer + (funcall cperl-test-mode) + (insert code) + (font-lock-ensure) + (goto-char (point-min)) + (search-forward "/f") + (should (equal (get-text-property (point) 'face) + 'font-lock-string-face))))) + (defun cperl-test--run-bug-10483 () "Runs a short program, intended to be under timer scrutiny. This function is intended to be used by an Emacs subprocess in commit 60102016e416e5c19fa5945aeb80693dac7ff2e6 Author: Mattias Engdegård Date: Mon Sep 19 10:55:09 2022 +0200 Abolish max-specpdl-size (bug#57911) The max-lisp-eval-depth limit is sufficient to prevent unbounded stack growth including the specbind stack; simplify matters for the user by not having them to worry about two different limits. This change turns max-specpdl-size into a harmless variable with no effects, to keep existing code happy. * lisp/subr.el (max-specpdl-size): Define as an ordinary (but obsolete) dynamic variable. * admin/grammars/Makefile.in: * doc/lispintro/emacs-lisp-intro.texi (Loops & Recursion): * doc/lispref/control.texi (Cleanups): * doc/lispref/edebug.texi (Checking Whether to Stop): * doc/lispref/eval.texi (Eval): * doc/lispref/variables.texi (Local Variables): * doc/misc/calc.texi (Recursion Depth): Update documentation. * etc/NEWS: Announce. * src/eval.c (FletX): Use safe iteration to guard against circular bindings list. (syms_of_eval): Remove old max-specpdl-size definition. (init_eval_once, restore_stack_limits, call_debugger) (signal_or_quit, grow_specpdl_allocation): * leim/Makefile.in: * lisp/Makefile.in: * lisp/calc/calc-stuff.el (calc-more-recursion-depth) (calc-less-recursion-depth): * lisp/calc/calc.el (calc-do): * lisp/cedet/semantic/ede-grammar.el (ede-proj-makefile-insert-rules): * lisp/cedet/semantic/grammar.el (semantic-grammar-batch-build-one-package): * lisp/cus-start.el (standard): * lisp/emacs-lisp/comp.el (comp--native-compile): * lisp/emacs-lisp/edebug.el (edebug-max-depth): (edebug-read-and-maybe-wrap-form, edebug-default-enter): * lisp/emacs-lisp/regexp-opt.el (regexp-opt): * lisp/eshell/esh-mode.el (eshell-mode): * lisp/loadup.el (max-specpdl-size): * lisp/mh-e/mh-e.el (mh-invisible-headers): * lisp/net/shr.el (shr-insert-document, shr-descend): * lisp/play/hanoi.el (hanoi-internal): * lisp/progmodes/cperl-mode.el: * src/fileio.c (Fdo_auto_save): Remove references to and modifications of max-specpdl-size. diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 4ca88982cd..178c79b7a0 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -35,7 +35,7 @@ unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH EMACS = ${top_builddir}/src/emacs emacs = "${EMACS}" -batch --no-site-file --no-site-lisp \ - --eval '(setq max-specpdl-size 5000)' --eval '(setq load-prefer-newer t)' + --eval '(setq load-prefer-newer t)' make_bovine = ${emacs} -l semantic/bovine/grammar -f bovine-batch-make-parser make_wisent = ${emacs} -l semantic/wisent/grammar -f wisent-batch-make-parser diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 47a5a870fd..df8fa2f8e7 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -10100,9 +10100,8 @@ resources; as it happens, methods that people find easy---that are frugal of mental resources---sometimes use considerable computer resources. Emacs was designed to run on machines that we now consider limited and its default settings are conservative. You may want to -increase the values of @code{max-specpdl-size} and -@code{max-lisp-eval-depth}. In my @file{.emacs} file, I set them to -15 and 30 times their default value.}. +increase the value of @code{max-lisp-eval-depth}. In my @file{.emacs} +file, I set it to 30 times its default value.}. @menu * while:: Causing a stretch of code to repeat. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index d4520ebdee..ee2acdb002 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2366,11 +2366,6 @@ of the @var{cleanup-forms} themselves exits nonlocally (via a guaranteed to evaluate the rest of them. If the failure of one of the @var{cleanup-forms} has the potential to cause trouble, then protect it with another @code{unwind-protect} around that form. - -The number of currently active @code{unwind-protect} forms counts, -together with the number of local variable bindings, against the limit -@code{max-specpdl-size} (@pxref{Definition of max-specpdl-size,, Local -Variables}). @end defspec For example, here we make an invisible buffer for temporary use, and diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 56f7b7bdfa..6a51489d8a 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1032,9 +1032,8 @@ program. @itemize @bullet @item @vindex edebug-max-depth -@code{max-lisp-eval-depth} (@pxref{Eval}) and @code{max-specpdl-size} -(@pxref{Local Variables}) are both increased to reduce Edebug's impact -on the stack. You could, however, still run out of stack space when +@code{max-lisp-eval-depth} (@pxref{Eval}) is increased to reduce Edebug's +impact on the stack. You could, however, still run out of stack space when using Edebug. You can also enlarge the value of @code{edebug-max-depth} if Edebug reaches the limit of recursion depth instrumenting code that contains very large quoted lists. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 6e29a5403f..11c321b32e 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -830,7 +830,7 @@ This variable defines the maximum depth allowed in calls to @code{eval}, @code{apply}, and @code{funcall} before an error is signaled (with error message @code{"Lisp nesting exceeds max-lisp-eval-depth"}). -This limit, with the associated error when it is exceeded, is one way +This limit, with the associated error when it is exceeded, is how Emacs Lisp avoids infinite recursion on an ill-defined function. If you increase the value of @code{max-lisp-eval-depth} too much, such code can cause stack overflow instead. On some systems, this overflow @@ -851,9 +851,6 @@ less than 100, Lisp will reset it to 100 if the given value is reached. Entry to the Lisp debugger increases the value, if there is little room left, to make sure the debugger itself has room to execute. - -@code{max-specpdl-size} provides another limit on nesting. -@xref{Definition of max-specpdl-size,, Local Variables}. @end defopt @defvar values diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 975e945b34..ccd19630bf 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -358,27 +358,6 @@ Variables}); a few variables have terminal-local bindings like ordinary local bindings, but they are localized depending on where you are in Emacs. -@defopt max-specpdl-size -@anchor{Definition of max-specpdl-size} -@cindex variable limit error -@cindex evaluation error -@cindex infinite recursion -This variable defines the limit on the total number of local variable -bindings and @code{unwind-protect} cleanups (@pxref{Cleanups,, -Cleaning Up from Nonlocal Exits}) that are allowed before Emacs -signals an error (with data @code{"Variable binding depth exceeds -max-specpdl-size"}). - -This limit, with the associated error when it is exceeded, is one way -that Lisp avoids infinite recursion on an ill-defined function. -@code{max-lisp-eval-depth} provides another limit on depth of nesting. -@xref{Definition of max-lisp-eval-depth,, Eval}. - -The default value is 2500. Entry to the Lisp debugger increases the -value, if there is little room left, to make sure the debugger itself -has room to execute. -@end defopt - @node Void Variables @section When a Variable is Void @cindex @code{void-variable} error diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 98f59b89c0..89a340e734 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -10392,7 +10392,6 @@ memory than it would otherwise, but it's guaranteed to fix the problem. @cindex Recursion depth @cindex ``Computation got stuck'' message @cindex @code{max-lisp-eval-depth} -@cindex @code{max-specpdl-size} Calc uses recursion in many of its calculations. Emacs Lisp keeps a variable @code{max-lisp-eval-depth} which limits the amount of recursion possible in an attempt to recover from program bugs. If a calculation @@ -10406,9 +10405,6 @@ is also an @kbd{I M} (@code{calc-less-recursion-depth}) command which decreases this limit by a factor of two, down to a minimum value of 200. The default value is 1000. -These commands also double or halve @code{max-specpdl-size}, another -internal Lisp recursion limit. The minimum value for this limit is 600. - @node Caches @subsection Caches diff --git a/etc/NEWS b/etc/NEWS index a739d74b65..723bdd7c75 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3806,6 +3806,12 @@ the same but works by modifying LIST destructively. --- ** 'string-split' is now an alias for 'split-string'. ++++ +** The variable 'max-specpdl-size' has been made obsolete. +Now 'max-lisp-eval-depth' alone is used for limiting Lisp recursion +and stack usage. 'max-specpdl-size' is still present as a plain +variable for compatibility but its limiting powers have been taken away. + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/leim/Makefile.in b/leim/Makefile.in index 29b9f3b2f8..fbd733b7f6 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -128,7 +128,6 @@ leim-list.el: ${leimdir}/leim-list.el ${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC} $(AM_V_GEN)rm -f $@ $(AM_V_at)${RUN_EMACS} -l international/quail \ - --eval "(setq max-specpdl-size 5000)" \ --eval "(update-leim-list-file (unmsys--file-name \"${leimdir}\"))" $(AM_V_at)sed -n -e '/^[^;]/p' -e 's/^;\(;*\)inc /;\1 /p' < $< >> $@ @@ -139,7 +138,6 @@ ${leimdir}/ja-dic/ja-dic.el: | $(leimdir)/ja-dic generate-ja-dic: ${leimdir}/ja-dic/ja-dic.el ${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L $(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \ - --eval "(setq max-specpdl-size 5000)" \ -f batch-skkdic-convert -dir "$(leimdir)/ja-dic" $(JA_DIC_NO_REDUCTION_OPTION) "$<" ${srcdir}/../lisp/language/pinyin.el: ${srcdir}/MISC-DIC/pinyin.map diff --git a/lisp/Makefile.in b/lisp/Makefile.in index c73a623cce..bcf4a3146d 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -70,9 +70,7 @@ BYTE_COMPILE_FLAGS = \ --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \ $(BYTE_COMPILE_EXTRA_FLAGS) # ... but we must prefer .elc files for those in the early bootstrap. -# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el. -compile-first: BYTE_COMPILE_FLAGS = \ - --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS) +compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use @@ -342,8 +340,8 @@ compile-first: $(COMPILE_FIRST) .PHONY: compile-targets # TARGETS is set dynamically in the recursive call from 'compile-main'. -# Do not build comp.el unless necessary not to exceed max-specpdl-size and -# max-lisp-eval-depth in normal builds. +# Do not build comp.el unless necessary not to exceed max-lisp-eval-depth +# in normal builds. ifneq ($(HAVE_NATIVE_COMP),yes) compile-targets: $(filter-out ./emacs-lisp/comp-cstr.elc,$(filter-out ./emacs-lisp/comp.elc,$(TARGETS))) else diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 0e8ea42bed..758b920184 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -52,18 +52,14 @@ With a prefix, push that prefix as a number onto the stack." (calc-less-recursion-depth n) (let ((n (if n (prefix-numeric-value n) 2))) (if (> n 1) - (setq max-specpdl-size (* max-specpdl-size n) - max-lisp-eval-depth (* max-lisp-eval-depth n)))) + (setq max-lisp-eval-depth (* max-lisp-eval-depth n)))) (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)))) (defun calc-less-recursion-depth (n) (interactive "P") (let ((n (if n (prefix-numeric-value n) 2))) (if (> n 1) - (setq max-specpdl-size - (max (/ max-specpdl-size n) 600) - max-lisp-eval-depth - (max (/ max-lisp-eval-depth n) 200)))) + (setq max-lisp-eval-depth (max (/ max-lisp-eval-depth n) 200)))) (message "max-lisp-eval-depth is now %d" max-lisp-eval-depth)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 5077c8c852..c0f87ad3d4 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1625,8 +1625,7 @@ See calc-keypad for details." (error (if (and (eq (car err) 'error) (stringp (nth 1 err)) - (string-match "max-specpdl-size\\|max-lisp-eval-depth" - (nth 1 err))) + (string-search "max-lisp-eval-depth" (nth 1 err))) (error (substitute-command-keys "Computation got stuck or ran too long. Type \\`M' to increase the limit")) (setq calc-aborted-prefix nil) diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index ff9f991ff4..40ff8fc86d 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -177,10 +177,9 @@ Lays claim to all -by.el, and -wy.el files." (cl-defmethod ede-proj-makefile-insert-rules :after ((this semantic-ede-proj-target-grammar)) "Insert rules needed by THIS target. -This raises `max-specpdl-size' and `max-lisp-eval-depth', which can be -needed for the compilation of the resulting parsers." - (insert (format "%s: EMACSFLAGS+= --eval '(setq max-specpdl-size 1500 \ -max-lisp-eval-depth 700)'\n" +This raises `max-lisp-eval-depth', which can be needed for the compilation +of the resulting parsers." + (insert (format "%s: EMACSFLAGS+= --eval '(setq max-lisp-eval-depth 700)'\n" (oref this name)))) (cl-defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar)) diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index 72037f4710..8ba0e346ff 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -1009,7 +1009,6 @@ Return non-nil if there were no errors, nil if errors." packagename (byte-compile-dest-file packagename)) (let (;; Some complex grammar table expressions need a few ;; more resources than the default. - (max-specpdl-size (max 3000 max-specpdl-size)) (max-lisp-eval-depth (max 1000 max-lisp-eval-depth)) ) ;; byte compile the resultant file diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 0e1cb4589d..d7fb56c985 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -251,7 +251,6 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; emacs.c (report-emacs-bug-address emacsbug string) ;; eval.c - (max-specpdl-size limits integer) (max-lisp-eval-depth limits integer) (max-mini-window-height limits (choice (const :tag "quarter screen" nil) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index a9087313b1..35acbff9b1 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -4044,7 +4044,6 @@ the deferred compilation mechanism." (list "Not a function symbol or file" function-or-file))) (catch 'no-native-compile (let* ((print-symbols-bare t) - (max-specpdl-size (max max-specpdl-size 5000)) (data function-or-file) (comp-native-compiling t) (byte-native-qualities nil) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 31c05057bf..67704bdb51 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -129,7 +129,7 @@ contains an infinite loop. When Edebug is instrumenting code containing very large quoted lists, it may reach this limit and give the error message \"Too deep - perhaps infinite loop in spec?\". Make this limit larger to countermand that, but you may also need to -increase `max-lisp-eval-depth' and `max-specpdl-size'." +increase `max-lisp-eval-depth'." :type 'integer :version "26.1") @@ -1107,8 +1107,7 @@ purpose by adding an entry to this alist, and setting edebug-best-error edebug-error-point ;; Do this once here instead of several times. - (max-lisp-eval-depth (+ 800 max-lisp-eval-depth)) - (max-specpdl-size (+ 2000 max-specpdl-size))) + (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))) (let ((no-match (catch 'no-match (setq result (edebug-read-and-maybe-wrap-form1)) @@ -2317,7 +2316,6 @@ and run its entry function, and set up `edebug-before' and ;; but not inside an unwind-protect. ;; Doing it here also keeps it from growing too large. (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? - (max-specpdl-size (+ 200 max-specpdl-size)) (debugger edebug-debugger) ; only while edebug is active. (edebug-outside-debug-on-error debug-on-error) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index cae5dd00d1..4d5a39458d 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -133,7 +133,6 @@ usually more efficient than that of a simplified version: (save-match-data ;; Recurse on the sorted list. (let* ((max-lisp-eval-depth 10000) - (max-specpdl-size 10000) (completion-ignore-case nil) (completion-regexp-list nil) (open (cond ((stringp paren) paren) (paren "\\("))) diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 69069183a3..8f11e6f04a 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -331,7 +331,6 @@ and the hook `eshell-exit-hook'." (setq-local require-final-newline nil) (setq-local max-lisp-eval-depth (max 3000 max-lisp-eval-depth)) - (setq-local max-specpdl-size (max 6000 max-lisp-eval-depth)) (setq-local eshell-last-input-start (point-marker)) (setq-local eshell-last-input-end (point-marker)) diff --git a/lisp/loadup.el b/lisp/loadup.el index 634a331436..c01c827a75 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -244,9 +244,7 @@ (load "language/indonesian") (load "indent") -(let ((max-specpdl-size (max max-specpdl-size 1800))) - ;; A particularly demanding file to load; 1600 does not seem to be enough. - (load "emacs-lisp/cl-generic")) +(load "emacs-lisp/cl-generic") (load "simple") (load "emacs-lisp/seq") (load "emacs-lisp/nadvice") diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 0ad934107d..9a04d89097 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -2831,9 +2831,7 @@ removed and entries from `mh-invisible-header-fields' are added." (setq mh-invisible-header-fields-compiled (concat "^" - ;; workaround for insufficient default - (let ((max-specpdl-size 1000)) - (regexp-opt fields t)))) + (regexp-opt fields t))) (setq mh-invisible-header-fields-compiled nil)))) ;; Compile invisible header fields. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 54ce9b1a41..d56420eb02 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -373,7 +373,6 @@ DOM should be a parse tree as generated by shr-width (* shr-width (frame-char-width))) (shr--window-width))) - (max-specpdl-size max-specpdl-size) (shr--link-targets nil) (hscroll (window-hscroll)) ;; `bidi-display-reordering' is supposed to be only used for @@ -625,41 +624,34 @@ size, and full-buffer size." (shr-stylesheet shr-stylesheet) (shr-depth (1+ shr-depth)) (start (point))) - ;; shr uses many frames per nested node. - (if (and (> shr-depth (/ max-specpdl-size 15)) - (not (and shr-offer-extend-specpdl - (y-or-n-p "Too deeply nested to render properly; increase `max-specpdl-size'?") - (setq max-specpdl-size (* max-specpdl-size 2))))) - (setq shr-warning - "Not rendering the complete page because of too-deep nesting") + (when style + (if (string-match-p "color\\|display\\|border-collapse" style) + (setq shr-stylesheet (nconc (shr-parse-style style) + shr-stylesheet)) + (setq style nil))) + ;; If we have a display:none, then just ignore this part of the DOM. + (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none") + (and shr-discard-aria-hidden + (equal (dom-attr dom 'aria-hidden) "true"))) + ;; We don't use shr-indirect-call here, since shr-descend is + ;; the central bit of shr.el, and should be as fast as + ;; possible. Having one more level of indirection with its + ;; negative effect on performance is deemed unjustified in + ;; this case. + (cond (external + (funcall external dom)) + ((fboundp function) + (funcall function dom)) + (t + (shr-generic dom))) + (when-let ((id (dom-attr dom 'id))) + (push (cons id (set-marker (make-marker) start)) shr--link-targets)) + ;; If style is set, then this node has set the color. (when style - (if (string-match-p "color\\|display\\|border-collapse" style) - (setq shr-stylesheet (nconc (shr-parse-style style) - shr-stylesheet)) - (setq style nil))) - ;; If we have a display:none, then just ignore this part of the DOM. - (unless (or (equal (cdr (assq 'display shr-stylesheet)) "none") - (and shr-discard-aria-hidden - (equal (dom-attr dom 'aria-hidden) "true"))) - ;; We don't use shr-indirect-call here, since shr-descend is - ;; the central bit of shr.el, and should be as fast as - ;; possible. Having one more level of indirection with its - ;; negative effect on performance is deemed unjustified in - ;; this case. - (cond (external - (funcall external dom)) - ((fboundp function) - (funcall function dom)) - (t - (shr-generic dom))) - (when-let ((id (dom-attr dom 'id))) - (push (cons id (set-marker (make-marker) start)) shr--link-targets)) - ;; If style is set, then this node has set the color. - (when style - (shr-colorize-region - start (point) - (cdr (assq 'color shr-stylesheet)) - (cdr (assq 'background-color shr-stylesheet)))))))) + (shr-colorize-region + start (point) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet))))))) (defun shr-fill-text (text) (if (zerop (length text)) diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el index 58fb82b6ed..1a4b6dbeb1 100644 --- a/lisp/play/hanoi.el +++ b/lisp/play/hanoi.el @@ -149,10 +149,9 @@ BITS must be of length nrings. Start at START-TIME." (setq show-trailing-whitespace nil) (unwind-protect (let* - (;; These lines can cause Emacs to crash if you ask for too - ;; many rings. If you uncomment them, on most systems you + (;; This line can cause Emacs to crash if you ask for too + ;; many rings. If you uncomment it, on most systems you ;; can get 10,000+ rings. - ;;(max-specpdl-size (max max-specpdl-size (* nrings 15))) ;;(max-lisp-eval-depth (max max-lisp-eval-depth (+ nrings 20))) (vert (not hanoi-horizontal-flag)) (pole-width (length (format "%d" (max 0 (1- nrings))))) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 614ee60fa0..c3704a05db 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3718,7 +3718,6 @@ This is part of `cperl-find-pods-heres' (below)." overshoot warning-message))) -;; Debugging this may require (setq max-specpdl-size 2000)... (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max end-of-here-doc) "Scan the buffer for hard-to-parse Perl constructions. If `cperl-pod-here-fontify' is non-nil after evaluation, diff --git a/lisp/subr.el b/lisp/subr.el index d7cdc28abb..59f9308f31 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1859,6 +1859,14 @@ be a list of the form returned by `event-start' and `event-end'." ;; in warnings when using `values' in let-bindings. ;;(make-obsolete-variable 'values "no longer used" "28.1") +(defvar max-specpdl-size 2500 + "Former limit on specbindings, now without effect. +This variable used to limit the size of the specpdl stack which, +among other things, holds dynamic variable bindings and `unwind-protect' +activations. To prevent runaway recursion, use `max-lisp-eval-depth' +instead; it will indirectly limit the specpdl stack size as well.") +(make-obsolete-variable 'max-specpdl-size nil "29.1") + ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/eval.c b/src/eval.c index bd414fb868..7da1d8fb98 100644 --- a/src/eval.c +++ b/src/eval.c @@ -211,9 +211,7 @@ backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl) void init_eval_once (void) { - /* Don't forget to update docs - (lispref nodes "Local Variables" and "Eval"). */ - max_specpdl_size = 2500; + /* Don't forget to update docs (lispref node "Eval"). */ max_lisp_eval_depth = 1600; Vrun_hooks = Qnil; pdumper_do_now_and_after_load (init_eval_once_for_pdumper); @@ -265,8 +263,7 @@ max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) static void restore_stack_limits (Lisp_Object data) { - integer_to_intmax (XCAR (data), &max_specpdl_size); - integer_to_intmax (XCDR (data), &max_lisp_eval_depth); + integer_to_intmax (data, &max_lisp_eval_depth); } /* Call the Lisp debugger, giving it argument ARG. */ @@ -278,9 +275,6 @@ call_debugger (Lisp_Object arg) specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; intmax_t old_depth = max_lisp_eval_depth; - /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ - ptrdiff_t counti = specpdl_ref_to_count (count); - intmax_t old_max = max (max_specpdl_size, counti); /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 @@ -288,20 +282,8 @@ call_debugger (Lisp_Object arg) currently requires 77 additional frames. See bug#31919. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - /* While debugging Bug#16603, previous value of 100 was found - too small to avoid specpdl overflow in the debugger itself. */ - max_ensure_room (&max_specpdl_size, counti, 200); - - if (old_max == counti) - { - /* We can enter the debugger due to specpdl overflow (Bug#16603). */ - specpdl_ptr--; - grow_specpdl (); - } - /* Restore limits after leaving the debugger. */ - record_unwind_protect (restore_stack_limits, - Fcons (make_int (old_max), make_int (old_depth))); + record_unwind_protect (restore_stack_limits, make_int (old_depth)); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -933,12 +915,9 @@ usage: (let* VARLIST BODY...) */) lexenv = Vinternal_interpreter_environment; Lisp_Object varlist = XCAR (args); - while (CONSP (varlist)) + FOR_EACH_TAIL (varlist) { - maybe_quit (); - elt = XCAR (varlist); - varlist = XCDR (varlist); if (SYMBOLP (elt)) { var = elt; @@ -1752,8 +1731,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - ptrdiff_t counti = specpdl_ref_to_count (SPECPDL_INDEX ()); - max_ensure_room (&max_specpdl_size, counti, 40); call2 (Vsignal_hook_function, error_symbol, data); } @@ -1822,8 +1799,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t counti = specpdl_ref_to_count (count); - max_ensure_room (&max_specpdl_size, counti, 200); specbind (Qdebugger, Qdebug_early); call_debugger (list2 (Qerror, Fcons (error_symbol, data))); unbind_to (count, Qnil); @@ -1839,12 +1814,10 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t counti = specpdl_ref_to_count (count); AUTO_STRING (redisplay_trace, "*Redisplay_trace*"); Lisp_Object redisplay_trace_buffer; AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ Lisp_Object delayed_warning; - max_ensure_room (&max_specpdl_size, counti, 200); redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); current_buffer = XBUFFER (redisplay_trace_buffer); if (!backtrace_yet) /* Are we on the first backtrace of the command? */ @@ -2376,17 +2349,12 @@ grow_specpdl_allocation (void) eassert (specpdl_ptr == specpdl_end); specpdl_ref count = SPECPDL_INDEX (); - ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX - 1000); + ptrdiff_t max_size = PTRDIFF_MAX - 1000; union specbinding *pdlvec = specpdl - 1; ptrdiff_t size = specpdl_end - specpdl; ptrdiff_t pdlvecsize = size + 1; if (max_size <= size) - { - if (max_specpdl_size < 400) - max_size = max_specpdl_size = 400; - if (max_size <= size) - xsignal0 (Qexcessive_variable_binding); - } + xsignal0 (Qexcessive_variable_binding); /* Can't happen, essentially. */ pdlvec = xpalloc (pdlvec, &pdlvecsize, 1, max_size + 1, sizeof *specpdl); specpdl = pdlvec + 1; specpdl_end = specpdl + pdlvecsize - 1; @@ -4229,22 +4197,6 @@ Lisp_Object backtrace_top_function (void) void syms_of_eval (void) { - DEFVAR_INT ("max-specpdl-size", max_specpdl_size, - doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. - -If Lisp code tries to use more bindings than this amount, an error is -signaled. - -You can safely increase this variable substantially if the default -value proves inconveniently small. However, if you increase it too -much, Emacs could run out of memory trying to make the stack bigger. -Note that this limit may be silently increased by the debugger if -`debug-on-error' or `debug-on-quit' is set. - -\"spec\" is short for \"special variables\", i.e., dynamically bound -variables. \"PDL\" is short for \"push-down list\", which is an old -term for \"stack\". */); - DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. diff --git a/src/fileio.c b/src/fileio.c index 6efea8ac36..dd7f85ec97 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6019,11 +6019,6 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) bool old_message_p = 0; struct auto_save_unwind auto_save_unwind; - intmax_t sum = INT_ADD_WRAPV (specpdl_end - specpdl, 40, &sum) - ? INTMAX_MAX : sum; - if (max_specpdl_size < sum) - max_specpdl_size = sum; - if (minibuf_level) no_message = Qt; commit a7c65fc6660878e244432a5b25fb3a4ff20e8604 Author: Stefan Kangas Date: Mon Sep 19 16:54:19 2022 +0200 Allow nil value for filter-buffer-substring-function * lisp/simple.el (filter-buffer-substring): Support a nil value to be more resilient. (filter-buffer-substring-function): Doc fix; improve and update for above change. diff --git a/lisp/simple.el b/lisp/simple.el index 1b9bf9fa6d..40df5695c3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5363,7 +5363,10 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." The function is called with the same 3 arguments (BEG END DELETE) that `filter-buffer-substring' received. It should return the buffer substring between BEG and END, after filtering. If DELETE is -non-nil, it should delete the text between BEG and END from the buffer.") +non-nil, it should delete the text between BEG and END from the buffer. + +The default value is `buffer-substring--filter', and nil means +the same as the default.") (defun filter-buffer-substring (beg end &optional delete) "Return the buffer substring between BEG and END, after filtering. @@ -5379,7 +5382,9 @@ Use `filter-buffer-substring' instead of `buffer-substring', you want to allow filtering to take place. For example, major or minor modes can use `filter-buffer-substring-function' to exclude text properties that are special to a buffer, and should not be copied into other buffers." - (funcall filter-buffer-substring-function beg end delete)) + (funcall (or filter-buffer-substring-function + #'buffer-substring--filter) + beg end delete)) (defun buffer-substring--filter (beg end &optional delete) "Default function to use for `filter-buffer-substring-function'. commit ba0e989c11ebe05bb519845a6d3ab5af1e2715d8 Author: Stefan Kangas Date: Mon Sep 19 16:02:28 2022 +0200 Support imenu in emacs-news-mode * lisp/outline.el (outline-imenu-generic-expression): New variable broken out from... (outline-mode): ...here. * lisp/textmodes/emacs-news-mode.el (emacs-news--mode-common): Use above new variable to add imenu support. diff --git a/lisp/outline.el b/lisp/outline.el index 25ef1616b9..e3fbd8b327 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -341,6 +341,10 @@ data reflects the `outline-regexp'.") :safe #'booleanp :version "22.1") +(defvar outline-imenu-generic-expression + (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0)) + "Value for `imenu-generic-expression' in Outline mode.") + ;;;###autoload (define-derived-mode outline-mode text-mode "Outline" "Set major mode for editing outlines with selective display. @@ -375,8 +379,7 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) (setq-local font-lock-defaults '(outline-font-lock-keywords t nil nil backward-paragraph)) - (setq-local imenu-generic-expression - (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) + (setq-local imenu-generic-expression outline-imenu-generic-expression) (add-hook 'change-major-mode-hook #'outline-show-all nil t) (add-hook 'hack-local-variables-hook #'outline-apply-default-state nil t)) diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 88e8948060..d9decae4df 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -80,6 +80,7 @@ outline-minor-mode-cycle t outline-minor-mode-highlight 'append) (outline-minor-mode) + (setq-local imenu-generic-expression outline-imenu-generic-expression) (emacs-etc--hide-local-variables)) ;;;###autoload commit cd2168cd131852279a7d9257c7dff45224c9d6a9 Author: Eli Zaretskii Date: Mon Sep 19 16:24:44 2022 +0300 Fix 'posn-at-point' around several 'display' properties * src/xdisp.c (pos_visible_p): Fix the case when CHARPOS is hidden by a display property, and its neighbors are also hidden. (Bug#45915) diff --git a/src/xdisp.c b/src/xdisp.c index 80a0763695..ee074c018e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1960,15 +1960,18 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, int top_x_before_string = it3.current_x; /* Finally, advance the iterator until we hit the first display element whose character position is - CHARPOS, or until the first newline from the - display string, which signals the end of the - display line. */ + at or beyond CHARPOS, or until the first newline + from the display string, which signals the end of + the display line. */ while (get_next_display_element (&it3)) { if (!EQ (it3.object, string)) top_x_before_string = it3.current_x; PRODUCE_GLYPHS (&it3); - if (IT_CHARPOS (it3) == charpos + if ((it3.bidi_it.scan_dir == 1 + && IT_CHARPOS (it3) >= charpos) + || (it3.bidi_it.scan_dir == -1 + && IT_CHARPOS (it3) <= charpos) || ITERATOR_AT_END_OF_LINE_P (&it3)) break; it3_moved = true; commit c464bcb20a53a15e0d07209c73547d9b74cb9a1a Author: Stefan Monnier Date: Mon Sep 19 07:39:21 2022 -0400 * doc/misc/eieio.texi (Introduction, Generics): Remove outdated limits Reported by Hokomo . diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 18a2b74033..b1ec5c0dce 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -193,7 +193,7 @@ also differs in some other aspects which are mentioned below (also @enumerate @item A structured framework for the creation of basic classes with attributes -and methods using singular inheritance similar to CLOS. +and methods using inheritance similar to CLOS. @item Type checking, and slot unbinding. @item @@ -225,11 +225,6 @@ lacks: @table @asis -@item Method dispatch -EIEO does not support method dispatch for built-in types and multiple -arguments types. In other words, method dispatch only looks at the -first argument, and this one must be an @eieio{} type. - @item Support for metaclasses There is just one default metaclass, @code{eieio-default-superclass}, and you cannot define your own. The @code{:metaclass} tag in @@ -856,11 +851,6 @@ You can also create a generic method with @code{cl-defmethod} (@pxref{Methods}). When a method is created and there is no generic method in place with that name, then a new generic will be created, and the new method will use it. - -In CLOS, a generic method can also be used to provide an argument list -and dispatch precedence for all the arguments. In @eieio{}, -dispatching only occurs for the first argument, so the @var{arglist} -is not used. @end defmac @node Methods commit a71de4b52d3de14349ded7d88c4cae6e2a9376ae Author: Philipp Stephani Date: Mon Sep 19 13:34:51 2022 +0200 Improve check for misleading 'cl-case' cases (Bug#57915). * lisp/emacs-lisp/cl-macs.el (cl-case): Check that the case is of the form (quote FOO), not just (quote). * test/lisp/emacs-lisp/cl-macs-tests.el (cl-case-no-warning): New unit test. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5d330f32d6..beafee1d63 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -792,7 +792,7 @@ compared by `eql'. (macroexp-warn-and-return "Case nil will never match" nil 'suspicious)) - ((and (consp (car c)) (not (cddar c)) + ((and (consp (car c)) (cdar c) (not (cddar c)) (memq (caar c) '(quote function))) (macroexp-warn-and-return (format-message diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 83928775f1..f742637ee3 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -792,4 +792,15 @@ constructs." (should (equal messages (concat "Warning: " message "\n")))))))))) +(ert-deftest cl-case-no-warning () + "Test that `cl-case' and `cl-ecase' don't warn in some valid cases. +See Bug#57915." + (dolist (case '(quote (quote) function (function))) + (dolist (macro '(cl-case cl-ecase)) + (let ((form `(,macro val (,case 1)))) + (ert-info ((prin1-to-string form) :prefix "Form: ") + (ert-with-message-capture messages + (macroexpand form) + (should (string-empty-p messages)))))))) + ;;; cl-macs-tests.el ends here commit 0e5eb6ec8ce99c423bbafc6e8e3292d4459050d1 Author: Michael Albinus Date: Mon Sep 19 11:39:29 2022 +0200 Revert change in Tramp inotifywait * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch): Revert use of "-P", it doesn't exist in older inotifywait versions. * test/lisp/filenotify-tests.el: Deactivate instrumentation. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2052fa5a73..1d0d0f8b1b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3814,7 +3814,8 @@ Fall back to normal file name handler if no Tramp handler exists." (concat "create,modify,move,moved_from,moved_to,move_self," "delete,delete_self,ignored")) ((memq 'attribute-change flags) "attrib,ignored")) - sequence `(,command "-mPq" "-e" ,events ,localname) + ;; "-P" has been added to version 3.21, so we cannot assume it yet. + sequence `(,command "-mq" "-e" ,events ,localname) ;; Make events a list of symbols. events (mapcar diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 1e36117825..d82e2dae7a 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -137,11 +137,10 @@ Return nil when any other file notification watch is still active." (defun file-notify--test-cleanup () "Cleanup after a test." - (when (getenv "EMACS_EMBA_CI") - (dolist (buf (tramp-list-tramp-buffers)) - (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) - (kill-buffer buf))) - + ;; (when (getenv "EMACS_EMBA_CI") + ;; (dolist (buf (tramp-list-tramp-buffers)) + ;; (message ";; %s\n%s" buf (tramp-get-buffer-string buf)) + ;; (kill-buffer buf))) (file-notify-rm-all-watches) (ignore-errors @@ -178,8 +177,8 @@ Return nil when any other file notification watch is still active." (setq file-notify-debug nil password-cache-expiry nil - tramp-verbose (if (getenv "EMACS_EMBA_CI") 10 0) - + ;; tramp-verbose (if (getenv "EMACS_EMBA_CI") 10 0) + tramp-verbose 0 ;; When the remote user id is 0, Tramp refuses unsafe temporary files. tramp-allow-unsafe-temporary-files (or tramp-allow-unsafe-temporary-files noninteractive)) commit f735aa0f3954750df799fce3452b56e5bdac2184 Author: Stefan Kangas Date: Mon Sep 19 11:39:00 2022 +0200 Prefer DE specific commands to set wallpaper * lisp/image/wallpaper.el (wallpaper--default-commands): Rearrange order to prioritize desktop environment specific commands before general Wayland commands like "wbg" or even "swaybg". (Bug#57781) diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el index 4572a8c062..ff47d37e3a 100644 --- a/lisp/image/wallpaper.el +++ b/lisp/image/wallpaper.el @@ -55,10 +55,6 @@ (defvar wallpaper--default-commands ;; When updating this, also update the custom :type for `wallpaper-command'. '( - ;; Sway (Wayland) - ("swaybg" "-o" "*" "-i" "%f" "-m" "fill") - ;; Wayland General - ("wbg" "%f") ;; Gnome ("gsettings" "set" "org.gnome.desktop.background" "picture-uri" "file://%f") ;; KDE Plasma @@ -66,6 +62,10 @@ ;; XFCE ("xfconf-query" "-c" "xfce4-desktop" "-p" "/backdrop/screen0/monitoreDP/workspace0/last-image" "-s" "%f") + ;; Sway (Wayland) + ("swaybg" "-o" "*" "-i" "%f" "-m" "fill") + ;; Wayland General + ("wbg" "%f") ;; macOS ("osascript" "-e" "tell application \"Finder\" to set desktop picture to POSIX file \"%f\"") ;; Other / General X commit 97679d06e854da4656b64df1bafa9a321c05349d Author: Stefan Kangas Date: Mon Sep 19 11:06:01 2022 +0200 Avoid an unnecessary call to intern * src/doc.c (Fdocumentation): Prefer DEFSYM to using intern directly. diff --git a/src/doc.c b/src/doc.c index d98d121ebd..67a5f845b9 100644 --- a/src/doc.c +++ b/src/doc.c @@ -342,7 +342,7 @@ string is passed through `substitute-command-keys'. */) doc = module_function_documentation (XMODULE_FUNCTION (fun)); #endif else - doc = call1 (intern ("function-documentation"), fun); + doc = call1 (Qfunction_documentation, fun); /* If DOC is 0, it's typically because of a dumped file missing from the DOC file (bug in src/Makefile.in). */ commit 899055eef5b212d63e352ada2ac917d13c033a59 Author: Daniel Pettersson Date: Mon Sep 19 10:21:59 2022 +0200 Fix eshell directory and executable completion on action t * lisp/eshell/em-cmpl.el (eshell--pcomplete-executables): New function (bug#57905). (eshell--complete-commands-list): Use it. Copyright-paperwork-exempt: yes diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 822cc94149..ac82e3f225 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -378,6 +378,31 @@ to writing a completion function." args) posns))) +(defun eshell--pcomplete-executables () + "Complete amongst a list of directories and executables. + +Wrapper for `pcomplete-executables' or `pcomplete-dirs-or-entries', +depending on the value of `eshell-force-execution'. + +Adds path prefix to candidates independent of `action' value." + ;; `pcomplete-entries' returns filenames without path on `action' to + ;; use current string directory as done in `completion-file-name-table' + ;; when `action' is nil to construct executable candidates. + (let ((table (if eshell-force-execution + (pcomplete-dirs-or-entries nil #'file-readable-p) + (pcomplete-executables)))) + (lambda (string pred action) + (let ((cands (funcall table string pred action))) + (if (eq action t) + (let ((specdir (file-name-directory string))) + (mapcar + (lambda (cand) + (if (stringp cand) + (file-name-concat specdir cand) + cand)) + cands)) + cands))))) + (defun eshell--complete-commands-list () "Generate list of applicable, visible commands." ;; Building the commands list can take quite a while, especially over Tramp @@ -392,9 +417,7 @@ to writing a completion function." (completion-table-dynamic (lambda (filename) (if (file-name-directory filename) - (if eshell-force-execution - (pcomplete-dirs-or-entries nil #'file-readable-p) - (pcomplete-executables)) + (eshell--pcomplete-executables) (let* ((paths (eshell-get-path)) (cwd (file-name-as-directory (expand-file-name default-directory))) commit f12111af404374977023711abf4f87467e44d62b Author: Gregory Heytings Date: Mon Sep 19 09:50:03 2022 +0200 ; * Makefile.in: Fix typo. diff --git a/Makefile.in b/Makefile.in index 260962d048..d118ba6821 100644 --- a/Makefile.in +++ b/Makefile.in @@ -388,7 +388,7 @@ actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis # ADVICE-ON-FAILURE-BEGIN:bootstrap # You might try to: -# - run "git bootstrap configure=default", to rebuild Emacs with the +# - run "make bootstrap configure=default", to rebuild Emacs with the #   default configuration options, which might fix the problem # - run "git clean -fdx" and run "make bootstrap" again, which might #   fix the problem if "git boostrap configure=default" did not commit a53781470935fc0b7c7e576c3d02ed723c9587c4 Author: Lars Ingebrigtsen Date: Mon Sep 19 09:42:28 2022 +0200 Don't save bookmark context from encrypted files * doc/emacs/regs.texi (Bookmarks): Mention this. * lisp/bookmark.el (bookmark-make-record): Don't include context in encrypted files (bug#57856). * lisp/epa-hook.el (epa-file-name-p): New function. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index fb93601879..ef9187bb9a 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -381,7 +381,8 @@ jump to the bookmark. @code{bookmark-jump} can find the proper position even if the file is modified slightly. The variable @code{bookmark-search-size} says how many characters of context to record on each side of the bookmark's -position. +position. (In buffers that are visiting encrypted files, no context +is saved in the bookmarks file no matter the value of this variable.) Here are some additional commands for working with bookmarks: diff --git a/etc/NEWS b/etc/NEWS index e5d9b1ca23..a739d74b65 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -180,6 +180,11 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 ++++ +*** bookmarks no longer include context for encrypted files. +If you're visiting an encrypted file, setting a bookmark no longer +includes excerpts from that buffer in the bookmarks file. + --- *** 'show-paren-mode' is now disabled in 'special-mode' buffers. In Emacs versions previous to Emacs 28.1, 'show-paren-mode' defaulted diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 8dfc16bf9f..f150a24bbf 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -594,7 +594,18 @@ equivalently just return ALIST without NAME.") (defun bookmark-make-record () "Return a new bookmark record (NAME . ALIST) for the current location." - (let ((record (funcall bookmark-make-record-function))) + (let* ((bookmark-search-size + ;; If we're in a buffer that's visiting an encrypted file, + ;; don't include any context in the bookmark file, because + ;; that would leak (possibly secret) data. + (if (and buffer-file-name + (or (and (fboundp 'epa-file-name-p) + (epa-file-name-p buffer-file-name)) + (and (fboundp 'tramp-crypt-file-name-p) + (tramp-crypt-file-name-p buffer-file-name)))) + 0 + bookmark-search-size)) + (record (funcall bookmark-make-record-function))) ;; Set up default name if the function does not provide one. (unless (stringp (car record)) (if (car record) (push nil record)) diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 18e47c682e..70c3030881 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -88,6 +88,10 @@ interface, update `file-name-handler-alist'." epa-file-inhibit-auto-save) (auto-save-mode 0))) +(defun epa-file-name-p (file) + "Say whether FILE is handled by `epa-file'." + (and auto-encryption-mode (string-match-p epa-file-name-regexp file))) + (define-minor-mode auto-encryption-mode "Toggle automatic file encryption/decryption (Auto Encryption mode)." :global t :init-value t :group 'epa-file :version "23.1" commit 3fd2b00a4b20afa827afe0eee2b7ba5f08e4cce6 Author: Gregory Heytings Date: Mon Sep 19 07:34:35 2022 +0000 ; * Makefile.in: Add "make bootstrap configure=default" as a first choice. diff --git a/Makefile.in b/Makefile.in index de263c6858..260962d048 100644 --- a/Makefile.in +++ b/Makefile.in @@ -388,8 +388,10 @@ actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis # ADVICE-ON-FAILURE-BEGIN:bootstrap # You might try to: +# - run "git bootstrap configure=default", to rebuild Emacs with the +#   default configuration options, which might fix the problem # - run "git clean -fdx" and run "make bootstrap" again, which might -#   fix the problem +#   fix the problem if "git boostrap configure=default" did not #   !BEWARE! "git clean -fdx" deletes all files that are not under #   !BEWARE! version control, which means that all changes to such #   !BEWARE! files will be lost and cannot be restored later commit 5a8e2dedf54fc5c777b093de25eafe679e646930 Author: Gregory Heytings Date: Mon Sep 19 09:38:58 2022 +0200 Revert 60de98f6f0 and b2d419ed5b. diff --git a/Makefile.in b/Makefile.in index 43108dc37f..de263c6858 100644 --- a/Makefile.in +++ b/Makefile.in @@ -380,30 +380,26 @@ bootstrap-all: actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lisp # ADVICE-ON-FAILURE-BEGIN:all -# It can help to run "make bootstrap", which can resolve many build -# failures caused by incrementally building from a previously built -# checkout. - -# Failing that, running "make V=1" will cause Make to display the full -# commands it invokes to build Emacs, which helps to investigate the -# problem. +# You might try to: +# - run "make bootstrap", which might fix the problem +# - run "make V=1", which displays the full commands invoked by make, +#   to further investigate the problem # ADVICE-ON-FAILURE-END:all # ADVICE-ON-FAILURE-BEGIN:bootstrap -# If "make bootstrap" failed, try running "make extraclean" and then -# "make bootstrap" again. If that still fails and you are building -# Emacs from a repository checkout, run "git clean -fdx" and retry -# "make bootstrap". Otherwise, please report a bug by sending email -# to bug-gnu-emacs@gnu.org. -# -# Take care: "git clean -fdx" deletes all files that are not under -# version control, which means that all changes to such files will be -# lost and cannot be restored later. +# You might try to: +# - run "git clean -fdx" and run "make bootstrap" again, which might +#   fix the problem +#   !BEWARE! "git clean -fdx" deletes all files that are not under +#   !BEWARE! version control, which means that all changes to such +#   !BEWARE! files will be lost and cannot be restored later +# - run "make V=1", which displays the full commands invoked by make, +#   to further investigate the problem # ADVICE-ON-FAILURE-END:bootstrap advice-on-failure: @echo - @echo "make ${make-target}\" failed with exit status ${exit-status}." + @echo " \"make ${make-target}\" failed with exit status ${exit-status}." @cat Makefile | \ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q};' | \ sed 's/^# //' | grep -v '^ADVICE-ON-FAILURE-' commit 60de98f6f016d66deb4ddf7934245961237a64fb Author: Po Lu Date: Mon Sep 19 15:20:25 2022 +0800 * Makefile.in: Readd warnings about "git clean -fdx" diff --git a/Makefile.in b/Makefile.in index 9c9923a1f6..43108dc37f 100644 --- a/Makefile.in +++ b/Makefile.in @@ -395,6 +395,10 @@ actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis # Emacs from a repository checkout, run "git clean -fdx" and retry # "make bootstrap". Otherwise, please report a bug by sending email # to bug-gnu-emacs@gnu.org. +# +# Take care: "git clean -fdx" deletes all files that are not under +# version control, which means that all changes to such files will be +# lost and cannot be restored later. # ADVICE-ON-FAILURE-END:bootstrap advice-on-failure: commit b2d419ed5bf052499d497c50a60c4dd14f176858 Author: Po Lu Date: Mon Sep 19 15:19:23 2022 +0800 Revert "; * Makefile.in: Partly revert 5b3c4004a9." This reverts commit e54da280ff4bf458c437f87dd64e848cdc75479c. diff --git a/Makefile.in b/Makefile.in index de263c6858..9c9923a1f6 100644 --- a/Makefile.in +++ b/Makefile.in @@ -380,26 +380,26 @@ bootstrap-all: actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lisp # ADVICE-ON-FAILURE-BEGIN:all -# You might try to: -# - run "make bootstrap", which might fix the problem -# - run "make V=1", which displays the full commands invoked by make, -#   to further investigate the problem +# It can help to run "make bootstrap", which can resolve many build +# failures caused by incrementally building from a previously built +# checkout. + +# Failing that, running "make V=1" will cause Make to display the full +# commands it invokes to build Emacs, which helps to investigate the +# problem. # ADVICE-ON-FAILURE-END:all # ADVICE-ON-FAILURE-BEGIN:bootstrap -# You might try to: -# - run "git clean -fdx" and run "make bootstrap" again, which might -#   fix the problem -#   !BEWARE! "git clean -fdx" deletes all files that are not under -#   !BEWARE! version control, which means that all changes to such -#   !BEWARE! files will be lost and cannot be restored later -# - run "make V=1", which displays the full commands invoked by make, -#   to further investigate the problem +# If "make bootstrap" failed, try running "make extraclean" and then +# "make bootstrap" again. If that still fails and you are building +# Emacs from a repository checkout, run "git clean -fdx" and retry +# "make bootstrap". Otherwise, please report a bug by sending email +# to bug-gnu-emacs@gnu.org. # ADVICE-ON-FAILURE-END:bootstrap advice-on-failure: @echo - @echo " \"make ${make-target}\" failed with exit status ${exit-status}." + @echo "make ${make-target}\" failed with exit status ${exit-status}." @cat Makefile | \ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q};' | \ sed 's/^# //' | grep -v '^ADVICE-ON-FAILURE-'