From 8b8708eadd94fcdad4c426a20370ff4ab13df258 Mon Sep 17 00:00:00 2001 From: Petteri Hintsanen Date: Sun, 7 Feb 2021 13:10:19 +0100 Subject: Fix example in Sequence Functions node in the manual * doc/lispref/sequences.texi (Sequence Functions): Fix the result from the example. --- doc/lispref/sequences.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index bdf0b95d810..b48d4569180 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -594,7 +594,7 @@ returned value is a list. (seq-map-indexed (lambda (elt idx) (list idx elt)) '(a b c)) -@result{} ((0 a) (b 1) (c 2)) +@result{} ((0 a) (1 b) (2 c)) @end group @end example @end defun -- cgit v1.2.3 From abedf3a8653829f5170ff72b2fc7adad0e6f80d4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 7 Feb 2021 17:52:30 +0200 Subject: Fix language-environment and font selection on MS-Windows These changes improve setting the language-environment and font selection when MS-Windows returns useless "ZZZ" as the "language name", which then disrupts all the setup of the locale-dependent stuff, and in particular font selection. * lisp/w32-fns.el (w32-charset-info-alist): Add an element for "iso8859-5", in case LANG is set to something unusable, like "ZZZ". This allows fonts capable of displaying Cyrillic characters to be used even when language preferences are screwed. * src/w32.c (init_environment): If GetLocaleInfo returns "ZZZ" as the "language name" for LOCALE_USER_DEFAULT, try again with locale ID based on what GetUserDefaultUILanguage returns. (Bug#39286) --- lisp/w32-fns.el | 1 + src/w32.c | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+) diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index eb12dcd8960..687afc828d1 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -252,6 +252,7 @@ bit output with no translation." (w32-add-charset-info "iso8859-2" 'w32-charset-easteurope 28592) (w32-add-charset-info "iso8859-3" 'w32-charset-turkish 28593) (w32-add-charset-info "iso8859-4" 'w32-charset-baltic 28594) + (w32-add-charset-info "iso8859-5" 'w32-charset-russian 28595) (w32-add-charset-info "iso8859-6" 'w32-charset-arabic 28596) (w32-add-charset-info "iso8859-7" 'w32-charset-greek 28597) (w32-add-charset-info "iso8859-8" 'w32-charset-hebrew 1255) diff --git a/src/w32.c b/src/w32.c index e6dffe2e63f..d4f31924429 100644 --- a/src/w32.c +++ b/src/w32.c @@ -346,6 +346,7 @@ static BOOL g_b_init_get_adapters_addresses; static BOOL g_b_init_reg_open_key_ex_w; static BOOL g_b_init_reg_query_value_ex_w; static BOOL g_b_init_expand_environment_strings_w; +static BOOL g_b_init_get_user_default_ui_language; BOOL g_b_init_compare_string_w; BOOL g_b_init_debug_break_process; @@ -533,6 +534,7 @@ DWORD multiByteToWideCharFlags; typedef LONG (WINAPI *RegOpenKeyExW_Proc) (HKEY,LPCWSTR,DWORD,REGSAM,PHKEY); typedef LONG (WINAPI *RegQueryValueExW_Proc) (HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYTE,LPDWORD); typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD); +typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void); /* ** A utility function ** */ static BOOL @@ -1489,6 +1491,28 @@ expand_environment_strings_w (LPCWSTR lpSrc, LPWSTR lpDst, DWORD nSize) return s_pfn_Expand_Environment_Strings_w (lpSrc, lpDst, nSize); } +static LANGID WINAPI +get_user_default_ui_language (void) +{ + static GetUserDefaultUILanguage_Proc s_pfn_GetUserDefaultUILanguage = NULL; + HMODULE hm_kernel32 = NULL; + + if (is_windows_9x () == TRUE) + return 0; + + if (g_b_init_get_user_default_ui_language == 0) + { + g_b_init_get_user_default_ui_language = 1; + hm_kernel32 = LoadLibrary ("Kernel32.dll"); + if (hm_kernel32) + s_pfn_GetUserDefaultUILanguage = (GetUserDefaultUILanguage_Proc) + get_proc_addr (hm_kernel32, "GetUserDefaultUILanguage"); + } + if (s_pfn_GetUserDefaultUILanguage == NULL) + return 0; + return s_pfn_GetUserDefaultUILanguage (); +} + /* Return 1 if P is a valid pointer to an object of size SIZE. Return @@ -2927,6 +2951,32 @@ init_environment (char ** argv) LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, locale_name, sizeof (locale_name))) { + /* Microsoft are migrating away of locale IDs, replacing them + with locale names, such as "en-US", and are therefore + deprecating the APIs which use LCID etc. As part of that + deprecation, they don't bother inventing LCID and LANGID + codes for new locales and language/culture combinations; + instead, those get LCID of 0xC000 and LANGID of 0x2000, for + which the LCID/LANGID oriented APIs return "ZZZ" as the + "language name". Such "language name" is useless for our + purposes. So we instead use the default UI language, in the + hope of getting something usable. */ + if (strcmp (locale_name, "ZZZ") == 0) + { + LANGID lang_id = get_user_default_ui_language (); + + if (lang_id != 0) + { + /* Disregard the sorting order differences between cultures. */ + LCID def_lcid = MAKELCID (lang_id, SORT_DEFAULT); + char locale_name_def[32]; + + if (GetLocaleInfo (def_lcid, + LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP, + locale_name_def, sizeof (locale_name_def))) + strcpy (locale_name, locale_name_def); + } + } for (i = 0; i < N_ENV_VARS; i++) { if (strcmp (env_vars[i].name, "LANG") == 0) @@ -10451,6 +10501,7 @@ globals_of_w32 (void) g_b_init_expand_environment_strings_w = 0; g_b_init_compare_string_w = 0; g_b_init_debug_break_process = 0; + g_b_init_get_user_default_ui_language = 0; num_of_processors = 0; /* The following sets a handler for shutdown notifications for console apps. This actually applies to Emacs in both console and -- cgit v1.2.3 From 4712c75ab853ee77587dbc1910cc7c0401e02aa0 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 7 Feb 2021 22:01:34 +0100 Subject: Clarify when activate-mark-hook is run * doc/lispref/markers.texi (The Mark): * lisp/simple.el (activate-mark-hook): Clarify when the hook is run (bug#23444). --- doc/lispref/markers.texi | 4 ++-- lisp/simple.el | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi index cdd0938b458..93f98190fa3 100644 --- a/doc/lispref/markers.texi +++ b/doc/lispref/markers.texi @@ -607,8 +607,8 @@ the function @code{use-region-p} for that (@pxref{The Region}). @defvarx deactivate-mark-hook These normal hooks are run, respectively, when the mark becomes active and when it becomes inactive. The hook @code{activate-mark-hook} is -also run at the end of the command loop if the mark is active and it -is possible that the region may have changed. +also run when the region is reactivated, for instance after using a +command that switches back to a buffer that has an active mark. @ignore This piece of command_loop_1, run unless deactivating the mark: if (current_buffer != prev_buffer || MODIFF != prev_modiff) diff --git a/lisp/simple.el b/lisp/simple.el index 10cde4e4b89..28738a262d3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -5536,8 +5536,9 @@ START and END specify the portion of the current buffer to be copied." (defvar activate-mark-hook nil "Hook run when the mark becomes active. -It is also run at the end of a command, if the mark is active and -it is possible that the region may have changed.") +It is also run when the region is reactivated, for instance after +using a command that switches back to a buffer that has an active +mark.") (defvar deactivate-mark-hook nil "Hook run when the mark becomes inactive.") -- cgit v1.2.3 From 120149cf6a82dd20dfade3b2c09996f7be562441 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Feb 2021 07:30:18 +0100 Subject: Clarify "changes" in CONTRIBUTE * CONTRIBUTE: Clarify that "changes" doesn't include removing code (bug#44834). (cherry picked from commit 33c9556c9db9b8c62dcd80dd3cc665e669ea66d4) --- CONTRIBUTE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 4e42c7aafcc..125c183229f 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,7 +67,7 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial changes, we will need you to assign to the FSF the +of non-trivial code, we will need you to assign to the FSF the copyright for your contributions. Ask on emacs-devel@gnu.org, and we will send you the necessary form together with the instructions to fill and email it, in order to start this legal paperwork. -- cgit v1.2.3 From dcc00bbb1989b27c49442422e7fbaf8c3f6415cb Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 8 Feb 2021 18:09:21 +0200 Subject: ; * CONTRIBUTE: Clarify the "15-lines" rule a bit more. --- CONTRIBUTE | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 125c183229f..9f0d9e7e164 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -67,10 +67,11 @@ error-prone. It also allows sending patches whose author is someone other than the email sender. Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial code, we will need you to assign to the FSF the -copyright for your contributions. Ask on emacs-devel@gnu.org, and we -will send you the necessary form together with the instructions to -fill and email it, in order to start this legal paperwork. +of non-trivial code you added or changed (not counting deleted lines), +we will need you to assign to the FSF the copyright for your +contributions. Ask on emacs-devel@gnu.org, and we will send you the +necessary form together with the instructions to fill and email it, in +order to start this legal paperwork. ** Issue tracker (a.k.a. "bug tracker") -- cgit v1.2.3 From d03f2a6ee942882c5bc78226b4730dac6f1d0916 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 10 Feb 2021 20:04:26 +0200 Subject: Avoid assertion violation in callproc.c * src/callproc.c (call_process): Avoid assertion violation when DESTINATION is a cons cell '(:file . "FOO")'. (Bug#46426) --- src/callproc.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/callproc.c b/src/callproc.c index 5b1d8bfb765..3eac38d375a 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -394,7 +394,11 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd, /* If the buffer is (still) a list, it might be a (:file "file") spec. */ if (CONSP (buffer) && EQ (XCAR (buffer), QCfile)) { - output_file = Fexpand_file_name (XCAR (XCDR (buffer)), + Lisp_Object ofile = XCDR (buffer); + if (CONSP (ofile)) + ofile = XCAR (ofile); + CHECK_STRING (ofile); + output_file = Fexpand_file_name (ofile, BVAR (current_buffer, directory)); CHECK_STRING (output_file); buffer = Qnil; -- cgit v1.2.3 From da64a257a482e95a3a314da97260ea08635a83e0 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 12 Feb 2021 09:25:13 +0200 Subject: ; * CONTRIBUTE: Yet another clarification of significant changes. --- CONTRIBUTE | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index 9f0d9e7e164..b7d72f9965e 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -66,12 +66,15 @@ more reliably, and makes the job of applying the patches easier and less error-prone. It also allows sending patches whose author is someone other than the email sender. -Once the cumulative amount of your submissions exceeds about 15 lines -of non-trivial code you added or changed (not counting deleted lines), -we will need you to assign to the FSF the copyright for your -contributions. Ask on emacs-devel@gnu.org, and we will send you the -necessary form together with the instructions to fill and email it, in -order to start this legal paperwork. +Once the cumulative amount of your submissions exceeds about 10 lines +of non-trivial changes, we will need you to assign to the FSF the +copyright for your contributions. (To see how many lines were +non-trivially changed, count only added and modified lines in the +patched code. Consider an added or changed line non-trivial if it +includes at least one identifier, string, or substantial comment.) +Ask on emacs-devel@gnu.org, and we will send you the necessary form +together with the instructions to fill and email it, in order to start +this legal paperwork. ** Issue tracker (a.k.a. "bug tracker") -- cgit v1.2.3 From c977370dd734be12ffbaf0da2f3db529d6175b62 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 16 Feb 2021 18:20:06 +0200 Subject: Avoid point movement when visiting image files * lisp/image-mode.el (image-toggle-display-image): Preserve point around the call to exif-parse-buffer, to prevent it from moving into the image data. (Bug#46552) --- lisp/image-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index aee91ee8b21..24be008f3f7 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -829,7 +829,9 @@ was inserted." (setq image-transform-rotation (or (exif-orientation (ignore-error exif-error - (exif-parse-buffer))) + ;; exif-parse-buffer can move point, so preserve it. + (save-excursion + (exif-parse-buffer)))) 0.0))) ;; Swap width and height when changing orientation ;; between portrait and landscape. -- cgit v1.2.3 From fbc9c59b9eb02d49f426341ee32334784d224ce4 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Wed, 17 Feb 2021 21:15:51 +0000 Subject: Make goto-line-history buffer local only when so customized * lisp/simple.el (goto-line-history-local): New customizable option. (goto-line-history): Define this simply with defvar, not defvar-local. (goto-line-read-args): Handle goto-line-history-local, and changes to it. * doc/emacs/basic.texi (Moving Point): Add a paragraph about goto-line-history-local. * etc/NEWS: Add an item under "Editing Changes in Emacs 28.1". --- doc/emacs/basic.texi | 5 +++++ etc/NEWS | 5 +++++ lisp/simple.el | 19 ++++++++++++++++++- 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi index 8bf52d5dd30..4a34fd36c5d 100644 --- a/doc/emacs/basic.texi +++ b/doc/emacs/basic.texi @@ -331,6 +331,11 @@ a plain prefix argument. Alternatively, you can use the command @code{goto-line-relative} to move point to the line relative to the accessible portion of the narrowed buffer. +@code{goto-line} has its own history list (@pxref{Minibuffer +History}). You can have either a single list shared between all +buffers (the default) or a separate list for each buffer, by +customizing the user option @code{goto-line-history-local}. + @item M-g @key{TAB} @kindex M-g TAB @findex move-to-column diff --git a/etc/NEWS b/etc/NEWS index b96bcd9eccd..7665d4740f9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -345,6 +345,11 @@ trying to be non-destructive. This command opens a new buffer called "*Memory Report*" and gives a summary of where Emacs is using memory currently. ++++ +** The history list for the 'goto-line' command is now a single list +for all buffers by default. You can configure a separate list for +each buffer by customizing the user option 'goto-line-history-local'. + ** Outline +++ diff --git a/lisp/simple.el b/lisp/simple.el index e54cbed7a76..363a0f26d5d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1278,7 +1278,19 @@ that uses or sets the mark." ;; Counting lines, one way or another. -(defvar-local goto-line-history nil +(defcustom goto-line-history-local nil + "If this option is nil, `goto-line-history' is shared between all buffers. +if it is non-nil, each buffer has its own value of this history list. + +Note that on changing from non-nil to nil, the former contents of +`goto-line-history' for each buffer are discarded on use of +`goto-line' in that buffer." + :group 'editing + :type 'boolean + :safe #'booleanp + :version "28.1") + +(defvar goto-line-history nil "History of values entered with `goto-line'.") (defun goto-line-read-args (&optional relative) @@ -1296,6 +1308,11 @@ that uses or sets the mark." (if buffer (concat " in " (buffer-name buffer)) ""))) + ;; Has the buffer locality of `goto-line-history' changed? + (cond ((and goto-line-history-local (not (local-variable-p 'goto-line-history))) + (make-local-variable 'goto-line-history)) + ((and (not goto-line-history-local) (local-variable-p 'goto-line-history)) + (kill-local-variable 'goto-line-history))) ;; Read the argument, offering that number (if any) as default. (list (read-number (format "Goto%s line%s: " (if (buffer-narrowed-p) -- cgit v1.2.3 From 79940d038f27c46507377a91fcf07fe94b80111a Mon Sep 17 00:00:00 2001 From: Matt Armstrong Date: Wed, 17 Feb 2021 23:33:21 +0100 Subject: doc/lispref/commands.texi (Command Modes): Fix typo. * doc/lispref/commands.texi (Command Modes): Fix typo. --- doc/lispref/commands.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 85376cc4598..e171c3e168d 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -597,8 +597,8 @@ Put them into three windows, selecting the last one." @subsection Specifying Modes For Commands Many commands in Emacs are general, and not tied to any specific mode. -For instance, @kbd{M-x kill-region} can be used pretty in pretty much -any mode that has editable text, and commands that display information +For instance, @kbd{M-x kill-region} can be used in pretty much any +mode that has editable text, and commands that display information (like @kbd{M-x list-buffers}) can be used in pretty much any context. Many other commands, however, are specifically tied to a mode, and -- cgit v1.2.3 From 6d0089cabcc8c960cbc24e60481a916275a6833d Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 22:48:18 +0000 Subject: ; Fix typo in last change to simple.el. --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/simple.el b/lisp/simple.el index 363a0f26d5d..b0a0896b682 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1280,7 +1280,7 @@ that uses or sets the mark." (defcustom goto-line-history-local nil "If this option is nil, `goto-line-history' is shared between all buffers. -if it is non-nil, each buffer has its own value of this history list. +If it is non-nil, each buffer has its own value of this history list. Note that on changing from non-nil to nil, the former contents of `goto-line-history' for each buffer are discarded on use of -- cgit v1.2.3 From a68a5fe03a8b11d00ca9a1de2a86caa3d97d4d35 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 22:49:15 +0000 Subject: Fix recent Command Modes changes in Elisp manual * doc/lispref/commands.texi (Command Modes): Fix typos and grammar. Cross-reference the 'declare' form node. --- doc/lispref/commands.texi | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index e171c3e168d..1ad2df95919 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -603,10 +603,11 @@ mode that has editable text, and commands that display information Many other commands, however, are specifically tied to a mode, and make no sense outside of that context. For instance, @code{M-x -dired-diff} will just signal an error used outside of a dired buffer. +dired-diff} will just signal an error if used outside of a Dired +buffer. Emacs therefore has a mechanism for specifying what mode (or modes) a -command ``belong'' to: +command ``belongs'' to: @lisp (defun dired-diff (...) @@ -634,8 +635,8 @@ commands (if they aren't bound to any keys). If using this extended @code{interactive} form isn't convenient (because the code is supposed to work in older versions of Emacs that -doesn't support the extended @code{interactive} form), the following -can be used instead: +don't support the extended @code{interactive} form), the following +equivalent declaration (@pxref{Declare Form}) can be used instead: @lisp (declare (modes dired-mode)) @@ -657,10 +658,10 @@ call @code{kill-buffer}. This command will ``work'' from any mode, but it is highly unlikely that anybody would actually want to use the command outside the context of this special mode. -Many modes have a set of different commands that start that start the -mode in different ways, (e.g., @code{eww-open-in-new-buffer} and +Many modes have a set of different commands that start the mode in +different ways (e.g., @code{eww-open-in-new-buffer} and @code{eww-open-file}). Commands like that should never be tagged as -mode-specific, as then can be issued by the user from pretty much any +mode-specific, as they can be issued by the user from pretty much any context. @node Generic Commands -- cgit v1.2.3 From a10574c579cf072ace1db0f80a462a737ade45cb Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 17 Feb 2021 23:08:24 +0000 Subject: ; Fix another recent typo in simple.el. --- lisp/simple.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index b0a0896b682..d6ccdad9021 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1924,13 +1924,13 @@ to get different commands to edit and resubmit." (defcustom read-extended-command-predicate nil "Predicate to use to determine which commands to include when completing. If it's nil, include all the commands. -If it's a functoion, it will be called with two parameters: the +If it's a function, it will be called with two parameters: the symbol of the command and a buffer. The predicate should return non-nil if the command should be present when doing `M-x TAB' in that buffer." :version "28.1" :group 'completion - :type `(choice (const :tag "Don't exclude any commands" nil) + :type '(choice (const :tag "Don't exclude any commands" nil) (const :tag "Exclude commands irrelevant to current buffer's mode" command-completion-default-include-p) (function :tag "Other function"))) -- cgit v1.2.3 From 3fe2fb5794715b075fc1dd6d5d84bf10eae24c73 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Feb 2021 01:41:03 +0200 Subject: Present C source files as absolute file names too when possible * lisp/progmodes/elisp-mode.el (xref-location-group): Present C source files as absolute file names too when possible (bug#46514). --- lisp/progmodes/elisp-mode.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 312153052d6..c14b18425f6 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -904,7 +904,13 @@ non-nil result supersedes the xrefs produced by (point-marker))))))) (cl-defmethod xref-location-group ((l xref-elisp-location)) - (xref-elisp-location-file l)) + (let ((file (xref-elisp-location-file l))) + (defvar find-function-C-source-directory) + (if (and find-function-C-source-directory + (string-match-p "\\`src/" file)) + (concat find-function-C-source-directory + (substring file 3)) + file))) (defun elisp-load-path-roots () (if (boundp 'package-user-dir) -- cgit v1.2.3 From 8358637936c455d906675932db4cbf90c35b6c53 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 18 Feb 2021 05:06:33 +0200 Subject: Move 'project-try-ede' to the back of 'project-find-functions' * lisp/cedet/ede.el (project-find-functions): Move 'project-try-ede' further back, so that 'project-try-vc' has priority (bug46202). --- lisp/cedet/ede.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index e3cc9062ed4..369a9f7e713 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -1518,7 +1518,7 @@ It does not apply the value to buffers." ;;; FIXME: Could someone look into implementing `project-ignores' for ;;; EDE and/or a faster `project-files'? -(add-hook 'project-find-functions #'project-try-ede) +(add-hook 'project-find-functions #'project-try-ede 50) (provide 'ede) -- cgit v1.2.3 From 892db042a0d85caeea9a4969073e13f525eb9f60 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 18 Feb 2021 11:11:11 +0100 Subject: Fix rx `regexp` form with deprecated syntax The argument of the rx `regexp` form is assumed to evaluate to a valid regexp, but certain kinds of deprecated but still accepted usage were not handled correctly, such as unescaped literal (special) characters: (rx "a" (regexp "*")) => "a*" which is wrong. Handle these cases; there is no extra trouble. * lisp/emacs-lisp/rx.el (rx--translate-regexp): Force bracketing of single special characters. * test/lisp/emacs-lisp/rx-tests.el (rx-regexp): Add test case. --- lisp/emacs-lisp/rx.el | 2 +- test/lisp/emacs-lisp/rx-tests.el | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index b29b870061d..58584f300c9 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -890,7 +890,7 @@ Return (REGEXP . PRECEDENCE)." (* (or (seq "[:" (+ (any "a-z")) ":]") (not (any "]")))) "]") - anything + (not (any "*+?^$[\\")) (seq "\\" (or anything (seq (any "sScC_") anything) diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 63d7c7b91ea..388c5e86b4c 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -391,6 +391,8 @@ (let ((x "a*")) (should (equal (rx (regexp x) "b") "\\(?:a*\\)b")) + (should (equal (rx "a" (regexp "*")) + "a\\(?:*\\)")) (should (equal (rx "" (regexp x) (eval "")) "a*")))) -- cgit v1.2.3 From 546f552e7b2439b482c7d28222fb88761a9c876a Mon Sep 17 00:00:00 2001 From: Doug Davis Date: Thu, 18 Feb 2021 12:39:00 +0100 Subject: Do interactive mode tagging for python.el navigation functions. * lisp/progmodes/python.el (navigation functions): Add python-mode to `interactive' declarations for mode-specific commands (bug#46610). Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index afb96974b17..7506043a190 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1506,7 +1506,7 @@ point position. Return non-nil if point is moved to (defun python-nav-end-of-defun () "Move point to the end of def or class. Returns nil if point is not in a def or class." - (interactive) + (interactive nil python-mode) (let ((beg-defun-indent) (beg-pos (point))) (when (or (python-info-looking-at-beginning-of-defun) @@ -1577,19 +1577,19 @@ repeat it." "Navigate to closer defun backward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p") + (interactive "^p" python-mode) (python-nav--forward-defun (- (or arg 1)))) (defun python-nav-forward-defun (&optional arg) "Navigate to closer defun forward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p") + (interactive "^p" python-mode) (python-nav--forward-defun (or arg 1))) (defun python-nav-beginning-of-statement () "Move to start of current statement." - (interactive "^") + (interactive "^" python-mode) (forward-line 0) (let* ((ppss (syntax-ppss)) (context-point @@ -1613,7 +1613,7 @@ nested definitions." Optional argument NOEND is internal and makes the logic to not jump to the end of line when moving forward searching for the end of the statement." - (interactive "^") + (interactive "^" python-mode) (let (string-start bs-pos (last-string-end 0)) (while (and (or noend (goto-char (line-end-position))) (not (eobp)) @@ -1654,7 +1654,7 @@ Overlapping strings detected (start=%d, last-end=%d)") (defun python-nav-backward-statement (&optional arg) "Move backward to previous statement. With ARG, repeat. See `python-nav-forward-statement'." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-statement (- arg))) @@ -1662,7 +1662,7 @@ With ARG, repeat. See `python-nav-forward-statement'." "Move forward to next statement. With ARG, repeat. With negative argument, move ARG times backward to previous statement." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (while (> arg 0) (python-nav-end-of-statement) @@ -1677,7 +1677,7 @@ backward to previous statement." (defun python-nav-beginning-of-block () "Move to start of current block." - (interactive "^") + (interactive "^" python-mode) (let ((starting-pos (point))) (if (progn (python-nav-beginning-of-statement) @@ -1701,7 +1701,7 @@ backward to previous statement." (defun python-nav-end-of-block () "Move to end of current block." - (interactive "^") + (interactive "^" python-mode) (when (python-nav-beginning-of-block) (let ((block-indentation (current-indentation))) (python-nav-end-of-statement) @@ -1717,7 +1717,7 @@ backward to previous statement." (defun python-nav-backward-block (&optional arg) "Move backward to previous block of code. With ARG, repeat. See `python-nav-forward-block'." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-block (- arg))) @@ -1725,7 +1725,7 @@ With ARG, repeat. See `python-nav-forward-block'." "Move forward to next block of code. With ARG, repeat. With negative argument, move ARG times backward to previous block." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (let ((block-start-regexp (python-rx line-start (* whitespace) block-start)) @@ -1878,7 +1878,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) ;; Do not follow parens on interactive calls. This hack to detect ;; if the function was called interactively copes with the way @@ -1912,7 +1912,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-forward-sexp (- arg) safe skip-parens-p)) @@ -1922,7 +1922,7 @@ With ARG, do it that many times. Negative arg -N means move backward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (python-nav-forward-sexp arg t skip-parens-p)) (defun python-nav-backward-sexp-safe (&optional arg skip-parens-p) @@ -1931,7 +1931,7 @@ With ARG, do it that many times. Negative arg -N means move forward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p") + (interactive "^p" python-mode) (python-nav-backward-sexp arg t skip-parens-p)) (defun python-nav--up-list (&optional dir) @@ -1977,7 +1977,7 @@ DIR is always 1 or -1 and comes sanitized from With ARG, do this that many times. A negative argument means move backward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (while (> arg 0) (python-nav--up-list 1) @@ -1991,7 +1991,7 @@ This command assumes point is not in a string or comment." With ARG, do this that many times. A negative argument means move forward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p") + (interactive "^p" python-mode) (or arg (setq arg 1)) (python-nav-up-list (- arg))) @@ -1999,7 +1999,7 @@ This command assumes point is not in a string or comment." "Move point at the beginning the __main__ block. When \"if __name__ == \\='__main__\\=':\" is found returns its position, else returns nil." - (interactive) + (interactive nil python-mode) (let ((point (point)) (found (catch 'found (goto-char (point-min)) -- cgit v1.2.3 From 850f18ef23ded4aff38afee89de7980e1c9dd1fd Mon Sep 17 00:00:00 2001 From: Ryan Prior Date: Thu, 18 Feb 2021 12:48:28 +0100 Subject: Allow newlines in password prompts again in comint * lisp/comint.el (comint-password-prompt-regexp): Match all whitespace (including newline) at the end of the passphrase, not just space and \t (bug#46609). (comint-watch-for-password-prompt): Remove trailing newlines from the prompt (bug#46609). Copyright-paperwork-exempt: yes --- lisp/comint.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/comint.el b/lisp/comint.el index f5abd1a5bc3..24ef0f239b2 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -366,7 +366,7 @@ This variable is buffer-local." "\\(?:" (regexp-opt password-word-equivalents) "\\|Response\\)" "\\(?:\\(?:, try\\)? *again\\| (empty for no passphrase)\\| (again)\\)?" ;; "[[:alpha:]]" used to be "for", which fails to match non-English. - "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:blank:]]*\\'") + "\\(?: [[:alpha:]]+ .+\\)?[[:blank:]]*[:：៖][[:space:]]*\\'") "Regexp matching prompts for passwords in the inferior process. This is used by `comint-watch-for-password-prompt'." :version "27.1" @@ -2405,6 +2405,8 @@ This function could be in the list `comint-output-filter-functions'." (string-match comint-password-prompt-regexp string)) (when (string-match "^[ \n\r\t\v\f\b\a]+" string) (setq string (replace-match "" t t string))) + (when (string-match "\n+\\'" string) + (setq string (replace-match "" t t string))) (let ((comint--prompt-recursion-depth (1+ comint--prompt-recursion-depth))) (if (> comint--prompt-recursion-depth 10) (message "Password prompt recursion too deep") -- cgit v1.2.3 From eb9f80e37b42576dd5a86c89e18d44ad2cec4273 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 18 Feb 2021 12:52:55 +0100 Subject: Revert "Do interactive mode tagging for python.el navigation functions." This reverts commit 546f552e7b2439b482c7d28222fb88761a9c876a. This is a "core package", so can't use the new syntax. --- lisp/progmodes/python.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 7506043a190..afb96974b17 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1506,7 +1506,7 @@ point position. Return non-nil if point is moved to (defun python-nav-end-of-defun () "Move point to the end of def or class. Returns nil if point is not in a def or class." - (interactive nil python-mode) + (interactive) (let ((beg-defun-indent) (beg-pos (point))) (when (or (python-info-looking-at-beginning-of-defun) @@ -1577,19 +1577,19 @@ repeat it." "Navigate to closer defun backward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p" python-mode) + (interactive "^p") (python-nav--forward-defun (- (or arg 1)))) (defun python-nav-forward-defun (&optional arg) "Navigate to closer defun forward ARG times. Unlikely `python-nav-beginning-of-defun' this doesn't care about nested definitions." - (interactive "^p" python-mode) + (interactive "^p") (python-nav--forward-defun (or arg 1))) (defun python-nav-beginning-of-statement () "Move to start of current statement." - (interactive "^" python-mode) + (interactive "^") (forward-line 0) (let* ((ppss (syntax-ppss)) (context-point @@ -1613,7 +1613,7 @@ nested definitions." Optional argument NOEND is internal and makes the logic to not jump to the end of line when moving forward searching for the end of the statement." - (interactive "^" python-mode) + (interactive "^") (let (string-start bs-pos (last-string-end 0)) (while (and (or noend (goto-char (line-end-position))) (not (eobp)) @@ -1654,7 +1654,7 @@ Overlapping strings detected (start=%d, last-end=%d)") (defun python-nav-backward-statement (&optional arg) "Move backward to previous statement. With ARG, repeat. See `python-nav-forward-statement'." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-statement (- arg))) @@ -1662,7 +1662,7 @@ With ARG, repeat. See `python-nav-forward-statement'." "Move forward to next statement. With ARG, repeat. With negative argument, move ARG times backward to previous statement." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) (python-nav-end-of-statement) @@ -1677,7 +1677,7 @@ backward to previous statement." (defun python-nav-beginning-of-block () "Move to start of current block." - (interactive "^" python-mode) + (interactive "^") (let ((starting-pos (point))) (if (progn (python-nav-beginning-of-statement) @@ -1701,7 +1701,7 @@ backward to previous statement." (defun python-nav-end-of-block () "Move to end of current block." - (interactive "^" python-mode) + (interactive "^") (when (python-nav-beginning-of-block) (let ((block-indentation (current-indentation))) (python-nav-end-of-statement) @@ -1717,7 +1717,7 @@ backward to previous statement." (defun python-nav-backward-block (&optional arg) "Move backward to previous block of code. With ARG, repeat. See `python-nav-forward-block'." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-block (- arg))) @@ -1725,7 +1725,7 @@ With ARG, repeat. See `python-nav-forward-block'." "Move forward to next block of code. With ARG, repeat. With negative argument, move ARG times backward to previous block." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (let ((block-start-regexp (python-rx line-start (* whitespace) block-start)) @@ -1878,7 +1878,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) ;; Do not follow parens on interactive calls. This hack to detect ;; if the function was called interactively copes with the way @@ -1912,7 +1912,7 @@ throw errors when at end of sexp, skip it instead. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-forward-sexp (- arg) safe skip-parens-p)) @@ -1922,7 +1922,7 @@ With ARG, do it that many times. Negative arg -N means move backward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (python-nav-forward-sexp arg t skip-parens-p)) (defun python-nav-backward-sexp-safe (&optional arg skip-parens-p) @@ -1931,7 +1931,7 @@ With ARG, do it that many times. Negative arg -N means move forward N times. With optional argument SKIP-PARENS-P force sexp motion to ignore parenthesized expressions when looking at them in either direction (forced to t in interactive calls)." - (interactive "^p" python-mode) + (interactive "^p") (python-nav-backward-sexp arg t skip-parens-p)) (defun python-nav--up-list (&optional dir) @@ -1977,7 +1977,7 @@ DIR is always 1 or -1 and comes sanitized from With ARG, do this that many times. A negative argument means move backward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (while (> arg 0) (python-nav--up-list 1) @@ -1991,7 +1991,7 @@ This command assumes point is not in a string or comment." With ARG, do this that many times. A negative argument means move forward but still to a less deep spot. This command assumes point is not in a string or comment." - (interactive "^p" python-mode) + (interactive "^p") (or arg (setq arg 1)) (python-nav-up-list (- arg))) @@ -1999,7 +1999,7 @@ This command assumes point is not in a string or comment." "Move point at the beginning the __main__ block. When \"if __name__ == \\='__main__\\=':\" is found returns its position, else returns nil." - (interactive nil python-mode) + (interactive) (let ((point (point)) (found (catch 'found (goto-char (point-min)) -- cgit v1.2.3 From 9882e63eeaed54244a6b608685dd748f72ef66a6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 18 Feb 2021 16:07:34 +0200 Subject: ; * CONTRIBUTE: Another wording change regarding tiny changes. --- CONTRIBUTE | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/CONTRIBUTE b/CONTRIBUTE index b7d72f9965e..fe773510d36 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -66,9 +66,9 @@ more reliably, and makes the job of applying the patches easier and less error-prone. It also allows sending patches whose author is someone other than the email sender. -Once the cumulative amount of your submissions exceeds about 10 lines -of non-trivial changes, we will need you to assign to the FSF the -copyright for your contributions. (To see how many lines were +Once the cumulative amount of your submissions exceeds a dozen or so +lines of non-trivial changes, we will need you to assign to the FSF +the copyright for your contributions. (To see how many lines were non-trivially changed, count only added and modified lines in the patched code. Consider an added or changed line non-trivial if it includes at least one identifier, string, or substantial comment.) -- cgit v1.2.3 From bae2cfe63cbd11eaf348dfa7fbb2b9f7362fc747 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Feb 2021 10:27:36 -0500 Subject: * lisp/emacs-lisp/edebug.el (eval-defun): Simplify (edebug-all-defs, edebug-all-forms): Don't autoload since the problem it was working around has been fixed a while back. (edebug--eval-defun): Rename from `edebug-eval-defun` and simplify by making it an `:around` advice. (edebug-install-read-eval-functions) (edebug-uninstall-read-eval-functions): Adjust accordingly. (edebug-eval-defun): Redefine as an obsolete wrapper. * lisp/progmodes/elisp-mode.el (elisp--eval-defun): Use `load-read-function` so it obeys `edebug-all-(defs|forms)`. (elisp--eval-defun): Fix recent regression introduced with `elisp--eval-defun-result`. --- lisp/emacs-lisp/edebug.el | 74 ++++++++------------------------------------ lisp/progmodes/elisp-mode.el | 12 ++++--- 2 files changed, 21 insertions(+), 65 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 45996945948..45e76c751fe 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -88,7 +88,6 @@ using, but only when you also use Edebug." ;; because the byte compiler binds them; as a result, if edebug ;; is first loaded for a require in a compilation, they will be left unbound. -;;;###autoload (defcustom edebug-all-defs nil "If non-nil, evaluating defining forms instruments for Edebug. This applies to `eval-defun', `eval-region', `eval-buffer', and @@ -101,11 +100,6 @@ variable. You may wish to make it local to each buffer with `emacs-lisp-mode-hook'." :type 'boolean) -;; edebug-all-defs and edebug-all-forms need to be autoloaded -;; because the byte compiler binds them; as a result, if edebug -;; is first loaded for a require in a compilation, they will be left unbound. - -;;;###autoload (defcustom edebug-all-forms nil "Non-nil means evaluation of all forms will instrument for Edebug. This doesn't apply to loading or evaluations in the minibuffer. @@ -457,66 +451,24 @@ the option `edebug-all-forms'." ;; We should somehow arrange to be able to do this ;; without actually replacing the eval-defun command. -(defun edebug-eval-defun (edebug-it) - "Evaluate the top-level form containing point, or after point. - -If the current defun is actually a call to `defvar', then reset the -variable using its initial value expression even if the variable -already has some other value. (Normally `defvar' does not change the -variable's value if it already has a value.) Treat `defcustom' -similarly. Reinitialize the face according to `defface' specification. - -With a prefix argument, instrument the code for Edebug. - -Setting option `edebug-all-defs' to a non-nil value reverses the meaning +(defun edebug--eval-defun (orig-fun edebug-it) + "Setting option `edebug-all-defs' to a non-nil value reverses the meaning of the prefix argument. Code is then instrumented when this function is invoked without a prefix argument. If acting on a `defun' for FUNCTION, and the function was instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, -just FUNCTION is printed. +just FUNCTION is printed." + (let* ((edebug-all-forms (not (eq (not edebug-it) (not edebug-all-defs)))) + (edebug-all-defs edebug-all-forms)) + (funcall orig-fun nil))) -If not acting on a `defun', the result of evaluation is displayed in -the minibuffer." +(defun edebug-eval-defun (edebug-it) + (declare (obsolete "use eval-defun or edebug--eval-defun instead" "28.1")) (interactive "P") - (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs)))) - (edebug-result) - (form - (let ((edebug-all-forms edebugging) - (edebug-all-defs (eq edebug-all-defs (not edebug-it)))) - (edebug-read-top-level-form)))) - ;; This should be consistent with `eval-defun-1', but not the - ;; same, since that gets a macroexpanded form. - (cond ((and (eq (car form) 'defvar) - (cdr-safe (cdr-safe form))) - ;; Force variable to be bound. - (makunbound (nth 1 form))) - ((and (eq (car form) 'defcustom) - (default-boundp (nth 1 form))) - ;; Force variable to be bound. - ;; FIXME: Shouldn't this use the :setter or :initializer? - (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) - ((eq (car form) 'defface) - ;; Reset the face. - (setq face-new-frame-defaults - (assq-delete-all (nth 1 form) face-new-frame-defaults)) - (put (nth 1 form) 'face-defface-spec nil) - (put (nth 1 form) 'face-documentation (nth 3 form)) - ;; See comments in `eval-defun-1' for purpose of code below - (setq form (prog1 `(prog1 ,form - (put ',(nth 1 form) 'saved-face - ',(get (nth 1 form) 'saved-face)) - (put ',(nth 1 form) 'customized-face - ,(nth 2 form))) - (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding)) - (if (not edebugging) - (prog1 - (prin1 edebug-result) - (let ((str (eval-expression-print-format edebug-result))) - (if str (princ str)))) - edebug-result))) - + (if (advice-member-p #'edebug--eval-defun 'eval-defun) + (eval-defun edebug-it) + (edebug--eval-defun #'eval-defun edebug-it))) ;;;###autoload (defalias 'edebug-defun 'edebug-eval-top-level-form) @@ -588,12 +540,12 @@ already is one.)" (defun edebug-install-read-eval-functions () (interactive) (add-function :around load-read-function #'edebug--read) - (advice-add 'eval-defun :override #'edebug-eval-defun)) + (advice-add 'eval-defun :around #'edebug--eval-defun)) (defun edebug-uninstall-read-eval-functions () (interactive) (remove-function load-read-function #'edebug--read) - (advice-remove 'eval-defun #'edebug-eval-defun)) + (advice-remove 'eval-defun #'edebug--eval-defun)) ;;; Edebug internal data diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index c14b18425f6..397eb269a71 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1342,6 +1342,7 @@ if it already has a value.) Return the result of evaluation." ;; FIXME: the print-length/level bindings should only be applied while ;; printing, not while evaluating. + (defvar elisp--eval-defun-result) (let ((debug-on-error eval-expression-debug-on-error) (print-length eval-expression-print-length) (print-level eval-expression-print-level) @@ -1357,19 +1358,22 @@ Return the result of evaluation." (end-of-defun) (beginning-of-defun) (setq beg (point)) - (setq form (read (current-buffer))) + (setq form (funcall load-read-function (current-buffer))) (setq end (point))) ;; Alter the form if necessary. (let ((form (eval-sexp-add-defvars (elisp--eval-defun-1 - (macroexpand - `(setq elisp--eval-defun-result ,form)))))) + (macroexpand form))))) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region ;; will make eval-region return. (goto-char end) - form))))) + ;; This `setq' needs to be added *after* passing + ;; form through `elisp--eval-defun-1' since it + ;; would otherwise "hide" forms like `defvar's and + ;; thus defeat their special treatment. + `(setq elisp--eval-defun-result ,form)))))) (let ((str (eval-expression-print-format elisp--eval-defun-result))) (if str (princ str))) elisp--eval-defun-result)) -- cgit v1.2.3 From de15ca7d0065c5f77c88a90f4f14569886be3617 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 18 Feb 2021 16:41:36 +0100 Subject: Fix typos * doc/lispref/display.texi (Size of Displayed Text): * doc/lispref/windows.texi (Buffer Display Action Functions): * etc/NEWS: * etc/ORG-NEWS (Org-Attach has been refactored and extended): * lisp/battery.el (display-battery-mode, battery--upower-subsribe): * lisp/calendar/parse-time.el: * lisp/dired-x.el: * lisp/emacs-lisp/chart.el (chart-sequece, chart-bar-quickie): * lisp/emacs-lisp/eldoc.el (eldoc-echo-area-use-multiline-p) (eldoc-documentation-strategy): * lisp/emacs-lisp/pcase.el (pcase--split-pred, pcase--u1): * lisp/gnus/gnus-search.el (gnus-search-expandable-keys) (gnus-search-parse-query, gnus-search-query-return-string) (gnus-search-imap, gnus-search-imap-search-command) (gnus-search-transform-expression): * lisp/gnus/nnselect.el: * lisp/isearch.el (isearch-lazy-count-format): * lisp/mh-e/mh-show.el (mh-show-msg): * lisp/net/dictionary-connection.el (dictionary-connection-open): * lisp/net/dictionary.el (dictionary-default-popup-strategy) (dictionary, dictionary-split-string, dictionary-do-select-dictionary) (dictionary-display-dictionarys, dictionary-search) (dictionary-tooltip-mode): * lisp/net/eudcb-macos-contacts.el (eudc-macos-contacts-set-server): * lisp/net/mailcap.el (mailcap-mime-data): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): * lisp/nxml/nxml-mode.el (nxml-mode): * lisp/progmodes/cc-engine.el: * lisp/progmodes/cperl-mode.el (cperl-mode) (cperl-fontify-syntaxically): * lisp/progmodes/flymake.el (flymake-diagnostic-functions): * lisp/progmodes/verilog-mode.el (verilog--supressed-warnings) (verilog-preprocess): * lisp/simple.el (self-insert-uses-region-functions): * lisp/textmodes/bibtex.el (bibtex-copy-summary-as-kill): * lisp/textmodes/texnfo-upd.el (texinfo-insert-master-menu-list): * src/dispnew.c: * src/font.c (Ffont_get): * src/indent.c (compute_motion): * src/process.c (init_process_emacs): * src/w32fns.c (deliver_wm_chars): * test/lisp/jsonrpc-tests.el (deferred-action-complex-tests): Fix typos in documentation, comments, and internal identifiers. --- doc/lispref/display.texi | 2 +- doc/lispref/windows.texi | 2 +- etc/NEWS | 2 +- etc/ORG-NEWS | 2 +- lisp/battery.el | 4 ++-- lisp/calendar/parse-time.el | 2 +- lisp/dired-x.el | 2 +- lisp/emacs-lisp/chart.el | 6 +++--- lisp/emacs-lisp/eldoc.el | 4 ++-- lisp/emacs-lisp/pcase.el | 4 ++-- lisp/gnus/gnus-search.el | 16 ++++++++-------- lisp/gnus/nnselect.el | 2 +- lisp/isearch.el | 2 +- lisp/mh-e/mh-show.el | 2 +- lisp/net/dictionary-connection.el | 6 +++--- lisp/net/dictionary.el | 20 ++++++++++---------- lisp/net/eudcb-macos-contacts.el | 2 +- lisp/net/mailcap.el | 2 +- lisp/net/tramp-smb.el | 2 +- lisp/nxml/nxml-mode.el | 2 +- lisp/progmodes/cc-engine.el | 2 +- lisp/progmodes/cperl-mode.el | 6 +++--- lisp/progmodes/flymake.el | 2 +- lisp/progmodes/verilog-mode.el | 4 ++-- lisp/simple.el | 2 +- lisp/textmodes/bibtex.el | 2 +- lisp/textmodes/texnfo-upd.el | 2 +- src/dispnew.c | 2 +- src/font.c | 2 +- src/indent.c | 2 +- src/process.c | 2 +- src/w32fns.c | 2 +- test/lisp/jsonrpc-tests.el | 2 +- 33 files changed, 59 insertions(+), 59 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 93e935ccf86..131ad2d9c87 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -1997,7 +1997,7 @@ the beginning of the result if a multi-column character in If @var{ellipsis} is non-@code{nil}, it should be a string which will replace the end of @var{string} when it is truncated. In this case, -more charcaters will be removed from @var{string} to free enough space +more characters will be removed from @var{string} to free enough space for @var{ellipsis} to fit within @var{width} columns. However, if the display width of @var{string} is less than the display width of @var{ellipsis}, @var{ellipsis} will not be appended to the result. If diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index f305d1a8ee8..c32d711f12a 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -2557,7 +2557,7 @@ frame visible and, unless @var{alist} contains an This function tries to display @var{buffer} by finding a window that is displaying a buffer in a given mode. -If @var{alist} contains a @code{mode} entry, its value specifes a +If @var{alist} contains a @code{mode} entry, its value specifies a major mode (a symbol) or a list of major modes. If @var{alist} contains no @code{mode} entry, the current major mode of @var{buffer} is used instead. A window is a candidate if it displays a buffer diff --git a/etc/NEWS b/etc/NEWS index 7665d4740f9..ee8a68a259d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1015,7 +1015,7 @@ separate buffer, or a tooltip. *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose the results of 'eldoc-documentation-functions' in various ways, even -if some of those functions are sychronous and some asynchchronous. +if some of those functions are synchronous and some asynchronous. The user option replaces 'eldoc-documentation-function', which is now obsolete. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 2cae8b92ace..2b9cbf37c45 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -747,7 +747,7 @@ removed. For those who hate breaking changes, even though the changes are made to clean things up; fear not. ATTACH_DIR will still continue to work. It's just not documented any longer. When you get the chance, run the -code above to clean things up anyways! +code above to clean things up anyway! **** New hooks Two hooks are added to org-attach: diff --git a/lisp/battery.el b/lisp/battery.el index 77ad73d15d7..59f6987ad16 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -246,7 +246,7 @@ seconds." (add-to-list 'global-mode-string 'battery-mode-line-string t) (and (eq battery-status-function #'battery-upower) battery-upower-subscribe - (battery--upower-subsribe)) + (battery--upower-subscribe)) (setq battery-update-timer (run-at-time nil battery-update-interval #'battery-update-handler)) (battery-update)) @@ -634,7 +634,7 @@ Intended as a UPower PropertiesChanged signal handler." (mapc #'dbus-unregister-object battery--upower-signals) (setq battery--upower-signals ())) -(defun battery--upower-subsribe () +(defun battery--upower-subscribe () "Subscribe to UPower device change signals." (push (dbus-register-signal :system battery-upower-service battery-upower-path diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index ba7418faf78..aa3236cf256 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -29,7 +29,7 @@ ;; `parse-time-string' parses a time in a string and returns a list of ;; values, just like `decode-time', where unspecified elements in the -;; string are returned as nil (except unspecfied DST is returned as -1). +;; string are returned as nil (except unspecified DST is returned as -1). ;; `encode-time' may be applied on these values to obtain an internal ;; time value. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 5a52eccbbe3..1199de183fb 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -447,7 +447,7 @@ If it is `no-dir', omitting is much faster, but you can only match against the non-directory part of the file name. Set it to nil if you need to match the entire file name.") -;; \017=^O for Omit - other packages can chose other control characters. +;; \017=^O for Omit - other packages can choose other control characters. (defvar dired-omit-marker-char ?\017 "Temporary marker used by Dired-Omit. Should never be used as marker by the user or other packages.") diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index 7d760ffc57f..40c17b916f9 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -187,7 +187,7 @@ Make sure the width/height is correct." ) "Class used to display an axis which represents different named items.") -(defclass chart-sequece () +(defclass chart-sequence () ((data :initarg :data :initform nil) (name :initarg :name @@ -583,12 +583,12 @@ SORT-PRED if desired." )) (iv (eq dir 'vertical))) (chart-add-sequence nc - (make-instance 'chart-sequece + (make-instance 'chart-sequence :data namelst :name nametitle) (if iv 'x-axis 'y-axis)) (chart-add-sequence nc - (make-instance 'chart-sequece + (make-instance 'chart-sequence :data numlst :name numtitle) (if iv 'y-axis 'x-axis)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index c95540ea3cf..a02406a7b73 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -100,7 +100,7 @@ If the value is a positive number, it is used to calculate a number of logical lines of documentation that ElDoc is allowed to put in the echo area. If a positive integer, the number is used directly, while a float specifies the number of lines as a -proporting of the echo area frame's height. +proportion of the echo area frame's height. If value is the symbol `truncate-sym-name-if-fit' t, the part of the doc string that represents a symbol's name may be truncated @@ -692,7 +692,7 @@ following values are allowed: - `eldoc-documentation-compose-eagerly': calls all functions in the special hook and display as many of the resulting doc - strings as possible, as soon as possibl. Preserving the + strings as possible, as soon as possible. Preserving the relative order of doc strings; - `eldoc-documentation-enthusiast': calls all functions in the diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d3928fa5051..c7288b7fa2a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -642,7 +642,7 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase--split-pred (vars upat pat) "Indicate the overlap or mutual-exclusion between UPAT and PAT. -More specifically retuns a pair (A . B) where A indicates whether PAT +More specifically returns a pair (A . B) where A indicates whether PAT can match when UPAT has matched, and B does the same for the case where UPAT failed to match. A and B can be one of: @@ -784,7 +784,7 @@ Otherwise, it defers to REST which is a list of branches of the form \(ELSE-MATCH ELSE-CODE . ELSE-VARS)." ;; Depending on the order in which we choose to check each of the MATCHES, ;; the resulting tree may be smaller or bigger. So in general, we'd want - ;; to be careful to chose the "optimal" order. But predicate + ;; to be careful to choose the "optimal" order. But predicate ;; patterns make this harder because they create dependencies ;; between matches. So we don't bother trying to reorder anything. (cond diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index d7b1c06114b..339bff9d67a 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -365,7 +365,7 @@ This variable can also be set per-server." "A list of strings representing expandable search keys. \"Expandable\" simply means the key can be abbreviated while typing in search queries, ie \"subject\" could be entered as -\"subj\" or even \"su\", though \"s\" is ambigous between +\"subj\" or even \"su\", though \"s\" is ambiguous between \"subject\" and \"since\". Ambiguous abbreviations will raise an error." @@ -402,7 +402,7 @@ The search \"language\" is essentially a series of key:value expressions. Key is most often a mail header, but there are other keys. Value is a string, quoted if it contains spaces. Key and value are separated by a colon, no space. Expressions -are implictly ANDed; the \"or\" keyword can be used to +are implicitly ANDed; the \"or\" keyword can be used to OR. \"not\" will negate the following expression, or keys can be prefixed with a \"-\". The \"near\" operator will work for engines that understand it; other engines will convert it to @@ -448,7 +448,7 @@ auto-completion of contact names and addresses for keys like Date values (any key in `gnus-search-date-keys') can be provided in any format that `parse-time-string' can parse (note that this can produce weird results). Dates with missing bits will be -interpreted as the most recent occurance thereof (ie \"march 03\" +interpreted as the most recent occurence thereof (ie \"march 03\" is the most recent March 3rd). Lastly, relative specifications such as 1d (one day ago) are understood. This also accepts w, m, and y. m is assumed to be 30 days. @@ -646,7 +646,7 @@ gnus-*-mark marks, and return an appropriate string." "Return a string from the current buffer. If DELIMITED is non-nil, assume the next character is a delimiter character, and return everything between point and the next -occurance of the delimiter, including the delimiters themselves. +occurence of the delimiter, including the delimiters themselves. If TRIM is non-nil, do not return the delimiters. Otherwise, return one word." ;; This function cannot handle nested delimiters, as it's not a @@ -789,7 +789,7 @@ the files in ARTLIST by that search key.") (raw-queries-p :initform (symbol-value 'gnus-search-imap-raw-queries-p))) :documentation - "The base IMAP search engine, using an IMAP server's search capabilites. + "The base IMAP search engine, using an IMAP server's search capabilities. This backend may be subclassed to handle particular IMAP servers' quirks.") @@ -1082,7 +1082,7 @@ Responsible for handling and, or, and parenthetical expressions.") (cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap) (query string)) "Create the IMAP search command for QUERY. -Currenly takes into account support for the LITERAL+ capability. +Currently takes into account support for the LITERAL+ capability. Other capabilities could be tested here." (with-slots (literal-plus) engine (when literal-plus @@ -1672,8 +1672,8 @@ and \"-\" before marks." (cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix) (expr (head or))) "Handle Mairix \"or\" statement. -Mairix only accepts \"or\" expressions on homogenous keys. We -cast \"or\" expressions on heterogenous keys as \"and\", which +Mairix only accepts \"or\" expressions on homogeneous keys. We +cast \"or\" expressions on heterogeneous keys as \"and\", which isn't quite right, but it's the best we can do. For date keys, only keep one of the terms." (let ((term1 (caadr expr)) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index fffa2d27312..1daa8aa673b 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -33,7 +33,7 @@ ;; turn be a vector of three elements: a real prefixed group name, an ;; article number in that group, and an integer score. The score is ;; not used by nnselect but may be used by other code to help in -;; sorting. Most functions will just chose a fixed number, such as +;; sorting. Most functions will just choose a fixed number, such as ;; 100, for this score. ;; For example the search function `gnus-search-run-query' applied to diff --git a/lisp/isearch.el b/lisp/isearch.el index c571ea94670..8266c4b7a01 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3356,7 +3356,7 @@ the word mode." (defun isearch-lazy-count-format (&optional suffix-p) "Format the current match number and the total number of matches. -When SUFFIX-P is non-nil, the returned string is indended for +When SUFFIX-P is non-nil, the returned string is intended for isearch-message-suffix prompt. Otherwise, for isearch-message-prefix." (let ((format-string (if suffix-p lazy-count-suffix-format diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 9ad843c3259..1d25b147323 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -136,7 +136,7 @@ displayed." (show-window (get-buffer-window mh-show-buffer)) (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag)) (if (not (eq (next-window (minibuffer-window)) (selected-window))) - (delete-other-windows)) ; force ourself to the top window + (delete-other-windows)) ; force ourselves to the top window (mh-in-show-buffer (mh-show-buffer) (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag) (if (and show-window diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index 8ad4fe4e637..83125742be3 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -23,9 +23,9 @@ ;;; Commentary: ;; dictionary-connection allows to handle TCP-based connections in -;; client mode where text-based information are exchanged. There is +;; client mode where text-based information is exchanged. There is ;; special support for handling CR LF (and the usual CR LF . CR LF -;; terminater). +;; terminator). ;;; Code: @@ -68,7 +68,7 @@ (defun dictionary-connection-open (server port) "Open a connection to SERVER at PORT. -A data structure identifing the connection is returned" +A data structure identifying the connection is returned" (let ((process-buffer (generate-new-buffer (format " connection to %s:%s" server diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el index 6f086053b6a..c6af4e66e39 100644 --- a/lisp/net/dictionary.el +++ b/lisp/net/dictionary.el @@ -127,9 +127,9 @@ by the choice value: The found word exactly matches the searched word. -- Similiar sounding +- Similar sounding - The found word sounds similiar to the searched word. For this match type + The found word sounds similar to the searched word. For this match type the soundex algorithm defined by Donald E. Knuth is used. It will only works with english words and the algorithm is not very reliable (i.e., the soundex algorithm is quite simple). @@ -148,7 +148,7 @@ by the choice value: dictionary server." :group 'dictionary :type '(choice (const :tag "Exact match" "exact") - (const :tag "Similiar sounding" "soundex") + (const :tag "Similar sounding" "soundex") (const :tag "Levenshtein distance one" "lev") (string :tag "User choice")) :version "28.1") @@ -419,7 +419,7 @@ This is a quick reference to this mode describing the default key bindings: ;;;###autoload (defun dictionary () - "Create a new dictonary buffer and install `dictionary-mode'." + "Create a new dictionary buffer and install `dictionary-mode'." (interactive) (let ((buffer (or (and dictionary-use-single-buffer (get-buffer "*Dictionary*")) @@ -568,7 +568,7 @@ The connection takes the proxy setting in customization group answer))) (defun dictionary-split-string (string) - "Split STRING constiting of space-separated words into elements. + "Split STRING consisting of space-separated words into elements. This function knows about the special meaning of quotes (\")" (let ((list)) (while (and string (> (length string) 0)) @@ -894,7 +894,7 @@ The word is taken from the buffer, the DICTIONARY is given as argument." (unless (dictionary-check-reply reply 110) (error "Unknown server answer: %s" (dictionary-reply reply))) - (dictionary-display-dictionarys)))) + (dictionary-display-dictionaries)))) (defun dictionary-simple-split-string (string &optional pattern) "Return a list of substrings of STRING which are separated by PATTERN. @@ -909,7 +909,7 @@ If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." start (match-end 0))) (nreverse (cons (substring string start) parts)))) -(defun dictionary-display-dictionarys () +(defun dictionary-display-dictionaries () "Handle the display of all dictionaries existing on the server." (dictionary-pre-buffer) (insert "Please select your default dictionary:\n\n") @@ -1171,7 +1171,7 @@ allows editing it." ;; if called by pressing the button (unless word (setq word (read-string "Search word: " nil 'dictionary-word-history))) - ;; just in case non-interactivly called + ;; just in case non-interactively called (unless dictionary (setq dictionary dictionary-default-dictionary)) (dictionary-new-search (cons word dictionary))) @@ -1249,10 +1249,10 @@ allows editing it." ;;; Tooltip support -;; Add a mode indicater named "Dict" +;; Add a mode indicator named "Dict" (defvar dictionary-tooltip-mode nil - "Indicates wheather the dictionary tooltip mode is active.") + "Indicates whether the dictionary tooltip mode is active.") (nconc minor-mode-alist '((dictionary-tooltip-mode " Dict"))) (defcustom dictionary-tooltip-dictionary diff --git a/lisp/net/eudcb-macos-contacts.el b/lisp/net/eudcb-macos-contacts.el index 66a684dfc59..b07016c1229 100644 --- a/lisp/net/eudcb-macos-contacts.el +++ b/lisp/net/eudcb-macos-contacts.el @@ -108,7 +108,7 @@ RETURN-ATTRS is a list of attributes to return, defaulting to (defun eudc-macos-contacts-set-server (dummy) "Set the EUDC server to macOS Contacts app. The server in DUMMY is not actually used, since this backend -always and implicitly connetcs to an instance of the Contacts app +always and implicitly connects to an instance of the Contacts app running on the local host." (interactive) (eudc-set-server dummy 'macos-contacts) diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index b95cd0febcd..3097c9a671e 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -332,7 +332,7 @@ whose car is a symbol, it is `eval'uated to yield the validity. If it is a string or list of strings, it represents a shell command to run to return a true or false shell value for the validity. -The last matching entry in this structure takes presedence over +The last matching entry in this structure takes precedence over preceding entries.") (put 'mailcap-mime-data 'risky-local-variable t) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4519c34d36e..69359553e44 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1928,7 +1928,7 @@ If ARGUMENT is non-nil, use it as argument for ;; Check whether we still have the same smbclient version. ;; Otherwise, we must delete the connection cache, because - ;; capabilities migh have changed. + ;; capabilities might have changed. (unless (or argument (processp p)) (let ((default-directory (tramp-compat-temporary-file-directory)) (command (concat tramp-smb-program " -V"))) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 0602943db20..1bc905cee2d 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -546,7 +546,7 @@ Many aspects this mode can be customized using (when (and nxml-default-buffer-file-coding-system (not (local-variable-p 'buffer-file-coding-system))) (setq buffer-file-coding-system nxml-default-buffer-file-coding-system)) - ;; When starting a new file, insert the XML declaraction. + ;; When starting a new file, insert the XML declaration. (when (and nxml-auto-insert-xml-declaration-flag (zerop (buffer-size))) (nxml-insert-xml-declaration))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 484624b8664..9038c7bd95a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -2665,7 +2665,7 @@ comment at the start of cc-engine.el for more info." ;; One of the above "near" caches is associated with each of these functions. ;; ;; When searching this cache, these functions first seek an exact match, then -;; a "close" match from the assiciated near cache. If neither of these +;; a "close" match from the associated near cache. If neither of these ;; succeed, the nearest preceding entry in the far cache is used. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 44a75269524..d01bd3a48ef 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1764,12 +1764,12 @@ or as help on variables `cperl-tips', `cperl-problems', (setq-local syntax-propertize-function (lambda (start end) (goto-char start) - ;; Even if cperl-fontify-syntaxically has already gone + ;; Even if cperl-fontify-syntactically has already gone ;; beyond `start', syntax-propertize has just removed ;; syntax-table properties between start and end, so we have ;; to re-apply them. (setq cperl-syntax-done-to start) - (cperl-fontify-syntaxically end)))) + (cperl-fontify-syntactically end)))) (setq cperl-font-lock-multiline t) ; Not localized... (setq-local font-lock-multiline t) (setq-local font-lock-fontify-region-function @@ -8407,7 +8407,7 @@ do extra unwind via `cperl-unwind-to-safe'." (setq end (point))) (font-lock-default-fontify-region beg end loudly)) -(defun cperl-fontify-syntaxically (end) +(defun cperl-fontify-syntactically (end) ;; Some vars for debugging only ;; (message "Syntaxifying...") (let ((dbg (point)) (iend end) (idone cperl-syntax-done-to) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index b8c8a827eed..d01803282aa 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -483,7 +483,7 @@ Currently, Flymake may provide these keyword-value pairs: * `:recent-changes', a list of recent changes since the last time the backend function was called for the buffer. An empty list - indicates that no changes have been reocrded. If it is the + indicates that no changes have been recorded. If it is the first time that this backend function is called for this activation of `flymake-mode', then this argument isn't provided at all (i.e. it's not merely nil). diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index f934ef7a80e..55c04e13323 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -134,7 +134,7 @@ (interactive) (message "Using verilog-mode version %s" verilog-mode-version)) -(defmacro verilog--supressed-warnings (warnings &rest body) +(defmacro verilog--suppressed-warnings (warnings &rest body) (declare (indent 1) (debug t)) (cond ((fboundp 'with-suppressed-warnings) @@ -5550,7 +5550,7 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name'." ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to ;; solve only appears in Emacsen older than font-lock-ensure anyway. (when fontlocked - (verilog--supressed-warnings + (verilog--suppressed-warnings ((interactive-only font-lock-fontify-buffer)) (font-lock-fontify-buffer)))))))) diff --git a/lisp/simple.el b/lisp/simple.el index d6ccdad9021..a4da3f58a99 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -549,7 +549,7 @@ It must be called via `run-hook-with-args-until-success' with no arguments. If any function on this hook returns a non-nil value, `delete-selection-mode' will act on that value (see `delete-selection-helper') and will usually delete the region. If all the functions on this hook return -nil, it is an indiction that `self-insert-command' needs the region +nil, it is an indication that `self-insert-command' needs the region untouched by `delete-selection-mode' and will itself do whatever is appropriate with the region. Any function on `post-self-insert-hook' that acts on the region should diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index a22cd97b309..301f7017e41 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3327,7 +3327,7 @@ Use `bibtex-summary-function' to generate summary." (message "%s %s" key summary)))))) (defun bibtex-copy-summary-as-kill (&optional arg) - "Push summery of current BibTeX entry to kill ring. + "Push summary of current BibTeX entry to kill ring. Use `bibtex-summary-function' to generate summary. If prefix ARG is non-nil push BibTeX entry's URL to kill ring that is generated by calling `bibtex-url'." diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index ea35641a6c6..04778ee94d4 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -1033,7 +1033,7 @@ However, there does not need to be a title field." (save-excursion ;; `master-menu-inserted-p' is a kludge to tell - ;; whether to insert @end detailmenu (see bleow) + ;; whether to insert @end detailmenu (see below) (let (master-menu-inserted-p) ;; Handle top of menu (insert "\n@menu\n") diff --git a/src/dispnew.c b/src/dispnew.c index e603c671363..b3e4587250f 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3328,7 +3328,7 @@ update_frame_with_menu (struct frame *f, int row, int col) } /* Update the mouse position for a frame F. This handles both - updating the display for mouse-face propreties and updating the + updating the display for mouse-face properties and updating the help echo text. Returns the number of events generated. */ diff --git a/src/font.c b/src/font.c index a59ebe216b8..7c1d1ff89b1 100644 --- a/src/font.c +++ b/src/font.c @@ -4122,7 +4122,7 @@ representing the OpenType features supported by the font by this form: SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType Layout tags. -In addition to the keys listed abobe, the following keys are reserved +In addition to the keys listed above, the following keys are reserved for the specific meanings as below: The value of :combining-capability is non-nil if the font-backend of diff --git a/src/indent.c b/src/indent.c index 0a6b460f753..6246b544fbd 100644 --- a/src/indent.c +++ b/src/indent.c @@ -1315,7 +1315,7 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte, EMACS_INT fromvpos, j ^---- next after the point ^--- next char. after the point. ---------- - In case of sigle-column character + In case of single-column character ---------- abcdefgh\\ diff --git a/src/process.c b/src/process.c index 3beb9cf7146..b98bc297a3f 100644 --- a/src/process.c +++ b/src/process.c @@ -8255,7 +8255,7 @@ init_process_emacs (int sockfd) private SIGCHLD handler, allowing catch_child_signal to copy it into lib_child_handler. - Unfortunatly in glib commit 2e471acf, the behavior changed to + Unfortunately in glib commit 2e471acf, the behavior changed to always install a signal handler when g_child_watch_source_new is called and not just the first time it's called. Glib also now resets signal handlers to SIG_DFL when it no longer has a diff --git a/src/w32fns.c b/src/w32fns.c index 86c3db64e7b..9db367bfafe 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3893,7 +3893,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, Essentially, we have no information about the "role" of modifiers on this key: which contribute into the produced character (so "are consumed"), and which are - "extra" (must attache to bindable events). + "extra" (must attach to bindable events). The default above would consume ALL modifiers, so the character is reported "as is". However, on many layouts diff --git a/test/lisp/jsonrpc-tests.el b/test/lisp/jsonrpc-tests.el index ea340c370d1..92306d1c7e5 100644 --- a/test/lisp/jsonrpc-tests.el +++ b/test/lisp/jsonrpc-tests.el @@ -244,7 +244,7 @@ :timeout 1) ;; Wait another 0.5 secs just in case the success handlers of ;; one of these last two requests didn't quite have a chance to - ;; run (Emacs 25.2 apparentely needs this). + ;; run (Emacs 25.2 apparently needs this). (accept-process-output nil 0.5) (should second-deferred-went-through-p) (should (eq 1 n-deferred-1)) -- cgit v1.2.3 From 5977de581cbffb18f1cacb266928329dc807cb22 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 18 Feb 2021 11:15:13 -0500 Subject: * lisp/emacs-lisp/bindat.el: Tweak example in comment Suggested by Kim Storm . --- lisp/emacs-lisp/bindat.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index 1f5022c2743..b1b2144e3de 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -41,23 +41,23 @@ ;; Consider the following C structures: ;; ;; struct header { -;; unsigned long dest_ip; -;; unsigned long src_ip; -;; unsigned short dest_port; -;; unsigned short src_port; +;; uint32_t dest_ip; +;; uint32_t src_ip; +;; uint16_t dest_port; +;; uint16_t src_port; ;; }; ;; ;; struct data { -;; unsigned char type; -;; unsigned char opcode; -;; unsigned long length; /* In little endian order */ +;; uint8_t type; +;; uint8_t opcode; +;; uint32_t length; /* In little endian order */ ;; unsigned char id[8]; /* nul-terminated string */ ;; unsigned char data[/* (length + 3) & ~3 */]; ;; }; ;; ;; struct packet { ;; struct header header; -;; unsigned char items; +;; uint8_t items; ;; unsigned char filler[3]; ;; struct data item[/* items */]; ;; }; @@ -75,7 +75,7 @@ ;; (bindat-spec ;; (type u8) ;; (opcode u8) -;; (length u16r) ;; little endian order +;; (length u32r) ;; little endian order ;; (id strz 8) ;; (data vec (length)) ;; (align 4))) -- cgit v1.2.3 From 32e790f2514154c72927c414f43c3e277b1344ac Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Thu, 18 Feb 2021 18:05:38 -0500 Subject: Implement NTLM server for ntlm.el testing * test/Makefile.in (GNU_ELPA_DIRECTORY, elpa_dependencies, elpa_els, elpa_opts): New variables. (EMACSOPT, ert_opts): Add elpa_opts. * test/README: Document GNU_ELPA_DIRECTORY make variable. * test/lisp/net/ntlm-tests.el: Fix checkdoc-reported issues. (ntlm-tests-message, ntlm-server-build-type-2, ntlm-server-hash) (ntlm-server-check-authorization, ntlm-server-do-token) (ntlm-server-filter, ntlm-server-handler, ntlm-server-start) (ntlm-server-stop, ntlm-tests--url-retrieve-internal-around) (ntlm-tests--authenticate) (ntlm-tests--start-server-authenticate-stop-server): New functions. (ntlm-tests--username-oem, ntlm-tests--username-unicode) (ntlm-tests--client-supports-unicode, ntlm-tests--challenge) (ntlm-tests--result-buffer, ntlm-tests--successful-result): New variables. (ntlm-authentication) (ntlm-authentication-old-compatibility-level): New tests. * test/lisp/net/ntlm-resources/authinfo: New file. (Bug#43566) --- test/Makefile.in | 13 +- test/README | 5 + test/lisp/net/ntlm-resources/authinfo | 1 + test/lisp/net/ntlm-tests.el | 360 ++++++++++++++++++++++++++++++++++ 4 files changed, 377 insertions(+), 2 deletions(-) create mode 100644 test/lisp/net/ntlm-resources/authinfo diff --git a/test/Makefile.in b/test/Makefile.in index f907602a622..ff228d1261e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -71,6 +71,15 @@ am__v_at_0 = @ am__v_at_1 = +# Load any GNU ELPA dependencies that are present, for optional tests. +GNU_ELPA_DIRECTORY ?= $(srcdir)/../../elpa +# Keep elpa_dependencies dependency-ordered. +elpa_dependencies = \ + url-http-ntlm/url-http-ntlm.el \ + web-server/web-server.el +elpa_els = $(addprefix $(GNU_ELPA_DIRECTORY)/packages/,$(elpa_dependencies)) +elpa_opts = $(foreach el,$(elpa_els),$(and $(wildcard $(el)),-L $(dir $(el)) -l $(el))) + # We never change directory before running Emacs, so a relative file # name is fine, and makes life easier. If we need to change # directory, we can use emacs --chdir. @@ -81,7 +90,7 @@ EMACS_EXTRAOPT= # Command line flags for Emacs. # Apparently MSYS bash would convert "-L :" to "-L ;" anyway, # but we might as well be explicit. -EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(EMACS_EXTRAOPT) +EMACSOPT = --no-init-file --no-site-file --no-site-lisp -L "$(SEPCHAR)$(srcdir)" $(elpa_opts) $(EMACS_EXTRAOPT) # Prevent any settings in the user environment causing problems. unexport EMACSDATA EMACSDOC EMACSPATH GREP_OPTIONS @@ -105,7 +114,7 @@ export TEST_LOAD_EL ?= \ $(if $(findstring $(MAKECMDGOALS), all check check-maybe),no,yes) # Additional settings for ert. -ert_opts = +ert_opts += $(elpa_opts) # Maximum length of lines in ert backtraces; nil for no limit. # (if empty, use the default ert-batch-backtrace-right-margin). diff --git a/test/README b/test/README index 5f3c10adbe1..877f77ab947 100644 --- a/test/README +++ b/test/README @@ -108,6 +108,11 @@ to a suitable value in order to overwrite the default value: env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... +Some optional tests require packages from GNU ELPA. By default +../../elpa will be checked for these packages. If GNU ELPA is checked +out somewhere else, use + + make GNU_ELPA_DIRECTORY=/path/to/elpa ... There are also continuous integration tests on (see diff --git a/test/lisp/net/ntlm-resources/authinfo b/test/lisp/net/ntlm-resources/authinfo new file mode 100644 index 00000000000..698391e9313 --- /dev/null +++ b/test/lisp/net/ntlm-resources/authinfo @@ -0,0 +1 @@ +machine localhost port http user ntlm password ntlm diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index 6408ac13349..0ed430afe68 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -17,11 +17,26 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . +;;; Commentary: + +;; Run this with `NTLM_TESTS_VERBOSE=1' to get verbose debugging. + +;;; Code: + (require 'ert) +(require 'ert-x) (require 'ntlm) +(defsubst ntlm-tests-message (format-string &rest arguments) + "Print a message conditional on an environment variable being set. +FORMAT-STRING and ARGUMENTS are passed to the message function." + (when (getenv "NTLM_TESTS_VERBOSE") + (apply #'message (concat "ntlm-tests: " format-string) arguments))) + + ;; This is the Lisp bignum implementation of `ntlm--time-to-timestamp', ;; for reference. + (defun ntlm-tests--time-to-timestamp (time) "Convert TIME to an NTLMv2 timestamp. Return a unibyte string representing the number of tenths of a @@ -49,4 +64,349 @@ signed integer. TIME must be on the form (HIGH LOW USEC PSEC)." (should (equal (ntlm--time-to-timestamp time) (ntlm-tests--time-to-timestamp time))))) +(defvar ntlm-tests--username-oem "ntlm" + "The username for NTLM authentication tests, in OEM string encoding.") +(defvar ntlm-tests--username-unicode + (ntlm-ascii2unicode ntlm-tests--username-oem + (length ntlm-tests--username-oem)) + "The username for NTLM authentication tests, in Unicode string encoding.") + +(defvar ntlm-tests--password "ntlm" + "The password used for NTLM authentication tests.") + +(defvar ntlm-tests--client-supports-unicode nil + "Non-nil if client supports Unicode strings. +If client only supports OEM strings, nil.") + +(defvar ntlm-tests--challenge nil "The global random challenge.") + +(defun ntlm-server-build-type-2 () + "Return an NTLM Type 2 message as a string. +This string will be returned from the NTLM server to the NTLM client." + (let ((target (if ntlm-tests--client-supports-unicode + (ntlm-ascii2unicode "DOMAIN" (length "DOMAIN")) + "DOMAIN")) + (target-information ntlm-tests--password) + ;; Flag byte 1 flags. + (_negotiate-unicode 1) + (negotiate-oem 2) + (request-target 4) + ;; Flag byte 2 flags. + (negotiate-ntlm 2) + (_negotiate-local-call 4) + (_negotiate-always-sign 8) + ;; Flag byte 3 flags. + (_target-type-domain 1) + (_target-type-server 2) + (target-type-share 4) + (_negotiate-ntlm2-key 8) + (negotiate-target-information 128) + ;; Flag byte 4 flags, unused. + (_negotiate-128 32) + (_negotiate-56 128)) + (concat + ;; Signature. + "NTLMSSP" (unibyte-string 0) + ;; Type 2. + (unibyte-string 2 0 0 0) + ;; Target length + (unibyte-string (length target) 0) + ;; Target allocated space. + (unibyte-string (length target) 0) + ;; Target offset. + (unibyte-string 48 0 0 0) + ;; Flags. + ;; Flag byte 1. + ;; Tell the client that this test server only supports OEM + ;; strings. This test server will handle Unicode strings + ;; anyway though. + (unibyte-string (logior negotiate-oem request-target)) + ;; Flag byte 2. + (unibyte-string negotiate-ntlm) + ;; Flag byte 3. + (unibyte-string (logior negotiate-target-information target-type-share)) + ;; Flag byte 4. Not sure what 2 means here. + (unibyte-string 2) + ;; Challenge. Set this to (unibyte-string 1 2 3 4 5 6 7 8) + ;; instead of (ntlm-generate-nonce) to hold constant for + ;; debugging. + (setq ntlm-tests--challenge (ntlm-generate-nonce)) + ;; Context. + (make-string 8 0) + (unibyte-string (length target-information) 0) + (unibyte-string (length target-information) 0) + (unibyte-string 54 0 0 0) + target + target-information))) + +(defun ntlm-server-hash (challenge blob username password) + "Hash CHALLENGE, BLOB, USERNAME and PASSWORD for a Type 3 check." + (hmac-md5 (concat challenge blob) + (hmac-md5 (concat + (upcase + ;; This calculation always uses + ;; Unicode username, even when the + ;; server only supports OEM strings. + (ntlm-ascii2unicode username (length username))) "") + (cadr (ntlm-get-password-hashes password))))) + +(defun ntlm-server-check-authorization (authorization-string) + "Return t if AUTHORIZATION-STRING correctly authenticates the user." + (let* ((binary (base64-decode-string + (caddr (split-string authorization-string " ")))) + (_lm-response-length (md4-unpack-int16 (substring binary 12 14))) + (_lm-response-offset + (cdr (md4-unpack-int32 (substring binary 16 20)))) + (ntlm-response-length (md4-unpack-int16 (substring binary 20 22))) + (ntlm-response-offset + (cdr (md4-unpack-int32 (substring binary 24 28)))) + (ntlm-hash + (substring binary ntlm-response-offset (+ ntlm-response-offset 16))) + (username-length (md4-unpack-int16 (substring binary 36 38))) + (username-offset (cdr (md4-unpack-int32 (substring binary 40 44)))) + (username (substring binary username-offset + (+ username-offset username-length)))) + (if (equal ntlm-response-length 24) + (let* ((expected + (ntlm-smb-owf-encrypt + (cadr (ntlm-get-password-hashes ntlm-tests--password)) + ntlm-tests--challenge)) + (received (substring binary ntlm-response-offset + (+ ntlm-response-offset + ntlm-response-length)))) + (ntlm-tests-message "Got NTLMv1 response:") + (ntlm-tests-message "Expected hash: ===%S===" expected) + (ntlm-tests-message "Got hash: ===%S===" received) + (ntlm-tests-message "Expected username: ===%S===" + ntlm-tests--username-oem) + (ntlm-tests-message "Got username: ===%S===" username) + (and (or (equal username ntlm-tests--username-oem) + (equal username ntlm-tests--username-unicode)) + (equal expected received))) + (let* ((ntlm-response-blob + (substring binary (+ ntlm-response-offset 16) + (+ (+ ntlm-response-offset 16) + (- ntlm-response-length 16)))) + (_ntlm-timestamp (substring ntlm-response-blob 8 16)) + (_ntlm-nonce (substring ntlm-response-blob 16 24)) + (_target-length (md4-unpack-int16 (substring binary 28 30))) + (_target-offset + (cdr (md4-unpack-int32 (substring binary 32 36)))) + (_workstation-length (md4-unpack-int16 (substring binary 44 46))) + (_workstation-offset + (cdr (md4-unpack-int32 (substring binary 48 52))))) + (cond + ;; This test server claims to only support OEM strings, + ;; but also checks Unicode strings. + ((or (equal username ntlm-tests--username-oem) + (equal username ntlm-tests--username-unicode)) + (let* ((password ntlm-tests--password) + (ntlm-hash-from-type-3 (ntlm-server-hash + ntlm-tests--challenge + ntlm-response-blob + ;; Always -oem since + ;; `ntlm-server-hash' + ;; always converts it to + ;; Unicode. + ntlm-tests--username-oem + password))) + (ntlm-tests-message "Got NTLMv2 response:") + (ntlm-tests-message "Expected hash: ==%S==" ntlm-hash) + (ntlm-tests-message "Got hash: ==%S==" ntlm-hash-from-type-3) + (ntlm-tests-message "Expected username: ===%S===" + ntlm-tests--username-oem) + (ntlm-tests-message " or username: ===%S===" + ntlm-tests--username-unicode) + (ntlm-tests-message "Got username: ===%S===" username) + (equal ntlm-hash ntlm-hash-from-type-3))) + (t + nil)))))) + +(require 'eieio) +(require 'cl-lib) + +;; Silence some byte-compiler warnings that occur when +;; web-server/web-server.el is not found. +(declare-function ws-send nil) +(declare-function ws-parse-request nil) +(declare-function ws-start nil) +(declare-function ws-stop-all nil) + +(require 'web-server nil t) +(require 'url-http-ntlm nil t) + +(defun ntlm-server-do-token (request _process) + "Process an NTLM client's REQUEST. +PROCESS is unused." + (with-slots (process headers) request + (let* ((header-alist (cdr headers)) + (authorization-header (assoc ':AUTHORIZATION header-alist)) + (authorization-string (cdr authorization-header))) + (if (and (stringp authorization-string) + (string-match "NTLM " authorization-string)) + (let* ((challenge (substring authorization-string (match-end 0))) + (binary (base64-decode-string challenge)) + (type (aref binary 8)) + ;; Flag byte 1 flags. + (negotiate-unicode 1) + (negotiate-oem 2) + (flags-byte-1 (aref binary 12)) + (client-supports-unicode + (not (zerop (logand flags-byte-1 negotiate-unicode)))) + (client-supports-oem + (not (zerop (logand flags-byte-1 negotiate-oem)))) + (connection-header (assoc ':CONNECTION header-alist)) + (_keep-alive + (when connection-header (cdr connection-header))) + (response + (cl-case type + (1 + ;; Return Type 2 message. + (when (and (not client-supports-unicode) + (not client-supports-oem)) + (warn (concat + "Weird client supports neither Unicode" + " nor OEM strings, using OEM."))) + (setq ntlm-tests--client-supports-unicode + client-supports-unicode) + (concat + "HTTP/1.1 401 Unauthorized\r\n" + "WWW-Authenticate: NTLM " + (base64-encode-string + (ntlm-server-build-type-2) t) "\r\n" + "WWW-Authenticate: Negotiate\r\n" + "WWW-Authenticate: Basic realm=\"domain\"\r\n" + "Content-Length: 0\r\n\r\n")) + (3 + (if (ntlm-server-check-authorization + authorization-string) + "HTTP/1.1 200 OK\r\n\r\nAuthenticated.\r\n" + (progn + (if process + (set-process-filter process nil) + (error "Type 3 message found first?")) + (concat "HTTP/1.1 401 Unauthorized\r\n\r\n" + "Access Denied.\r\n"))))))) + (if response + (ws-send process response) + (when process + (set-process-filter process nil))) + (when (equal type 3) + (set-process-filter process nil) + (process-send-eof process))) + (progn + ;; Did not get NTLM anything. + (set-process-filter process nil) + (process-send-eof process) + (concat "HTTP/1.1 401 Unauthorized\r\n\r\n" + "Access Denied.\r\n")))))) + +(defun ntlm-server-filter (process string) + "Read from PROCESS a STRING and treat it as a request from an NTLM client." + (let ((request (make-instance 'ws-request + :process process :pending string))) + (if (ws-parse-request request) + (ntlm-server-do-token request process) + (error "Failed to parse request")))) + +(defun ntlm-server-handler (request) + "Handle an HTTP REQUEST." + (with-slots (process headers) request + (let* ((header-alist (cdr headers)) + (authorization-header (assoc ':AUTHORIZATION header-alist)) + (connection-header (assoc ':CONNECTION header-alist)) + (keep-alive (when connection-header (cdr connection-header))) + (response (concat + "HTTP/1.1 401 Unauthorized\r\n" + "WWW-Authenticate: Negotiate\r\n" + "WWW-Authenticate: NTLM\r\n" + "WWW-Authenticate: Basic realm=\"domain\"\r\n" + "Content-Length: 0\r\n\r\n"))) + (if (null authorization-header) + ;; Tell client to use NTLM. Firefox will create a new + ;; connection. + (progn + (process-send-string process response) + (process-send-eof process)) + (progn + (ntlm-server-do-token request nil) + (set-process-filter process #'ntlm-server-filter) + (if (equal (upcase keep-alive) "KEEP-ALIVE") + :keep-alive + (error "NTLM server expects keep-alive connection header"))))))) + +(defun ntlm-server-start () + "Start an NTLM server on port 8080 for testing." + (ws-start 'ntlm-server-handler 8080)) + +(defun ntlm-server-stop () + "Stop the NTLM server." + (ws-stop-all)) + +(defvar ntlm-tests--result-buffer nil "Final NTLM result buffer.") + +(require 'url) + +(defun ntlm-tests--url-retrieve-internal-around (original &rest arguments) + "Save the result buffer from a `url-retrieve-internal' to a global variable. +ORIGINAL is the original `url-retrieve-internal' function and +ARGUMENTS are passed to it." + (setq ntlm-tests--result-buffer (apply original arguments))) + +(defun ntlm-tests--authenticate () + "Authenticate using credentials from the authinfo resource file." + (setq ntlm-tests--result-buffer nil) + (let ((auth-sources (list (ert-resource-file "authinfo"))) + (auth-source-do-cache nil) + (auth-source-debug (when (getenv "NTLM_TESTS_VERBOSE") 'trivia))) + (ntlm-tests-message "Using auth-sources: %S" auth-sources) + (url-retrieve-synchronously "http://localhost:8080")) + (sleep-for 0.1) + (ntlm-tests-message "Results are in: %S" ntlm-tests--result-buffer) + (with-current-buffer ntlm-tests--result-buffer + (buffer-string))) + +(defun ntlm-tests--start-server-authenticate-stop-server () + "Start an NTLM server, authenticate against it, then stop the server." + (advice-add #'url-retrieve-internal + :around #'ntlm-tests--url-retrieve-internal-around) + (ntlm-server-stop) + (ntlm-server-start) + (let ((result (ntlm-tests--authenticate))) + (advice-remove #'url-retrieve-internal + #'ntlm-tests--url-retrieve-internal-around) + (ntlm-server-stop) + result)) + +(defvar ntlm-tests--successful-result + (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n") + "Expected result of successful NTLM authentication.") + +(defvar ntlm-tests--dependencies-present + (and (featurep 'url-http-ntlm) (featurep 'web-server)) + "Non-nil if GNU ELPA test dependencies were loaded.") + +(when (not ntlm-tests--dependencies-present) + (warn "Cannot find one or more GNU ELPA packages") + (when (not (featurep 'url-http-ntlm)) + (warn "Need url-http-ntlm/url-http-ntlm.el")) + (when (not (featurep 'web-server)) + (warn "Need web-server/web-server.el")) + (warn "Skipping NTLM authentication tests") + (warn "See GNU_ELPA_DIRECTORY in test/README")) + +(ert-deftest ntlm-authentication () + "Check ntlm.el's implementation of NTLM authentication over HTTP." + (skip-unless ntlm-tests--dependencies-present) + (should (equal (ntlm-tests--start-server-authenticate-stop-server) + ntlm-tests--successful-result))) + +(ert-deftest ntlm-authentication-old-compatibility-level () + (skip-unless ntlm-tests--dependencies-present) + (setq ntlm-compatibility-level 0) + (should (equal (ntlm-tests--start-server-authenticate-stop-server) + ntlm-tests--successful-result))) + (provide 'ntlm-tests) + +;;; ntlm-tests.el ends here -- cgit v1.2.3 From 7467dc4f181f2bf9adc3335afab9fb7ee909a60d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 02:27:56 +0100 Subject: Do interactive mode tagging for package.el --- lisp/emacs-lisp/package.el | 53 +++++++++++++++++++++++++++------------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 90b7b88d58a..092befa1f2e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2802,6 +2802,7 @@ either a full name or nil, and EMAIL is a valid email address." Letters do not insert themselves; instead, they are commands. \\ \\{package-menu-mode-map}" + :interactive nil (setq mode-line-process '((package--downloads-in-progress ":Loading") (package-menu--transaction-status package-menu--transaction-status))) @@ -2924,7 +2925,7 @@ Installed obsolete packages are always displayed.") Also hide packages whose name matches a regexp in user option `package-hidden-regexps' (a list). To add regexps to this list, use `package-menu-hide-package'." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (setq package-menu--hide-packages (not package-menu--hide-packages)) @@ -3261,7 +3262,7 @@ To unhide a package, type Type \\[package-menu-toggle-hiding] to toggle package hiding." (declare (interactive-only "change `package-hidden-regexps' instead.")) - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let* ((name (when (derived-mode-p 'package-menu-mode) (concat "\\`" (regexp-quote (symbol-name (package-desc-name @@ -3285,7 +3286,7 @@ Type \\[package-menu-toggle-hiding] to toggle package hiding." (defun package-menu-describe-package (&optional button) "Describe the current package. If optional arg BUTTON is non-nil, describe its associated package." - (interactive) + (interactive nil package-menu-mode) (let ((pkg-desc (if button (button-get button 'package-desc) (tabulated-list-get-id)))) (if pkg-desc @@ -3295,7 +3296,7 @@ If optional arg BUTTON is non-nil, describe its associated package." ;; fixme numeric argument (defun package-menu-mark-delete (&optional _num) "Mark a package for deletion and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("installed" "dependency" "obsolete" "unsigned")) @@ -3304,7 +3305,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-install (&optional _num) "Mark a package for installation and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency")) (tabulated-list-put-tag "I" t) @@ -3312,20 +3313,20 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-mark-unmark (&optional _num) "Clear any marks on a package and move to the next line." - (interactive "p") + (interactive "p" package-menu-mode) (package--ensure-package-menu-mode) (tabulated-list-put-tag " " t)) (defun package-menu-backup-unmark () "Back up one line and clear any marks on that package." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (forward-line -1) (tabulated-list-put-tag " ")) (defun package-menu-mark-obsolete-for-deletion () "Mark all obsolete packages for deletion." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (save-excursion (goto-char (point-min)) @@ -3356,7 +3357,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (defun package-menu-quick-help () "Show short key binding help for `package-menu-mode'. The full list of keys can be viewed with \\[describe-mode]." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (message (mapconcat #'package--prettify-quick-help-key package--quick-help-keys "\n"))) @@ -3452,7 +3453,7 @@ call will upgrade the package. If there's an async refresh operation in progress, the flags will be placed as part of `package-menu--post-refresh' instead of immediately." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (if (not package--downloads-in-progress) (package-menu--mark-upgrades-1) @@ -3546,7 +3547,7 @@ packages list, respectively." Packages marked for installation are downloaded and installed; packages marked for deletion are removed. Optional argument NOQUERY non-nil means do not ask the user to confirm." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (let (install-list delete-list cmd pkg-desc) (save-excursion @@ -3791,7 +3792,8 @@ strings. If ARCHIVE is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Filter by archive (comma separated): " - (mapcar #'car package-archives)))) + (mapcar #'car package-archives))) + package-menu-mode) (package--ensure-package-menu-mode) (let ((re (if (listp archive) (regexp-opt archive) @@ -3812,7 +3814,8 @@ DESCRIPTION. When called interactively, prompt for DESCRIPTION. If DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by description (regexp)"))) + (interactive (list (read-regexp "Filter by description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not description) (string-empty-p description)) (package-menu--generate t t) @@ -3833,10 +3836,11 @@ strings. If KEYWORD is nil or the empty string, show all packages." (interactive (list (completing-read-multiple "Keywords (comma separated): " - (package-all-keywords)))) + (package-all-keywords))) + package-menu-mode) + (package--ensure-package-menu-mode) (when (stringp keyword) (setq keyword (list keyword))) - (package--ensure-package-menu-mode) (if (not keyword) (package-menu--generate t t) (package-menu--filter-by (lambda (pkg-desc) @@ -3855,7 +3859,8 @@ When called interactively, prompt for NAME-OR-DESCRIPTION. If NAME-OR-DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name or description (regexp)"))) + (interactive (list (read-regexp "Filter by name or description (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name-or-description) (string-empty-p name-or-description)) (package-menu--generate t t) @@ -3874,7 +3879,8 @@ Display only packages with name that matches regexp NAME. When called interactively, prompt for NAME. If NAME is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name (regexp)"))) + (interactive (list (read-regexp "Filter by name (regexp)")) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not name) (string-empty-p name)) (package-menu--generate t t) @@ -3904,7 +3910,8 @@ packages." "incompat" "installed" "new" - "unsigned")))) + "unsigned"))) + package-menu-mode) (package--ensure-package-menu-mode) (if (or (not status) (string-empty-p status)) (package-menu--generate t t) @@ -3939,7 +3946,9 @@ If VERSION is nil or the empty string, show all packages." ('< "< less than") ('> "> greater than")) "): ")) - choice)))) + choice))) + package-menu-mode) + (package--ensure-package-menu-mode) (unless (equal predicate 'quit) (if (or (not version) (string-empty-p version)) (package-menu--generate t t) @@ -3957,7 +3966,7 @@ If VERSION is nil or the empty string, show all packages." (defun package-menu-filter-marked () "Filter \"*Packages*\" buffer by non-empty upgrade mark. Unlike other filters, this leaves the marks intact." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (widen) (let (found-entries mark pkg-id entry marks) @@ -3985,7 +3994,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-filter-upgradable () "Filter \"*Packages*\" buffer to show only upgradable packages." - (interactive) + (interactive nil package-menu-mode) (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) (package-menu--filter-by (lambda (pkg) @@ -3994,7 +4003,7 @@ Unlike other filters, this leaves the marks intact." (defun package-menu-clear-filter () "Clear any filter currently applied to the \"*Packages*\" buffer." - (interactive) + (interactive nil package-menu-mode) (package--ensure-package-menu-mode) (package-menu--generate t t)) -- cgit v1.2.3 From 388a87432b5e95544d6d74252ea531e64d6495a5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:29:00 +0100 Subject: Do interactive mode tagging for man.el --- lisp/man.el | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lisp/man.el b/lisp/man.el index 1fded38e72d..70b8aa8eb2f 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual pages." ;;;###autoload (defun man-follow (man-args) "Get a Un*x manual page of the item under point and put it in a buffer." - (interactive (list (Man-default-man-entry))) + (interactive (list (Man-default-man-entry)) Man-mode) (if (or (not man-args) (string= man-args "")) (error "No item under point") @@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear." (defun Man-update-manpage () "Reformat current manpage by calling the man command again synchronously." - (interactive) + (interactive nil Man-mode) (when (eq Man-arguments nil) ;;this shouldn't happen unless it is not in a Man buffer." (error "Man-arguments not initialized")) @@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different notification behaviors." (defun Man-fontify-manpage () "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." - (interactive) + (interactive nil Man-mode) (goto-char (point-min)) ;; Fontify ANSI escapes. (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face) @@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the buttons." Normally skip any jobs that should have been done by the sed script, but when called interactively, do those jobs even if the sed script would have done them." - (interactive "p") + (interactive "p" Man-mode) (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) @@ -1723,7 +1723,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-next-section (n) "Move point to Nth next section (default 1)." - (interactive "p") + (interactive "p" Man-mode) (let ((case-fold-search nil) (start (point))) (if (looking-at Man-heading-regexp) @@ -1739,7 +1739,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-previous-section (n) "Move point to Nth previous section (default 1)." - (interactive "p") + (interactive "p" Man-mode) (let ((case-fold-search nil)) (if (looking-at Man-heading-regexp) (forward-line -1)) @@ -1756,8 +1756,7 @@ Returns t if section is found, nil otherwise." (if (re-search-forward (concat "^" section) (point-max) t) (progn (beginning-of-line) t) (goto-char curpos) - nil) - )) + nil))) (defvar Man--last-section nil) @@ -1771,7 +1770,8 @@ Returns t if section is found, nil otherwise." (prompt (concat "Go to section (default " default "): ")) (chosen (completing-read prompt Man--sections nil nil nil nil default))) - (list chosen))) + (list chosen)) + Man-mode) (setq Man--last-section section) (unless (Man-find-section section) (error "Section %s not found" section))) @@ -1780,7 +1780,7 @@ Returns t if section is found, nil otherwise." (defun Man-goto-see-also-section () "Move point to the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." - (interactive) + (interactive nil Man-mode) (if (not (Man-find-section Man-see-also-regexp)) (error "%s" (concat "No " Man-see-also-regexp " section found in the current manpage")))) @@ -1834,7 +1834,8 @@ Specify which REFERENCE to use; default is based on word at point." (prompt (concat "Refer to (default " default "): ")) (chosen (completing-read prompt Man--refpages nil nil nil nil defaults))) - chosen)))) + chosen))) + Man-mode) (if (not Man--refpages) (error "Can't find any references in the current manpage") (setq Man--last-refpage reference) @@ -1843,7 +1844,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-kill () "Kill the buffer containing the manpage." - (interactive) + (interactive nil Man-mode) (quit-window t)) (defun Man-goto-page (page &optional noerror) @@ -1854,7 +1855,8 @@ Specify which REFERENCE to use; default is based on word at point." (if (= (length Man-page-list) 1) (error "You're looking at the only manpage in the buffer") (list (read-minibuffer (format "Go to manpage [1-%d]: " - (length Man-page-list))))))) + (length Man-page-list)))))) + Man-mode) (if (and (not Man-page-list) (not noerror)) (error "Not a man page buffer")) (when Man-page-list @@ -1876,7 +1878,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-next-manpage () "Find the next manpage entry in the buffer." - (interactive) + (interactive nil Man-mode) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (< Man-current-page (length Man-page-list)) @@ -1887,7 +1889,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-previous-manpage () "Find the previous manpage entry in the buffer." - (interactive) + (interactive nil Man-mode) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (> Man-current-page 1) -- cgit v1.2.3 From 928b643a28919e927af3aba8f8b420e098eb45c4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:32:04 +0100 Subject: Do interactive mode tagging for tetris.el --- lisp/play/tetris.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index 05e4ffe0111..f43aa47326f 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -506,7 +506,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-bottom () "Drop the shape to the bottom of the playing area." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (let ((hit nil)) (tetris-erase-shape) @@ -519,7 +519,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-left () "Move the shape one square to the left." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1- tetris-pos-x)) @@ -529,7 +529,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-right () "Move the shape one square to the right." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-x (1+ tetris-pos-x)) @@ -539,7 +539,7 @@ Drops the shape one square, testing for collision." (defun tetris-move-down () "Move the shape one square to the bottom." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-pos-y (1+ tetris-pos-y)) @@ -549,7 +549,7 @@ Drops the shape one square, testing for collision." (defun tetris-rotate-prev () "Rotate the shape clockwise." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-rot (% (+ 1 tetris-rot) @@ -561,7 +561,7 @@ Drops the shape one square, testing for collision." (defun tetris-rotate-next () "Rotate the shape anticlockwise." - (interactive) + (interactive nil tetris-mode) (unless tetris-paused (tetris-erase-shape) (setq tetris-rot (% (+ 3 tetris-rot) @@ -573,14 +573,14 @@ Drops the shape one square, testing for collision." (defun tetris-end-game () "Terminate the current game." - (interactive) + (interactive nil tetris-mode) (gamegrid-kill-timer) (use-local-map tetris-null-map) (gamegrid-add-score tetris-score-file tetris-score)) (defun tetris-start-game () "Start a new game of Tetris." - (interactive) + (interactive nil tetris-mode) (tetris-reset-game) (use-local-map tetris-mode-map) (let ((period (or (tetris-get-tick-period) @@ -589,7 +589,7 @@ Drops the shape one square, testing for collision." (defun tetris-pause-game () "Pause (or resume) the current game." - (interactive) + (interactive nil tetris-mode) (setq tetris-paused (not tetris-paused)) (message (and tetris-paused "Game paused (press p to resume)"))) @@ -600,6 +600,7 @@ Drops the shape one square, testing for collision." (define-derived-mode tetris-mode nil "Tetris" "A mode for playing Tetris." + :interactive nil (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) -- cgit v1.2.3 From 73a6ab0a1b5c0f9620b439e13998a08f8214a334 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 06:51:49 +0100 Subject: Do interactive mode tagging for snake.el --- lisp/play/snake.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/play/snake.el b/lisp/play/snake.el index bed7cea6ee5..29effa23460 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -336,38 +336,38 @@ Argument SNAKE-BUFFER is the name of the buffer." (defun snake-move-left () "Make the snake move left." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-x-velocity)) (push '(-1 0) snake-velocity-queue))) (defun snake-move-right () "Make the snake move right." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-x-velocity)) (push '(1 0) snake-velocity-queue))) (defun snake-move-up () "Make the snake move up." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-y-velocity)) (push '(0 -1) snake-velocity-queue))) (defun snake-move-down () "Make the snake move down." - (interactive) + (interactive nil snake-mode) (when (zerop (snake-final-y-velocity)) (push '(0 1) snake-velocity-queue))) (defun snake-end-game () "Terminate the current game." - (interactive) + (interactive nil snake-mode) (gamegrid-kill-timer) (use-local-map snake-null-map) (gamegrid-add-score snake-score-file snake-score)) (defun snake-start-game () "Start a new game of Snake." - (interactive) + (interactive nil snake-mode) (snake-reset-game) (snake-set-dot) (use-local-map snake-mode-map) @@ -375,7 +375,7 @@ Argument SNAKE-BUFFER is the name of the buffer." (defun snake-pause-game () "Pause (or resume) the current game." - (interactive) + (interactive nil snake-mode) (setq snake-paused (not snake-paused)) (message (and snake-paused "Game paused (press p to resume)"))) @@ -386,6 +386,7 @@ Argument SNAKE-BUFFER is the name of the buffer." (define-derived-mode snake-mode special-mode "Snake" "A mode for playing Snake." + :interactive nil (add-hook 'kill-buffer-hook 'gamegrid-kill-timer nil t) -- cgit v1.2.3 From 3c7b839e1a2bd8c896892c61f75a9016f52e787b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Feb 2021 09:21:55 +0100 Subject: Fix Tramp bug#46625 * test/lisp/net/tramp-tests.el (tramp-test33-environment-variables): Adapt test. (Bug#46625) --- test/lisp/net/tramp-tests.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 9a83fa66761..016b4d3c8f0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5102,8 +5102,10 @@ INPUT, if non-nil, is a string sent to the process." (string-match-p (regexp-quote envvar) ;; We must remove PS1, the output is truncated otherwise. + ;; We must suppress "_=VAR...". (funcall - this-shell-command-to-string "printenv | grep -v PS1"))))))))) + this-shell-command-to-string + "printenv | grep -v PS1 | grep -v _="))))))))) (tramp--test--deftest-direct-async-process tramp-test33-environment-variables "Check that remote processes set / unset environment variables properly. -- cgit v1.2.3 From 87669400aff6ecdf670de6368168c5833848d56f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 08:30:04 +0100 Subject: ; * lisp/plstore.el: Fix formatting. --- lisp/plstore.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/plstore.el b/lisp/plstore.el index 46533664d52..4ca5886bf15 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -1,4 +1,5 @@ ;;; plstore.el --- secure plist store -*- lexical-binding: t -*- + ;; Copyright (C) 2011-2021 Free Software Foundation, Inc. ;; Author: Daiki Ueno @@ -19,7 +20,7 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Commentary +;;; Commentary: ;; Plist based data store providing search and partial encryption. ;; -- cgit v1.2.3 From 9b944f48c9ce65bad50e7c6a957200c0f2d4f1a8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 08:38:29 +0100 Subject: * lisp/calculator.el: Minor doc fix. Remove redundant :group args. --- lisp/calculator.el | 62 ++++++++++++++++++------------------------------------ 1 file changed, 20 insertions(+), 42 deletions(-) diff --git a/lisp/calculator.el b/lisp/calculator.el index b4c00753e91..00883989b29 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -20,23 +20,18 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;;===================================================================== ;;; Commentary: -;; + ;; A calculator for Emacs. ;; Why should you reach for your mouse to get xcalc (calc.exe, gcalc or ;; whatever), when you have Emacs running already? ;; -;; If this is not part of your Emacs distribution, then simply bind -;; `calculator' to a key and make it an autoloaded function, e.g.: -;; (autoload 'calculator "calculator" -;; "Run the Emacs calculator." t) +;; You can bind this to a key by adding this to your Init file: +;; ;; (global-set-key [(control return)] 'calculator) ;; ;; Written by Eli Barzilay, eli@barzilay.org -;; -;;;===================================================================== ;;; Customization: (defgroup calculator nil @@ -50,19 +45,16 @@ "Run `calculator' electrically, in the echo area. Electric mode saves some place but changes the way you interact with the calculator." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-use-menu t "Make `calculator' create a menu. Note that this requires easymenu. Must be set before loading." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-bind-escape nil "If non-nil, set escape to exit the calculator." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-unary-style 'postfix "Value is either `prefix' or `postfix'. @@ -75,44 +67,38 @@ This determines the default behavior of unary operators." It should contain a \"%s\" somewhere that will indicate the i/o radixes; this will be a two-character string as described in the documentation for `calculator-mode'." - :type 'string - :group 'calculator) + :type 'string) (defcustom calculator-number-digits 3 "The calculator's number of digits used for standard display. Used by the `calculator-standard-display' function - it will use the format string \"%.NC\" where this number is N and C is a character given at runtime." - :type 'integer - :group 'calculator) + :type 'integer) (defcustom calculator-radix-grouping-mode t "Use digit grouping in radix output mode. If this is set, chunks of `calculator-radix-grouping-digits' characters will be separated by `calculator-radix-grouping-separator' when in radix output mode is active (determined by `calculator-output-radix')." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-radix-grouping-digits 4 "The number of digits used for grouping display in radix modes. See `calculator-radix-grouping-mode'." - :type 'integer - :group 'calculator) + :type 'integer) (defcustom calculator-radix-grouping-separator "'" "The separator used in radix grouping display. See `calculator-radix-grouping-mode'." - :type 'string - :group 'calculator) + :type 'string) (defcustom calculator-remove-zeros t "Non-nil value means delete all redundant zero decimal digits. If this value is not t and not nil, redundant zeros are removed except for one. Used by the `calculator-remove-zeros' function." - :type '(choice (const t) (const leave-decimal) (const nil)) - :group 'calculator) + :type '(choice (const t) (const leave-decimal) (const nil))) (defcustom calculator-displayer '(std ?n) "A displayer specification for numerical values. @@ -135,8 +121,7 @@ a character and G is an optional boolean, in this case the arguments." :type '(choice (function) (string) (sexp) (list (const std) character) - (list (const std) character boolean)) - :group 'calculator) + (list (const std) character boolean))) (defcustom calculator-displayers '(((std ?n) "Standard display, decimal point or scientific") @@ -152,15 +137,13 @@ specification is the same as the values that can be stored in `calculator-displayer'. `calculator-rotate-displayer' rotates this list." - :type 'sexp - :group 'calculator) + :type 'sexp) (defcustom calculator-paste-decimals t "If non-nil, convert pasted integers so they have a decimal point. This makes it possible to paste big integers since they will be read as floats, otherwise the Emacs reader will fail on them." - :type 'boolean - :group 'calculator) + :type 'boolean) (make-obsolete-variable 'calculator-paste-decimals "it is no longer used." "26.1") @@ -169,14 +152,12 @@ floats, otherwise the Emacs reader will fail on them." `calculator-displayer', to format a string before copying it with `calculator-copy'. If nil, then `calculator-displayer's normal value is used." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-2s-complement nil "If non-nil, show negative numbers in 2s complement in radix modes. Otherwise show as a negative number." - :type 'boolean - :group 'calculator) + :type 'boolean) (defcustom calculator-mode-hook nil "List of hook functions for `calculator-mode' to run. @@ -184,8 +165,7 @@ Note: if `calculator-electric-mode' is on, then this hook will get activated in the minibuffer -- in that case it should not do much more than local key settings and other effects that will change things outside the scope of calculator related code." - :type 'hook - :group 'calculator) + :type 'hook) (defcustom calculator-user-registers nil "An association list of user-defined register bindings. @@ -200,8 +180,7 @@ before you load calculator." (when (boundp 'calculator-registers) (setq calculator-registers (append val calculator-registers))) - (setq calculator-user-registers val)) - :group 'calculator) + (setq calculator-user-registers val))) (defcustom calculator-user-operators nil "A list of additional operators. @@ -234,8 +213,7 @@ Examples: Note that this will be either postfix or prefix, according to `calculator-unary-style'." - :type '(repeat (list string symbol sexp integer integer)) - :group 'calculator) + :type '(repeat (list string symbol sexp integer integer))) ;;;===================================================================== ;;; Code: -- cgit v1.2.3 From a9b49dc31159283c962da61a259254b512e63ace Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 19 Feb 2021 10:03:20 +0100 Subject: ; Fix indentation in test/README --- test/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/README b/test/README index 877f77ab947..1e0e43a8aca 100644 --- a/test/README +++ b/test/README @@ -106,7 +106,7 @@ tramp-tests.el). Per default, a mock-up connection method is used to test a real remote connection, set $REMOTE_TEMPORARY_FILE_DIRECTORY to a suitable value in order to overwrite the default value: - env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... + env REMOTE_TEMPORARY_FILE_DIRECTORY=/ssh:host:/tmp make ... Some optional tests require packages from GNU ELPA. By default ../../elpa will be checked for these packages. If GNU ELPA is checked -- cgit v1.2.3 From dcb2015a5b644dafd61580c791f1f6625f5858e4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 10:21:14 +0100 Subject: Mention the GNU Kind Communications Guidelines in the FAQ * doc/misc/efaq.texi (Guidelines for newsgroup postings): Mention the GNU Kind Communications Guidelines. --- doc/misc/efaq.texi | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index fdfde96a991..c0536e0e3a2 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -388,6 +388,11 @@ posting a followup that recommends such software. @uref{news:gnu.emacs.bug} is a place where bug reports appear, but avoid posting bug reports to this newsgroup directly (@pxref{Reporting bugs}). +Finally, we recommend reading the +@url{https://www.gnu.org/philosophy/kind-communication.html, GNU Kind +Communications Guidelines} before posting to any GNU lists or +newsgroups. + @node Newsgroup archives @section Where can I get old postings to @uref{news:gnu.emacs.help} and other GNU groups? @cindex Archived postings from @code{gnu.emacs.help} -- cgit v1.2.3 From d4f6927d48043d01929a93da53a64b1e4296f994 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Fri, 19 Feb 2021 13:44:25 +0100 Subject: Fix regexp mistakes * lisp/progmodes/cperl-mode.el (cperl--package-regexp): Avoid double repetition; cperl--ws-or-comment-regexp is already repeated with 1+. * test/lisp/textmodes/dns-mode-tests.el (dns-mode-tests-dns-mode-soa-increment-serial): Escape literal '$'. * test/lisp/emacs-lisp/rx-tests.el (rx-regexp): Modify test to not trigger a linting warning while retaining its testing power. --- lisp/progmodes/cperl-mode.el | 2 +- test/lisp/emacs-lisp/rx-tests.el | 4 ++-- test/lisp/textmodes/dns-mode-tests.el | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d01bd3a48ef..db142c0dc3e 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1305,7 +1305,7 @@ is a legal variable name).") (group (regexp ,cperl--normal-identifier-regexp)) (opt (sequence - (1+ (regexp ,cperl--ws-or-comment-regexp)) + (regexp ,cperl--ws-or-comment-regexp) (group (regexp ,cperl--version-regexp)))))) "A regular expression for package NAME VERSION in Perl. Contains two groups for the package name and version.") diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 388c5e86b4c..12bf4f7978e 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -388,11 +388,11 @@ (ert-deftest rx-regexp () (should (equal (rx (regexp "abc") (regex "[de]")) "\\(?:abc\\)[de]")) + (should (equal (rx "a" (regexp "$")) + "a\\(?:$\\)")) (let ((x "a*")) (should (equal (rx (regexp x) "b") "\\(?:a*\\)b")) - (should (equal (rx "a" (regexp "*")) - "a\\(?:*\\)")) (should (equal (rx "" (regexp x) (eval "")) "a*")))) diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el index 92b6cc9177c..8bc48732c62 100644 --- a/test/lisp/textmodes/dns-mode-tests.el +++ b/test/lisp/textmodes/dns-mode-tests.el @@ -37,7 +37,7 @@ (dns-mode-soa-increment-serial) ;; Number is updated from 2015080302 to the current date ;; (actually, just ensure the year part is later than 2020). - (should (string-match "$TTL 86400 + (should (string-match "\\$TTL 86400 @ IN SOA ns.icann.org. noc.dns.icann.org. ( 20[2-9][0-9]+ ;Serial 7200 ;Refresh -- cgit v1.2.3 From 8e8b46ef818a5f94a9697dce1c49c6869d61deed Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 19 Feb 2021 15:16:31 +0200 Subject: More accurate documentation of the "r" interactive spec * doc/lispref/commands.texi (Interactive Codes): Describe the effect of 'mark-even-if-inactive'. --- doc/lispref/commands.texi | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 5385c03790d..7569ca6e691 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -488,7 +488,10 @@ I/O. Point and the mark, as two numeric arguments, smallest first. This is the only code letter that specifies two successive arguments rather than one. This will signal an error if the mark is not set in the buffer -which is current when the command is invoked. No I/O. +which is current when the command is invoked. If Transient Mark mode +is turned on (@pxref{The Mark}) --- as it is by default --- and user +option @code{mark-even-if-inactive} is @code{nil}, Emacs will signal +an error even if the mark @emph{is} set, but is inactive. No I/O. @item s Arbitrary text, read in the minibuffer and returned as a string -- cgit v1.2.3 From 6830199984b9964286fda8e4c904ce84aa68e514 Mon Sep 17 00:00:00 2001 From: Ulf Jasper Date: Fri, 19 Feb 2021 17:07:36 +0100 Subject: Enable newsticker--group-shift-feed-(up|down) to move groups as well Fix broken newsticker--group-shift-group-(up-down). * lisp/net/newst-treeview.el (newsticker-treeview-jump): Change prompt string. (newsticker--group-shift): Move the group when a group is currently selected. Fix error when explicitly shifting a group. (Fixes first issue in Bug#41376.) --- lisp/net/newst-treeview.el | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index cf55f66e780..a2d4d89ee55 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -1626,7 +1626,7 @@ Return t if a new feed was activated, nil otherwise." (interactive (list (let ((completion-ignore-case t)) (completing-read - "Jump to feed: " + "Jump to feed/group: " (append '("new" "obsolete" "immortal" "all") (mapcar #'car (append newsticker-url-list newsticker-url-list-defaults))) @@ -1852,28 +1852,34 @@ of the shift. If MOVE-GROUP is nil the currently selected feed `newsticker--treeview-current-feed' is shifted, if it is t then the current feed's parent group is shifted.." (let* ((cur-feed newsticker--treeview-current-feed) - (thing (if move-group - (newsticker--group-find-parent-group cur-feed) + (thing (if (and move-group + (not (newsticker--group-get-group cur-feed))) + (car (newsticker--group-find-parent-group cur-feed)) cur-feed)) (parent-group (newsticker--group-find-parent-group - (if move-group (car thing) thing)))) + ;;(if move-group (car thing) thing) + thing))) (unless parent-group (error "Group not found!")) (let* ((siblings (cdr parent-group)) - (pos (cl-position thing siblings :test 'equal)) + (pos (cl-position thing siblings :test + (lambda (o1 o2) + (equal (if (listp o1) (car o1) o1) + (if (listp o2) (car o2) o2))))) (tpos (+ pos delta )) (new-pos (max 0 (min (length siblings) tpos))) (beg (cl-subseq siblings 0 (min pos new-pos))) (end (cl-subseq siblings (+ 1 (max pos new-pos)))) (p (elt siblings new-pos))) (when (not (= pos new-pos)) - (setcdr parent-group - (cl-concatenate 'list - beg - (if (> delta 0) - (list p thing) - (list thing p)) - end)) + (let ((th (or (newsticker--group-get-group thing) thing))) + (setcdr parent-group + (cl-concatenate 'list + beg + (if (> delta 0) + (list p th) + (list th p)) + end))) (newsticker--treeview-tree-update) (newsticker-treeview-update) (newsticker-treeview-jump cur-feed))))) -- cgit v1.2.3 From 9b7eed33f94a65c4a9d1353aa052114415fc6381 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Feb 2021 12:08:00 -0500 Subject: * test/lisp/emacs-lisp/edebug-tests.el: Adjust to new `edebug-eval-defun`. (edebug-tests-trivial-backquote): Adjust to the way `eval-defun` outputs its result. (edebug-tests-cl-macrolet): Adjust to the fact that now macro expansion takes place during the `eval-defun` even when Edebugging. --- test/lisp/emacs-lisp/edebug-tests.el | 34 ++++++++++++++++++------------- test/src/keyboard-tests.el | 39 ++++++++++++++++++++++++++++-------- 2 files changed, 51 insertions(+), 22 deletions(-) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index daac43372ac..dcb261c2eb9 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -219,16 +219,16 @@ index." (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq saved-local-map overriding-local-map) (setq overriding-local-map edebug-tests-keymap) - (add-hook 'post-command-hook 'edebug-tests-post-command)) + (add-hook 'post-command-hook #'edebug-tests-post-command)) (advice-add 'exit-recursive-edit - :around 'edebug-tests-preserve-keyboard-macro-state) + :around #'edebug-tests-preserve-keyboard-macro-state) (unwind-protect (kmacro-call-macro nil nil nil kbdmac) (advice-remove 'exit-recursive-edit - 'edebug-tests-preserve-keyboard-macro-state) + #'edebug-tests-preserve-keyboard-macro-state) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (setq overriding-local-map saved-local-map) - (remove-hook 'post-command-hook 'edebug-tests-post-command))))) + (remove-hook 'post-command-hook #'edebug-tests-post-command))))) (defun edebug-tests-preserve-keyboard-macro-state (orig &rest args) "Call ORIG with ARGS preserving the value of `executing-kbd-macro'. @@ -857,12 +857,14 @@ test and possibly others should be updated." (ert-deftest edebug-tests-trivial-backquote () "Edebug can instrument a trivial backquote expression (Bug#23651)." (edebug-tests-with-normal-env - (read-only-mode -1) - (delete-region (point-min) (point-max)) - (insert "`1") - (read-only-mode) + (let ((inhibit-read-only t)) + (delete-region (point-min) (point-max)) + (insert "`1")) (edebug-eval-defun nil) - (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)") + ;; `eval-defun' outputs its message to the echo area in a rather + ;; funny way, so the "1" and the " (#o1, #x1, ?\C-a)" end up placed + ;; there in separate pieces (via `print' rather than via `message'). + (should (string-match-p (regexp-quote " (#o1, #x1, ?\\C-a)") edebug-tests-messages)) (setq edebug-tests-messages "") @@ -912,13 +914,17 @@ test and possibly others should be updated." (ert-deftest edebug-tests-cl-macrolet () "Edebug can instrument `cl-macrolet' expressions. (Bug#29919)" (edebug-tests-with-normal-env - (edebug-tests-setup-@ "use-cl-macrolet" '(10) t) + (edebug-tests-locate-def "use-cl-macrolet") (edebug-tests-run-kbd-macro - "@ SPC SPC" + "C-u C-M-x SPC" (edebug-tests-should-be-at "use-cl-macrolet" "func") - (edebug-tests-should-match-result-in-messages "+") - "g" - (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11"))))) + (edebug-tests-should-match-result-in-messages "+")) + (let ((edebug-initial-mode 'Go-nonstop)) + (edebug-tests-setup-@ "use-cl-macrolet" '(10) t)) + (edebug-tests-run-kbd-macro + "@ SPC g" + (should (equal edebug-tests-@-result "The result of applying + to (1 x) is 11")) + ))) (ert-deftest edebug-tests-backtrace-goto-source () "Edebug can jump to instrumented source from its *Edebug-Backtrace* buffer." diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el index 607d2eafd45..41c8cdd15f0 100644 --- a/test/src/keyboard-tests.el +++ b/test/src/keyboard-tests.el @@ -23,14 +23,15 @@ (ert-deftest keyboard-unread-command-events () "Test `unread-command-events'." - (should (equal (progn (push ?\C-a unread-command-events) - (read-event nil nil 1)) - ?\C-a)) - (should (equal (progn (run-with-timer - 1 nil - (lambda () (push '(t . ?\C-b) unread-command-events))) - (read-event nil nil 2)) - ?\C-b))) + (let ((unread-command-events nil)) + (should (equal (progn (push ?\C-a unread-command-events) + (read-event nil nil 1)) + ?\C-a)) + (should (equal (progn (run-with-timer + 1 nil + (lambda () (push '(t . ?\C-b) unread-command-events))) + (read-event nil nil 2)) + ?\C-b)))) (ert-deftest keyboard-lossage-size () "Test `lossage-size'." @@ -46,6 +47,28 @@ (should-error (lossage-size (1- min-value))) (should (= lossage-orig (lossage-size lossage-orig))))) +;; FIXME: This test doesn't currently work :-( +;; (ert-deftest keyboard-tests--echo-keystrokes-bug15332 () +;; (let ((msgs '()) +;; (unread-command-events nil) +;; (redisplay--interactive t) +;; (echo-keystrokes 2)) +;; (setq unread-command-events '(?\C-u)) +;; (let* ((timer1 +;; (run-with-timer 3 1 +;; (lambda () +;; (setq unread-command-events '(?5))))) +;; (timer2 +;; (run-with-timer 2.5 1 +;; (lambda () +;; (push (current-message) msgs))))) +;; (run-with-timer 5 nil +;; (lambda () +;; (cancel-timer timer1) +;; (cancel-timer timer2) +;; (throw 'exit msgs))) +;; (recursive-edit) +;; (should (equal msgs '("C-u 55-" "C-u 5-" "C-u-")))))) (provide 'keyboard-tests) ;;; keyboard-tests.el ends here -- cgit v1.2.3 From b6eccad06c89eea878c1464571255fe8ce5c6d86 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 19 Feb 2021 12:51:36 -0500 Subject: * lisp/emacs-lisp/bytecomp.el: Don't warn for repeated _ args (byte-compile-check-lambda-list): Skip warnings of repeated arg for those that are declared as unused anyway. --- lisp/emacs-lisp/bytecomp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9d80afd774f..1b0906b50bb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2859,7 +2859,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((eq arg '&optional) (when (memq '&optional (cdr list)) (error "Duplicate &optional"))) - ((memq arg vars) + ((and (memq arg vars) + ;; Allow repetitions for unused args. + (not (string-match "\\`_" (symbol-name arg)))) (byte-compile-warn "repeated variable %s in lambda-list" arg)) (t (push arg vars)))) -- cgit v1.2.3 From 283f98353fe3549ac8f66a3ab8fba85d93c81a88 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Fri, 19 Feb 2021 19:25:39 +0000 Subject: Fix frame contents scaling bug on macOS (bug#46155) Discussion in bug#46406. * src/nsterm.m ([EmacsView focusOnDrawingBuffer:]): Set the scale factor for the backing layer. --- src/nsterm.m | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/nsterm.m b/src/nsterm.m index b0cf5952fd5..6551694abee 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -8377,6 +8377,11 @@ not_in_argv (NSString *arg) surface = [[EmacsSurface alloc] initWithSize:s ColorSpace:[[[self window] colorSpace] CGColorSpace]]; + + /* Since we're using NSViewLayerContentsRedrawOnSetNeedsDisplay + the layer's scale factor is not set automatically, so do it + now. */ + [[self layer] setContentsScale:[[self window] backingScaleFactor]]; } CGContextRef context = [surface getContext]; -- cgit v1.2.3 From ade9c22c0497f50e492a8fe8c0356c0c28e313b3 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:07:52 -0500 Subject: ntlm-tests: Skip tests if dependencies are too old * test/lisp/net/ntlm-tests.el (ntlm-tests--dependencies-present): Add version and functionality checks. Co-authored-by: Michael Albinus --- test/lisp/net/ntlm-tests.el | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index 0ed430afe68..c31ab83226c 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -382,8 +382,25 @@ ARGUMENTS are passed to it." (concat "HTTP/1.1 200 OK\n\nAuthenticated." (unibyte-string 13) "\n") "Expected result of successful NTLM authentication.") +(require 'find-func) +(defun ntlm-tests--ensure-ws-parse-ntlm-support () + "Ensure NTLM special-case in `ws-parse'." + (let* ((hit (find-function-search-for-symbol + 'ws-parse nil (locate-file "web-server.el" load-path))) + (buffer (car hit)) + (position (cdr hit))) + (with-current-buffer buffer + (goto-char position) + (search-forward-regexp + ":NTLM" (save-excursion (forward-sexp) (point)) t)))) + +(require 'lisp-mnt) (defvar ntlm-tests--dependencies-present - (and (featurep 'url-http-ntlm) (featurep 'web-server)) + (and (featurep 'url-http-ntlm) + (version<= "2.0.4" + (lm-version (locate-file "url-http-ntlm.el" load-path))) + (featurep 'web-server) + (ntlm-tests--ensure-ws-parse-ntlm-support)) "Non-nil if GNU ELPA test dependencies were loaded.") (when (not ntlm-tests--dependencies-present) -- cgit v1.2.3 From 7366859fe0e185155cbe426903c6081ec1723be1 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:11:16 -0500 Subject: ntlm-tests: Remove missing dependency warnings * test/lisp/net/ntlm-tests.el: Remove warnings about dependencies not being present. --- test/lisp/net/ntlm-tests.el | 9 --------- 1 file changed, 9 deletions(-) diff --git a/test/lisp/net/ntlm-tests.el b/test/lisp/net/ntlm-tests.el index c31ab83226c..2420b3b48a9 100644 --- a/test/lisp/net/ntlm-tests.el +++ b/test/lisp/net/ntlm-tests.el @@ -403,15 +403,6 @@ ARGUMENTS are passed to it." (ntlm-tests--ensure-ws-parse-ntlm-support)) "Non-nil if GNU ELPA test dependencies were loaded.") -(when (not ntlm-tests--dependencies-present) - (warn "Cannot find one or more GNU ELPA packages") - (when (not (featurep 'url-http-ntlm)) - (warn "Need url-http-ntlm/url-http-ntlm.el")) - (when (not (featurep 'web-server)) - (warn "Need web-server/web-server.el")) - (warn "Skipping NTLM authentication tests") - (warn "See GNU_ELPA_DIRECTORY in test/README")) - (ert-deftest ntlm-authentication () "Check ntlm.el's implementation of NTLM authentication over HTTP." (skip-unless ntlm-tests--dependencies-present) -- cgit v1.2.3 From 5f539581a461ebdfec107bc2648a399bac888c49 Mon Sep 17 00:00:00 2001 From: Thomas Fitzsimmons Date: Fri, 19 Feb 2021 17:32:59 -0500 Subject: * lisp/url/url-http.el (url-http): Fix docstring typo. --- lisp/url/url-http.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 8cebd4e79f6..e3c178630ae 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1292,7 +1292,7 @@ passing it an updated value of CBARGS as arguments. The first element in CBARGS should be a plist describing what has happened so far during the request, as described in the docstring of `url-retrieve' (if in doubt, specify nil). The current buffer -then CALLBACK is executed is the retrieval buffer. +when CALLBACK is executed is the retrieval buffer. Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a previous `url-http' call, which is being re-attempted. -- cgit v1.2.3 From b612f1a41f3f0282da6bbe1f7864d93ec9ac8007 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 04:21:35 +0100 Subject: * lisp/woman.el: Doc fix; remove redundant setup info. --- lisp/woman.el | 18 +++--------------- 1 file changed, 3 insertions(+), 15 deletions(-) diff --git a/lisp/woman.el b/lisp/woman.el index 9a03d30bb7f..98f1a47d24c 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -69,13 +69,7 @@ ;; Recommended use ;; =============== -;; Put this in your .emacs: -;; (autoload 'woman "woman" -;; "Decode and browse a UN*X man page." t) -;; (autoload 'woman-find-file "woman" -;; "Find, decode and browse a specific UN*X man-page file." t) - -;; Then either (1 -- *RECOMMENDED*): If the `MANPATH' environment +;; Either (1 -- *RECOMMENDED*): If the `MANPATH' environment ;; variable is set then WoMan will use it; otherwise you may need to ;; reset the Lisp variable `woman-manpath', and you may also want to ;; set the Lisp variable `woman-path'. Please see the online @@ -139,14 +133,8 @@ ;; ============================== ;; WoMan supports the GNU Emacs customization facility, and puts -;; a customization group called `WoMan' in the `Help' group under the -;; top-level `Emacs' group. In order to be able to customize WoMan -;; without first loading it, add the following sexp to your .emacs: - -;; (defgroup woman nil -;; "Browse UNIX manual pages `wo (without) man'." -;; :tag "WoMan" :group 'help :load "woman") - +;; a customization group called `woman' in the `help' group under the +;; top-level `emacs' group. ;; WoMan currently runs two hooks: `woman-pre-format-hook' immediately ;; before formatting a buffer and `woman-post-format-hook' immediately -- cgit v1.2.3 From c85c8e7d42ae2a5fc95fa7b14257389d8383b34d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 05:55:33 +0100 Subject: Add toolbar for help-mode * lisp/help-mode.el (help-mode): Add toolbar. (help-mode-tool-bar-map): New variable. (help-mode-menu): Disable forward/backward items when stack is empty. (help-bookmark-make-record, help-bookmark-jump): Minor doc fixes. --- lisp/help-mode.el | 28 +++++++++++++++++++++++----- 1 file changed, 23 insertions(+), 5 deletions(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 79710a18073..30a1ce053c1 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -54,14 +54,30 @@ ["Show Help for Symbol" help-follow-symbol :help "Show the docs for the symbol at point"] ["Previous Topic" help-go-back - :help "Go back to previous topic in this help buffer"] + :help "Go back to previous topic in this help buffer" + :active help-xref-stack] ["Next Topic" help-go-forward - :help "Go back to next topic in this help buffer"] + :help "Go back to next topic in this help buffer" + :active help-xref-forward-stack] ["Move to Previous Button" backward-button :help "Move to the Previous Button in the help buffer"] ["Move to Next Button" forward-button :help "Move to the Next Button in the help buffer"])) +(defvar help-mode-tool-bar-map + (let ((map (make-sparse-keymap))) + (tool-bar-local-item "close" 'quit-window 'quit map + :label "Quit help." + :vert-only t) + (define-key-after map [separator-1] menu-bar-separator) + (tool-bar-local-item "search" 'isearch-forward 'search map + :label "Search" :vert-only t) + (tool-bar-local-item-from-menu 'help-go-back "left-arrow" map help-mode-map + :rtl "right-arrow" :vert-only t) + (tool-bar-local-item-from-menu 'help-go-forward "right-arrow" map help-mode-map + :rtl "left-arrow" :vert-only t) + map)) + (defvar-local help-xref-stack nil "A stack of ways by which to return to help buffers after following xrefs. Used by `help-follow' and `help-xref-go-back'. @@ -317,6 +333,8 @@ Commands: \\{help-mode-map}" (setq-local revert-buffer-function #'help-mode-revert-buffer) + (setq-local tool-bar-map + help-mode-tool-bar-map) (setq-local bookmark-make-record-function #'help-bookmark-make-record)) @@ -778,8 +796,8 @@ help buffer by other means." (&optional no-file no-context posn)) (defun help-bookmark-make-record () - "Create and return a help-mode bookmark record. -Implements `bookmark-make-record-function' for help-mode buffers." + "Create and return a `help-mode' bookmark record. +Implements `bookmark-make-record-function' for `help-mode' buffers." (unless (car help-xref-stack-item) (error "Cannot create bookmark - help command not known")) `(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT) @@ -792,7 +810,7 @@ Implements `bookmark-make-record-function' for help-mode buffers." ;;;###autoload (defun help-bookmark-jump (bookmark) - "Jump to help-mode bookmark BOOKMARK. + "Jump to `help-mode' bookmark BOOKMARK. Handler function for record returned by `help-bookmark-make-record'. BOOKMARK is a bookmark name or a bookmark record." (let ((help-fn (bookmark-prop-get bookmark 'help-fn)) -- cgit v1.2.3 From 7b12747e2f2136bc76bfbeb3648131281ec14961 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 06:59:02 +0100 Subject: Convert finder menu to easy-menu-define * lisp/finder.el (finder-mode-map): Move menu definition from here... (finder-mode-menu): ...to here, and rewrite using easy-menu-define. --- lisp/finder.el | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/lisp/finder.el b/lisp/finder.el index 15c3fcbac79..2c3869b5089 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -90,24 +90,21 @@ Each element has the form (KEYWORD . DESCRIPTION).") (define-key map "p" 'previous-line) (define-key map "q" 'finder-exit) (define-key map "d" 'finder-list-keywords) - - (define-key map [menu-bar finder-mode] - (cons "Finder" menu-map)) - (define-key menu-map [finder-exit] - '(menu-item "Quit" finder-exit - :help "Exit Finder mode")) - (define-key menu-map [finder-summary] - '(menu-item "Summary" finder-summary - :help "Summary item on current line in a finder buffer")) - (define-key menu-map [finder-list-keywords] - '(menu-item "List keywords" finder-list-keywords - :help "Display descriptions of the keywords in the Finder buffer")) - (define-key menu-map [finder-select] - '(menu-item "Select" finder-select - :help "Select item on current line in a finder buffer")) map) "Keymap used in `finder-mode'.") +(easy-menu-define finder-mode-menu finder-mode-map + "Menu for `finder-mode'." + '("Finder" + ["Select" finder-select + :help "Select item on current line in a finder buffer"] + ["List keywords" finder-list-keywords + :help "Display descriptions of the keywords in the Finder buffer"] + ["Summary" finder-summary + :help "Summary item on current line in a finder buffer"] + ["Quit" finder-exit + :help "Exit Finder mode"])) + (defvar finder-mode-syntax-table (let ((st (make-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\; ". " st) -- cgit v1.2.3 From d184895a42b37718cded839b95252e7bb165bcfd Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 07:34:52 +0100 Subject: Convert re-builder menu to easy-menu-define * lisp/emacs-lisp/re-builder.el (reb-mode-map): Move menu definition from here... (reb-mode-menu): ...to here, and rewrite using easy-menu-define. --- lisp/emacs-lisp/re-builder.el | 78 ++++++++++++++++--------------------------- 1 file changed, 29 insertions(+), 49 deletions(-) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index ce8d98df807..7f404c8296c 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -217,8 +217,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") ;; Define the local "\C-c" keymap (defvar reb-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-c" 'reb-toggle-case) (define-key map "\C-c\C-q" 'reb-quit) (define-key map "\C-c\C-w" 'reb-copy) @@ -228,43 +227,37 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (define-key map "\C-c\C-e" 'reb-enter-subexp-mode) (define-key map "\C-c\C-b" 'reb-change-target-buffer) (define-key map "\C-c\C-u" 'reb-force-update) - (define-key map [menu-bar reb-mode] (cons "Re-Builder" menu-map)) - (define-key menu-map [rq] - '(menu-item "Quit" reb-quit - :help "Quit the RE Builder mode")) - (define-key menu-map [div1] '(menu-item "--")) - (define-key menu-map [rt] - '(menu-item "Case sensitive" reb-toggle-case - :button (:toggle . (with-current-buffer - reb-target-buffer - (null case-fold-search))) - :help "Toggle case sensitivity of searches for RE Builder target buffer")) - (define-key menu-map [rb] - '(menu-item "Change target buffer..." reb-change-target-buffer - :help "Change the target buffer and display it in the target window")) - (define-key menu-map [rs] - '(menu-item "Change syntax..." reb-change-syntax - :help "Change the syntax used by the RE Builder")) - (define-key menu-map [div2] '(menu-item "--")) - (define-key menu-map [re] - '(menu-item "Enter subexpression mode" reb-enter-subexp-mode - :help "Enter the subexpression mode in the RE Builder")) - (define-key menu-map [ru] - '(menu-item "Force update" reb-force-update - :help "Force an update in the RE Builder target window without a match limit")) - (define-key menu-map [rn] - '(menu-item "Go to next match" reb-next-match - :help "Go to next match in the RE Builder target window")) - (define-key menu-map [rp] - '(menu-item "Go to previous match" reb-prev-match - :help "Go to previous match in the RE Builder target window")) - (define-key menu-map [div3] '(menu-item "--")) - (define-key menu-map [rc] - '(menu-item "Copy current RE" reb-copy - :help "Copy current RE into the kill ring for later insertion")) map) "Keymap used by the RE Builder.") +(easy-menu-define reb-mode-menu reb-mode-map + "Menu for the RE Builder." + '("Re-Builder" + ["Copy current RE" reb-copy + :help "Copy current RE into the kill ring for later insertion"] + "---" + ["Go to previous match" reb-prev-match + :help "Go to previous match in the RE Builder target window"] + ["Go to next match" reb-next-match + :help "Go to next match in the RE Builder target window"] + ["Force update" reb-force-update + :help "Force an update in the RE Builder target window without a match limit"] + ["Enter subexpression mode" reb-enter-subexp-mode + :help "Enter the subexpression mode in the RE Builder"] + "---" + ["Change syntax..." reb-change-syntax + :help "Change the syntax used by the RE Builder"] + ["Change target buffer..." reb-change-target-buffer + :help "Change the target buffer and display it in the target window"] + ["Case sensitive" reb-toggle-case + :button (:toggle . (with-current-buffer + reb-target-buffer + (null case-fold-search))) + :help "Toggle case sensitivity of searches for RE Builder target buffer"] + "---" + ["Quit" reb-quit + :help "Quit the RE Builder mode"])) + (define-derived-mode reb-mode nil "RE Builder" "Major mode for interactively building Regular Expressions." (setq-local blink-matching-paren nil) @@ -368,7 +361,6 @@ matching parts of the target buffer will be highlighted." (defun reb-change-target-buffer (buf) "Change the target buffer and display it in the target window." (interactive "bSet target buffer to: ") - (let ((buffer (get-buffer buf))) (if (not buffer) (error "No such buffer") @@ -381,7 +373,6 @@ matching parts of the target buffer will be highlighted." (defun reb-force-update () "Force an update in the RE Builder target window without a match limit." (interactive) - (let ((reb-auto-match-limit nil)) (reb-update-overlays (if reb-subexp-mode reb-subexp-displayed nil)))) @@ -389,7 +380,6 @@ matching parts of the target buffer will be highlighted." (defun reb-quit () "Quit the RE Builder mode." (interactive) - (setq reb-subexp-mode nil reb-subexp-displayed nil) (reb-delete-overlays) @@ -399,7 +389,6 @@ matching parts of the target buffer will be highlighted." (defun reb-next-match () "Go to next match in the RE Builder target window." (interactive) - (reb-assert-buffer-in-window) (with-selected-window reb-target-window (if (not (re-search-forward reb-regexp (point-max) t)) @@ -411,7 +400,6 @@ matching parts of the target buffer will be highlighted." (defun reb-prev-match () "Go to previous match in the RE Builder target window." (interactive) - (reb-assert-buffer-in-window) (with-selected-window reb-target-window (let ((p (point))) @@ -426,7 +414,6 @@ matching parts of the target buffer will be highlighted." (defun reb-toggle-case () "Toggle case sensitivity of searches for RE Builder target buffer." (interactive) - (with-current-buffer reb-target-buffer (setq case-fold-search (not case-fold-search))) (reb-update-modestring) @@ -435,7 +422,6 @@ matching parts of the target buffer will be highlighted." (defun reb-copy () "Copy current RE into the kill ring for later insertion." (interactive) - (reb-update-regexp) (let ((re (with-output-to-string (print (reb-target-binding reb-regexp))))) @@ -503,7 +489,6 @@ Optional argument SYNTAX must be specified if called non-interactively." (defun reb-do-update (&optional subexp) "Update matches in the RE Builder target window. If SUBEXP is non-nil mark only the corresponding sub-expressions." - (reb-assert-buffer-in-window) (reb-update-regexp) (reb-update-overlays subexp)) @@ -541,7 +526,6 @@ optional fourth argument FORCE is non-nil." (defun reb-assert-buffer-in-window () "Assert that `reb-target-buffer' is displayed in `reb-target-window'." - (if (not (eq reb-target-buffer (window-buffer reb-target-window))) (set-window-buffer reb-target-window reb-target-buffer))) @@ -560,7 +544,6 @@ optional fourth argument FORCE is non-nil." (defun reb-display-subexp (&optional subexp) "Highlight only subexpression SUBEXP in the RE Builder." (interactive) - (setq reb-subexp-displayed (or subexp (string-to-number (format "%c" last-command-event)))) (reb-update-modestring) @@ -568,7 +551,6 @@ optional fourth argument FORCE is non-nil." (defun reb-kill-buffer () "When the RE Builder buffer is killed make sure no overlays stay around." - (when (reb-mode-buffer-p) (reb-delete-overlays))) @@ -600,7 +582,6 @@ optional fourth argument FORCE is non-nil." (defun reb-insert-regexp () "Insert current RE." - (let ((re (or (reb-target-binding reb-regexp) (reb-empty-regexp)))) (cond ((eq reb-re-syntax 'read) @@ -636,7 +617,6 @@ Return t if the (cooked) expression changed." ;; And now the real core of the whole thing (defun reb-count-subexps (re) "Return number of sub-expressions in the regexp RE." - (let ((i 0) (beg 0)) (while (string-match "\\\\(" re beg) (setq i (1+ i) -- cgit v1.2.3 From acf71609200e56ef28f31be0df33ea3905eb2188 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 5 Feb 2021 05:24:55 -0800 Subject: Add more auth-related tests for socks.el * test/lisp/net/socks-tests.el (auth-registration-and-suite-offer) (filter-response-parsing-v4, filter-response-parsing-v5): Assert auth-method selection wrangling and socks-filter parsing. (v5-auth-user-pass, v5-auth-user-pass-blank, v5-auth-none): Show prep and execution of the SOCKS connect command and proxying of an HTTP request; simplify fake server. (Bug#46342) --- test/lisp/net/socks-tests.el | 270 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 215 insertions(+), 55 deletions(-) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index b378ed2964e..340a42d79cc 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -21,68 +21,151 @@ ;;; Code: +(require 'ert) (require 'socks) (require 'url-http) -(defvar socks-tests-canned-server-port nil) +(ert-deftest socks-tests-auth-registration-and-suite-offer () + (ert-info ("Default favors user/pass auth") + (should (equal socks-authentication-methods + '((2 "Username/Password" . socks-username/password-auth) + (0 "No authentication" . identity)))) + (should (equal "\2\0\2" (socks-build-auth-list)))) ; length [offer ...] + (let (socks-authentication-methods) + (ert-info ("Empty selection/no methods offered") + (should (equal "\0" (socks-build-auth-list)))) + (ert-info ("Simulate library defaults") + (socks-register-authentication-method 0 "No authentication" + 'identity) + (should (equal socks-authentication-methods + '((0 "No authentication" . identity)))) + (should (equal "\1\0" (socks-build-auth-list))) + (socks-register-authentication-method 2 "Username/Password" + 'socks-username/password-auth) + (should (equal socks-authentication-methods + '((2 "Username/Password" . socks-username/password-auth) + (0 "No authentication" . identity)))) + (should (equal "\2\0\2" (socks-build-auth-list)))) + (ert-info ("Removal") + (socks-unregister-authentication-method 2) + (should (equal socks-authentication-methods + '((0 "No authentication" . identity)))) + (should (equal "\1\0" (socks-build-auth-list))) + (socks-unregister-authentication-method 0) + (should-not socks-authentication-methods) + (should (equal "\0" (socks-build-auth-list)))))) -(defun socks-tests-canned-server-create (verbatim patterns) - "Create a fake SOCKS server and return the process. +(ert-deftest socks-tests-filter-response-parsing-v4 () + "Ensure new chunks added on right (Bug#45162)." + (let* ((buf (generate-new-buffer "*test-socks-filter*")) + (proc (start-process "test-socks-filter" buf "sleep" "1"))) + (process-put proc 'socks t) + (process-put proc 'socks-state socks-state-waiting) + (process-put proc 'socks-server-protocol 4) + (ert-info ("Receive initial incomplete segment") + (socks-filter proc (concat [0 90 0 0 93 184 216])) + ;; From example.com: OK status ^ ^ msg start + (ert-info ("State still set to waiting") + (should (eq (process-get proc 'socks-state) socks-state-waiting))) + (ert-info ("Response field is nil because processing incomplete") + (should-not (process-get proc 'socks-response))) + (ert-info ("Scratch field holds stashed partial payload") + (should (string= (concat [0 90 0 0 93 184 216]) + (process-get proc 'socks-scratch))))) + (ert-info ("Last part arrives") + (socks-filter proc "\42") ; ?\" 34 + (ert-info ("State transitions to complete (length check passes)") + (should (eq (process-get proc 'socks-state) socks-state-connected))) + (ert-info ("Scratch and response fields hold stash w. last chunk") + (should (string= (concat [0 90 0 0 93 184 216 34]) + (process-get proc 'socks-response))) + (should (string= (process-get proc 'socks-response) + (process-get proc 'socks-scratch))))) + (delete-process proc) + (kill-buffer buf))) -`VERBATIM' and `PATTERNS' are dotted alists containing responses. -Requests are tried in order. On failure, an error is raised." - (let* ((buf (generate-new-buffer "*canned-socks-server*")) +(ert-deftest socks-tests-filter-response-parsing-v5 () + "Ensure new chunks added on right (Bug#45162)." + (let* ((buf (generate-new-buffer "*test-socks-filter*")) + (proc (start-process "test-socks-filter" buf "sleep" "1"))) + (process-put proc 'socks t) + (process-put proc 'socks-state socks-state-waiting) + (process-put proc 'socks-server-protocol 5) + (ert-info ("Receive initial incomplete segment") + ;; From fedora.org: 2605:bc80:3010:600:dead:beef:cafe:fed9 + ;; 5004 ~~> Version Status (OK) NOOP Addr-Type (4 -> IPv6) + (socks-filter proc "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60") + (ert-info ("State still waiting and response emtpy") + (should (eq (process-get proc 'socks-state) socks-state-waiting)) + (should-not (process-get proc 'socks-response))) + (ert-info ("Scratch field holds partial payload of pending msg") + (should (string= "\5\0\0\4\x26\x05\xbc\x80\x30\x10\x00\x60" + (process-get proc 'socks-scratch))))) + (ert-info ("Middle chunk arrives") + (socks-filter proc "\xde\xad\xbe\xef\xca\xfe\xfe\xd9") + (ert-info ("State and response fields still untouched") + (should (eq (process-get proc 'socks-state) socks-state-waiting)) + (should-not (process-get proc 'socks-response))) + (ert-info ("Scratch contains new arrival appended (on RHS)") + (should (string= (concat "\5\0\0\4" + "\x26\x05\xbc\x80\x30\x10\x00\x60" + "\xde\xad\xbe\xef\xca\xfe\xfe\xd9") + (process-get proc 'socks-scratch))))) + (ert-info ("Final part arrives (port number)") + (socks-filter proc "\0\0") + (ert-info ("State transitions to complete") + (should (eq (process-get proc 'socks-state) socks-state-connected))) + (ert-info ("Scratch and response fields show last chunk appended") + (should (string= (concat "\5\0\0\4" + "\x26\x05\xbc\x80\x30\x10\x00\x60" + "\xde\xad\xbe\xef\xca\xfe\xfe\xd9" + "\0\0") + (process-get proc 'socks-scratch))) + (should (string= (process-get proc 'socks-response) + (process-get proc 'socks-scratch))))) + (delete-process proc) + (kill-buffer buf))) + +(defvar socks-tests-canned-server-patterns nil + "Alist containing request/response cons pairs to be tried in order. +Vectors must match verbatim. Strings are considered regex patterns.") + +(defun socks-tests-canned-server-create () + "Create and return a fake SOCKS server." + (let* ((port (nth 2 socks-server)) + (name (format "socks-server:%d" port)) + (pats socks-tests-canned-server-patterns) (filt (lambda (proc line) - (let ((resp (or (assoc-default line verbatim - (lambda (k s) ; s is line - (string= (concat k) s))) - (assoc-default line patterns - (lambda (p s) - (string-match-p p s)))))) - (unless resp + (pcase-let ((`(,pat . ,resp) (pop pats))) + (unless (or (and (vectorp pat) (equal pat (vconcat line))) + (string-match-p pat line)) (error "Unknown request: %s" line)) (let ((print-escape-control-characters t)) - (princ (format "<- %s\n" (prin1-to-string line)) buf) - (princ (format "-> %s\n" (prin1-to-string resp)) buf)) + (message "[%s] <- %s" name (prin1-to-string line)) + (message "[%s] -> %s" name (prin1-to-string resp))) (process-send-string proc (concat resp))))) - (srv (make-network-process :server 1 - :buffer buf - :filter filt - :name "server" - :family 'ipv4 - :host 'local - :service socks-tests-canned-server-port))) - (set-process-query-on-exit-flag srv nil) - (princ (format "[%s] Listening on localhost:10080\n" srv) buf) - srv)) - -;; Add ([5 3 0 1 2] . [5 2]) to the `verbatim' list below to validate -;; against curl 7.71 with the following options: -;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com -;; -;; If later implementing version 4a, try these: -;; [4 1 0 80 0 0 0 1 0 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0] . [0 90 0 0 0 0 0 0] -;; $ curl --verbose --proxy socks4a://127.0.0.1:10080 example.com + (serv (make-network-process :server 1 + :buffer (get-buffer-create name) + :filter filt + :name name + :family 'ipv4 + :host 'local + :coding 'binary + :service port))) + (set-process-query-on-exit-flag serv nil) + serv)) -(ert-deftest socks-tests-auth-filter-url-http () - "Verify correct handling of SOCKS5 user/pass authentication." - (let* ((socks-server '("server" "127.0.0.1" 10080 5)) - (socks-username "foo") - (socks-password "bar") - (url-gateway-method 'socks) +(defvar socks-tests--hello-world-http-request-pattern + (cons "^GET /" (concat "HTTP/1.1 200 OK\r\n" + "Content-Type: text/plain\r\n" + "Content-Length: 13\r\n\r\n" + "Hello World!\n"))) + +(defun socks-tests-perform-hello-world-http-request () + "Start canned server, validate hello-world response, and finalize." + (let* ((url-gateway-method 'socks) (url (url-generic-parse-url "http://example.com")) - (verbatim '(([5 2 0 2] . [5 2]) - ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0]) - ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] - . [5 0 0 1 0 0 0 0 0 0]))) - (patterns - `(("^GET /" . ,(concat "HTTP/1.1 200 OK\r\n" - "Content-Type: text/plain; charset=UTF-8\r\n" - "Content-Length: 13\r\n\r\n" - "Hello World!\n")))) - (socks-tests-canned-server-port 10080) - (server (socks-tests-canned-server-create verbatim patterns)) - (tries 10) + (server (socks-tests-canned-server-create)) ;; done ;; @@ -90,14 +173,91 @@ Requests are tried in order. On failure, an error is raised." (goto-char (point-min)) (should (search-forward "Hello World" nil t)) (setq done t))) - (buf (url-http url cb '(nil)))) - (ert-info ("Connect to HTTP endpoint over SOCKS5 with USER/PASS method") - (while (and (not done) (< 0 (cl-decf tries))) ; cl-lib via url-http - (sleep-for 0.1))) + (buf (url-http url cb '(nil))) + (proc (get-buffer-process buf)) + (attempts 10)) + (while (and (not done) (< 0 (cl-decf attempts))) + (sleep-for 0.1)) (should done) (delete-process server) + (delete-process proc) ; otherwise seems client proc is sometimes reused (kill-buffer (process-buffer server)) (kill-buffer buf) (ignore url-gateway-method))) +;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate +;; against curl 7.71 with the following options: +;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com + +(ert-deftest socks-tests-v5-auth-user-pass () + "Verify correct handling of SOCKS5 user/pass authentication." + (should (assq 2 socks-authentication-methods)) + (let ((socks-server '("server" "127.0.0.1" 10080 5)) + (socks-username "foo") + (socks-password "bar") + (url-user-agent "Test/auth-user-pass") + (socks-tests-canned-server-patterns + `(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 3 ?b ?a ?r] . [1 0]) + ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern))) + (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method") + (socks-tests-perform-hello-world-http-request)))) + +;; Services (like Tor) may be configured without auth but for some +;; reason still prefer the user/pass method over none when offered both. +;; Given this library's defaults, the scenario below is possible. +;; +;; FYI: RFC 1929 doesn't say that a username or password is required +;; but notes that the length of both fields should be at least one. +;; However, both socks.el and curl send zero-length fields (though +;; curl drops the user part too when the password is empty). +;; +;; From Tor's docs /socks-extensions.txt, 1.1 Extent of support: +;; > We allow username/password fields of this message to be empty ... +;; line 41 in blob 5fd1f828f3e9d014f7b65fa3bd1d33c39e4129e2 +;; https://gitweb.torproject.org/torspec.git/tree/socks-extensions.txt +;; +;; To verify against curl 7.71, swap out the first two pattern pairs +;; with ([5 3 0 1 2] . [5 2]) and ([1 0 0] . [1 0]), then run: +;; $ curl verbose -U "foo:" --proxy socks5h://127.0.0.1:10081 example.com + +(ert-deftest socks-tests-v5-auth-user-pass-blank () + "Verify correct SOCKS5 user/pass authentication with empty pass." + (should (assq 2 socks-authentication-methods)) + (let ((socks-server '("server" "127.0.0.1" 10081 5)) + (socks-username "foo") ; defaults to (user-login-name) + (socks-password "") ; simulate user hitting enter when prompted + (url-user-agent "Test/auth-user-pass-blank") + (socks-tests-canned-server-patterns + `(([5 2 0 2] . [5 2]) + ([1 3 ?f ?o ?o 0] . [1 0]) + ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern))) + (ert-info ("Make HTTP request over SOCKS5 with USER/PASS auth method") + (socks-tests-perform-hello-world-http-request)))) + +;; Swap out ([5 2 0 1] . [5 0]) with the first pattern below to validate +;; against curl 7.71 with the following options: +;; $ curl --verbose --proxy socks5h://127.0.0.1:10082 example.com + +(ert-deftest socks-tests-v5-auth-none () + "Verify correct handling of SOCKS5 when auth method 0 requested." + (let ((socks-server '("server" "127.0.0.1" 10082 5)) + (socks-authentication-methods (append socks-authentication-methods + nil)) + (url-user-agent "Test/auth-none") + (socks-tests-canned-server-patterns + `(([5 1 0] . [5 0]) + ([5 1 0 3 11 ?e ?x ?a ?m ?p ?l ?e ?. ?c ?o ?m 0 80] + . [5 0 0 1 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern))) + (socks-unregister-authentication-method 2) + (should-not (assq 2 socks-authentication-methods)) + (ert-info ("Make HTTP request over SOCKS5 with no auth method") + (socks-tests-perform-hello-world-http-request))) + (should (assq 2 socks-authentication-methods))) + ;;; socks-tests.el ends here -- cgit v1.2.3 From 43703a06b9ea31b86c46bef7cb488ea885569ddc Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Fri, 5 Feb 2021 19:41:04 -0800 Subject: Use raw bytes for SOCKS 4 IP addresses * lisp/net/socks.el: (socks--open-network-stream, socks-send-command): * test/lisp/net/socks-tests.el: (socks-tests-v4-basic): (Bug#46342). --- lisp/net/socks.el | 4 +++- test/lisp/net/socks-tests.el | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+), 1 deletion(-) diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 96fafc826b8..1da1d31d678 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -390,6 +390,8 @@ proc))) (defun socks-send-command (proc command atype address port) + "Send COMMAND to SOCKS service PROC for proxying ADDRESS and PORT. +When ATYPE indicates an IP, param ADDRESS must be given as raw bytes." (let ((addr (cond ((or (= atype socks-address-type-v4) (= atype socks-address-type-v6)) @@ -528,7 +530,7 @@ (setq host (socks-nslookup-host host)) (if (not (listp host)) (error "Could not get IP address for: %s" host)) - (setq host (apply #'format "%c%c%c%c" host)) + (setq host (apply #'unibyte-string host)) socks-address-type-v4) (t socks-address-type-name)))) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 340a42d79cc..9a2dcba9daf 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -185,6 +185,26 @@ Vectors must match verbatim. Strings are considered regex patterns.") (kill-buffer buf) (ignore url-gateway-method))) +;; Unlike curl, socks.el includes the ID field (but otherwise matches): +;; $ curl --proxy socks4://127.0.0.1:1080 example.com + +(ert-deftest socks-tests-v4-basic () + "Show correct preparation of SOCKS4 connect command (Bug#46342)." + (let ((socks-server '("server" "127.0.0.1" 10079 4)) + (url-user-agent "Test/4-basic") + (socks-tests-canned-server-patterns + `(([4 1 0 80 93 184 216 34 ?f ?o ?o 0] . [0 90 0 0 0 0 0 0]) + ,socks-tests--hello-world-http-request-pattern)) + socks-nslookup-program) + (ert-info ("Make HTTP request over SOCKS4") + (cl-letf (((symbol-function 'socks-nslookup-host) + (lambda (host) + (should (equal host "example.com")) + (list 93 184 216 34))) + ((symbol-function 'user-full-name) + (lambda () "foo"))) + (socks-tests-perform-hello-world-http-request))))) + ;; Replace first pattern below with ([5 3 0 1 2] . [5 2]) to validate ;; against curl 7.71 with the following options: ;; $ curl --verbose -U foo:bar --proxy socks5h://127.0.0.1:10080 example.com -- cgit v1.2.3 From 825aed11d267f7879ca8915eb2b0d154e0beb2d4 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Feb 2021 13:44:19 +0100 Subject: Add the `always' function * doc/lispref/functions.texi (Calling Functions): Document it. * lisp/subr.el (always): New function. * lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Mark it as side effect free. --- doc/lispref/functions.texi | 4 ++++ etc/NEWS | 4 ++++ lisp/emacs-lisp/byte-opt.el | 2 +- lisp/subr.el | 9 ++++++++- 4 files changed, 17 insertions(+), 2 deletions(-) diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 1e3da8e3a5d..2a9b57f19f3 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -861,6 +861,10 @@ This function returns @var{argument} and has no side effects. @defun ignore &rest arguments This function ignores any @var{arguments} and returns @code{nil}. +@end defun + +@defun always &rest arguments +This function ignores any @var{arguments} and returns @code{t}. @end defun Some functions are user-visible @dfn{commands}, which can be called diff --git a/etc/NEWS b/etc/NEWS index ee8a68a259d..c0c292aebc8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2305,6 +2305,10 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', * Lisp Changes in Emacs 28.1 ++++ +** New function 'always'. +This is identical to 'ignore', but returns t instead. + +++ ** New forms to declare how completion should happen has been added. '(declare (completion PREDICATE))' can be used as a general predicate diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e0feb95a461..9f0ba232a4b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1348,7 +1348,7 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") window-total-height window-total-width window-use-time window-vscroll window-width zerop)) (side-effect-and-error-free-fns - '(arrayp atom + '(always arrayp atom bignump bobp bolp bool-vector-p buffer-end buffer-list buffer-size buffer-string bufferp car-safe case-table-p cdr-safe char-or-string-p characterp diff --git a/lisp/subr.el b/lisp/subr.el index 490aec93f19..f9bb1bb3ad1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -373,10 +373,17 @@ PREFIX is a string, and defaults to \"g\"." (defun ignore (&rest _arguments) "Do nothing and return nil. -This function accepts any number of ARGUMENTS, but ignores them." +This function accepts any number of ARGUMENTS, but ignores them. +Also see `always'." (interactive) nil) +(defun always (&rest _arguments) + "Do nothing and return t. +This function accepts any number of ARGUMENTS, but ignores them. +Also see `ignore'." + t) + ;; Signal a compile-error if the first arg is missing. (defun error (&rest args) "Signal an error, making a message by passing ARGS to `format-message'. -- cgit v1.2.3 From 12578d6aca2cc7182afdd070aa31c7aff6a3add8 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Feb 2021 14:29:41 +0100 Subject: Change how (declare (modes store the data * lisp/emacs-lisp/byte-run.el (byte-run--set-modes): Change from being a predicate to storing the modes. This allows using the modes for positive command discovery, too. * src/data.c (Fcommand_modes): Look at the `command-modes' symbol property, too. --- lisp/emacs-lisp/byte-run.el | 4 +--- src/data.c | 10 +++++++++- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 76e7f01ace6..afe94bb0352 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -154,9 +154,7 @@ The return value of this function is not used." (defalias 'byte-run--set-modes #'(lambda (f _args &rest val) (list 'function-put (list 'quote f) - ''completion-predicate - `(lambda (_ b) - (command-completion-with-modes-p ',val b))))) + ''command-modes (list 'quote val)))) ;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist diff --git a/src/data.c b/src/data.c index ace859d2d0c..9af9131b123 100644 --- a/src/data.c +++ b/src/data.c @@ -957,9 +957,17 @@ The value, if non-nil, is a list of mode name symbols. */) if (NILP (fun)) return Qnil; + /* Use a `command-modes' property if present, analogous to the + function-documentation property. */ fun = command; while (SYMBOLP (fun)) - fun = Fsymbol_function (fun); + { + Lisp_Object modes = Fget (fun, Qcommand_modes); + if (!NILP (modes)) + return modes; + else + fun = Fsymbol_function (fun); + } if (COMPILEDP (fun)) { -- cgit v1.2.3 From e3e3133f800cf4395dc4594b791276498e426c34 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Feb 2021 15:12:45 +0100 Subject: Add a new command for mode-specific commands * doc/lispref/commands.texi (Interactive Call): Document it. * lisp/simple.el (command-completion-using-modes-p): Refactored out into its own function for reuse... (command-completion-default-include-p): ... from here. (execute-extended-command-for-buffer): New command and keystroke (`M-S-x'). --- doc/lispref/commands.texi | 9 ++++++ etc/NEWS | 7 +++++ lisp/simple.el | 72 +++++++++++++++++++++++++++++++++++------------ lisp/subr.el | 1 + 4 files changed, 71 insertions(+), 18 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 1c762c27e8e..8199ece1101 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -851,6 +851,15 @@ non-@code{nil} if the command is to be included when completing in that buffer. @end deffn +@deffn Command execute-extended-command-for-buffer prefix-argument +This is like @code{execute-extended-command}, but limits the commands +offered for completion to those commands that are of particular +relevance to the current major mode (and enabled minor modes). This +includes commands that are tagged with the modes (@pxref{Using +Interactive}), and also commands that are bound to locally active +keymaps. +@end deffn + @node Distinguish Interactive @section Distinguish Interactive Calls @cindex distinguish interactive calls diff --git a/etc/NEWS b/etc/NEWS index c0c292aebc8..b623b13b34f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -251,6 +251,13 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), * Editing Changes in Emacs 28.1 ++++ +** New command 'execute-extended-command-for-buffer'. +This new command, bound to 'M-S-x', works like +'execute-extended-command', but limits the set of commands to the +commands that have been determined to be particularly of use to the +current mode. + +++ ** New user option 'read-extended-command-predicate'. This option controls how 'M-x' performs completion of commands when diff --git a/lisp/simple.el b/lisp/simple.el index 7c0b6e1d745..0e3a1ee9053 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1994,6 +1994,26 @@ This function uses the `read-extended-command-predicate' user option." (funcall read-extended-command-predicate sym buffer))))) t nil 'extended-command-history)))) +(define-inline command-completion-using-modes-p (symbol buffer) + "Say whether SYMBOL has been marked as a mode-specific command in BUFFER." + ;; Check the modes. + (let ((modes (command-modes symbol))) + ;; Common case: Just a single mode. + (if (null (cdr modes)) + (or (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) (car modes)) + (memq (car modes) + (buffer-local-value 'local-minor-modes buffer)) + (memq (car modes) global-minor-modes)) + ;; Uncommon case: Multiple modes. + (apply #'provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + modes) + (seq-intersection modes + (buffer-local-value 'local-minor-modes buffer) + #'eq) + (seq-intersection modes global-minor-modes #'eq)))) + (defun command-completion-default-include-p (symbol buffer) "Say whether SYMBOL should be offered as a completion. If there's a `completion-predicate' for SYMBOL, the result from @@ -2004,24 +2024,8 @@ BUFFER." (if (get symbol 'completion-predicate) ;; An explicit completion predicate takes precedence. (funcall (get symbol 'completion-predicate) symbol buffer) - ;; Check the modes. - (let ((modes (command-modes symbol))) - (or (null modes) - ;; Common case: Just a single mode. - (if (null (cdr modes)) - (or (provided-mode-derived-p - (buffer-local-value 'major-mode buffer) (car modes)) - (memq (car modes) - (buffer-local-value 'local-minor-modes buffer)) - (memq (car modes) global-minor-modes)) - ;; Uncommon case: Multiple modes. - (apply #'provided-mode-derived-p - (buffer-local-value 'major-mode buffer) - modes) - (seq-intersection modes - (buffer-local-value 'local-minor-modes buffer) - #'eq) - (seq-intersection modes global-minor-modes #'eq)))))) + (or (null (command-modes symbol)) + (command-completion-using-modes-p symbol buffer)))) (defun command-completion-with-modes-p (modes buffer) "Say whether MODES are in action in BUFFER. @@ -2189,6 +2193,38 @@ invoking, give a prefix argument to `execute-extended-command'." suggest-key-bindings 2)))))))) +(defun execute-extended-command-for-buffer (prefixarg &optional + command-name typed) + "Query usert for a command relevant for the current mode and then execute it. +This is like `execute-extended-command', but limits the +completions to commands that are particularly relevant to the +current buffer. This includes commands that have been marked as +being specially designed for the current major mode (and enabled +minor modes), as well as commands bound in the active local key +maps." + (declare (interactive-only command-execute)) + (interactive + (let* ((execute-extended-command--last-typed nil) + (keymaps + ;; The major mode's keymap and any active minor modes. + (cons + (current-local-map) + (mapcar + #'cdr + (seq-filter + (lambda (elem) + (symbol-value (car elem))) + minor-mode-map-alist)))) + (read-extended-command-predicate + (lambda (symbol buffer) + (or (command-completion-using-modes-p symbol buffer) + (where-is-internal symbol keymaps))))) + (list current-prefix-arg + (read-extended-command) + execute-extended-command--last-typed))) + (with-suppressed-warnings ((interactive-only execute-extended-command)) + (execute-extended-command prefixarg command-name typed))) + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. diff --git a/lisp/subr.el b/lisp/subr.el index f9bb1bb3ad1..cf70b249cfc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1305,6 +1305,7 @@ in a cleaner way with command remapping, like this: (define-key map "l" #'downcase-word) (define-key map "c" #'capitalize-word) (define-key map "x" #'execute-extended-command) + (define-key map "X" #'execute-extended-command-for-buffer) map) "Default keymap for ESC (meta) commands. The normal global definition of the character ESC indirects to this keymap.") -- cgit v1.2.3 From 4c4c2eab7eaf81f87f8513a40b8a38a1c071cfe6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 20 Feb 2021 16:24:03 +0200 Subject: ; Fix typos in last change * etc/NEWS: Improve wording. * lisp/simple.el (execute-extended-command-for-buffer): Fix typo. --- etc/NEWS | 2 +- lisp/simple.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index b623b13b34f..c4f4c1d9d86 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -255,7 +255,7 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer'), ** New command 'execute-extended-command-for-buffer'. This new command, bound to 'M-S-x', works like 'execute-extended-command', but limits the set of commands to the -commands that have been determined to be particularly of use to the +commands that have been determined to be particularly useful with the current mode. +++ diff --git a/lisp/simple.el b/lisp/simple.el index 0e3a1ee9053..121b4d35a73 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2195,8 +2195,8 @@ invoking, give a prefix argument to `execute-extended-command'." (defun execute-extended-command-for-buffer (prefixarg &optional command-name typed) - "Query usert for a command relevant for the current mode and then execute it. -This is like `execute-extended-command', but limits the + "Query user for a command relevant for the current mode, and then execute it. +This is like `execute-extended-command', but it limits the completions to commands that are particularly relevant to the current buffer. This includes commands that have been marked as being specially designed for the current major mode (and enabled -- cgit v1.2.3 From 006d0ae396de59bce95bc0a3ff4648caee87babd Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Feb 2021 15:37:24 +0100 Subject: Mention `M-S-x' in the Emacs manual. * doc/emacs/m-x.texi (M-x): Mention `M-S-x' in the Emacs manual. --- doc/emacs/m-x.texi | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/doc/emacs/m-x.texi b/doc/emacs/m-x.texi index c51f10a47aa..d35a8351541 100644 --- a/doc/emacs/m-x.texi +++ b/doc/emacs/m-x.texi @@ -58,6 +58,14 @@ Modes}). By default, no commands are excluded, but you can customize the option @code{read-extended-command-predicate} to exclude those irrelevant commands from completion results. +@kindex M-S-x + Conversely, Emacs can exclude all commands except those that are +particularly relevant to the current buffer. The @kbd{M-S-x} (that's +``meta shift x'') command works just like @kbd{M-x}, but instead of +listing all (or most) of the commands Emacs knows about, it will only +list the commands that have been marked as ``belonging'' to the +current major mode, or any enabled minor modes. + To cancel the @kbd{M-x} and not run a command, type @kbd{C-g} instead of entering the command name. This takes you back to command level. -- cgit v1.2.3 From 496bed5cf4c9dc02f18741e3eacfaca78c373db6 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sat, 20 Feb 2021 15:43:26 +0100 Subject: Change command-completion-using-modes-p to defun * lisp/simple.el (command-completion-using-modes-p): Change into a defun for now because of a build problem. --- lisp/simple.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/simple.el b/lisp/simple.el index 121b4d35a73..26710e6d53d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1994,7 +1994,7 @@ This function uses the `read-extended-command-predicate' user option." (funcall read-extended-command-predicate sym buffer))))) t nil 'extended-command-history)))) -(define-inline command-completion-using-modes-p (symbol buffer) +(defun command-completion-using-modes-p (symbol buffer) "Say whether SYMBOL has been marked as a mode-specific command in BUFFER." ;; Check the modes. (let ((modes (command-modes symbol))) -- cgit v1.2.3 From a6234bb5b4cfa9f073e324f01210adf368abc4f1 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 20 Feb 2021 06:50:30 -0800 Subject: Mute noisy test fixture for socks.el * test/lisp/net/socks-tests.el: (socks-tests-perform-hello-world-http-request): Bind 'inhibit-message' non-nil when in batch mode. (Bug#46342) --- test/lisp/net/socks-tests.el | 1 + 1 file changed, 1 insertion(+) diff --git a/test/lisp/net/socks-tests.el b/test/lisp/net/socks-tests.el index 9a2dcba9daf..71bdd74890a 100644 --- a/test/lisp/net/socks-tests.el +++ b/test/lisp/net/socks-tests.el @@ -173,6 +173,7 @@ Vectors must match verbatim. Strings are considered regex patterns.") (goto-char (point-min)) (should (search-forward "Hello World" nil t)) (setq done t))) + (inhibit-message noninteractive) (buf (url-http url cb '(nil))) (proc (get-buffer-process buf)) (attempts 10)) -- cgit v1.2.3 From cf95b53405772d2f5bd5da91e57184f3de28a7f4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sat, 20 Feb 2021 17:43:03 +0100 Subject: Convert makefile-mode menu to easy-menu-define * lisp/progmodes/make-mode.el (makefile-mode-map): Move menu definition from here... (makefile-mode-menu): ...to here, and rewrite using easy-menu-define. --- lisp/progmodes/make-mode.el | 113 +++++++++++++++++++------------------------- 1 file changed, 48 insertions(+), 65 deletions(-) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 3d1e7d634a2..d444ce29995 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -573,8 +573,7 @@ The function must satisfy this calling convention: "Abbrev table in use in Makefile buffers.") (defvar makefile-mode-map - (let ((map (make-sparse-keymap)) - (opt-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) ;; set up the keymap (define-key map "\C-c:" 'makefile-insert-target-ref) (if makefile-electric-keys @@ -599,72 +598,56 @@ The function must satisfy this calling convention: (define-key map "\M-p" 'makefile-previous-dependency) (define-key map "\M-n" 'makefile-next-dependency) (define-key map "\e\t" 'completion-at-point) - - ;; Make menus. - (define-key map [menu-bar makefile-mode] - (cons "Makefile" (make-sparse-keymap "Makefile"))) - - (define-key map [menu-bar makefile-mode makefile-type] - (cons "Switch Makefile Type" opt-map)) - (define-key opt-map [makefile-makepp-mode] - '(menu-item "Makepp" makefile-makepp-mode - :help "An adapted `makefile-mode' that knows about makepp" - :button (:radio . (eq major-mode 'makefile-makepp-mode)))) - (define-key opt-map [makefile-imake-mode] - '(menu-item "Imake" makefile-imake-mode - :help "An adapted `makefile-mode' that knows about imake" - :button (:radio . (eq major-mode 'makefile-imake-mode)))) - (define-key opt-map [makefile-mode] - '(menu-item "Classic" makefile-mode - :help "`makefile-mode' with no special functionality" - :button (:radio . (eq major-mode 'makefile-mode)))) - (define-key opt-map [makefile-bsdmake-mode] - '(menu-item "BSD" makefile-bsdmake-mode - :help "An adapted `makefile-mode' that knows about BSD make" - :button (:radio . (eq major-mode 'makefile-bsdmake-mode)))) - (define-key opt-map [makefile-automake-mode] - '(menu-item "Automake" makefile-automake-mode - :help "An adapted `makefile-mode' that knows about automake" - :button (:radio . (eq major-mode 'makefile-automake-mode)))) - (define-key opt-map [makefile-gmake-mode] - '(menu-item "GNU make" makefile-gmake-mode - :help "An adapted `makefile-mode' that knows about GNU make" - :button (:radio . (eq major-mode 'makefile-gmake-mode)))) - (define-key map [menu-bar makefile-mode browse] - '(menu-item "Pop up Makefile Browser" makefile-switch-to-browser - ;; XXX: this needs a better string, the function is not documented... - :help "Pop up Makefile Browser")) - (define-key map [menu-bar makefile-mode overview] - '(menu-item "Up To Date Overview" makefile-create-up-to-date-overview - :help "Create a buffer containing an overview of the state of all known targets")) - ;; Target related - (define-key map [menu-bar makefile-mode separator1] '("----")) - (define-key map [menu-bar makefile-mode pickup-file] - '(menu-item "Pick File Name as Target" makefile-pickup-filenames-as-targets - :help "Scan the current directory for filenames to use as targets")) - (define-key map [menu-bar makefile-mode function] - '(menu-item "Insert GNU make function" makefile-insert-gmake-function - :help "Insert a GNU make function call")) - (define-key map [menu-bar makefile-mode pickup] - '(menu-item "Find Targets and Macros" makefile-pickup-everything - :help "Notice names of all macros and targets in Makefile")) - (define-key map [menu-bar makefile-mode complete] - '(menu-item "Complete Target or Macro" completion-at-point - :help "Perform completion on Makefile construct preceding point")) - (define-key map [menu-bar makefile-mode backslash] - '(menu-item "Backslash Region" makefile-backslash-region - :help "Insert, align, or delete end-of-line backslashes on the lines in the region")) - ;; Motion - (define-key map [menu-bar makefile-mode separator] '("----")) - (define-key map [menu-bar makefile-mode prev] - '(menu-item "Move to Previous Dependency" makefile-previous-dependency - :help "Move point to the beginning of the previous dependency line")) - (define-key map [menu-bar makefile-mode next] - '(menu-item "Move to Next Dependency" makefile-next-dependency - :help "Move point to the beginning of the next dependency line")) map) "The keymap that is used in Makefile mode.") +(easy-menu-define makefile-mode-menu makefile-mode-map + "Menu for Makefile mode." + '("Makefile" + ;; Motion + ["Move to Next Dependency" makefile-next-dependency + :help "Move point to the beginning of the next dependency line"] + ["Move to Previous Dependency" makefile-previous-dependency + :help "Move point to the beginning of the previous dependency line"] + "----" + ;; Target related + ["Backslash Region" makefile-backslash-region + :help "Insert, align, or delete end-of-line backslashes on the lines in the region"] + ["Complete Target or Macro" completion-at-point + :help "Perform completion on Makefile construct preceding point"] + ["Find Targets and Macros" makefile-pickup-everything + :help "Notice names of all macros and targets in Makefile"] + ["Insert GNU make function" makefile-insert-gmake-function + :help "Insert a GNU make function call"] + ["Pick File Name as Target" makefile-pickup-filenames-as-targets + :help "Scan the current directory for filenames to use as targets"] + "----" + ;; Other. + ["Up To Date Overview" makefile-create-up-to-date-overview + :help "Create a buffer containing an overview of the state of all known targets"] + ["Pop up Makefile Browser" makefile-switch-to-browser + ;; XXX: this needs a better string, the function is not documented... + :help "Pop up Makefile Browser"] + ("Switch Makefile Type" + ["GNU make" makefile-gmake-mode + :help "An adapted `makefile-mode' that knows about GNU make" + :button (:radio . (eq major-mode 'makefile-gmake-mode))] + ["Automake" makefile-automake-mode + :help "An adapted `makefile-mode' that knows about automake" + :button (:radio . (eq major-mode 'makefile-automake-mode))] + ["BSD" makefile-bsdmake-mode + :help "An adapted `makefile-mode' that knows about BSD make" + :button (:radio . (eq major-mode 'makefile-bsdmake-mode))] + ["Classic" makefile-mode + :help "`makefile-mode' with no special functionality" + :button (:radio . (eq major-mode 'makefile-mode))] + ["Imake" makefile-imake-mode + :help "An adapted `makefile-mode' that knows about imake" + :button (:radio . (eq major-mode 'makefile-imake-mode))] + ["Makepp" makefile-makepp-mode + :help "An adapted `makefile-mode' that knows about makepp" + :button (:radio . (eq major-mode 'makefile-makepp-mode))]))) + (defvar makefile-browser-map (let ((map (make-sparse-keymap))) -- cgit v1.2.3 From e6842038c9c48131503804b139872bd565a245d9 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 20 Feb 2021 20:40:56 +0000 Subject: Fix memory leak * src/nsterm.m ([EmacsSurface dealloc]): Release will remove all objects and free the memory. --- src/nsterm.m | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nsterm.m b/src/nsterm.m index 6551694abee..88317f88393 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -9767,7 +9767,7 @@ nswindow_orderedIndex_sort (id w1, id w2, void *c) for (id object in cache) CFRelease ((IOSurfaceRef)object); - [cache removeAllObjects]; + [cache release]; [super dealloc]; } -- cgit v1.2.3 From 3010794753ddbb652d4362fcdf74aabf424144d1 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 21 Feb 2021 10:24:56 +0100 Subject: Clarification of password handling in Tramp manual * doc/misc/tramp.texi (Password handling): Describe, how to suppress `auth-sources' for Tramp. (Remote shell setup, Remote processes) (Cleanup remote connections, Frequently Asked Questions): Handle reference to Emacs manual. --- doc/misc/tramp.texi | 66 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 53 insertions(+), 13 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6d602157344..e745af2a7de 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1927,6 +1927,25 @@ file, you must customize @code{ange-ftp-netrc-filename}: (customize-set-variable 'ange-ftp-netrc-filename "~/.authinfo.gpg") @end lisp +In case you do not want to use an authentication file for +@value{tramp} passwords, use connection-local variables +@ifinfo +(@pxref{Connection Variables, , , emacs}) +@end ifinfo +like this: + +@lisp +@group +(connection-local-set-profile-variables + 'remote-without-auth-sources '((auth-sources . nil))) +@end group + +@group +(connection-local-set-profiles + '(:application tramp) 'remote-without-auth-sources) +@end group +@end lisp + @anchor{Caching passwords} @subsection Caching passwords @@ -2345,10 +2364,16 @@ fi Another possibility is to check the environment variable @env{INSIDE_EMACS}. Like for all subprocesses of Emacs, this is set -to the version of the parent Emacs process, @xref{Interactive Shell, , -, emacs}. @value{tramp} adds its own package version to this string, -which could be used for further tests in an inferior shell. The -string of that environment variable looks always like +to the version of the parent Emacs +@ifinfo +process, @xref{Interactive Shell, , , emacs}. +@end ifinfo +@ifnotinfo +process. +@end ifnotinfo +@value{tramp} adds its own package version to this string, which could +be used for further tests in an inferior shell. The string of that +environment variable looks always like @example @group @@ -3473,10 +3498,13 @@ uid=0(root) gid=0(root) groups=0(root) @cindex @code{gdb} @cindex @code{perldb} -@file{gud.el} provides a unified interface to symbolic debuggers +@file{gud.el} provides a unified interface to symbolic @ifinfo -(@ref{Debuggers, , , emacs}). +debuggers (@pxref{Debuggers, , , emacs}). @end ifinfo +@ifnotinfo +debuggers. +@end ifnotinfo @value{tramp} can run debug on remote hosts by calling @code{gdb} with a remote file name: @@ -3637,9 +3665,15 @@ minibuffer. Each connection is of the format Flushing remote connections also cleans the password cache (@pxref{Password handling}), file cache, connection cache -(@pxref{Connection caching}), and recentf cache (@pxref{File -Conveniences, , , emacs}). It also deletes session timers -(@pxref{Predefined connection information}) and connection buffers. +(@pxref{Connection caching}), and recentf +@ifinfo +cache (@pxref{File Conveniences, , , emacs}). +@end ifinfo +@ifnotinfo +cache. +@end ifnotinfo +It also deletes session timers (@pxref{Predefined connection +information}) and connection buffers. If @var{keep-debug} is non-@code{nil}, the debug buffer is kept. A non-@code{nil} @var{keep-password} preserves the password cache. @@ -4544,10 +4578,16 @@ HISTFILE=/dev/null @item Where are remote files trashed to? -Emacs can trash file instead of deleting them, @ref{Misc File Ops, -Trashing , , emacs}. Remote files are always trashed to the local -trash, except remote encrypted files (@pxref{Keeping files -encrypted}), which are deleted anyway. +Emacs can trash file instead of deleting +@ifinfo +them, @ref{Misc File Ops, Trashing , , emacs}. +@end ifinfo +@ifnotinfo +them. +@end ifnotinfo +Remote files are always trashed to the local trash, except remote +encrypted files (@pxref{Keeping files encrypted}), which are deleted +anyway. If Emacs is configured to use the XDG conventions for the trash directory, remote files cannot be restored with the respective tools, -- cgit v1.2.3 From 2c26eb11159b0acc2e3e74f9d1a96e615e86a40b Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 08:24:44 +0100 Subject: Convert some progmodes menus to easy-menu-define * lisp/progmodes/asm-mode.el (asm-mode-map): * lisp/progmodes/grep.el (grep-mode-map): * lisp/progmodes/m4-mode.el (m4-mode-map): * lisp/progmodes/sh-script.el (sh-mode-map): Move menu definition from here... * lisp/progmodes/asm-mode.el (asm-mode-menu): * lisp/progmodes/grep.el (grep-menu-map): * lisp/progmodes/m4-mode.el (m4-mode-menu): * lisp/progmodes/sh-script.el (sh-mode-menu): ...to here, and rewrite using easy-menu-define. --- lisp/progmodes/asm-mode.el | 20 ++++---- lisp/progmodes/grep.el | 76 +++++++++++------------------ lisp/progmodes/m4-mode.el | 26 +++++----- lisp/progmodes/sh-script.el | 116 +++++++++++++++++++------------------------- 4 files changed, 101 insertions(+), 137 deletions(-) diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 99b2ec6d87e..2f7d7bf7966 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -73,19 +73,19 @@ ;; Note that the comment character isn't set up until asm-mode is called. (define-key map ":" 'asm-colon) (define-key map "\C-c;" 'comment-region) - (define-key map [menu-bar asm-mode] (cons "Asm" (make-sparse-keymap))) - (define-key map [menu-bar asm-mode comment-region] - '(menu-item "Comment Region" comment-region - :help "Comment or uncomment each line in the region")) - (define-key map [menu-bar asm-mode newline-and-indent] - '(menu-item "Insert Newline and Indent" newline-and-indent - :help "Insert a newline, then indent according to major mode")) - (define-key map [menu-bar asm-mode asm-colon] - '(menu-item "Insert Colon" asm-colon - :help "Insert a colon; if it follows a label, delete the label's indentation")) map) "Keymap for Asm mode.") +(easy-menu-define asm-mode-menu asm-mode-map + "Menu for Asm mode." + '("Asm" + ["Insert Colon" asm-colon + :help "Insert a colon; if it follows a label, delete the label's indentation"] + ["Insert Newline and Indent" newline-and-indent + :help "Insert a newline, then indent according to major mode"] + ["Comment Region" comment-region + :help "Comment or uncomment each line in the region"])) + (defconst asm-font-lock-keywords (append '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\(\\.\\sw+\\)*\\)?" diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index d6ee8bb4236..3e92c699132 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -279,57 +279,39 @@ See `compilation-error-screen-columns'." (define-key map "}" 'compilation-next-file) (define-key map "\t" 'compilation-next-error) (define-key map [backtab] 'compilation-previous-error) - - ;; Set up the menu-bar - (define-key map [menu-bar grep] - (cons "Grep" (make-sparse-keymap "Grep"))) - - (define-key map [menu-bar grep grep-find-toggle-abbreviation] - '(menu-item "Toggle command abbreviation" - grep-find-toggle-abbreviation - :help "Toggle showing verbose command options")) - (define-key map [menu-bar grep compilation-separator3] '("----")) - (define-key map [menu-bar grep compilation-kill-compilation] - '(menu-item "Kill Grep" kill-compilation - :help "Kill the currently running grep process")) - (define-key map [menu-bar grep compilation-separator2] '("----")) - (define-key map [menu-bar grep compilation-compile] - '(menu-item - "Compile..." compile - :help - "Compile the program including the current buffer. Default: run `make'")) - (define-key map [menu-bar grep compilation-rgrep] - '(menu-item "Recursive grep..." rgrep - :help "User-friendly recursive grep in directory tree")) - (define-key map [menu-bar grep compilation-lgrep] - '(menu-item "Local grep..." lgrep - :help "User-friendly grep in a directory")) - (define-key map [menu-bar grep compilation-grep-find] - '(menu-item "Grep via Find..." grep-find - :help "Run grep via find, with user-specified args")) - (define-key map [menu-bar grep compilation-grep] - '(menu-item - "Another grep..." grep - :help - "Run grep, with user-specified args, and collect output in a buffer.")) - (define-key map [menu-bar grep compilation-recompile] - '(menu-item "Repeat grep" recompile - :help "Run grep again")) - (define-key map [menu-bar grep compilation-separator1] '("----")) - (define-key map [menu-bar grep compilation-first-error] - '(menu-item - "First Match" first-error - :help "Restart at the first match, visit corresponding location")) - (define-key map [menu-bar grep compilation-previous-error] - '(menu-item "Previous Match" previous-error - :help "Visit the previous match and corresponding location")) - (define-key map [menu-bar grep compilation-next-error] - '(menu-item "Next Match" next-error - :help "Visit the next match and corresponding location")) map) "Keymap for grep buffers. `compilation-minor-mode-map' is a cdr of this.") +(easy-menu-define grep-menu-map grep-mode-map + "Menu for grep buffers." + '("Grep" + ["Next Match" next-error + :help "Visit the next match and corresponding location"] + ["Previous Match" previous-error + :help "Visit the previous match and corresponding location"] + ["First Match" first-error + :help "Restart at the first match, visit corresponding location"] + "----" + ["Repeat grep" recompile + :help "Run grep again"] + ["Another grep..." grep + :help "Run grep, with user-specified args, and collect output in a buffer."] + ["Grep via Find..." grep-find + :help "Run grep via find, with user-specified args"] + ["Local grep..." lgrep + :help "User-friendly grep in a directory"] + ["Recursive grep..." rgrep + :help "User-friendly recursive grep in directory tree"] + ["Compile..." compile + :help "Compile the program including the current buffer. Default: run `make'"] + "----" + ["Kill Grep" kill-compilation + :help "Kill the currently running grep process"] + "----" + ["Toggle command abbreviation" grep-find-toggle-abbreviation + :help "Toggle showing verbose command options"])) + (defvar grep-mode-tool-bar-map ;; When bootstrapping, tool-bar-map is not properly initialized yet, ;; so don't do anything. diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index 7dfaed44282..d9c09f6fe6b 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -122,22 +122,22 @@ If m4 is not in your PATH, set this to an absolute file name." (string-to-syntax ".")))))) (defvar m4-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (define-key map "\C-c\C-b" 'm4-m4-buffer) (define-key map "\C-c\C-r" 'm4-m4-region) (define-key map "\C-c\C-c" 'comment-region) - (define-key map [menu-bar m4-mode] (cons "M4" menu-map)) - (define-key menu-map [m4c] - '(menu-item "Comment Region" comment-region - :help "Comment Region")) - (define-key menu-map [m4b] - '(menu-item "M4 Buffer" m4-m4-buffer - :help "Send contents of the current buffer to m4")) - (define-key menu-map [m4r] - '(menu-item "M4 Region" m4-m4-region - :help "Send contents of the current region to m4")) - map)) + map) + "Keymap for M4 Mode.") + +(easy-menu-define m4-mode-menu m4-mode-map + "Menu for M4 Mode." + '("M4" + ["M4 Region" m4-m4-region + :help "Send contents of the current region to m4"] + ["M4 Buffer" m4-m4-buffer + :help "Send contents of the current buffer to m4"] + ["Comment Region" comment-region + :help "Comment Region"])) (defun m4-m4-buffer () "Send contents of the current buffer to m4." diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f588ad99c9d..ba59f9c6616 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -403,8 +403,7 @@ This is buffer-local in every such buffer.") "Syntax-table used in Shell-Script mode. See `sh-feature'.") (defvar sh-mode-map - (let ((map (make-sparse-keymap)) - (menu-map (make-sparse-keymap))) + (let ((map (make-sparse-keymap))) (define-key map "\C-c(" 'sh-function) (define-key map "\C-c\C-w" 'sh-while) (define-key map "\C-c\C-u" 'sh-until) @@ -434,74 +433,57 @@ This is buffer-local in every such buffer.") (define-key map "\C-c:" 'sh-set-shell) (define-key map [remap backward-sentence] 'sh-beginning-of-command) (define-key map [remap forward-sentence] 'sh-end-of-command) - (define-key map [menu-bar sh-script] (cons "Sh-Script" menu-map)) - (define-key menu-map [smie-config-guess] - '(menu-item "Learn buffer indentation" smie-config-guess - :help "Learn how to indent the buffer the way it currently is.")) - (define-key menu-map [smie-config-show-indent] - '(menu-item "Show indentation" smie-config-show-indent - :help "Show the how the current line would be indented")) - (define-key menu-map [smie-config-set-indent] - '(menu-item "Set indentation" smie-config-set-indent - :help "Set the indentation for the current line")) - - (define-key menu-map [sh-pair] - '(menu-item "Insert braces and quotes in pairs" - electric-pair-mode - :button (:toggle . (bound-and-true-p electric-pair-mode)) - :help "Inserting a brace or quote automatically inserts the matching pair")) - - (define-key menu-map [sh-s0] '("--")) - ;; Insert - (define-key menu-map [sh-function] - '(menu-item "Function..." sh-function - :help "Insert a function definition")) - (define-key menu-map [sh-add] - '(menu-item "Addition..." sh-add - :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell")) - (define-key menu-map [sh-until] - '(menu-item "Until Loop" sh-until - :help "Insert an until loop")) - (define-key menu-map [sh-repeat] - '(menu-item "Repeat Loop" sh-repeat - :help "Insert a repeat loop definition")) - (define-key menu-map [sh-while] - '(menu-item "While Loop" sh-while - :help "Insert a while loop")) - (define-key menu-map [sh-getopts] - '(menu-item "Options Loop" sh-while-getopts - :help "Insert a while getopts loop.")) - (define-key menu-map [sh-indexed-loop] - '(menu-item "Indexed Loop" sh-indexed-loop - :help "Insert an indexed loop from 1 to n.")) - (define-key menu-map [sh-select] - '(menu-item "Select Statement" sh-select - :help "Insert a select statement ")) - (define-key menu-map [sh-if] - '(menu-item "If Statement" sh-if - :help "Insert an if statement")) - (define-key menu-map [sh-for] - '(menu-item "For Loop" sh-for - :help "Insert a for loop")) - (define-key menu-map [sh-case] - '(menu-item "Case Statement" sh-case - :help "Insert a case/switch statement")) - (define-key menu-map [sh-s1] '("--")) - (define-key menu-map [sh-exec] - '(menu-item "Execute region" sh-execute-region - :help "Pass optional header and region to a subshell for noninteractive execution")) - (define-key menu-map [sh-exec-interpret] - '(menu-item "Execute script..." executable-interpret - :help "Run script with user-specified args, and collect output in a buffer")) - (define-key menu-map [sh-set-shell] - '(menu-item "Set shell type..." sh-set-shell - :help "Set this buffer's shell to SHELL (a string)")) - (define-key menu-map [sh-backslash-region] - '(menu-item "Backslash region" sh-backslash-region - :help "Insert, align, or delete end-of-line backslashes on the lines in the region.")) map) "Keymap used in Shell-Script mode.") +(easy-menu-define sh-mode-menu sh-mode-map + "Menu for Shell-Script mode." + '("Sh-Script" + ["Backslash region" sh-backslash-region + :help "Insert, align, or delete end-of-line backslashes on the lines in the region."] + ["Set shell type..." sh-set-shell + :help "Set this buffer's shell to SHELL (a string)"] + ["Execute script..." executable-interpret + :help "Run script with user-specified args, and collect output in a buffer"] + ["Execute region" sh-execute-region + :help "Pass optional header and region to a subshell for noninteractive execution"] + "---" + ;; Insert + ["Case Statement" sh-case + :help "Insert a case/switch statement"] + ["For Loop" sh-for + :help "Insert a for loop"] + ["If Statement" sh-if + :help "Insert an if statement"] + ["Select Statement" sh-select + :help "Insert a select statement "] + ["Indexed Loop" sh-indexed-loop + :help "Insert an indexed loop from 1 to n."] + ["Options Loop" sh-while-getopts + :help "Insert a while getopts loop."] + ["While Loop" sh-while + :help "Insert a while loop"] + ["Repeat Loop" sh-repeat + :help "Insert a repeat loop definition"] + ["Until Loop" sh-until + :help "Insert an until loop"] + ["Addition..." sh-add + :help "Insert an addition of VAR and prefix DELTA for Bourne (type) shell"] + ["Function..." sh-function + :help "Insert a function definition"] + "---" + ;; Other + ["Insert braces and quotes in pairs" electric-pair-mode + :style toggle + :selected (bound-and-true-p electric-pair-mode) + :help "Inserting a brace or quote automatically inserts the matching pair"] + ["Set indentation" smie-config-set-indent + :help "Set the indentation for the current line"] + ["Show indentation" smie-config-show-indent + :help "Show the how the current line would be indented"] + ["Learn buffer indentation" smie-config-guess + :help "Learn how to indent the buffer the way it currently is."])) + (defvar sh-skeleton-pair-default-alist '((?\( _ ?\)) (?\)) (?\[ ?\s _ ?\s ?\]) (?\]) (?{ _ ?}) (?\})) -- cgit v1.2.3 From df932bef91122b8400299b83b774c8c5e5ee4d75 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 10:02:43 +0100 Subject: * etc/NEWS.19: Add entry for 'easy-menu-define'. --- etc/NEWS.19 | 1 + 1 file changed, 1 insertion(+) diff --git a/etc/NEWS.19 b/etc/NEWS.19 index f2cef62971b..fd91c0842f7 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -4011,6 +4011,7 @@ The third component is now determined on the basis of the names of the existing executable files. This means that version.el is not altered by building Emacs. +** New macro 'easy-menu-define' * Changes in 19.22. -- cgit v1.2.3 From 669b911c6660120c73b7760063d490872240a727 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 10:10:03 +0100 Subject: ; Fix previous easy-menu-define conversion * lisp/emacs-lisp/re-builder.el (reb-mode-menu): * lisp/progmodes/make-mode.el (makefile-mode-menu): Replace :button attribute with :style and :selected. --- lisp/emacs-lisp/re-builder.el | 6 +++--- lisp/progmodes/make-mode.el | 18 ++++++++++++------ 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 7f404c8296c..455fcac701f 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -250,9 +250,9 @@ Except for Lisp syntax this is the same as `reb-regexp'.") ["Change target buffer..." reb-change-target-buffer :help "Change the target buffer and display it in the target window"] ["Case sensitive" reb-toggle-case - :button (:toggle . (with-current-buffer - reb-target-buffer - (null case-fold-search))) + :style toggle + :selected (with-current-buffer reb-target-buffer + (null case-fold-search)) :help "Toggle case sensitivity of searches for RE Builder target buffer"] "---" ["Quit" reb-quit diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index d444ce29995..3f466e1150b 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -631,22 +631,28 @@ The function must satisfy this calling convention: ("Switch Makefile Type" ["GNU make" makefile-gmake-mode :help "An adapted `makefile-mode' that knows about GNU make" - :button (:radio . (eq major-mode 'makefile-gmake-mode))] + :style radio + :selected (eq major-mode 'makefile-gmake-mode)] ["Automake" makefile-automake-mode :help "An adapted `makefile-mode' that knows about automake" - :button (:radio . (eq major-mode 'makefile-automake-mode))] + :style radio + :selected (eq major-mode 'makefile-automake-mode)] ["BSD" makefile-bsdmake-mode :help "An adapted `makefile-mode' that knows about BSD make" - :button (:radio . (eq major-mode 'makefile-bsdmake-mode))] + :style radio + :selected (eq major-mode 'makefile-bsdmake-mode)] ["Classic" makefile-mode :help "`makefile-mode' with no special functionality" - :button (:radio . (eq major-mode 'makefile-mode))] + :style radio + :selected (eq major-mode 'makefile-mode)] ["Imake" makefile-imake-mode :help "An adapted `makefile-mode' that knows about imake" - :button (:radio . (eq major-mode 'makefile-imake-mode))] + :style radio + :selected (eq major-mode 'makefile-imake-mode)] ["Makepp" makefile-makepp-mode :help "An adapted `makefile-mode' that knows about makepp" - :button (:radio . (eq major-mode 'makefile-makepp-mode))]))) + :style radio + :selected (eq major-mode 'makefile-makepp-mode)]))) (defvar makefile-browser-map -- cgit v1.2.3 From 1b9e233493a65952060d1678cec5f149d10f90e4 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 10:19:23 +0100 Subject: Convert bubbles menu to easy-menu-define * lisp/play/bubbles.el (bubbles-game-theme-menu) (bubbles-graphics-theme-menu, bubbles-menu, bubbles-mode-map): Move menu definition from here... (bubbles-menu): ...to here, and convert to easy-menu-define. --- lisp/play/bubbles.el | 130 +++++++++++++++++++++------------------------------ 1 file changed, 53 insertions(+), 77 deletions(-) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index dc93ef90310..dddd19fa0a3 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -811,78 +811,7 @@ static char * dot3d_xpm[] = { (bubbles--initialize-images) (bubbles--update-faces-or-images)) -;; game theme menu -(defvar bubbles-game-theme-menu - (let ((menu (make-sparse-keymap "Game Theme"))) - (define-key menu [bubbles-set-game-userdefined] - (list 'menu-item "User defined" 'bubbles-set-game-userdefined - :button '(:radio . (eq bubbles-game-theme 'user-defined)))) - (define-key menu [bubbles-set-game-hard] - (list 'menu-item "Hard" 'bubbles-set-game-hard - :button '(:radio . (eq bubbles-game-theme 'hard)))) - (define-key menu [bubbles-set-game-difficult] - (list 'menu-item "Difficult" 'bubbles-set-game-difficult - :button '(:radio . (eq bubbles-game-theme 'difficult)))) - (define-key menu [bubbles-set-game-medium] - (list 'menu-item "Medium" 'bubbles-set-game-medium - :button '(:radio . (eq bubbles-game-theme 'medium)))) - (define-key menu [bubbles-set-game-easy] - (list 'menu-item "Easy" 'bubbles-set-game-easy - :button '(:radio . (eq bubbles-game-theme 'easy)))) - menu) - "Map for bubbles game theme menu.") - -;; graphics theme menu -(defvar bubbles-graphics-theme-menu - (let ((menu (make-sparse-keymap "Graphics Theme"))) - (define-key menu [bubbles-set-graphics-theme-ascii] - (list 'menu-item "ASCII" 'bubbles-set-graphics-theme-ascii - :button '(:radio . (eq bubbles-graphics-theme 'ascii)))) - (define-key menu [bubbles-set-graphics-theme-emacs] - (list 'menu-item "Emacs" 'bubbles-set-graphics-theme-emacs - :button '(:radio . (eq bubbles-graphics-theme 'emacs)))) - (define-key menu [bubbles-set-graphics-theme-balls] - (list 'menu-item "Balls" 'bubbles-set-graphics-theme-balls - :button '(:radio . (eq bubbles-graphics-theme 'balls)))) - (define-key menu [bubbles-set-graphics-theme-diamonds] - (list 'menu-item "Diamonds" 'bubbles-set-graphics-theme-diamonds - :button '(:radio . (eq bubbles-graphics-theme 'diamonds)))) - (define-key menu [bubbles-set-graphics-theme-squares] - (list 'menu-item "Squares" 'bubbles-set-graphics-theme-squares - :button '(:radio . (eq bubbles-graphics-theme 'squares)))) - (define-key menu [bubbles-set-graphics-theme-circles] - (list 'menu-item "Circles" 'bubbles-set-graphics-theme-circles - :button '(:radio . (eq bubbles-graphics-theme 'circles)))) - menu) - "Map for bubbles graphics theme menu.") - -;; menu -(defvar bubbles-menu - (let ((menu (make-sparse-keymap "Bubbles"))) - (define-key menu [bubbles-quit] - (list 'menu-item "Quit" 'bubbles-quit)) - (define-key menu [bubbles] - (list 'menu-item "New game" 'bubbles)) - (define-key menu [bubbles-separator-1] - '("--")) - (define-key menu [bubbles-save-settings] - (list 'menu-item "Save all settings" 'bubbles-save-settings)) - (define-key menu [bubbles-customize] - (list 'menu-item "Edit all settings" 'bubbles-customize)) - (define-key menu [bubbles-game-theme-menu] - (list 'menu-item "Game Theme" bubbles-game-theme-menu)) - (define-key menu [bubbles-graphics-theme-menu] - (list 'menu-item "Graphics Theme" bubbles-graphics-theme-menu - :enable 'bubbles--playing)) - (define-key menu [bubbles-separator-2] - '("--")) - (define-key menu [bubbles-undo] - (list 'menu-item "Undo last move" 'bubbles-undo - :enable '(and bubbles--playing (listp buffer-undo-list)))) - menu) - "Map for bubbles menu.") - -;; bubbles mode map + (defvar bubbles-mode-map (let ((map (make-sparse-keymap 'bubbles-mode-map))) ;; (suppress-keymap map t) @@ -897,12 +826,59 @@ static char * dot3d_xpm[] = { (define-key map "n" 'next-line) (define-key map "f" 'forward-char) (define-key map "b" 'backward-char) - ;; bind menu to mouse - (define-key map [down-mouse-3] bubbles-menu) - ;; Put menu in menu-bar - (define-key map [menu-bar Bubbles] (cons "Bubbles" bubbles-menu)) map) - "Mode map for bubbles.") + "Mode map for `bubbles'.") + +(easy-menu-define bubbles-menu bubbles-mode-map + "Menu for `bubbles'." + '("Bubbles" + ["Undo last move" bubbles-undo + :enable '(and bubbles--playing (listp buffer-undo-list))] + "---" + ("Graphics Theme" + :enable bubbles--playing + ["Circles" bubbles-set-graphics-theme-circles + :style radio + :selected (eq bubbles-graphics-theme 'circles)] + ["Squares" bubbles-set-graphics-theme-squares + :style radio + :selected (eq bubbles-graphics-theme 'squares)] + ["Diamonds" bubbles-set-graphics-theme-diamonds + :style radio + :selected (eq bubbles-graphics-theme 'diamonds)] + ["Balls" bubbles-set-graphics-theme-balls + :style radio + :selected (eq bubbles-graphics-theme 'balls)] + ["Emacs" bubbles-set-graphics-theme-emacs + :style radio + :selected (eq bubbles-graphics-theme 'emacs)] + ["ASCII" bubbles-set-graphics-theme-ascii + :style radio + :selected (eq bubbles-graphics-theme 'ascii)]) + ("Game Theme" + ["Easy" bubbles-set-game-easy + :style radio + :selected (eq bubbles-game-theme 'easy)] + ["Medium" bubbles-set-game-medium + :style radio + :selected (eq bubbles-game-theme 'medium)] + ["Difficult" bubbles-set-game-difficult + :style radio + :selected (eq bubbles-game-theme 'difficult)] + ["Hard" bubbles-set-game-hard + :style radio + :selected (eq bubbles-game-theme 'hard)] + ["User defined" bubbles-set-game-userdefined + :style radio + :selected (eq bubbles-game-theme 'user-defined)]) + ["Edit all settings" bubbles-customize] + ["Save all settings" bubbles-save-settings] + "---" + ["New game" bubbles] + ["Quit" bubbles-quit])) + +;; bind menu to mouse +(define-key bubbles-mode-map [down-mouse-3] bubbles-menu) (define-derived-mode bubbles-mode nil "Bubbles" "Major mode for playing bubbles. -- cgit v1.2.3 From 767608ef56044af63712206325d177b0caf279df Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 10:23:12 +0100 Subject: Make unused variable menu-bar-handwrite-map obsolete * lisp/play/handwrite.el (menu-bar-handwrite-map): Make unused variable obsolete. --- lisp/play/handwrite.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 98da26c2e6c..3cc5d9c8dce 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -90,7 +90,7 @@ (define-key map [handwrite] '("Write by hand" . handwrite)) map)) (fset 'menu-bar-handwrite-map menu-bar-handwrite-map) - +(make-obsolete-variable 'menu-bar-handwrite-map nil "28.1") ;; User definable variables -- cgit v1.2.3 From 908f251e19dc64c75000f87bc6db4e9a8852d1ad Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 11 Feb 2021 12:00:05 +0000 Subject: Fix json.el encoding of confusable object keys * lisp/json.el (json-encode-string): Clarify commentary. (json--encode-stringlike): New function that covers a subset of json-encode. (json-encode-key): Use it for more efficient encoding and validation, and to avoid mishandling confusable keys like boolean symbols (bug#42545). (json-encode-array): Make it clearer that argument can be a list. (json-encode): Reuse json-encode-keyword and json--encode-stringlike for a subset of the dispatch logic. (json-pretty-print): Ensure confusable keys like ":a" survive a decoding/encoding roundtrip (bug#24252, bug#45032). * test/lisp/json-tests.el (test-json-encode-string) (test-json-encode-hash-table, test-json-encode-alist) (test-json-encode-plist, test-json-pretty-print-object): Test encoding of confusable keys. --- lisp/json.el | 36 +++++++++++----------- test/lisp/json-tests.el | 79 ++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 90 insertions(+), 25 deletions(-) diff --git a/lisp/json.el b/lisp/json.el index 1f1f608eaba..f20123fcfbc 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -438,7 +438,8 @@ Initialized lazily by `json-encode-string'.") ;; This seems to afford decent performance gains. (setq-local inhibit-modification-hooks t) (setq json--string-buffer (current-buffer)))) - (insert ?\" (substring-no-properties string)) ; see bug#43549 + ;; Strip `read-only' property (bug#43549). + (insert ?\" (substring-no-properties string)) (goto-char (1+ (point-min))) (while (re-search-forward (rx json--escape) nil 'move) (let ((char (preceding-char))) @@ -452,14 +453,20 @@ Initialized lazily by `json-encode-string'.") ;; Empty buffer for next invocation. (delete-and-extract-region (point-min) (point-max))))) +(defun json--encode-stringlike (object) + "Return OBJECT encoded as a JSON string, or nil if not possible." + (cond ((stringp object) (json-encode-string object)) + ((keywordp object) (json-encode-string + (substring (symbol-name object) 1))) + ((symbolp object) (json-encode-string (symbol-name object))))) + (defun json-encode-key (object) "Return a JSON representation of OBJECT. If the resulting JSON object isn't a valid JSON object key, this signals `json-key-format'." - (let ((encoded (json-encode object))) - (unless (stringp (json-read-from-string encoded)) - (signal 'json-key-format (list object))) - encoded)) + ;; Encoding must be a JSON string. + (or (json--encode-stringlike object) + (signal 'json-key-format (list object)))) ;;; Objects @@ -652,11 +659,10 @@ become JSON objects." ;; Array encoding (defun json-encode-array (array) - "Return a JSON representation of ARRAY." + "Return a JSON representation of ARRAY. +ARRAY can also be a list." (if (and json-encoding-pretty-print - (if (listp array) - array - (> (length array) 0))) + (not (length= array 0))) (concat "[" (json--with-indentation @@ -737,15 +743,9 @@ you will get the following structure returned: OBJECT should have a structure like one returned by `json-read'. If an error is detected during encoding, an error based on `json-error' is signaled." - (cond ((eq object t) (json-encode-keyword object)) - ((eq object json-null) (json-encode-keyword object)) - ((eq object json-false) (json-encode-keyword object)) - ((stringp object) (json-encode-string object)) - ((keywordp object) (json-encode-string - (substring (symbol-name object) 1))) + (cond ((json-encode-keyword object)) ((listp object) (json-encode-list object)) - ((symbolp object) (json-encode-string - (symbol-name object))) + ((json--encode-stringlike object)) ((numberp object) (json-encode-number object)) ((arrayp object) (json-encode-array object)) ((hash-table-p object) (json-encode-hash-table object)) @@ -774,6 +774,8 @@ With prefix argument MINIMIZE, minimize it instead." (json-null :json-null) ;; Ensure that ordering is maintained. (json-object-type 'alist) + ;; Ensure that keys survive roundtrip (bug#24252, bug#42545). + (json-key-type 'string) (orig-buf (current-buffer)) error) ;; Strategy: Repeatedly `json-read' from the original buffer and diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 11b61d8b47e..9886dc0d457 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -421,12 +421,21 @@ Point is moved to beginning of the buffer." "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) (ert-deftest test-json-encode-key () - (should (equal (json-encode-key "") "\"\"")) (should (equal (json-encode-key '##) "\"\"")) (should (equal (json-encode-key :) "\"\"")) - (should (equal (json-encode-key "foo") "\"foo\"")) - (should (equal (json-encode-key 'foo) "\"foo\"")) - (should (equal (json-encode-key :foo) "\"foo\"")) + (should (equal (json-encode-key "") "\"\"")) + (should (equal (json-encode-key 'a) "\"a\"")) + (should (equal (json-encode-key :a) "\"a\"")) + (should (equal (json-encode-key "a") "\"a\"")) + (should (equal (json-encode-key t) "\"t\"")) + (should (equal (json-encode-key :t) "\"t\"")) + (should (equal (json-encode-key "t") "\"t\"")) + (should (equal (json-encode-key nil) "\"nil\"")) + (should (equal (json-encode-key :nil) "\"nil\"")) + (should (equal (json-encode-key "nil") "\"nil\"")) + (should (equal (json-encode-key ":a") "\":a\"")) + (should (equal (json-encode-key ":t") "\":t\"")) + (should (equal (json-encode-key ":nil") "\":nil\"")) (should (equal (should-error (json-encode-key 5)) '(json-key-format 5))) (should (equal (should-error (json-encode-key ["foo"])) @@ -572,6 +581,39 @@ Point is moved to beginning of the buffer." (should (equal (json-encode-hash-table #s(hash-table)) "{}")) (should (equal (json-encode-hash-table #s(hash-table data (a 1))) "{\"a\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (t 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (nil 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:a 1))) + "{\"a\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:t 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table #s(hash-table data (:nil 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("a" 1))) + "{\"a\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("t" 1))) + "{\"t\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data ("nil" 1))) + "{\"nil\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":a" 1))) + "{\":a\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":t" 1))) + "{\":t\":1}")) + (should (equal (json-encode-hash-table + #s(hash-table test equal data (":nil" 1))) + "{\":nil\":1}")) + (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1))) + '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) + (should (member (json-encode-hash-table + #s(hash-table test equal data (:t 2 ":t" 1))) + '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) @@ -638,7 +680,16 @@ Point is moved to beginning of the buffer." (let ((json-encoding-object-sort-predicate nil) (json-encoding-pretty-print nil)) (should (equal (json-encode-alist ()) "{}")) - (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}")) + (should (equal (json-encode-alist '((a . 1) (t . 2) (nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((:a . 1) (:t . 2) (:nil . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '(("a" . 1) ("t" . 2) ("nil" . 3))) + "{\"a\":1,\"t\":2,\"nil\":3}")) + (should (equal (json-encode-alist '((":a" . 1) (":t" . 2) (":nil" . 3))) + "{\":a\":1,\":t\":2,\":nil\":3}")) + (should (equal (json-encode-alist '((t . 1) (:nil . 2) (":nil" . 3))) + "{\"t\":1,\"nil\":2,\":nil\":3}")) (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1))) "{\"c\":3,\"b\":2,\"a\":1}")))) @@ -687,8 +738,14 @@ Point is moved to beginning of the buffer." (should (equal (json-encode-plist ()) "{}")) (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}")) (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) - (should (equal (json-encode-plist '(:c 3 :b 2 :a 1)) - "{\"c\":3,\"b\":2,\"a\":1}")))) + (should (equal (json-encode-plist '(":d" 4 "c" 3 b 2 :a 1)) + "{\":d\":4,\"c\":3,\"b\":2,\"a\":1}")) + (should (equal (json-encode-plist '(nil 2 t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(:nil 2 :t 1)) + "{\"nil\":2,\"t\":1}")) + (should (equal (json-encode-plist '(":nil" 4 "nil" 3 ":t" 2 "t" 1)) + "{\":nil\":4,\"nil\":3,\":t\":2,\"t\":1}")))) (ert-deftest test-json-encode-plist-pretty () (let ((json-encoding-object-sort-predicate nil) @@ -950,7 +1007,13 @@ nil, ORIGINAL should stay unchanged by pretty-printing." ;; Nested array. (json-tests-equal-pretty-print "{\"key\":[1,2]}" - "{\n \"key\": [\n 1,\n 2\n ]\n}")) + "{\n \"key\": [\n 1,\n 2\n ]\n}") + ;; Confusable keys (bug#24252, bug#42545). + (json-tests-equal-pretty-print + (concat "{\"t\":1,\"nil\":2,\":t\":3,\":nil\":4," + "\"null\":5,\":json-null\":6,\":json-false\":7}") + (concat "{\n \"t\": 1,\n \"nil\": 2,\n \":t\": 3,\n \":nil\": 4," + "\n \"null\": 5,\n \":json-null\": 6,\n \":json-false\": 7\n}"))) (ert-deftest test-json-pretty-print-array () ;; Empty. -- cgit v1.2.3 From d15a42ac453c47c4da8ba1a66170dee106541d63 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 21 Feb 2021 14:03:13 +0100 Subject: Use `undefined' instead of `ignore' in wdired * lisp/wdired.el (wdired-mode-map): Use `undefined' here instead of `ignore' to give the user more feedback. --- lisp/wdired.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/wdired.el b/lisp/wdired.el index a096abd106f..3829ff1f977 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -169,9 +169,9 @@ nonexistent directory will fail." (define-key map "\C-c\C-k" 'wdired-abort-changes) (define-key map "\C-c\C-[" 'wdired-abort-changes) (define-key map "\C-x\C-q" 'wdired-exit) - (define-key map "\C-m" 'ignore) - (define-key map "\C-j" 'ignore) - (define-key map "\C-o" 'ignore) + (define-key map "\C-m" 'undefined) + (define-key map "\C-j" 'undefined) + (define-key map "\C-o" 'undefined) (define-key map [up] 'wdired-previous-line) (define-key map "\C-p" 'wdired-previous-line) (define-key map [down] 'wdired-next-line) -- cgit v1.2.3 From 24166be166ccda48353b395174da7e2bb1ca7659 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 21 Feb 2021 19:26:39 +0100 Subject: Declare that `ignore' and `undefined' shouldn't be completed over * lisp/subr.el (ignore, undefined): Declare that these shouldn't be completed over. --- lisp/subr.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/subr.el b/lisp/subr.el index cf70b249cfc..2ad31b656ea 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -375,6 +375,7 @@ PREFIX is a string, and defaults to \"g\"." "Do nothing and return nil. This function accepts any number of ARGUMENTS, but ignores them. Also see `always'." + (declare (completion #'ignore)) (interactive) nil) @@ -922,6 +923,7 @@ For an approximate inverse of this, see `key-description'." (defun undefined () "Beep to tell the user this binding is undefined." + (declare (completion #'ignore)) (interactive) (ding) (if defining-kbd-macro -- cgit v1.2.3 From ff759b1d0a901e5408a9dfea6c6bc77d1ae1dbf3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 21 Feb 2021 11:19:57 +0100 Subject: Fix interactive mode tagging for man and woman * lisp/man.el (man-common): New mode inheriting special-mode. (Man-mode): * lisp/woman.el (woman-mode): Inherit from man-common. * lisp/man.el (man-follow, Man-update-manpage) (Man-fontify-manpage, Man-cleanup-manpage, Man-next-section) (Man-previous-section, Man-goto-section) (Man-goto-see-also-section, Man-follow-manual-reference) (Man-kill, Man-goto-page, Man-next-manpage) (Man-previous-manpage): Change interactive mode tag to man-common. This was discussed in: https://lists.gnu.org/r/emacs-devel/2021-02/msg01619.html --- lisp/man.el | 35 +++++++++++++++++++++-------------- lisp/woman.el | 4 +++- 2 files changed, 24 insertions(+), 15 deletions(-) diff --git a/lisp/man.el b/lisp/man.el index 70b8aa8eb2f..abb9bbad8fd 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1024,7 +1024,7 @@ to auto-complete your input based on the installed manual pages." ;;;###autoload (defun man-follow (man-args) "Get a Un*x manual page of the item under point and put it in a buffer." - (interactive (list (Man-default-man-entry)) Man-mode) + (interactive (list (Man-default-man-entry)) man-common) (if (or (not man-args) (string= man-args "")) (error "No item under point") @@ -1143,7 +1143,7 @@ Return the buffer in which the manpage will appear." (defun Man-update-manpage () "Reformat current manpage by calling the man command again synchronously." - (interactive nil Man-mode) + (interactive nil man-common) (when (eq Man-arguments nil) ;;this shouldn't happen unless it is not in a Man buffer." (error "Man-arguments not initialized")) @@ -1239,7 +1239,7 @@ See the variable `Man-notify-method' for the different notification behaviors." (defun Man-fontify-manpage () "Convert overstriking and underlining to the correct fonts. Same for the ANSI bold and normal escape sequences." - (interactive nil Man-mode) + (interactive nil man-common) (goto-char (point-min)) ;; Fontify ANSI escapes. (let ((ansi-color-apply-face-function #'ansi-color-apply-text-property-face) @@ -1355,7 +1355,7 @@ default type, `Man-xref-man-page' is used for the buttons." Normally skip any jobs that should have been done by the sed script, but when called interactively, do those jobs even if the sed script would have done them." - (interactive "p" Man-mode) + (interactive "p" man-common) (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) @@ -1527,7 +1527,14 @@ manpage command." (defvar bookmark-make-record-function) -(define-derived-mode Man-mode special-mode "Man" +(define-derived-mode man-common special-mode "Man Shared" + "Parent mode for `Man-mode' like modes. +This mode is here to be inherited by modes that need to use +commands from `Man-mode'. Used by `woman'. +(In itself, this mode currently does nothing.)" + :interactive nil) + +(define-derived-mode Man-mode man-common "Man" "A mode for browsing Un*x manual pages. The following man commands are available in the buffer. Try @@ -1723,7 +1730,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-next-section (n) "Move point to Nth next section (default 1)." - (interactive "p" Man-mode) + (interactive "p" man-common) (let ((case-fold-search nil) (start (point))) (if (looking-at Man-heading-regexp) @@ -1739,7 +1746,7 @@ The following key bindings are currently in effect in the buffer: (defun Man-previous-section (n) "Move point to Nth previous section (default 1)." - (interactive "p" Man-mode) + (interactive "p" man-common) (let ((case-fold-search nil)) (if (looking-at Man-heading-regexp) (forward-line -1)) @@ -1771,7 +1778,7 @@ Returns t if section is found, nil otherwise." (chosen (completing-read prompt Man--sections nil nil nil nil default))) (list chosen)) - Man-mode) + man-common) (setq Man--last-section section) (unless (Man-find-section section) (error "Section %s not found" section))) @@ -1780,7 +1787,7 @@ Returns t if section is found, nil otherwise." (defun Man-goto-see-also-section () "Move point to the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." - (interactive nil Man-mode) + (interactive nil man-common) (if (not (Man-find-section Man-see-also-regexp)) (error "%s" (concat "No " Man-see-also-regexp " section found in the current manpage")))) @@ -1835,7 +1842,7 @@ Specify which REFERENCE to use; default is based on word at point." (chosen (completing-read prompt Man--refpages nil nil nil nil defaults))) chosen))) - Man-mode) + man-common) (if (not Man--refpages) (error "Can't find any references in the current manpage") (setq Man--last-refpage reference) @@ -1844,7 +1851,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-kill () "Kill the buffer containing the manpage." - (interactive nil Man-mode) + (interactive nil man-common) (quit-window t)) (defun Man-goto-page (page &optional noerror) @@ -1856,7 +1863,7 @@ Specify which REFERENCE to use; default is based on word at point." (error "You're looking at the only manpage in the buffer") (list (read-minibuffer (format "Go to manpage [1-%d]: " (length Man-page-list)))))) - Man-mode) + man-common) (if (and (not Man-page-list) (not noerror)) (error "Not a man page buffer")) (when Man-page-list @@ -1878,7 +1885,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-next-manpage () "Find the next manpage entry in the buffer." - (interactive nil Man-mode) + (interactive nil man-common) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (< Man-current-page (length Man-page-list)) @@ -1889,7 +1896,7 @@ Specify which REFERENCE to use; default is based on word at point." (defun Man-previous-manpage () "Find the previous manpage entry in the buffer." - (interactive nil Man-mode) + (interactive nil man-common) (if (= (length Man-page-list) 1) (error "This is the only manpage in the buffer")) (if (> Man-current-page 1) diff --git a/lisp/woman.el b/lisp/woman.el index 98f1a47d24c..d4f7e8c0db7 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1856,13 +1856,15 @@ Argument EVENT is the invoking mouse event." (defvar bookmark-make-record-function) -(define-derived-mode woman-mode special-mode "WoMan" +(define-derived-mode woman-mode man-common "WoMan" "Turn on (most of) Man mode to browse a buffer formatted by WoMan. WoMan is an ELisp emulation of much of the functionality of the Emacs `man' command running the standard UN*X man and ?roff programs. WoMan author: F.J.Wright@Maths.QMW.ac.uk See `Man-mode' for additional details. \\{woman-mode-map}" + ;; FIXME: Should all this just be re-arranged so that this can just + ;; inherit `man-common' and be done with it? (let ((Man-build-page-list (symbol-function 'Man-build-page-list)) (Man-strip-page-headers (symbol-function 'Man-strip-page-headers)) (Man-unindent (symbol-function 'Man-unindent)) -- cgit v1.2.3 From 2790c6a572a905359c60f055c682b28ef5c8ff0d Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 19 Feb 2021 12:31:56 +0100 Subject: Run admin/cus-tests.el tests from test suite * test/Makefile.in (SUBDIRS): Run tests in new directory "misc", intended for tests not belonging to any one file. * test/misc/test-custom-deps.el: * test/misc/test-custom-libs.el: * test/misc/test-custom-noloads.el: * test/misc/test-custom-opts.el: New files. * test/lisp/custom-tests.el (custom--test-local-option): Move test to above new file test-custom-opts.el. * admin/cus-test.el: Document running tests from regular test suite. * test/file-organization.org (Test Files): Document new test directory "misc" for tests not belonging to any one file. --- admin/cus-test.el | 7 ++++++ test/Makefile.in | 2 +- test/file-organization.org | 4 ++++ test/lisp/custom-tests.el | 11 ---------- test/misc/test-custom-deps.el | 42 ++++++++++++++++++++++++++++++++++++ test/misc/test-custom-libs.el | 46 ++++++++++++++++++++++++++++++++++++++++ test/misc/test-custom-noloads.el | 45 +++++++++++++++++++++++++++++++++++++++ test/misc/test-custom-opts.el | 39 ++++++++++++++++++++++++++++++++++ 8 files changed, 184 insertions(+), 12 deletions(-) create mode 100644 test/misc/test-custom-deps.el create mode 100644 test/misc/test-custom-libs.el create mode 100644 test/misc/test-custom-noloads.el create mode 100644 test/misc/test-custom-opts.el diff --git a/admin/cus-test.el b/admin/cus-test.el index afd5f4ceaec..30b5f655617 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -37,6 +37,13 @@ ;; ;; src/emacs -batch -l admin/cus-test.el -f cus-test-noloads ;; +;; or as a part of the test suite with +;; +;; make -C test test-custom-opts +;; make -C test test-custom-deps +;; make -C test test-custom-libs +;; make -C test test-custom-noloads +;; ;; in the emacs source directory. ;; ;; For interactive use: Load this file. Then diff --git a/test/Makefile.in b/test/Makefile.in index ff228d1261e..48bbe8712b4 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -257,7 +257,7 @@ endef $(foreach test,${TESTS},$(eval $(call test_template,${test}))) ## Get the tests for only a specific directory. -SUBDIRS = $(sort $(shell find lib-src lisp src -type d ! -path "*resources*" -print)) +SUBDIRS = $(sort $(shell find lib-src lisp misc src -type d ! -path "*resources*" -print)) define subdir_template .PHONY: check-$(subst /,-,$(1)) diff --git a/test/file-organization.org b/test/file-organization.org index 7cf5b88d6d0..d1f92da4324 100644 --- a/test/file-organization.org +++ b/test/file-organization.org @@ -43,6 +43,10 @@ Similarly, tests of features implemented in C should reside in ~-tests.el~ added to the base-name of the tested source file. Thus, tests for ~src/fileio.c~ should be in ~test/src/fileio-tests.el~. +Some tests do not belong to any one particular file. Such tests +should be put in the ~misc~ directory and be given a descriptive name +that does /not/ end with ~-tests.el~. + There are also some test materials that cannot be run automatically (i.e. via ert). These should be placed in ~/test/manual~; they are not run by the "make check" command and its derivatives. diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 10854c71d56..09f79c1a089 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el @@ -145,17 +145,6 @@ (widget-apply field :value-to-internal origvalue) "bar")))))) -(defconst custom-test-admin-cus-test - (expand-file-name "admin/cus-test.el" source-directory)) - -(declare-function cus-test-opts custom-test-admin-cus-test) - -(ert-deftest check-for-wrong-custom-types () - :tags '(:expensive-test) - (skip-unless (file-readable-p custom-test-admin-cus-test)) - (load custom-test-admin-cus-test) - (should (null (cus-test-opts t)))) - (ert-deftest custom-test-enable-theme-keeps-settings () "Test that enabling a theme doesn't change its settings." (let* ((custom-theme-load-path `(,(ert-resource-directory))) diff --git a/test/misc/test-custom-deps.el b/test/misc/test-custom-deps.el new file mode 100644 index 00000000000..f072adddcb0 --- /dev/null +++ b/test/misc/test-custom-deps.el @@ -0,0 +1,42 @@ +;;; test-custom-deps.el --- Test custom deps -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The command `cus-test-deps' loads all (!) custom dependencies and +;; reports about load errors. + +;;; Code: + +(require 'ert) + +(defconst custom-test-admin-cus-test + (expand-file-name "admin/cus-test.el" source-directory)) + +(declare-function cus-test-deps custom-test-admin-cus-test) +(defvar cus-test-deps-errors) ; from admin/cus-tests.el + +(ert-deftest test-custom-deps () + :tags '(:expensive-test) + (skip-unless (file-readable-p custom-test-admin-cus-test)) + (load custom-test-admin-cus-test) + (cus-test-deps) + (should-not cus-test-deps-errors)) + +;;; test-custom-deps.el ends here diff --git a/test/misc/test-custom-libs.el b/test/misc/test-custom-libs.el new file mode 100644 index 00000000000..70f043d1295 --- /dev/null +++ b/test/misc/test-custom-libs.el @@ -0,0 +1,46 @@ +;;; test-custom-libs.el --- Test custom loads -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This file runs for all libraries with autoloads separate emacs +;; processes of the form "emacs -batch -l LIB". + +;;; Code: + +(require 'ert) + +(defconst custom-test-admin-cus-test + (expand-file-name "admin/cus-test.el" source-directory)) + +(declare-function cus-test-libs custom-test-admin-cus-test) +(defvar cus-test-libs-errors) ; from admin/cus-tests.el + +;; FIXME: Currently fails for: +;; - lisp/term/ns-win.el +;; - lisp/org/org-num.el +(ert-deftest test-custom-libs () + :tags '(:expensive-test) + :expected-result :failed ; FIXME: See above. + (skip-unless (file-readable-p custom-test-admin-cus-test)) + (load custom-test-admin-cus-test) + (cus-test-libs t) + (should-not cus-test-libs-errors)) + +;;; test-custom-deps.el ends here diff --git a/test/misc/test-custom-noloads.el b/test/misc/test-custom-noloads.el new file mode 100644 index 00000000000..e999fe2abb0 --- /dev/null +++ b/test/misc/test-custom-noloads.el @@ -0,0 +1,45 @@ +;;; test-custom-deps.el --- Test custom noloads -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The command `cus-test-noloads' returns a list of variables which +;; are somewhere declared as custom options, but not loaded by +;; `custom-load-symbol'. + +;;; Code: + +(require 'ert) + +(defconst custom-test-admin-cus-test + (expand-file-name "admin/cus-test.el" source-directory)) + +(declare-function cus-test-noloads custom-test-admin-cus-test) +(defvar cus-test-vars-not-cus-loaded) ; from admin/cus-tests.el + +;; FIXME: Multiple failures here. +(ert-deftest custom-test-load () + :tags '(:expensive-test) + :expected-result :failed ; FIXME: See above. + (skip-unless (file-readable-p custom-test-admin-cus-test)) + (load custom-test-admin-cus-test) + (cus-test-noloads) + (should-not cus-test-vars-not-cus-loaded)) + +;;; test-custom-deps.el ends here diff --git a/test/misc/test-custom-opts.el b/test/misc/test-custom-opts.el new file mode 100644 index 00000000000..fa6b9e66aef --- /dev/null +++ b/test/misc/test-custom-opts.el @@ -0,0 +1,39 @@ +;;; test-custom-opts.el --- Test custom opts -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The command `cus-test-opts' tests many (all?) custom options. + +;;; Code: + +(require 'ert) + +(defconst custom-test-admin-cus-test + (expand-file-name "admin/cus-test.el" source-directory)) + +(declare-function cus-test-opts custom-test-admin-cus-test) + +(ert-deftest check-for-wrong-custom-opts () + :tags '(:expensive-test) + (skip-unless (file-readable-p custom-test-admin-cus-test)) + (load custom-test-admin-cus-test) + (should (null (cus-test-opts t)))) + +;;; test-custom-opts.el ends here -- cgit v1.2.3 From d0c47652e527397cae96444c881bf60455c763c1 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Sun, 21 Feb 2021 15:24:41 +0100 Subject: Faster, more compact, and readable closure creation Simplify closure creation by calling a single function at run time instead of putting it together from small pieces. This is faster (by about a factor 2), takes less space on disk and in memory, and makes internal functions somewhat readable in disassembly listings again. This is done by creating a prototype function at compile-time whose closure variables are placeholder values V0, V1... which can be seen in the disassembly. The prototype is then cloned at run time using the new make-closure function that replaces the placeholders with the actual closure variables. * lisp/emacs-lisp/bytecomp.el (byte-compile-make-closure): Generate call to make-closure from a prototype function. * src/alloc.c (Fmake_closure): New function. (syms_of_alloc): Defsubr it. * src/data.c (syms_of_data): Defsym byte-code-function-p. --- lisp/emacs-lisp/bytecomp.el | 24 +++++++++++++++--------- src/alloc.c | 33 +++++++++++++++++++++++++++++++++ src/data.c | 2 ++ 3 files changed, 50 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1b0906b50bb..69a63b169cc 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3817,15 +3817,21 @@ discarding." (cl-assert (or (> (length env) 0) docstring-exp)) ;Otherwise, we don't need a closure. (cl-assert (byte-code-function-p fun)) - (byte-compile-form `(make-byte-code - ',(aref fun 0) ',(aref fun 1) - (vconcat (vector . ,env) ',(aref fun 2)) - ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun)))) - (if docstring-exp - `(,(car rest) - ,docstring-exp - ,@(cddr rest)) - rest))))))) + (byte-compile-form + ;; Use symbols V0, V1 ... as placeholders for closure variables: + ;; they should be short (to save space in the .elc file), yet + ;; distinct when disassembled. + (let* ((dummy-vars (mapcar (lambda (i) (intern (format "V%d" i))) + (number-sequence 0 (1- (length env))))) + (proto-fun + (apply #'make-byte-code + (aref fun 0) (aref fun 1) + ;; Prepend dummy cells to the constant vector, + ;; to get the indices right when disassembling. + (vconcat dummy-vars (aref fun 2)) + (mapcar (lambda (i) (aref fun i)) + (number-sequence 3 (1- (length fun))))))) + `(make-closure ,proto-fun ,@env)))))) (defun byte-compile-get-closed-var (form) "Byte-compile the special `internal-get-closed-var' form." diff --git a/src/alloc.c b/src/alloc.c index b86ed4ed262..e72fc4c4332 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3498,6 +3498,38 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT return val; } +DEFUN ("make-closure", Fmake_closure, Smake_closure, 1, MANY, 0, + doc: /* Create a byte-code closure from PROTOTYPE and CLOSURE-VARS. +Return a copy of PROTOTYPE, a byte-code object, with CLOSURE-VARS +replacing the elements in the beginning of the constant-vector. +usage: (make-closure PROTOTYPE &rest CLOSURE-VARS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + Lisp_Object protofun = args[0]; + CHECK_TYPE (COMPILEDP (protofun), Qbyte_code_function_p, protofun); + + /* Create a copy of the constant vector, filling it with the closure + variables in the beginning. (The overwritten part should just + contain placeholder values.) */ + Lisp_Object proto_constvec = AREF (protofun, COMPILED_CONSTANTS); + ptrdiff_t constsize = ASIZE (proto_constvec); + ptrdiff_t nvars = nargs - 1; + if (nvars > constsize) + error ("Closure vars do not fit in constvec"); + Lisp_Object constvec = make_uninit_vector (constsize); + memcpy (XVECTOR (constvec)->contents, args + 1, nvars * word_size); + memcpy (XVECTOR (constvec)->contents + nvars, + XVECTOR (proto_constvec)->contents + nvars, + (constsize - nvars) * word_size); + + /* Return a copy of the prototype function with the new constant vector. */ + ptrdiff_t protosize = PVSIZE (protofun); + struct Lisp_Vector *v = allocate_vectorlike (protosize, false); + v->header = XVECTOR (protofun)->header; + memcpy (v->contents, XVECTOR (protofun)->contents, protosize * word_size); + v->contents[COMPILED_CONSTANTS] = constvec; + return make_lisp_ptr (v, Lisp_Vectorlike); +} /*********************************************************************** @@ -7573,6 +7605,7 @@ N should be nonnegative. */); defsubr (&Srecord); defsubr (&Sbool_vector); defsubr (&Smake_byte_code); + defsubr (&Smake_closure); defsubr (&Smake_list); defsubr (&Smake_vector); defsubr (&Smake_record); diff --git a/src/data.c b/src/data.c index 9af9131b123..0fa491b17a1 100644 --- a/src/data.c +++ b/src/data.c @@ -3989,6 +3989,8 @@ syms_of_data (void) DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qdefalias_fset_function, "defalias-fset-function"); + DEFSYM (Qbyte_code_function_p, "byte-code-function-p"); + defsubr (&Sindirect_variable); defsubr (&Sinteractive_form); defsubr (&Scommand_modes); -- cgit v1.2.3