From 3ec93bb7c240edd6e06647a75df31acc6ce600dd Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Apr 2021 10:16:34 +0300 Subject: [PATCH 001/128] Improve doc strings in replace.el * lisp/replace.el (occur, list-matching-lines-prefix-face) (list-matching-lines-jump-to-current-line): Doc fixes. --- lisp/replace.el | 34 +++++++++++++++++++++++++++------- 1 file changed, 27 insertions(+), 7 deletions(-) diff --git a/lisp/replace.el b/lisp/replace.el index 416d9f1d1ec..43534d23bb5 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1386,15 +1386,22 @@ If the value is nil, don't highlight the buffer names specially." (defcustom list-matching-lines-jump-to-current-line nil "If non-nil, \\[list-matching-lines] shows the current line highlighted. -Set the point right after such line when there are matches after it." +The current line for this purpose is the line of the original buffer +which was current when \\[list-matching-lines] was invoked. +Point in the `*Occur*' buffer will be set right after such line when +there are matches after it." :type 'boolean :group 'matching :version "26.1") (defcustom list-matching-lines-prefix-face 'shadow "Face used by \\[list-matching-lines] to show the prefix column. -If the face doesn't differ from the default face, -don't highlight the prefix with line numbers specially." +The prefix column is the part of display that precedes the actual +contents of the line; it normally shows the line number. \(For +multiline matches, the prefix column shows the line number for the +first line and whitespace for the rest of the lines.\) +If this face will display the same as the default face, the prefix +column will not be highlighted speciall." :type 'face :group 'matching :version "24.4") @@ -1471,11 +1478,24 @@ REGION must be a list of (START . END) positions as returned by `region-bounds'. The lines are shown in a buffer named `*Occur*'. -It serves as a menu to find any of the occurrences in this buffer. +That buffer can serve as a menu for finding any of the matches for REGEXP +in the current buffer. \\\\[describe-mode] in that buffer will explain how. -If `list-matching-lines-jump-to-current-line' is non-nil, then show -the current line highlighted with `list-matching-lines-current-line-face' -and set point at the first match after such line. + +Matches for REGEXP are shown in the face determined by the +variable `list-matching-lines-face'. +Names of buffers with matched lines are shown in the face determined +by the variable `list-matching-lines-buffer-name-face'. +The line numbers of the matching lines are shown in the face +determined by the variable `list-matching-lines-prefix-face'. + +If `list-matching-lines-jump-to-current-line' is non-nil, then the +line in the current buffer which was current when the command was +invoked will be shown in the `*Occur*' buffer highlighted with +the `list-matching-lines-current-line-face', with point at the end +of that line. (If the current line doesn't match REGEXP, it will +nonetheless be inserted into the `*Occur*' buffer between the 2 +closest lines that do match REGEXP.) If REGEXP contains upper case characters (excluding those preceded by `\\') and `search-upper-case' is non-nil, the matching is case-sensitive. From e2d199aa44a92e50f480e0aa265f96a144d57a60 Mon Sep 17 00:00:00 2001 From: Alan Third Date: Sat, 2 Jan 2021 22:27:53 +0000 Subject: [PATCH 002/128] Fix crash when using menus and tramp on NS ; Fixes bug#24472, bug#37557 and bug#37922. * src/nsterm.m (ns_select): Don't drain outerpool in this function. (cherry picked from commit f14869cd70e61b1908ec88a5e3d4bf21c7d538a0) --- src/nsterm.m | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index b8658a05daf..26cc9486141 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -4633,8 +4633,22 @@ in certain situations (rapid incoming events). thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask); } - [outerpool release]; - outerpool = [[NSAutoreleasePool alloc] init]; + /* FIXME: This draining of outerpool causes a crash when a buffer + running over tramp is displayed and the user tries to use the + menus. I believe some other autorelease pool's lifetime + straddles this call causing a violation of autorelease pool + nesting. There's no good reason to keep these here since the + pool will be drained some other time anyway, but removing them + leaves the menus sometimes not opening until the user moves their + mouse pointer, but that's better than a crash. + + There must be something about running external processes like + tramp that interferes with the modal menu code. + + See bugs 24472, 37557, 37922. */ + + // [outerpool release]; + // outerpool = [[NSAutoreleasePool alloc] init]; send_appdefined = YES; From 673c02f6d0228337ba320e429111538e1d30fea3 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 5 Apr 2021 08:49:07 -0700 Subject: [PATCH 003/128] * lisp/international/ja-dic-cnv.el (skkdic-convert): Doc fix. --- lisp/international/ja-dic-cnv.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 8e5dccd0de9..a5082f630c7 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -323,11 +323,9 @@ (insert ")\n\n"))) (defun skkdic-convert (filename &optional dirname) - "Generate Emacs Lisp file form Japanese dictionary file FILENAME. + "Generate Emacs Lisp file from Japanese dictionary file FILENAME. The format of the dictionary file should be the same as SKK dictionaries. -Optional argument DIRNAME if specified is the directory name under which -the generated Emacs Lisp is saved. -The name of generated file is specified by the variable `ja-dic-filename'." +Saves the output as `ja-dic-filename', in directory DIRNAME (if specified)." (interactive "FSKK dictionary file: ") (let* ((coding-system-for-read 'euc-japan) (skkbuf (get-buffer-create " *skkdic-unannotated*")) From 9c51a9d00007902232865e6e6265cdd0d7075ae8 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 5 Apr 2021 23:46:35 +0300 Subject: [PATCH 004/128] * lisp/repeat.el (repeat-post-hook): Fix key lookup. * lisp/repeat.el (repeat-post-hook): Rename let-bound repeat-map to rep-map. Define let-bound prefix-command-p. Use lookup-key with this-single-command-keys instead of last-command-event. Don't show message when typing prefix keys. https://lists.gnu.org/archive/html/emacs-devel/2021-04/msg00083.html --- lisp/repeat.el | 54 +++++++++++++++++++++++++++----------------------- 1 file changed, 29 insertions(+), 25 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index a2b04b81b03..a5ab43950c2 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -364,35 +364,39 @@ When Repeat mode is enabled, and the command symbol has the property named (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (when repeat-mode - (let ((repeat-map (and (symbolp this-command) - (get this-command 'repeat-map)))) - (when repeat-map - (when (boundp repeat-map) - (setq repeat-map (symbol-value repeat-map))) - (let ((map (copy-keymap repeat-map)) - keys mess) - (map-keymap (lambda (key _) (push key keys)) map) + (let ((rep-map (and (symbolp this-command) + (get this-command 'repeat-map)))) + (when rep-map + (when (boundp rep-map) + (setq rep-map (symbol-value rep-map))) + (let ((prefix-command-p (memq this-original-command + '(universal-argument + universal-argument-more + digit-argument + negative-argument))) + (map (copy-keymap rep-map)) + keys) ;; Exit when the last char is not among repeatable keys, ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (or (memq last-command-event keys) - (memq this-original-command '(universal-argument - universal-argument-more - digit-argument - negative-argument))) + (when (or (lookup-key map (this-single-command-keys) nil) + prefix-command-p) + ;; Messaging - (setq mess (format-message - "Repeat with %s%s" - (mapconcat (lambda (key) - (key-description (vector key))) - keys ", ") - (if repeat-exit-key - (format ", or exit with %s" - (key-description repeat-exit-key)) - ""))) - (if (current-message) - (message "%s [%s]" (current-message) mess) - (message mess)) + (unless prefix-command-p + (map-keymap (lambda (key _) (push key keys)) map) + (let ((mess (format-message + "Repeat with %s%s" + (mapconcat (lambda (key) + (key-description (vector key))) + keys ", ") + (if repeat-exit-key + (format ", or exit with %s" + (key-description repeat-exit-key)) + "")))) + (if (current-message) + (message "%s [%s]" (current-message) mess) + (message mess)))) ;; Adding an exit key (when repeat-exit-key From 15de559d98b1b19733bacf0c39716d5ebabe6dfa Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Apr 2021 00:02:43 +0300 Subject: [PATCH 005/128] * lisp/repeat.el (repeat-keep-prefix): New defcustom. * lisp/repeat.el (repeat-map): New autoloaded global variable. (repeat-post-hook): Use 'repeat-map' when non-nil and reset it to nil afterwards. (repeat-post-hook): Keep the current prefix when 'repeat-keep-prefix' is non-nil. * lisp/window.el (other-window-repeat-map): Add "O" that sets 'repeat-map' to 'other-window-repeat-map' before calling '(other-window -1)'. https://lists.gnu.org/archive/html/emacs-devel/2021-03/msg01387.html --- etc/NEWS | 4 ++++ lisp/repeat.el | 19 ++++++++++++++++--- lisp/window.el | 4 ++++ 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 1421efcaa07..c8400ba8c27 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2251,6 +2251,10 @@ You can type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'M-g n n p p' to navigate next-error matches. Any other key exits transient mode and then is executed normally. 'repeat-exit-key' defines an additional key to exit mode like 'isearch-exit' ('RET'). +With 'repeat-keep-prefix' you can keep the prefix arg of the previous command. +For example, this can help to reverse the window navigation direction +with e.g. 'C-x o M-- o o'. Also it can help to set a new step with +e.g. 'C-x { C-5 { { {' will set the window resizing step to 5 columns. * New Modes and Packages in Emacs 28.1 diff --git a/lisp/repeat.el b/lisp/repeat.el index a5ab43950c2..1830bcc0497 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -342,6 +342,14 @@ For example, you can set it to like `isearch-exit'." :group 'convenience :version "28.1") +(defcustom repeat-keep-prefix t + "Keep the prefix arg of the previous command." + :type 'boolean + :group 'convenience + :version "28.1") + +;;;###autoload (defvar repeat-map nil) + ;;;###autoload (define-minor-mode repeat-mode "Toggle Repeat mode. @@ -364,8 +372,9 @@ When Repeat mode is enabled, and the command symbol has the property named (defun repeat-post-hook () "Function run after commands to set transient keymap for repeatable keys." (when repeat-mode - (let ((rep-map (and (symbolp this-command) - (get this-command 'repeat-map)))) + (let ((rep-map (or repeat-map + (and (symbolp this-command) + (get this-command 'repeat-map))))) (when rep-map (when (boundp rep-map) (setq rep-map (symbol-value rep-map))) @@ -382,6 +391,9 @@ When Repeat mode is enabled, and the command symbol has the property named (when (or (lookup-key map (this-single-command-keys) nil) prefix-command-p) + (when (and repeat-keep-prefix (not prefix-command-p)) + (setq prefix-arg current-prefix-arg)) + ;; Messaging (unless prefix-command-p (map-keymap (lambda (key _) (push key keys)) map) @@ -402,7 +414,8 @@ When Repeat mode is enabled, and the command symbol has the property named (when repeat-exit-key (define-key map repeat-exit-key 'ignore)) - (set-transient-map map))))))) + (set-transient-map map)))))) + (setq repeat-map nil)) (provide 'repeat) diff --git a/lisp/window.el b/lisp/window.el index f27631bb86a..071761ea50f 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -10256,6 +10256,10 @@ displaying that processes's buffer." (defvar other-window-repeat-map (let ((map (make-sparse-keymap))) (define-key map "o" 'other-window) + (define-key map "O" (lambda () + (interactive) + (setq repeat-map 'other-window-repeat-map) + (other-window -1))) map) "Keymap to repeat other-window key sequences. Used in `repeat-mode'.") (put 'other-window 'repeat-map 'other-window-repeat-map) From c049c8da58106e422494914447e06fd7c9deb301 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Apr 2021 00:18:59 +0300 Subject: [PATCH 006/128] * lisp/tab-bar.el: Add repeat-map keymaps. * lisp/tab-bar.el (tab-bar-switch-repeat-map): New keymap used for 'tab-next' and 'tab-previous'. (tab-bar-move-repeat-map): New keymap used for 'tab-move'. https://lists.gnu.org/archive/html/emacs-devel/2021-03/msg01103.html --- lisp/tab-bar.el | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 2e27b293c5e..f3c2fb7ed96 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2075,6 +2075,28 @@ When `switch-to-buffer-obey-display-actions' is non-nil, (define-key tab-prefix-map "\C-r" 'find-file-read-only-other-tab) (define-key tab-prefix-map "t" 'other-tab-prefix) +(defvar tab-bar-switch-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "o" 'tab-next) + (define-key map "O" 'tab-previous) + map) + "Keymap to repeat tab switch key sequences `C-x t o o O'. +Used in `repeat-mode'.") +(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map) +(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map) + +(defvar tab-bar-move-repeat-map + (let ((map (make-sparse-keymap))) + (define-key map "m" 'tab-move) + (define-key map "M" (lambda () + (interactive) + (setq repeat-map 'tab-bar-move-repeat-map) + (tab-move -1))) + map) + "Keymap to repeat tab move key sequences `C-x t m m M'. +Used in `repeat-mode'.") +(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map) + (provide 'tab-bar) From 1d93540371aadec8f877bd781267d38d411c40a0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 5 Apr 2021 17:30:11 -0400 Subject: [PATCH 007/128] * lisp/comint.el: Fix understickiness of non-comint properties When a third party package adds properties to the prompt they don't necessarily want to be `read-nonsticky` (e.g. for the `cursor-intangible` property), so replace the catchall `rear-nonsticky t` with an actual list of the properties that we want to be `rear-nonsticky`. (comint-send-input, comint-output-filter): Don't mark all properties as non-sticky. --- lisp/comint.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index b04d404676d..4f13ff31acb 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1917,7 +1917,8 @@ Similarly for Soar, Scheme, etc." (unless (or no-newline comint-use-prompt-regexp) ;; Cover the terminating newline (add-text-properties end (1+ end) - '(rear-nonsticky t + '(rear-nonsticky + (field inhibit-line-move-field-capture read-only) field boundary inhibit-line-move-field-capture t))))) @@ -2126,7 +2127,8 @@ Make backspaces delete the previous character." (add-text-properties comint-last-output-start (point) '(front-sticky (field inhibit-line-move-field-capture) - rear-nonsticky t + rear-nonsticky + (field inhibit-line-move-field-capture read-only) field output inhibit-line-move-field-capture t)))) @@ -2155,7 +2157,9 @@ Make backspaces delete the previous character." (font-lock-prepend-text-property prompt-start (point) 'font-lock-face 'comint-highlight-prompt) - (add-text-properties prompt-start (point) '(rear-nonsticky t))) + (add-text-properties prompt-start (point) + '(rear-nonsticky + (field inhibit-line-move-field-capture read-only)))) (goto-char saved-point))))))) (defun comint-preinput-scroll-to-bottom () From 7b0a5a555f4986b743275756f61c18fef62873ac Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Apr 2021 00:13:44 -0400 Subject: [PATCH 008/128] * lisp/hippie-exp.el: Use lexical-binding Remove redundant `:group` args. (make-hippie-expand-function): Turn it into a function returning a closure. (try-expand-all-abbrevs): Strength-reduce `eval` to `symbol-value` and use `abbrev-table-p` rather than `vectorp`. --- lisp/hippie-exp.el | 53 +++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 29 deletions(-) diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 4d020232939..cbb69b206d4 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -1,4 +1,4 @@ -;;; hippie-exp.el --- expand text trying various ways to find its expansion +;;; hippie-exp.el --- expand text trying various ways to find its expansion -*- lexical-binding: t; -*- ;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc. @@ -58,7 +58,7 @@ ;; The variable `hippie-expand-dabbrev-as-symbol' controls whether ;; characters of syntax '_' is considered part of the words to expand ;; dynamically. -;; See also the macro `make-hippie-expand-function' below. +;; See also the function `make-hippie-expand-function' below. ;; ;; A short description of the current try-functions in this file: ;; `try-complete-file-name' : very convenient to have in any buffer, @@ -215,50 +215,42 @@ "The list of expansion functions tried in order by `hippie-expand'. To change the behavior of `hippie-expand', remove, change the order of, or insert functions in this list." - :type '(repeat function) - :group 'hippie-expand) + :type '(repeat function)) (defcustom hippie-expand-verbose t "Non-nil makes `hippie-expand' output which function it is trying." - :type 'boolean - :group 'hippie-expand) + :type 'boolean) (defcustom hippie-expand-dabbrev-skip-space nil "Non-nil means tolerate trailing spaces in the abbreviation to expand." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-dabbrev-as-symbol t "Non-nil means expand as symbols, i.e. syntax `_' is considered a letter." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-no-restriction t "Non-nil means that narrowed buffers are widened during search." - :group 'hippie-expand :type 'boolean) (defcustom hippie-expand-max-buffers () "The maximum number of buffers (apart from the current) searched. If nil, all buffers are searched." :type '(choice (const :tag "All" nil) - integer) - :group 'hippie-expand) + integer)) (defcustom hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode) "A list specifying which buffers not to search (if not current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms)." - :type '(repeat (choice regexp (symbol :tag "Major Mode"))) - :group 'hippie-expand) + :type '(repeat (choice regexp (symbol :tag "Major Mode")))) (defcustom hippie-expand-only-buffers () "A list specifying the only buffers to search (in addition to current). Can contain both regexps matching buffer names (as strings) and major modes \(as atoms). If non-nil, this variable overrides the variable `hippie-expand-ignore-buffers'." - :type '(repeat (choice regexp (symbol :tag "Major Mode"))) - :group 'hippie-expand) + :type '(repeat (choice regexp (symbol :tag "Major Mode")))) ;;;###autoload (defun hippie-expand (arg) @@ -407,18 +399,19 @@ undoes the expansion." ;; try-expand-line-all-buffers))) ;; ;;;###autoload -(defmacro make-hippie-expand-function (try-list &optional verbose) +(defun make-hippie-expand-function (try-list &optional verbose) "Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose." - `(lambda (arg) - ,(concat - "Try to expand text before point, using the following functions: \n" - (mapconcat 'prin1-to-string (eval try-list) ", ")) - (interactive "P") - (let ((hippie-expand-try-functions-list ,try-list) - (hippie-expand-verbose ,verbose)) - (hippie-expand arg)))) + (lambda (arg) + (:documentation + (concat + "Try to expand text before point, using the following functions: \n" + (mapconcat #'prin1-to-string try-list ", "))) + (interactive "P") + (let ((hippie-expand-try-functions-list try-list) + (hippie-expand-verbose verbose)) + (hippie-expand arg)))) ;;; Here follows the try-functions and their requisites: @@ -434,7 +427,8 @@ string). It returns t if a new completion is found, nil otherwise." (he-init-string (he-file-name-beg) (point)) (let ((name-part (file-name-nondirectory he-search-string)) (dir-part (expand-file-name (or (file-name-directory - he-search-string) "")))) + he-search-string) + "")))) (if (not (he-string-member name-part he-tried-table)) (setq he-tried-table (cons name-part he-tried-table))) (if (and (not (equal he-search-string "")) @@ -442,7 +436,7 @@ string). It returns t if a new completion is found, nil otherwise." (setq he-expand-list (sort (file-name-all-completions name-part dir-part) - 'string-lessp)) + #'string-lessp)) (setq he-expand-list ()))))) (while (and he-expand-list @@ -538,7 +532,7 @@ string). It returns t if a new completion is found, nil otherwise." (or (boundp sym) (fboundp sym) (symbol-plist sym)))) - 'string-lessp))))) + #'string-lessp))))) (while (and he-expand-list (he-string-member (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list))) @@ -822,9 +816,10 @@ string). It returns t if a new expansion is found, nil otherwise." (setq he-expand-list (and (not (equal he-search-string "")) (mapcar (lambda (sym) - (if (and (boundp sym) (vectorp (eval sym))) + (if (and (boundp sym) + (abbrev-table-p (symbol-value sym))) (abbrev-expansion (downcase he-search-string) - (eval sym)))) + (symbol-value sym)))) (append '(local-abbrev-table global-abbrev-table) abbrev-table-name-list)))))) From e0c3925961c17ed4920c3f7ca72e7c513766cb91 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Apr 2021 00:26:38 -0400 Subject: [PATCH 009/128] * lisp/msb.el: Use lexical-binding Remove redundant `:group` args. (msb--add-to-menu): Strength-reduce `eval` to `symbol-value` and use `push`. (msb--create-sort-item): Strength-reduce `eval` to `symbol-value`. (msb-menu-bar-update-buffers): Replace `(lambda...) with a proper closure. --- lisp/msb.el | 79 ++++++++++++++++++++++------------------------------- 1 file changed, 33 insertions(+), 46 deletions(-) diff --git a/lisp/msb.el b/lisp/msb.el index 14209d9956d..1064f940905 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -1,4 +1,4 @@ -;;; msb.el --- customizable buffer-selection with multiple menus +;;; msb.el --- customizable buffer-selection with multiple menus -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1995, 1997-2021 Free Software Foundation, Inc. @@ -252,14 +252,12 @@ error every time you do \\[msb]." :type `(choice (const :tag "long" :value ,msb--very-many-menus) (const :tag "short" :value ,msb--few-menus) (sexp :tag "user")) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-modes-key 4000 "The sort key for files sorted by mode." :type 'integer - :set 'msb-custom-set - :group 'msb + :set #'msb-custom-set :version "20.3") (defcustom msb-separator-diff 100 @@ -267,8 +265,7 @@ error every time you do \\[msb]." The separators will appear between all menus that have a sorting key that differs by this value or more." :type '(choice integer (const nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-files-by-directory-sort-key 0 "The sort key for files sorted by directory.") @@ -278,8 +275,7 @@ that differs by this value or more." If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each. A value of nil means no limit." :type '(choice integer (const nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-max-file-menu-items 10 "The maximum number of items from different directories. @@ -293,27 +289,23 @@ them together. If the value is not a number, then the value 10 is used." :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-most-recently-used-sort-key -1010 "Where should the menu with the most recently used buffers be placed?" :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-display-most-recently-used 15 "How many buffers should be in the most-recently-used menu. No buffers at all if less than 1 or nil (or any non-number)." :type 'integer - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-most-recently-used-title "Most recently used (%d)" "The title for the most-recently-used menu." :type 'string - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-horizontal-shift-function (lambda () 0) "Function that specifies how many pixels to shift the top menu leftwards.") @@ -323,8 +315,7 @@ No buffers at all if less than 1 or nil (or any non-number)." Non-nil means that the buffer menu should include buffers that have names that starts with a space character." :type 'boolean - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defvar msb-item-handling-function 'msb-item-handler "The appearance of a buffer menu. @@ -354,15 +345,13 @@ Set this to nil or t if you don't want any sorting (faster)." :type '(choice (const msb-sort-by-name) (const :tag "Newest first" t) (const :tag "Oldest first" nil)) - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (defcustom msb-files-by-directory nil "Non-nil means that files should be sorted by directory. This is instead of the groups in `msb-menu-cond'." :type 'boolean - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (define-obsolete-variable-alias 'msb-after-load-hooks 'msb-after-load-hook "24.1") @@ -370,8 +359,7 @@ This is instead of the groups in `msb-menu-cond'." (defcustom msb-after-load-hook nil "Hook run after the msb package has been loaded." :type 'hook - :set 'msb-custom-set - :group 'msb) + :set #'msb-custom-set) (make-obsolete-variable 'msb-after-load-hook "use `with-eval-after-load' instead." "28.1") @@ -458,10 +446,10 @@ An item look like (NAME . BUFFER)." ;;; ;;; msb -;;; -;;; This function can be used instead of (mouse-buffer-menu EVENT) -;;; function in "mouse.el". -;;; +;; +;; This function can be used instead of (mouse-buffer-menu EVENT) +;; function in "mouse.el". +;; (defun msb (event) "Pop up several menus of buffers for selection with the mouse. This command switches buffers in the window that you clicked on, and @@ -707,7 +695,7 @@ See `msb-menu-cond' for a description of its elements." (cl-loop for fi across function-info-vector if (and (setq result - (eval (aref fi 1))) ;Test CONDITION + (eval (aref fi 1) t)) ;Test CONDITION (not (and (eq result 'no-multi) multi-flag)) (progn (when (eq result 'multi) @@ -727,12 +715,11 @@ All side-effects. Adds an element of form (BUFFER-TITLE . BUFFER) to the buffer-list variable in FUNCTION-INFO." (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE ;; Here comes the hairy side-effect! - (set list-symbol - (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER - buffer - max-buffer-name-length) - buffer) - (eval list-symbol))))) + (push (cons (funcall (aref function-info 4) ;ITEM-HANDLER + buffer + max-buffer-name-length) + buffer) + (symbol-value list-symbol)))) (defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) "Select the appropriate menu for BUFFER." @@ -754,7 +741,7 @@ to the buffer-list variable in FUNCTION-INFO." (defun msb--create-sort-item (function-info) "Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the buffer-list is empty." - (let ((buffer-list (eval (aref function-info 0)))) + (let ((buffer-list (symbol-value (aref function-info 0)))) (when buffer-list (let ((sorter (aref function-info 5)) ;SORTER (sort-key (aref function-info 2))) ;MENU-SORT-KEY @@ -925,7 +912,7 @@ It takes the form ((TITLE . BUFFER-LIST)...)." for value = (msb--create-sort-item elt) if value collect value)))) (setq menu - (mapcar 'cdr ;Remove the SORT-KEY + (mapcar #'cdr ;Remove the SORT-KEY ;; Sort the menus - not the items. (msb--add-separators (sort @@ -1113,8 +1100,8 @@ variable `msb-menu-cond'." (nconc (list (frame-parameter frame 'name) (frame-parameter frame 'name)) - `(lambda () - (interactive) (menu-bar-select-frame ,frame)))) + (lambda () + (interactive) (menu-bar-select-frame frame)))) frames))))) (setcdr global-buffers-menu-map (if (and buffers-menu frames-menu) @@ -1128,7 +1115,7 @@ variable `msb-menu-cond'." ;; C-down-mouse-1). (defvar msb-mode-map (let ((map (make-sparse-keymap "Msb"))) - (define-key map [remap mouse-buffer-menu] 'msb) + (define-key map [remap mouse-buffer-menu] #'msb) map)) ;;;###autoload @@ -1137,14 +1124,14 @@ variable `msb-menu-cond'." This mode overrides the binding(s) of `mouse-buffer-menu' to provide a different buffer menu using the function `msb'." - :global t :group 'msb + :global t (if msb-mode (progn - (add-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) - (remove-hook 'menu-bar-update-hook 'menu-bar-update-buffers) + (add-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers) + (remove-hook 'menu-bar-update-hook #'menu-bar-update-buffers) (msb-menu-bar-update-buffers t)) - (remove-hook 'menu-bar-update-hook 'msb-menu-bar-update-buffers) - (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers) + (remove-hook 'menu-bar-update-hook #'msb-menu-bar-update-buffers) + (add-hook 'menu-bar-update-hook #'menu-bar-update-buffers) (menu-bar-update-buffers t))) (defun msb-unload-function () From 738266240dc1a19911770bf676330aa72352da79 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 6 Apr 2021 09:50:07 +0200 Subject: [PATCH 010/128] Fix Bug#47601 in Tramp * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): Use `tramp-handle-file-newer-than-file-p'. (Bug#47601) (tramp-sh-handle-file-newer-than-file-p, tramp-run-test2): Remove. --- lisp/net/tramp-sh.el | 63 +------------------------------------------- 1 file changed, 1 insertion(+), 62 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 499bf8abe41..b902ee6f352 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -949,7 +949,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (file-name-directory . tramp-handle-file-name-directory) (file-name-nondirectory . tramp-handle-file-name-nondirectory) ;; `file-name-sans-versions' performed by default handler. - (file-newer-than-file-p . tramp-sh-handle-file-newer-than-file-p) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) (file-notify-add-watch . tramp-sh-handle-file-notify-add-watch) (file-notify-rm-watch . tramp-handle-file-notify-rm-watch) (file-notify-valid-p . tramp-handle-file-notify-valid-p) @@ -1557,49 +1557,6 @@ ID-FORMAT valid values are `string' and `integer'." (or (tramp-check-cached-permissions v ?r) (tramp-run-test "-r" filename))))) -;; When the remote shell is started, it looks for a shell which groks -;; tilde expansion. Here, we assume that all shells which grok tilde -;; expansion will also provide a `test' command which groks `-nt' (for -;; newer than). If this breaks, tell me about it and I'll try to do -;; something smarter about it. -(defun tramp-sh-handle-file-newer-than-file-p (file1 file2) - "Like `file-newer-than-file-p' for Tramp files." - (cond ((not (file-exists-p file1)) nil) - ((not (file-exists-p file2)) t) - (t ;; We are sure both files exist at this point. We try to - ;; get the mtime of both files. If they are not equal to - ;; the "dont-know" value, then we subtract the times and - ;; obtain the result. - (let ((fa1 (file-attributes file1)) - (fa2 (file-attributes file2))) - (if (and - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa1) - tramp-time-dont-know)) - (not - (tramp-compat-time-equal-p - (tramp-compat-file-attribute-modification-time fa2) - tramp-time-dont-know))) - (time-less-p - (tramp-compat-file-attribute-modification-time fa2) - (tramp-compat-file-attribute-modification-time fa1)) - ;; If one of them is the dont-know value, then we can - ;; still try to run a shell command on the remote host. - ;; However, this only works if both files are Tramp - ;; files and both have the same method, same user, same - ;; host. - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "Files %s and %s must have same method, user, host" - file1 file2))) - (with-parsed-tramp-file-name file1 nil - (tramp-run-test2 - (tramp-get-test-nt-command v) file1 file2))))))) - ;; Functions implemented using the basic functions above. (defun tramp-sh-handle-file-directory-p (filename) @@ -3959,24 +3916,6 @@ Returns the exit code of the `test' program." switch (tramp-shell-quote-argument localname))))) -(defun tramp-run-test2 (format-string file1 file2) - "Run `test'-like program on the remote system, given FILE1, FILE2. -FORMAT-STRING contains the program name, switches, and place holders. -Returns the exit code of the `test' program. Barfs if the methods, -hosts, or files, disagree." - (unless (tramp-equal-remote file1 file2) - (with-parsed-tramp-file-name (if (tramp-tramp-file-p file1) file1 file2) nil - (tramp-error - v 'file-error - "tramp-run-test2 only implemented for same method, user, host"))) - (with-parsed-tramp-file-name file1 v1 - (with-parsed-tramp-file-name file1 v2 - (tramp-send-command-and-check - v1 - (format format-string - (tramp-shell-quote-argument v1-localname) - (tramp-shell-quote-argument v2-localname)))))) - (defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) "Regexp to determine remote SunOS.") From 2f5f30671a122aeed0a78dbee8f541dda5a6d4c2 Mon Sep 17 00:00:00 2001 From: Damien Cassou Date: Tue, 6 Apr 2021 19:31:56 +0200 Subject: [PATCH 011/128] Fix broken links in autorevert.el * lisp/autorevert.el (global-auto-revert-non-file-buffers): Fix broken links. (Bug#47621) --- lisp/autorevert.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index c857d2c9577..3fe7a00cf23 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -227,10 +227,10 @@ modes, etc., of files. You may still sometimes want to revert them manually. Use this option with care since it could lead to excessive auto-reverts. -For more information, see Info node `(emacs)Autorevert'." +For more information, see Info node `(emacs)Auto Revert'." :group 'auto-revert :type 'boolean - :link '(info-link "(emacs)Autorevert")) + :link '(info-link "(emacs)Auto Revert")) (defcustom global-auto-revert-ignore-modes () "List of major modes Global Auto-Revert Mode should not check." From ccd616aeb0519e936bc0064709d32905b5597859 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Apr 2021 14:05:58 -0400 Subject: [PATCH 012/128] * lisp/progmodes/ps-mode.el: Use lexical-binding And prefer #' to quote function names. --- lisp/progmodes/ps-mode.el | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 598f748f5b3..67c034d0905 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -1,4 +1,4 @@ -;;; ps-mode.el --- PostScript mode for GNU Emacs +;;; ps-mode.el --- PostScript mode for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1999, 2001-2021 Free Software Foundation, Inc. @@ -281,20 +281,20 @@ If nil, use `temporary-file-directory'." (defvar ps-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-v" 'ps-run-boundingbox) - (define-key map "\C-c\C-u" 'ps-mode-uncomment-region) - (define-key map "\C-c\C-t" 'ps-mode-epsf-rich) - (define-key map "\C-c\C-s" 'ps-run-start) - (define-key map "\C-c\C-r" 'ps-run-region) - (define-key map "\C-c\C-q" 'ps-run-quit) - (define-key map "\C-c\C-p" 'ps-mode-print-buffer) - (define-key map "\C-c\C-o" 'ps-mode-comment-out-region) - (define-key map "\C-c\C-k" 'ps-run-kill) - (define-key map "\C-c\C-j" 'ps-mode-other-newline) - (define-key map "\C-c\C-l" 'ps-run-clear) - (define-key map "\C-c\C-b" 'ps-run-buffer) + (define-key map "\C-c\C-v" #'ps-run-boundingbox) + (define-key map "\C-c\C-u" #'ps-mode-uncomment-region) + (define-key map "\C-c\C-t" #'ps-mode-epsf-rich) + (define-key map "\C-c\C-s" #'ps-run-start) + (define-key map "\C-c\C-r" #'ps-run-region) + (define-key map "\C-c\C-q" #'ps-run-quit) + (define-key map "\C-c\C-p" #'ps-mode-print-buffer) + (define-key map "\C-c\C-o" #'ps-mode-comment-out-region) + (define-key map "\C-c\C-k" #'ps-run-kill) + (define-key map "\C-c\C-j" #'ps-mode-other-newline) + (define-key map "\C-c\C-l" #'ps-run-clear) + (define-key map "\C-c\C-b" #'ps-run-buffer) ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead? - (define-key map "\177" 'ps-mode-backward-delete-char) + (define-key map "\177" #'ps-mode-backward-delete-char) map) "Local keymap to use in PostScript mode.") @@ -336,10 +336,10 @@ If nil, use `temporary-file-directory'." (defvar ps-run-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map comint-mode-map) - (define-key map "\C-c\C-q" 'ps-run-quit) - (define-key map "\C-c\C-k" 'ps-run-kill) - (define-key map "\C-c\C-e" 'ps-run-goto-error) - (define-key map [mouse-2] 'ps-run-mouse-goto-error) + (define-key map "\C-c\C-q" #'ps-run-quit) + (define-key map "\C-c\C-k" #'ps-run-kill) + (define-key map "\C-c\C-e" #'ps-run-goto-error) + (define-key map [mouse-2] #'ps-run-mouse-goto-error) map) "Local keymap to use in PostScript run mode.") @@ -1092,7 +1092,7 @@ Use line numbers if `ps-run-error-line-numbers' is not nil." ;; -(add-hook 'kill-emacs-hook 'ps-run-cleanup) +(add-hook 'kill-emacs-hook #'ps-run-cleanup) (provide 'ps-mode) From 735ed235c7edb4a487bda9375808ec29d4bea0fb Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 6 Apr 2021 22:15:30 +0300 Subject: [PATCH 013/128] * lisp/isearch.el (isearch-wrap-pause): New defcustom (bug#47599). (isearch-repeat): Use it. (isearch-search): Don't ding when isearch-wrap-pause is no-ding. --- etc/NEWS | 8 +++++++ lisp/isearch.el | 62 +++++++++++++++++++++++++++++++++++-------------- 2 files changed, 53 insertions(+), 17 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c8400ba8c27..d3a8748ded6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -929,6 +929,14 @@ take the actual screenshot, and defaults to "ImageMagick import". A server entry retrieved by auth-source can request a desired smtp authentication mechanism by setting a value for the key 'smtp-auth'. +** Search and Replace + +*** New user option 'isearch-wrap-pause' defines how to wrap the search. +There are choices to disable wrapping completely and to wrap immediately. +When wrapping immediately, it consistently handles the numeric arguments +of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'), +continuing with the remaining count after wrapping. + ** Grep +++ diff --git a/lisp/isearch.el b/lisp/isearch.el index 943e24aa563..a828c569aac 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -172,6 +172,19 @@ This allows you to resume earlier Isearch sessions through the command history." :type 'boolean) +(defcustom isearch-wrap-pause t + "Define the behavior of wrapping when there are no more matches. +When `t' (by default), signal an error when no more matches are found. +Then after repeating the search, wrap with `isearch-wrap-function'. +When `no', wrap immediately after reaching the last match. +When `no-ding', wrap immediately without flashing the screen. +When `nil', never wrap, just stop at the last match." + :type '(choice (const :tag "Pause before wrapping" t) + (const :tag "No pause before wrapping" no) + (const :tag "No pause and no flashing" no-ding) + (const :tag "Disable wrapping" nil)) + :version "28.1") + (defvar isearch-mode-hook nil "Function(s) to call after starting up an incremental search.") @@ -1827,13 +1840,12 @@ Use `isearch-exit' to quit without signaling." ;; After taking the last element, adjust ring to previous one. (isearch-ring-adjust1 nil)) ;; If already have what to search for, repeat it. - (or isearch-success - (progn - ;; Set isearch-wrapped before calling isearch-wrap-function - (setq isearch-wrapped t) - (if isearch-wrap-function - (funcall isearch-wrap-function) - (goto-char (if isearch-forward (point-min) (point-max))))))) + (unless (or isearch-success (null isearch-wrap-pause)) + ;; Set isearch-wrapped before calling isearch-wrap-function + (setq isearch-wrapped t) + (if isearch-wrap-function + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max)))))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward) isearch-success t)) @@ -1844,7 +1856,8 @@ Use `isearch-exit' to quit without signaling." (setq isearch-success t) ;; For the case when count > 1, don't keep intermediate states ;; added to isearch-cmds by isearch-push-state in this loop. - (let ((isearch-cmds isearch-cmds)) + (let ((isearch-cmds isearch-cmds) + (was-success isearch-success)) (while (<= 0 (setq count (1- (or count 1)))) (if (and isearch-success (equal (point) isearch-other-end) @@ -1859,13 +1872,28 @@ Use `isearch-exit' to quit without signaling." (forward-char (if isearch-forward 1 -1)) (isearch-search)) (isearch-search)) - (when (> count 0) - ;; Update isearch-cmds, so if isearch-search fails later, - ;; it can restore old successful state from isearch-cmds. - (isearch-push-state)) - ;; Stop looping on failure. - (when (or (not isearch-success) isearch-error) - (setq count 0))))) + (when (> count 0) + ;; Update isearch-cmds, so if isearch-search fails later, + ;; it can restore old successful state from isearch-cmds. + (isearch-push-state)) + (cond + ;; Wrap immediately and repeat the search again + ((memq isearch-wrap-pause '(no no-ding)) + (if isearch-success + (setq was-success isearch-success) + ;; If failed this time after succeeding last time + (when was-success + (setq was-success nil) + (setq count (1+ count)) ;; Increment to force repeat + (setq isearch-wrapped t) + (if isearch-wrap-function + ;; Note that some wrap functions change the value of + ;; isearch-success, so it's handled above before this call. + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max))))))) + ;; Stop looping on failure + (t (when (or (not isearch-success) isearch-error) + (setq count 0))))))) (isearch-push-state) (isearch-update)) @@ -3488,10 +3516,10 @@ Optional third argument, if t, means if fail just return nil (no error). ;; stack overflow in regexp search. (setq isearch-error (format "%s" lossage)))) - (if isearch-success - nil + (unless isearch-success ;; Ding if failed this time after succeeding last time. (and (isearch--state-success (car isearch-cmds)) + (not (eq isearch-wrap-pause 'no-ding)) (ding)) (if (functionp (isearch--state-pop-fun (car isearch-cmds))) (funcall (isearch--state-pop-fun (car isearch-cmds)) From c9655fcb47da8a104eb7b5eb7a3d0b4a6ba26fc3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Apr 2021 16:28:50 -0400 Subject: [PATCH 014/128] * lisp/find-file.el: Use lexical-binding Remove unused `:group` args. Prefer #' to quote function. (ff-special-constructs, ff-find-the-other-file, ff-get-file-name) (ff-list-replace-env-vars, ff-cc-hh-converter): Use `match-string`. (modula2-other-file-alist): Tighten regexps. (ff-get-other-file, ff-find-other-file): Use dynamic scoping. (ff-find-the-other-file): Minor simplification. (ff-other-file-name): Delete unused function. (ff-string-match): Don't let-bind `case-fold-search` if not needed. (ff-basename): Make it an obsolete alias for `file-name-nondirectory`. (ff-switch-file): Minor simplification. (ff-list-replace-env-vars): Use [:alnum:]. (ff-upcase-p): Use [:upper:] (ff-cc-hh-converter): Use [:upper:] and [:lower:]. --- lisp/find-file.el | 252 +++++++++++++--------------------------------- 1 file changed, 70 insertions(+), 182 deletions(-) diff --git a/lisp/find-file.el b/lisp/find-file.el index 8cc9c972ed4..d54fdffadb9 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -1,4 +1,4 @@ -;;; find-file.el --- find a file corresponding to this one given a pattern +;;; find-file.el --- find a file corresponding to this one given a pattern -*- lexical-binding: t; -*- ;; Author: Henry Guillaume ;; Maintainer: emacs-devel@gnu.org @@ -39,8 +39,8 @@ ;; and just has a different extension as described by the ff-other-file-alist ;; variable: ;; -;; '(("\\.cc$" (".hh" ".h")) -;; ("\\.hh$" (".cc" ".C" ".CC" ".cxx" ".cpp"))) +;; '(("\\.cc\\'" (".hh" ".h")) +;; ("\\.hh\\'" (".cc" ".C" ".CC" ".cxx" ".cpp"))) ;; ;; If the current file has a .cc extension, ff-find-other-file will attempt ;; to look for a .hh file, and then a .h file in some directory as described @@ -55,8 +55,8 @@ ;; format above can be changed to include a function to be called when the ;; current file matches the regexp: ;; -;; '(("\\.cc$" cc--function) -;; ("\\.hh$" hh-function)) +;; '(("\\.cc\\'" cc--function) +;; ("\\.hh\\'" hh-function)) ;; ;; These functions must return a list consisting of the possible names of the ;; corresponding file, with or without path. There is no real need for more @@ -64,10 +64,10 @@ ;; file-alist: ;; ;; (setq cc-other-file-alist -;; '(("\\.cc$" ff-cc-hh-converter) -;; ("\\.hh$" ff-cc-hh-converter) -;; ("\\.c$" (".h")) -;; ("\\.h$" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) +;; '(("\\.cc\\'" ff-cc-hh-converter) +;; ("\\.hh\\'" ff-cc-hh-converter) +;; ("\\.c\\'" (".h")) +;; ("\\.h\\'" (".c" ".cc" ".C" ".CC" ".cxx" ".cpp")))) ;; ;; ff-cc-hh-converter is included at the end of this file as a reference. ;; @@ -130,62 +130,51 @@ (defcustom ff-pre-find-hook nil "List of functions to be called before the search for the file starts." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-pre-load-hook nil "List of functions to be called before the other file is loaded." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-post-load-hook nil "List of functions to be called after the other file is loaded." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-not-found-hook nil "List of functions to be called if the other file could not be found." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-file-created-hook nil "List of functions to be called if the other file needs to be created." - :type 'hook - :group 'ff) + :type 'hook) (defcustom ff-case-fold-search nil "Non-nil means ignore cases in matches (see `case-fold-search'). If you have extensions in different cases, you will want this to be nil." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-always-in-other-window nil "If non-nil, find the corresponding file in another window by default. To override this, give an argument to `ff-find-other-file'." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-ignore-include nil "If non-nil, ignore `#include' lines." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-always-try-to-create t "If non-nil, always attempt to create the other file if it was not found." - :type 'boolean - :group 'ff) + :type 'boolean) (defcustom ff-quiet-mode nil "If non-nil, trace which directories are being searched." - :type 'boolean - :group 'ff) + :type 'boolean) ;;;###autoload (defcustom ff-special-constructs ;; C/C++ include, for NeXTstep too `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") . - (lambda () - (buffer-substring (match-beginning 2) (match-end 2))))) + ,(lambda () (match-string 2)))) ;; We include `ff-treat-as-special' documentation here so that autoload ;; can make it available to be read prior to loading this file. "List of special constructs recognized by `ff-treat-as-special'. @@ -194,8 +183,7 @@ If REGEXP matches the current line (from the beginning of the line), `ff-treat-as-special' calls function EXTRACT with no args. If EXTRACT returns nil, keep trying. Otherwise, return the filename that EXTRACT returned." - :type '(repeat (cons regexp function)) - :group 'ff) + :type '(repeat (cons regexp function))) (defvaralias 'ff-related-file-alist 'ff-other-file-alist) (defcustom ff-other-file-alist 'cc-other-file-alist @@ -207,8 +195,7 @@ directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh'). This alist should be set by the major mode." :type '(choice (repeat (list regexp (choice (repeat string) function))) - symbol) - :group 'ff) + symbol)) (defcustom ff-search-directories 'cc-search-directories "List of directories to search for a specific file. @@ -231,14 +218,12 @@ not exist, it is replaced (silently) with an empty string. The stars are *not* wildcards: they are searched for together with the preceding slash. The star represents all the subdirectories except `..', and each of these subdirectories will be searched in turn." - :type '(choice (repeat directory) symbol) - :group 'ff) + :type '(choice (repeat directory) symbol)) (defcustom cc-search-directories '("." "/usr/include" "/usr/local/include/*") "See the description of the `ff-search-directories' variable." - :type '(repeat directory) - :group 'ff) + :type '(repeat directory)) (defcustom cc-other-file-alist '(("\\.cc\\'" (".hh" ".h")) @@ -269,17 +254,15 @@ since the search algorithm searches sequentially through each directory specified in `ff-search-directories'. If a file is not found, a new one is created with the first matching extension (`.cc' yields `.hh')." :version "24.4" ; add .m - :type '(repeat (list regexp (choice (repeat string) function))) - :group 'ff) + :type '(repeat (list regexp (choice (repeat string) function)))) (defcustom modula2-other-file-alist '( - ("\\.mi$" (".md")) ;; Modula-2 module definition - ("\\.md$" (".mi")) ;; and implementation. + ("\\.mi\\'" (".md")) ;; Modula-2 module definition + ("\\.md\\'" (".mi")) ;; and implementation. ) "See the description for the `ff-search-directories' variable." - :type '(repeat (list regexp (choice (repeat string) function))) - :group 'ff) + :type '(repeat (list regexp (choice (repeat string) function)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -308,13 +291,11 @@ See also the documentation for `ff-find-other-file'. If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (interactive "P") - (let ((ignore ff-ignore-include)) - (setq ff-ignore-include t) - (ff-find-the-other-file in-other-window) - (setq ff-ignore-include ignore))) + (let ((ff-ignore-include t)) + (ff-find-the-other-file in-other-window))) ;;;###autoload -(defalias 'ff-find-related-file 'ff-find-other-file) +(defalias 'ff-find-related-file #'ff-find-other-file) ;;;###autoload (defun ff-find-other-file (&optional in-other-window ignore-include) @@ -370,10 +351,8 @@ Variables of interest include: - `ff-file-created-hook' List of functions to be called if the other file has been created." (interactive "P") - (let ((ignore ff-ignore-include)) - (setq ff-ignore-include ignore-include) - (ff-find-the-other-file in-other-window) - (setq ff-ignore-include ignore))) + (let ((ff-ignore-include ignore-include)) + (ff-find-the-other-file in-other-window))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support functions @@ -413,9 +392,9 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (message "Working...") (setq dirs - (if (symbolp ff-search-directories) - (ff-list-replace-env-vars (symbol-value ff-search-directories)) - (ff-list-replace-env-vars ff-search-directories))) + (ff-list-replace-env-vars (if (symbolp ff-search-directories) + (symbol-value ff-search-directories) + ff-search-directories))) (setq fname (ff-treat-as-special)) @@ -454,11 +433,10 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." ;; if we have a function to generate new names, ;; invoke it with the name of the current file (if (and (atom action) (fboundp action)) - (progn - (setq suffixes (funcall action (ff-buffer-file-name)) - match (cons (car match) (list suffixes)) - stub nil - default-name (car suffixes))) + (setq suffixes (funcall action (ff-buffer-file-name)) + match (cons (car match) (list suffixes)) + stub nil + default-name (car suffixes)) ;; otherwise build our filename stub (cond @@ -472,7 +450,8 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (t (setq format (concat "\\(.+\\)" (car match))) (string-match format fname) - (setq stub (substring fname (match-beginning 1) (match-end 1))) + ;; FIXME: What if `string-match' failed? + (setq stub (match-string 1 fname)) )) ;; if we find nothing, we should try to get a file like this one @@ -522,89 +501,6 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." found)) ;; return buffer-name or filename -(defun ff-other-file-name () - "Return name of the header or source file corresponding to the current file. -Being on a `#include' line pulls in that file, but see the help on -the `ff-ignore-include' variable." - - (let (match ;; matching regexp for this file - suffixes ;; set of replacing regexps for the matching regexp - action ;; function to generate the names of the other files - fname ;; basename of this file - pos ;; where we start matching filenames - stub ;; name of the file without extension - alist ;; working copy of the list of file extensions - pathname ;; the pathname of the file or the #include line - format ;; what we have to match - found ;; name of the file or buffer found - nil if none - dirs) ;; local value of ff-search-directories - - (message "Working...") - - (setq dirs - (if (symbolp ff-search-directories) - (ff-list-replace-env-vars (symbol-value ff-search-directories)) - (ff-list-replace-env-vars ff-search-directories))) - - (setq fname (ff-treat-as-special)) - - (cond - ((and (not ff-ignore-include) fname) - (setq found (ff-get-file-name dirs fname nil))) - - ;; let's just get the corresponding file - (t - (setq alist (if (symbolp ff-other-file-alist) - (symbol-value ff-other-file-alist) - ff-other-file-alist) - pathname (or (ff-buffer-file-name) "/none.none")) - - (setq fname (file-name-nondirectory pathname) - match (car alist)) - - ;; find the table entry corresponding to this file - (setq pos (ff-string-match (car match) fname)) - (while (and match (if (and pos (>= pos 0)) nil (not pos))) - (setq alist (cdr alist)) - (setq match (car alist)) - (setq pos (ff-string-match (car match) fname))) - - ;; no point going on if we haven't found anything - (when match - - ;; otherwise, suffixes contains what we need - (setq suffixes (car (cdr match)) - action (car (cdr match)) - found nil) - - ;; if we have a function to generate new names, - ;; invoke it with the name of the current file - (if (and (atom action) (fboundp action)) - (progn - (setq suffixes (funcall action (ff-buffer-file-name)) - match (cons (car match) (list suffixes)) - stub nil)) - - ;; otherwise build our filename stub - (cond - - ;; get around the problem that 0 and nil both mean false! - ((= pos 0) - (setq format "") - (setq stub "") - ) - - (t - (setq format (concat "\\(.+\\)" (car match))) - (string-match format fname) - (setq stub (substring fname (match-beginning 1) (match-end 1))) - ))) - - ;; do the real work - find the file - (setq found - (ff-get-file-name dirs stub suffixes))))) - found)) ;; return buffer-name or filename - (defun ff-get-file (search-dirs filename &optional suffix-list other-window) "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). If (optional) SUFFIX-LIST is nil, search for FILENAME, otherwise search @@ -709,11 +605,10 @@ name of the first file found." ;; otherwise dir matches the '/*', so search each dir separately (progn - (if (match-beginning 2) - (setq rest (substring dir (match-beginning 2) (match-end 2))) - (setq rest "") - ) - (setq dir (substring dir (match-beginning 1) (match-end 1))) + (setq rest (if (match-beginning 2) + (match-string 2 dir) + "")) + (setq dir (match-string 1 dir)) (let ((dirlist (ff-all-dirs-under dir '(".."))) this-dir compl-dirs) @@ -743,8 +638,8 @@ name of the first file found." (defun ff-string-match (regexp string &optional start) "Like `string-match', but set `case-fold-search' temporarily. The value used comes from `ff-case-fold-search'." - (let ((case-fold-search ff-case-fold-search)) - (if regexp + (if regexp + (let ((case-fold-search ff-case-fold-search)) (string-match regexp string start)))) (defun ff-list-replace-env-vars (search-list) @@ -752,12 +647,12 @@ The value used comes from `ff-case-fold-search'." (let (list (var (car search-list))) (while search-list - (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var) + (if (string-match "\\(.*\\)\\$[({]*\\([[:alnum:]_]+\\)[)}]*\\(.*\\)" var) (setq var (concat - (substring var (match-beginning 1) (match-end 1)) - (getenv (substring var (match-beginning 2) (match-end 2))) - (substring var (match-beginning 3) (match-end 3))))) + (match-string 1 var) + (getenv (match-string 2 var)) + (match-string 3 var)))) (setq search-list (cdr search-list)) (setq list (cons var list)) (setq var (car search-list))) @@ -782,11 +677,7 @@ See variable `ff-special-constructs'." (setq match (cdr elem))) fname))) -(defun ff-basename (string) - "Return the basename of pathname STRING." - (setq string (concat "/" string)) - (string-match ".*/\\([^/]+\\)$" string) - (setq string (substring string (match-beginning 1) (match-end 1)))) +(define-obsolete-function-alias 'ff-basename #'file-name-nondirectory "28.1") (defun ff-all-dirs-under (here &optional exclude) "Get all the directory files under directory HERE. @@ -800,7 +691,7 @@ Exclude all files in the optional EXCLUDE list." (setq file (car files)) (if (and (file-directory-p file) - (not (member (ff-basename file) exclude))) + (not (member (file-name-nondirectory file) exclude))) (setq dirlist (cons file dirlist))) (setq files (cdr files))) (setq dirlist (reverse dirlist)))) @@ -820,26 +711,26 @@ or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs. If optional NEW-FILE is t, then a special hook (`ff-file-created-hook') is called before `ff-post-load-hook'." (run-hooks 'ff-pre-load-hook 'ff-pre-load-hooks) - (if (or - (and in-other-window (not ff-always-in-other-window)) - (and (not in-other-window) ff-always-in-other-window)) - (funcall f2 file) - (funcall f1 file)) + (funcall (if (or + (and in-other-window (not ff-always-in-other-window)) + (and (not in-other-window) ff-always-in-other-window)) + f2 f1) + file) (if new-file (run-hooks 'ff-file-created-hook 'ff-file-created-hooks)) (run-hooks 'ff-post-load-hook 'ff-post-load-hooks)) (defun ff-find-file (file &optional in-other-window new-file) "Like `find-file', but may show the file in another window." - (ff-switch-file 'find-file - 'find-file-other-window + (ff-switch-file #'find-file + #'find-file-other-window file in-other-window new-file)) (defun ff-switch-to-buffer (buffer-or-name &optional in-other-window) "Like `switch-to-buffer', but may show the buffer in another window." - (ff-switch-file 'switch-to-buffer - 'switch-to-buffer-other-window + (ff-switch-file #'switch-to-buffer + #'switch-to-buffer-other-window buffer-or-name in-other-window nil)) ;;;###autoload @@ -873,7 +764,7 @@ Given START and/or END, checks between these characters." (setq end (1+ end))) (setq str (substring string start end)) (if (and - (ff-string-match "[A-Z]+" str) + (ff-string-match "[[:upper:]]+" str) (setq match (match-data)) (= (car match) 0) (= (car (cdr match)) (length str))) @@ -885,19 +776,16 @@ Given START and/or END, checks between these characters." Build up a new file list based possibly on part of the directory name and the name of the file passed in." (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg) - (let ((dire (if (match-beginning 2) - (substring arg (match-beginning 2) (match-end 2)) nil)) - (file (if (match-beginning 3) - (substring arg (match-beginning 3) (match-end 3)) nil)) - (extn (if (match-beginning 4) - (substring arg (match-beginning 4) (match-end 4)) nil)) + (let ((dire (match-string 2 arg)) + (file (match-string 3 arg)) + (extn (match-string 4 arg)) return-list) (cond ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h} ((and (string= extn "cc") - (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file)) - (let ((stub (substring file (match-beginning 2) (match-end 2)))) - (setq dire (upcase (substring file (match-beginning 1) (match-end 1)))) + (ff-string-match "^\\([[:lower:]]+\\)\\([[:upper:]].+\\)$" file)) + (let ((stub (match-string 2 file))) + (setq dire (upcase (match-string 1 file))) (setq return-list (list (concat stub ".hh") (concat stub ".h") (concat file ".hh") From c105017c44d4a679f7af739b2c0390b2c7850569 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Apr 2021 17:06:07 -0400 Subject: [PATCH 015/128] * lisp/find-file.el: Make the commands oblivious to mouse/non-mouse (ff-find-other-file): Add `event` argument. (ff-find-other-file-other-window): Rename from `ff-mouse-find-other-file-other-window` and use this new argument. (ff-mouse-find-other-file, ff-mouse-find-other-file-other-window): Make them obsolete aliases. (ff-upcase-p): Remove unused `start` and `end` arguments and simplify accordingly. --- lisp/find-file.el | 54 ++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 34 deletions(-) diff --git a/lisp/find-file.el b/lisp/find-file.el index d54fdffadb9..6c3c0f123b1 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -298,7 +298,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window." (defalias 'ff-find-related-file #'ff-find-other-file) ;;;###autoload -(defun ff-find-other-file (&optional in-other-window ignore-include) +(defun ff-find-other-file (&optional in-other-window ignore-include event) "Find the header or source file corresponding to this file. Being on a `#include' line pulls in that file. @@ -350,9 +350,11 @@ Variables of interest include: - `ff-file-created-hook' List of functions to be called if the other file has been created." - (interactive "P") - (let ((ff-ignore-include ignore-include)) - (ff-find-the-other-file in-other-window))) + (interactive (list current-prefix-arg nil last-nonmenu-event)) + (save-excursion + (posn-set-point (event-end event)) + (let ((ff-ignore-include ignore-include)) + (ff-find-the-other-file in-other-window)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Support functions @@ -734,42 +736,26 @@ called before `ff-post-load-hook'." buffer-or-name in-other-window nil)) ;;;###autoload -(defun ff-mouse-find-other-file (event) - "Visit the file you click on." - (interactive "e") - (save-excursion - (mouse-set-point event) - (ff-find-other-file nil))) +(define-obsolete-function-alias + 'ff-mouse-find-other-file #'ff-find-other-file "28.1") ;;;###autoload -(defun ff-mouse-find-other-file-other-window (event) - "Visit the file you click on in another window." - (interactive "e") - (save-excursion - (mouse-set-point event) - (ff-find-other-file t))) +(define-obsolete-function-alias + 'ff-mouse-find-other-file-other-window #'ff-find-other-file-other-window "28.1") +;;;###autoload +(defun ff-find-other-file-other-window (event) + "Visit the file you point at in another window." + (interactive (list last-nonmenu-event)) + (ff-find-other-file t nil event)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; This section offers an example of user defined function to select files -(defun ff-upcase-p (string &optional start end) - "Return t if STRING is all uppercase. -Given START and/or END, checks between these characters." - (let (match str) - (if (not start) - (setq start 0)) - (if (not end) - (setq end (length string))) - (if (= start end) - (setq end (1+ end))) - (setq str (substring string start end)) - (if (and - (ff-string-match "[[:upper:]]+" str) - (setq match (match-data)) - (= (car match) 0) - (= (car (cdr match)) (length str))) - t - nil))) +(defun ff-upcase-p (string) + "Return t if STRING is all uppercase." + ;; FIXME: Why `ff-string-match' since `[:upper:]' only makes + ;; sense when `case-fold-search' is nil? + (ff-string-match "\\`[[:upper:]]*\\'" string)) (defun ff-cc-hh-converter (arg) "Discriminate file extensions. From 5d293f4f7489bcc9659f69f41e8db2a0755e5f44 Mon Sep 17 00:00:00 2001 From: Dario Gjorgjevski Date: Tue, 6 Apr 2021 16:51:28 +0200 Subject: [PATCH 016/128] Allow complex key bindings in project-switch-project * lisp/progmodes/project.el (project-switch-project): Replace read-event with an overriding local map and read-key-sequence to allow for complex key bindings to be read (bug#47620). --- lisp/progmodes/project.el | 36 ++++++++++++++++++++---------------- 1 file changed, 20 insertions(+), 16 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 910f70db03c..84d02e25d93 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1338,23 +1338,27 @@ made from `project-switch-commands'. When called in a program, it will use the project corresponding to directory DIR." (interactive (list (project-prompt-project-dir))) - (let ((commands-menu - (mapcar - (lambda (row) - (if (characterp (car row)) - ;; Deprecated format. - ;; XXX: Add a warning about it? - (reverse row) - row)) - project-switch-commands)) - command) + (let* ((commands-menu + (mapcar + (lambda (row) + (if (characterp (car row)) + ;; Deprecated format. + ;; XXX: Add a warning about it? + (reverse row) + row)) + project-switch-commands)) + (commands-map + (let ((temp-map (make-sparse-keymap))) + (set-keymap-parent temp-map project-prefix-map) + (dolist (row commands-menu temp-map) + (when-let ((cmd (nth 0 row)) + (keychar (nth 2 row))) + (define-key temp-map (vector keychar) cmd))))) + command) (while (not command) - (let ((choice (read-event (project--keymap-prompt)))) - (when (setq command - (or (car - (seq-find (lambda (row) (equal choice (nth 2 row))) - commands-menu)) - (lookup-key project-prefix-map (vector choice)))) + (let ((overriding-local-map commands-map) + (choice (read-key-sequence (project--keymap-prompt)))) + (when (setq command (lookup-key commands-map choice)) (unless (or project-switch-use-entire-map (assq command commands-menu)) ;; TODO: Add some hint to the prompt, like "key not From 1ff7cde1027778e608acbe58a81fe08c1fd84189 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 7 Apr 2021 03:24:17 +0300 Subject: [PATCH 017/128] Add explicit support for C-g or ESC ESC ESC after keymap prompt * lisp/progmodes/project.el (project-switch-project): Add explicit support for C-g or ESC ESC ESC after keymap prompt (bug#47620). --- lisp/progmodes/project.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 84d02e25d93..a819e7243ca 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1363,7 +1363,11 @@ to directory DIR." (assq command commands-menu)) ;; TODO: Add some hint to the prompt, like "key not ;; recognized" or something. - (setq command nil))))) + (setq command nil))) + (let ((global-command (lookup-key (current-global-map) choice))) + (when (memq global-command + '(keyboard-quit keyboard-escape-quit)) + (call-interactively global-command))))) (let ((default-directory dir) (project-current-inhibit-prompt t)) (call-interactively command)))) From c1173f231d46f14f71886fa343dbc7501f064919 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 7 Apr 2021 01:49:21 +0200 Subject: [PATCH 018/128] ; Fix my previous change to shadowfile.el * lisp/shadowfile.el (shadow-add-to-todo, shadow-union): Wrap call to cl-union in nreverse for backwards-compatible ordering. --- lisp/shadowfile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index a03965cf6c7..b5e7d444c51 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -639,7 +639,7 @@ Consider them as regular expressions if third arg REGEXP is true." shadows shadow-files-to-copy (with-output-to-string (backtrace)))) (when shadows (setq shadow-files-to-copy - (cl-union shadows shadow-files-to-copy :test #'equal)) + (nreverse (cl-union shadows shadow-files-to-copy :test #'equal))) (when (not shadow-inhibit-message) (message "%s" (substitute-command-keys "Use \\[shadow-copy-files] to update shadows.")) @@ -832,7 +832,7 @@ look for files that have been changed and need to be copied to other systems." (defun shadow-union (a b) "Add members of list A to list B if not equal to items already in B." (declare (obsolete cl-union "28.1")) - (cl-union a b :test #'equal)) + (nreverse (cl-union a b :test #'equal))) (define-obsolete-function-alias 'shadow-find #'seq-find "28.1") From 55f0576ebd4601fbf8e5e7ba9ab14e00fa2821b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 7 Apr 2021 13:11:43 +0200 Subject: [PATCH 019/128] Fix mistakes in bytecomp-tests * test/lisp/emacs-lisp/bytecomp-tests.el (byte-opt-testsuite-arith-data): Fix typos and avoid errors that made the tests less powerful than intended. --- test/lisp/emacs-lisp/bytecomp-tests.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 5147cd26883..0f7a0ccc851 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -364,17 +364,17 @@ '((a c) (b c) (7 c) (-3 c) (nil nil) (t c) (q c) (r c) (s c) (t c) (x "a") (x "c") (x c) (x d) (x e))) - (mapcar (lambda (x) (cond ((member '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a . b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((memq '(a . b) x) 1) + ((equal x '(c)) 2)))) '(((a . b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((member '(a b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((member '(a b) x) 1) + ((equal x '(c)) 2)))) '(((a b)) a b (c) (d))) - (mapcar (lambda (x) (cond ((memq '(a b) x) 1) - ((equal x '(c)) 2))) + (mapcar (lambda (x) (ignore-errors (cond ((memq '(a b) x) 1) + ((equal x '(c)) 2)))) '(((a b)) a b (c) (d))) (assoc 'b '((a 1) (b 2) (c 3))) @@ -396,7 +396,7 @@ x) (let ((x 1) (bytecomp-test-var 2) (y 3)) - (list x bytecomp-test-var (bytecomp-get-test-var) y)) + (list x bytecomp-test-var (bytecomp-test-get-var) y)) (progn (defvar d) @@ -430,7 +430,7 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-identity 'a) (setq x 3)) x))) + (list (or (bytecomp-test-identity 'a) (setq x 3)) x))) "List of expression for test. Each element will be executed by interpreter and with bytecompiled code, and their results compared.") From 5d456136169468e78c877ead2a3e279d9ebc7e4c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 7 Apr 2021 13:35:59 +0200 Subject: [PATCH 020/128] Update whois-server-tld * lisp/net/net-utils.el (whois-server-tld): Update and add some missing entries. --- lisp/net/net-utils.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 3a561a0ea51..24f2aba8b86 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -857,9 +857,14 @@ and `network-connection-service-alist', which see." ;; FIXME: modern whois clients include a much better tld <-> whois server ;; list, Emacs should probably avoid specifying the server as the client ;; will DTRT anyway... -rfr +;; I'm not sure about the above FIXME. It seems to me that we should +;; just check the Root Zone Database maintained at: +;; https://www.iana.org/domains/root/db +;; For example: whois -h whois.iana.org .se | grep whois (defcustom whois-server-tld - '(("rs.internic.net" . "com") - ("whois.publicinterestregistry.net" . "org") + '(("whois.verisign-grs.com" . "com") + ("whois.verisign-grs.com" . "net") + ("whois.pir.org" . "org") ("whois.ripe.net" . "be") ("whois.ripe.net" . "de") ("whois.ripe.net" . "dk") @@ -867,10 +872,13 @@ and `network-connection-service-alist', which see." ("whois.ripe.net" . "fi") ("whois.ripe.net" . "fr") ("whois.ripe.net" . "uk") + ("whois.iis.se" . "se") + ("whois.iis.nu" . "nu") ("whois.apnic.net" . "au") ("whois.apnic.net" . "ch") ("whois.apnic.net" . "hk") ("whois.apnic.net" . "jp") + ("whois.eu" . "eu") ("whois.nic.gov" . "gov") ("whois.nic.mil" . "mil")) "Alist to map top level domains to whois servers." From b66e2a7b66711be35cd9cb5e5a9d1021cef32c4a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 7 Apr 2021 14:30:54 +0200 Subject: [PATCH 021/128] Clarify obsoletion messages for easy-menu-{add,remove} * lisp/emacs-lisp/easymenu.el (easy-menu-remove, easy-menu-add): Clarify obsoletion messages. --- lisp/emacs-lisp/easymenu.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 87b34e7cd57..f6661541a16 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -494,14 +494,16 @@ To implement dynamic menus, either call this from `menu-bar-update-hook' or use a menu filter." (easy-menu-add-item map path (easy-menu-create-menu name items) before)) -(define-obsolete-function-alias 'easy-menu-remove #'ignore "28.1" +(defalias 'easy-menu-remove #'ignore "Remove MENU from the current menu bar. Contrary to XEmacs, this is a nop on Emacs since menus are automatically \(de)activated when the corresponding keymap is (de)activated. \(fn MENU)") +(make-obsolete 'easy-menu-remove "this was always a no-op in Emacs \ +and can be safely removed." "28.1") -(define-obsolete-function-alias 'easy-menu-add #'ignore "28.1" +(defalias 'easy-menu-add #'ignore "Add the menu to the menubar. On Emacs this is a nop, because menus are already automatically activated when the corresponding keymap is activated. On XEmacs @@ -511,6 +513,8 @@ You should call this once the menu and keybindings are set up completely and menu filter functions can be expected to work. \(fn MENU &optional MAP)") +(make-obsolete 'easy-menu-add "this was always a no-op in Emacs \ +and can be safely removed." "28.1") (defun add-submenu (menu-path submenu &optional before in-menu) "Add submenu SUBMENU in the menu at MENU-PATH. From 151b202cf0b5ad3dd28941dcf60c20e5e2adab67 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 7 Apr 2021 19:47:09 +0300 Subject: [PATCH 022/128] Don't set isearch-success in isearch-wrap functions * lisp/comint.el (comint-history-isearch-wrap): * lisp/simple.el (minibuffer-history-isearch-wrap): Don't set isearch-success to t, so isearch-repeat won't skip the beginning of the wrapped match with (forward-char (if isearch-forward 1 -1)). --- lisp/comint.el | 1 - lisp/isearch.el | 2 -- lisp/simple.el | 1 - 3 files changed, 4 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index 4f13ff31acb..9cbcfc03fa6 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1627,7 +1627,6 @@ or to the last history element for a backward search." (if isearch-forward (comint-goto-input (1- (ring-length comint-input-ring))) (comint-goto-input nil)) - (setq isearch-success t) (goto-char (if isearch-forward (comint-line-beginning-position) (point-max)))) (defun comint-history-isearch-push-state () diff --git a/lisp/isearch.el b/lisp/isearch.el index a828c569aac..4b4f44bdffd 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -1887,8 +1887,6 @@ Use `isearch-exit' to quit without signaling." (setq count (1+ count)) ;; Increment to force repeat (setq isearch-wrapped t) (if isearch-wrap-function - ;; Note that some wrap functions change the value of - ;; isearch-success, so it's handled above before this call. (funcall isearch-wrap-function) (goto-char (if isearch-forward (point-min) (point-max))))))) ;; Stop looping on failure diff --git a/lisp/simple.el b/lisp/simple.el index c48e644345b..999755a642f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2798,7 +2798,6 @@ or to the last history element for a backward search." (if isearch-forward (goto-history-element (length (minibuffer-history-value))) (goto-history-element 0)) - (setq isearch-success t) (goto-char (if isearch-forward (minibuffer-prompt-end) (point-max)))) (defun minibuffer-history-isearch-push-state () From 9e8ac1f5be755a5618792b5b100915c2730c9d61 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Apr 2021 12:24:42 +0200 Subject: [PATCH 023/128] Revert use of powershell in Tramp, there are collateral damages * lisp/net/tramp-sh.el (tramp-methods) : Fix quoting for MS Windows. (tramp-connection-properties): Don't set "encoding-shell". (tramp-actions-before-shell): Remove `tramp-no-job-control-regexp'. (tramp-maybe-open-connection): Revert changes for "encoding-shell". * lisp/net/tramp.el (tramp-no-job-control-regexp): Remove. --- lisp/net/tramp-sh.el | 33 ++++++++++++--------------------- lisp/net/tramp.el | 9 --------- 2 files changed, 12 insertions(+), 30 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index b902ee6f352..8db9dd9d822 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -169,7 +169,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -225,7 +226,8 @@ The string is used in `tramp-methods'.") (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") ("-e" "none") ("-t" "-t") - ("-o" "RemoteCommand='%l'") ("%h"))) + ("-o" "RemoteCommand=\"%l\"") + ("%h"))) (tramp-async-args (("-q"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) @@ -389,14 +391,7 @@ The string is used in `tramp-methods'.") (regexp-opt '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) "\\'") - nil ,(user-login-name))) - - ;; MS Windows Openssh client does not cooperate well with cmdproxy. - (when-let ((encoding-shell - (and (eq system-type 'windows-nt) (executable-find "powershell")))) - (add-to-list 'tramp-connection-properties - `(,(regexp-opt '("/sshx:" "/scpx:")) - "encoding-shell" ,encoding-shell)))) + nil ,(user-login-name)))) ;;;###tramp-autoload (defconst tramp-completion-function-alist-rsh @@ -491,7 +486,6 @@ shell from reading its init file." '((tramp-login-prompt-regexp tramp-action-login) (tramp-password-prompt-regexp tramp-action-password) (tramp-wrong-passwd-regexp tramp-action-permission-denied) - (tramp-no-job-control-regexp tramp-action-permission-denied) (shell-prompt-pattern tramp-action-succeed) (tramp-shell-prompt-pattern tramp-action-succeed) (tramp-yesno-prompt-regexp tramp-action-yesno) @@ -4804,6 +4798,8 @@ connection if a previous connection has died for some reason." (setenv "HISTSIZE" "0")))) (setenv "PROMPT_COMMAND") (setenv "PS1" tramp-initial-end-of-output) + (unless (stringp tramp-encoding-shell) + (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) (let* ((current-host tramp-system-name) (target-alist (tramp-compute-multi-hops vec)) ;; We will apply `tramp-ssh-controlmaster-options' @@ -4815,23 +4811,17 @@ connection if a previous connection has died for some reason." ;; W32 systems. (process-coding-system-alist nil) (coding-system-for-read nil) - (encoding-shell - (tramp-get-connection-property - vec "encoding-shell" tramp-encoding-shell)) - (extra-args (tramp-get-sh-extra-args encoding-shell)) + (extra-args (tramp-get-sh-extra-args tramp-encoding-shell)) ;; This must be done in order to avoid our file ;; name handler. (p (let ((default-directory (tramp-compat-temporary-file-directory))) - (unless (stringp encoding-shell) - (tramp-error - vec 'file-error "`tramp-encoding-shell' not set")) (apply #'start-process (tramp-get-connection-name vec) (tramp-get-connection-buffer vec) (append - (list encoding-shell) + (list tramp-encoding-shell) (and extra-args (split-string extra-args)) (and tramp-encoding-command-interactive (list tramp-encoding-command-interactive))))))) @@ -4850,7 +4840,8 @@ connection if a previous connection has died for some reason." ;; Check whether process is alive. (tramp-barf-if-no-shell-prompt - p 10 "Couldn't find local shell prompt for %s" encoding-shell) + p 10 + "Couldn't find local shell prompt for %s" tramp-encoding-shell) ;; Now do all the connections as specified. (while target-alist @@ -4925,7 +4916,7 @@ connection if a previous connection has died for some reason." ?c (format-spec options (format-spec-make ?t tmpfile)) ?l (concat remote-shell " " extra-args " -i")) ;; A restricted shell does not allow "exec". - (when r-shell '("; exit"))) + (when r-shell '("&&" "exit" "||" "exit"))) " ")) ;; Send the command. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 99955b54598..b2c650f6e1a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -691,15 +691,6 @@ The regexp should match at end of buffer." :version "27.1" :type 'regexp) -;; Powershell requires "ssh -t -t" for terminal emulation. If it -;; doesn't fit, there is an error. -(defcustom tramp-no-job-control-regexp - (regexp-quote "Thus no job control in this shell.") - "Regular expression matching powershell's job control message. -The regexp should match at end of buffer." - :version "28.1" - :type 'regexp) - (defcustom tramp-operation-not-permitted-regexp (concat "\\(" "preserving times.*" "\\|" "set mode" "\\)" ":\\s-*" (regexp-opt '("Operation not permitted") t)) From 173d49b03ac945b700354f88b34fa61ea4000b42 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 8 Apr 2021 16:35:02 +0200 Subject: [PATCH 024/128] * doc/misc/tramp.texi (Frequently Asked Questions): New item about recentf. --- doc/misc/tramp.texi | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5ea0275bafe..40245acb8e5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5066,6 +5066,33 @@ path, or somewhere else entirely (including locally). @pxref{Renaming remote files}. +@item +How to prevent @value{tramp} from clearing the @code{recentf-list}? + +When @value{tramp} cleans a connection, it removes the respective +remote file name(s) from @code{recentf-list}. This is needed, because +an unresponsive remote host could trigger @code{recentf} to connect +that host again and again. + +If you find the cleanup disturbing, because the file names in +@code{recentf-list} are precious to you, you could add the following +two forms in your @file{~/.emacs} after loading the @code{tramp} and +@code{recentf} packages: + +@lisp +@group +(remove-hook + 'tramp-cleanup-connection-hook + #'tramp-recentf-cleanup) +@end group +@group +(remove-hook + 'tramp-cleanup-all-connections-hook + #'tramp-recentf-cleanup-all) +@end group +@end lisp + + @item I get a warning @samp{Tramp has been compiled with Emacs a.b, this is Emacs c.d} From a45493f2596c566de253eca98dfd5b82224ea217 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Apr 2021 14:36:51 -0400 Subject: [PATCH 025/128] * lisp/array.el: Use lexical-binding --- lisp/array.el | 54 +++++++++++++++++++++++++-------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) diff --git a/lisp/array.el b/lisp/array.el index cd8971bd266..6632da55dd4 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -1,4 +1,4 @@ -;;; array.el --- array editing commands for GNU Emacs +;;; array.el --- array editing commands for GNU Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1987, 2000-2021 Free Software Foundation, Inc. @@ -769,25 +769,25 @@ Return COLUMN." (defvar array-mode-map (let ((map (make-keymap))) - (define-key map "\M-ad" 'array-display-local-variables) - (define-key map "\M-am" 'array-make-template) - (define-key map "\M-ae" 'array-expand-rows) - (define-key map "\M-ar" 'array-reconfigure-rows) - (define-key map "\M-a=" 'array-what-position) - (define-key map "\M-ag" 'array-goto-cell) - (define-key map "\M-af" 'array-fill-rectangle) - (define-key map "\C-n" 'array-next-row) - (define-key map "\C-p" 'array-previous-row) - (define-key map "\C-f" 'array-forward-column) - (define-key map "\C-b" 'array-backward-column) - (define-key map "\M-n" 'array-copy-down) - (define-key map "\M-p" 'array-copy-up) - (define-key map "\M-f" 'array-copy-forward) - (define-key map "\M-b" 'array-copy-backward) - (define-key map "\M-\C-n" 'array-copy-row-down) - (define-key map "\M-\C-p" 'array-copy-row-up) - (define-key map "\M-\C-f" 'array-copy-column-forward) - (define-key map "\M-\C-b" 'array-copy-column-backward) + (define-key map "\M-ad" #'array-display-local-variables) + (define-key map "\M-am" #'array-make-template) + (define-key map "\M-ae" #'array-expand-rows) + (define-key map "\M-ar" #'array-reconfigure-rows) + (define-key map "\M-a=" #'array-what-position) + (define-key map "\M-ag" #'array-goto-cell) + (define-key map "\M-af" #'array-fill-rectangle) + (define-key map "\C-n" #'array-next-row) + (define-key map "\C-p" #'array-previous-row) + (define-key map "\C-f" #'array-forward-column) + (define-key map "\C-b" #'array-backward-column) + (define-key map "\M-n" #'array-copy-down) + (define-key map "\M-p" #'array-copy-up) + (define-key map "\M-f" #'array-copy-forward) + (define-key map "\M-b" #'array-copy-backward) + (define-key map "\M-\C-n" #'array-copy-row-down) + (define-key map "\M-\C-p" #'array-copy-row-up) + (define-key map "\M-\C-f" #'array-copy-column-forward) + (define-key map "\M-\C-b" #'array-copy-column-backward) map) "Keymap used in array mode.") @@ -815,17 +815,17 @@ in array mode may have different values assigned to the variables. The variables are: Variables you assign: - array-max-row: The number of rows in the array. - array-max-column: The number of columns in the array. - array-columns-per-line: The number of columns in the array + `array-max-row': The number of rows in the array. + `array-max-column': The number of columns in the array. + `array-columns-per-line': The number of columns in the array per line of buffer. - array-field-width: The width of each field, in characters. - array-rows-numbered: A logical variable describing whether to ignore + `array-field-width': The width of each field, in characters. + `array-rows-numbered': A logical variable describing whether to ignore row numbers in the buffer. Variables which are calculated: - array-line-length: The number of characters in a buffer line. - array-lines-per-row: The number of buffer lines used to + `array-line-length': The number of characters in a buffer line. + `array-lines-per-row': The number of buffer lines used to display each row. The following commands are available (an asterisk indicates it may From d365c947b53a2a1e4b43ab65922ebfeca23943d1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Apr 2021 14:44:37 -0400 Subject: [PATCH 026/128] * lisp/progmodes/vhdl-mode.el: Use progress-reporter This was actually prompted by a backward compatibility problem (because of the use of Emacs-27's `time-convert`). The new code seems to work fine in Emacs-25. It also fixes a minor bug that made the echo area messages of `vhdl-indent-region` compete with those of `indent-region`. (vhdl-progress-info): Delete variable. (vhdl--progress-reporter): New var to replace it. (vhdl-update-progress-info): Delete function. (vhdl-indent-line): Call progress-reporter-update instead. (vhdl-indent-region): Make it an obsolete alias of `indent-region`. Change all users. (vhdl-align-region-groups, vhdl-align-region, vhdl-fix-case-region-1): Use `make-progress-reporter` and `progress-reporter-update`. --- lisp/progmodes/vhdl-mode.el | 123 +++++++++++++++--------------------- 1 file changed, 51 insertions(+), 72 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 856432ccf10..f4a39c29ca5 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -2864,7 +2864,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) - (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) + (define-key vhdl-mode-map "\M-\C-\\" 'indent-region) (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) @@ -3575,7 +3575,7 @@ STRING are replaced by `-' and substrings are converted to lower case." ("Indent" ["Line" indent-according-to-mode :keys "C-c C-i C-l"] ["Group" vhdl-indent-group :keys "C-c C-i C-g"] - ["Region" vhdl-indent-region (mark)] + ["Region" indent-region (mark)] ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) ("Align" ["Group" vhdl-align-group t] @@ -7383,22 +7383,8 @@ only-lines." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Progress reporting -(defvar vhdl-progress-info nil - "Array variable for progress information: 0 begin, 1 end, 2 time.") - -(defun vhdl-update-progress-info (string pos) - "Update progress information." - (when (and vhdl-progress-info (not noninteractive) - (time-less-p vhdl-progress-interval - (time-since (aref vhdl-progress-info 2)))) - (let ((delta (- (aref vhdl-progress-info 1) - (aref vhdl-progress-info 0)))) - (message "%s... (%2d%%)" string - (if (= 0 delta) - 100 - (floor (* 100.0 (- pos (aref vhdl-progress-info 0))) - delta)))) - (aset vhdl-progress-info 2 (time-convert nil 'integer)))) +(defvar vhdl--progress-reporter nil + "Holds the progress reporter data during long running operations.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation commands @@ -7414,7 +7400,7 @@ else indent `correctly'." (cond ;; indent region if region is active ((and (not (featurep 'xemacs)) (use-region-p)) - (vhdl-indent-region (region-beginning) (region-end) nil)) + (indent-region (region-beginning) (region-end) nil)) ;; expand word ((= (char-syntax (preceding-char)) ?w) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) @@ -7509,25 +7495,17 @@ indentation change." (when (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))) (run-hooks 'vhdl-special-indent-hook) - (vhdl-update-progress-info "Indenting" (vhdl-current-line)) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))) shift-amt)) -(defun vhdl-indent-region (beg end &optional column) - "Indent region as VHDL code. -Adds progress reporting to `indent-region'." - (interactive "r\nP") - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0))) - (indent-region beg end column) - (when vhdl-progress-interval (message "Indenting...done")) - (setq vhdl-progress-info nil)) +(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1") (defun vhdl-indent-buffer () "Indent whole buffer as VHDL code. Calls `indent-region' for whole buffer and adds progress reporting." (interactive) - (vhdl-indent-region (point-min) (point-max))) + (indent-region (point-min) (point-max))) (defun vhdl-indent-group () "Indent group of lines between empty lines." @@ -7540,7 +7518,7 @@ Calls `indent-region' for whole buffer and adds progress reporting." (if (re-search-forward vhdl-align-group-separate nil t) (point-marker) (point-max-marker))))) - (vhdl-indent-region beg end))) + (indent-region beg end))) (defun vhdl-indent-sexp (&optional endpos) "Indent each line of the list starting just after point. @@ -7799,18 +7777,21 @@ the token in MATCH." "Align region, treat groups of lines separately." (interactive "r\nP") (save-excursion - (let (orig pos) - (goto-char beg) - (beginning-of-line) - (setq orig (point-marker)) - (setq beg (point)) - (goto-char end) - (setq end (point-marker)) - (untabify beg end) - (unless no-message - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0)))) + (goto-char beg) + (beginning-of-line) + (setq beg (point)) + (goto-char end) + (setq end (point-marker)) + (untabify beg end) + (let ((orig (copy-marker beg)) + pos + (vhdl--progress-reporter + (if no-message + ;; Preserve a potential progress reporter from + ;; when called from `vhdl-align-region' call. + vhdl--progress-reporter + (when vhdl-progress-interval + (make-progress-reporter "Aligning..." beg (copy-marker end)))))) (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (goto-char beg) @@ -7825,19 +7806,21 @@ the token in MATCH." (setq pos (point-marker)) (vhdl-align-region-1 beg pos spacing) (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) - (vhdl-update-progress-info "Aligning" (vhdl-current-line)) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))) (setq beg (1+ pos)) (goto-char beg)) ;; align last group (when (< beg end) (vhdl-align-region-1 beg end spacing) (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) - (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) + (when vhdl--progress-reporter + (progress-reporter-update vhdl--progress-reporter (point))))) (when vhdl-indent-tabs-mode (tabify orig end)) (unless no-message - (when vhdl-progress-interval (message "Aligning...done")) - (setq vhdl-progress-info nil))))) + (when vhdl--progress-reporter + (progress-reporter-done vhdl--progress-reporter)))))) (defun vhdl-align-region (beg end &optional spacing) "Align region, treat blocks with same indent and argument lists separately." @@ -7848,10 +7831,10 @@ the token in MATCH." ;; align blocks with same indent and argument lists (save-excursion (let ((cur-beg beg) - indent cur-end) - (when vhdl-progress-interval - (setq vhdl-progress-info (vector (count-lines (point-min) beg) - (count-lines (point-min) end) 0))) + indent cur-end + (vhdl--progress-reporter + (when vhdl-progress-interval + (make-progress-reporter "Aligning..." beg (copy-marker end))))) (goto-char end) (setq end (point-marker)) (goto-char cur-beg) @@ -7874,15 +7857,16 @@ the token in MATCH." (= (current-indentation) indent)) (<= (save-excursion (nth 0 (parse-partial-sexp - (point) (vhdl-point 'eol)))) 0)) + (point) (vhdl-point 'eol)))) + 0)) (unless (looking-at "^\\s-*$") (setq cur-end (vhdl-point 'bonl))) (beginning-of-line 2))) ;; align region (vhdl-align-region-groups cur-beg cur-end spacing t t)) (vhdl-align-inline-comment-region beg end spacing noninteractive) - (when vhdl-progress-interval (message "Aligning...done")) - (setq vhdl-progress-info nil))))) + (when vhdl--progress-reporter + (progress-reporter-done vhdl--progress-reporter)))))) (defun vhdl-align-group (&optional spacing) "Align group of lines between empty lines." @@ -8126,7 +8110,8 @@ end of line, do nothing in comments." "Convert all words matching WORD-REGEXP in region to lower or upper case, depending on parameter UPPER-CASE." (let ((case-replace nil) - (last-update 0)) + (pr (when (and count vhdl-progress-interval (not noninteractive)) + (make-progress-reporter "Fixing case..." beg (copy-marker end))))) (vhdl-prepare-search-2 (save-excursion (goto-char end) @@ -8137,14 +8122,8 @@ depending on parameter UPPER-CASE." (if upper-case (upcase-word -1) (downcase-word -1))) - (when (and count vhdl-progress-interval (not noninteractive) - (time-less-p vhdl-progress-interval - (time-since last-update))) - (message "Fixing case... (%2d%s)" - (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) - "%") - (setq last-update (time-convert nil 'integer)))) - (goto-char end))))) + (when pr (progress-reporter-update pr (point)))) + (when pr (progress-reporter-done pr)))))) (defun vhdl-fix-case-region (beg end &optional arg) "Convert all VHDL words in region to lower or upper case, depending on @@ -8283,7 +8262,7 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', (replace-match "" nil t))) (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) - (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) + (when (nth 2 vhdl-beautify-options) (indent-region beg end)) (when (nth 3 vhdl-beautify-options) (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) @@ -12411,7 +12390,7 @@ reflected in a subsequent paste operation." (insert "\n") (setq position (point)) (vhdl-insert-string-or-file vhdl-testbench-declarations) - (vhdl-indent-region position (point))) + (indent-region position (point))) (setq position (point)) (insert "\n\n") (vhdl-comment-display-line) (insert "\n") @@ -12442,7 +12421,7 @@ reflected in a subsequent paste operation." (insert "\n") (setq position (point)) (vhdl-insert-string-or-file vhdl-testbench-statements) - (vhdl-indent-region position (point))) + (indent-region position (point))) (insert "\n") (indent-to vhdl-basic-offset) (unless (eq vhdl-testbench-create-files 'none) @@ -14832,11 +14811,11 @@ if required." "Name of last selected project.") ;; macros must be defined in the file they are used (copied from `speedbar.el') -;;; (defmacro speedbar-with-writable (&rest forms) -;;; "Allow the buffer to be writable and evaluate FORMS." -;;; (list 'let '((inhibit-read-only t)) -;;; (cons 'progn forms))) -;;; (put 'speedbar-with-writable 'lisp-indent-function 0) +;; (defmacro speedbar-with-writable (&rest forms) +;; "Allow the buffer to be writable and evaluate FORMS." +;; (declare (indent 0) (debug t)) +;; (list 'let '((inhibit-read-only t)) +;; (cons 'progn forms))) (declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) (declare-function speedbar-directory-buttons "speedbar" (directory _index)) From 580c4c6510fca918610c9c0f440a7d21c4702f16 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 8 Apr 2021 21:43:35 +0300 Subject: [PATCH 027/128] * lisp/repeat.el (repeat-post-hook): Skip repeating in minibuffer (bug#47566). (repeat-map): Add docstring. --- lisp/repeat.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 1830bcc0497..8cbfaa07487 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -348,7 +348,11 @@ For example, you can set it to like `isearch-exit'." :group 'convenience :version "28.1") -;;;###autoload (defvar repeat-map nil) +;;;###autoload +(defvar repeat-map nil + "The value of the repeating map for the next command. +A command called from the map can set it again to the same map when +the map can't be set on the command symbol property `repeat-map'.") ;;;###autoload (define-minor-mode repeat-mode @@ -388,8 +392,9 @@ When Repeat mode is enabled, and the command symbol has the property named ;; Exit when the last char is not among repeatable keys, ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. - (when (or (lookup-key map (this-single-command-keys) nil) - prefix-command-p) + (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts + (or (lookup-key map (this-command-keys-vector)) + prefix-command-p)) (when (and repeat-keep-prefix (not prefix-command-p)) (setq prefix-arg current-prefix-arg)) From b4eb84d4afd1b847f6f4c272d04ffa1f4b36dc98 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 8 Apr 2021 21:46:57 +0300 Subject: [PATCH 028/128] * lisp/repeat.el (repeat-post-hook): Check for prefix-arg. This is instead of checking for a list of argument-related commands that set prefix-arg anyway. --- lisp/repeat.el | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 8cbfaa07487..b3c58f2f818 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -382,25 +382,17 @@ When Repeat mode is enabled, and the command symbol has the property named (when rep-map (when (boundp rep-map) (setq rep-map (symbol-value rep-map))) - (let ((prefix-command-p (memq this-original-command - '(universal-argument - universal-argument-more - digit-argument - negative-argument))) - (map (copy-keymap rep-map)) + (let ((map (copy-keymap rep-map)) keys) ;; Exit when the last char is not among repeatable keys, ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't. (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts (or (lookup-key map (this-command-keys-vector)) - prefix-command-p)) - - (when (and repeat-keep-prefix (not prefix-command-p)) - (setq prefix-arg current-prefix-arg)) + prefix-arg)) ;; Messaging - (unless prefix-command-p + (unless prefix-arg (map-keymap (lambda (key _) (push key keys)) map) (let ((mess (format-message "Repeat with %s%s" @@ -419,6 +411,9 @@ When Repeat mode is enabled, and the command symbol has the property named (when repeat-exit-key (define-key map repeat-exit-key 'ignore)) + (when (and repeat-keep-prefix (not prefix-arg)) + (setq prefix-arg current-prefix-arg)) + (set-transient-map map)))))) (setq repeat-map nil)) From 972bab0981fb0cc0d992b4a195ebaf33c79858c3 Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 7 Apr 2021 17:51:30 +0000 Subject: [PATCH 029/128] User option to move to another match when changing direction in isearch. * lisp/isearch.el (isearch-direction-change-changes-match): New user option (bug#47599). (isearch-repeat): Use the new option. (isearch-repeat-forward, isearch-repeat-backward): Adapt to the new option. * etc/NEWS: Mention the new user option. * doc/emacs/search.texi: Document the new user option. --- doc/emacs/search.texi | 8 ++++++++ etc/NEWS | 6 ++++++ lisp/isearch.el | 24 ++++++++++++++++++++---- 3 files changed, 34 insertions(+), 4 deletions(-) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index f3c42bcea7f..38430a2ab15 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -201,6 +201,14 @@ something before the starting point, type @kbd{C-r} to switch to a backward search, leaving the search string unchanged. Similarly, @kbd{C-s} in a backward search switches to a forward search. +@cindex search, changing direction +@vindex isearch-repeat-on-direction-change + When you change the direction of a search, the first command you +type will, by default, remain on the same match, and the cursor will +move to the other end of the match. To move to another match +immediately, customize the variable +@code{isearch-repeat-on-direction-change} to @code{t}. + @cindex search, wrapping around @cindex search, overwrapped @cindex wrapped search diff --git a/etc/NEWS b/etc/NEWS index d3a8748ded6..8d7b3a6c46e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -367,6 +367,12 @@ 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. ++++ +** New user option 'isearch-repeat-on-direction-change'. +When this option is set, direction changes in Isearch move to another +search match, if there is one, instead of moving point to the other +end of the current match. + ** Outline +++ diff --git a/lisp/isearch.el b/lisp/isearch.el index 4b4f44bdffd..1ac1e63a9b7 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -185,6 +185,16 @@ When `nil', never wrap, just stop at the last match." (const :tag "Disable wrapping" nil)) :version "28.1") +(defcustom isearch-repeat-on-direction-change nil + "Whether a direction change should move to another match. +When `nil', the default, a direction change moves point to the other +end of the current search match. +When `t', a direction change moves to another search match, if there +is one." + :type '(choice (const :tag "Remain on the same match" nil) + (const :tag "Move to another match" t)) + :version "28.1") + (defvar isearch-mode-hook nil "Function(s) to call after starting up an incremental search.") @@ -1847,6 +1857,8 @@ Use `isearch-exit' to quit without signaling." (funcall isearch-wrap-function) (goto-char (if isearch-forward (point-min) (point-max)))))) ;; C-s in reverse or C-r in forward, change direction. + (if (and isearch-other-end isearch-repeat-on-direction-change) + (goto-char isearch-other-end)) (setq isearch-forward (not isearch-forward) isearch-success t)) @@ -1910,10 +1922,12 @@ of the buffer, type \\[isearch-beginning-of-buffer] with a numeric argument." (cond ((< count 0) (isearch-repeat-backward (abs count)) ;; Reverse the direction back - (isearch-repeat 'forward)) + (let ((isearch-repeat-on-direction-change nil)) + (isearch-repeat 'forward))) (t ;; Take into account one iteration to reverse direction - (when (not isearch-forward) (setq count (1+ count))) + (unless isearch-repeat-on-direction-change + (when (not isearch-forward) (setq count (1+ count)))) (isearch-repeat 'forward count)))) (isearch-repeat 'forward))) @@ -1931,10 +1945,12 @@ of the buffer, type \\[isearch-end-of-buffer] with a numeric argument." (cond ((< count 0) (isearch-repeat-forward (abs count)) ;; Reverse the direction back - (isearch-repeat 'backward)) + (let ((isearch-repeat-on-direction-change nil)) + (isearch-repeat 'backward))) (t ;; Take into account one iteration to reverse direction - (when isearch-forward (setq count (1+ count))) + (unless isearch-repeat-on-direction-change + (when isearch-forward (setq count (1+ count)))) (isearch-repeat 'backward count)))) (isearch-repeat 'backward))) From ff796823e50a97761ba20796753eb6606e7d016c Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Wed, 7 Apr 2021 16:58:51 +0000 Subject: [PATCH 030/128] Terminate isearch when point has moved to another buffer * lisp/isearch.el (isearch-post-command-hook): Terminate isearch when the command just executed has moved point to another buffer. https://lists.gnu.org/archive/html/emacs-devel/2021-04/msg00309.html --- lisp/isearch.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/isearch.el b/lisp/isearch.el index 1ac1e63a9b7..5efac4c78f4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -3054,6 +3054,10 @@ See more for options in `search-exit-option'." (goto-char isearch-pre-move-point)) (isearch-search-and-update))) (setq isearch-pre-move-point nil)) + ;; Terminate the search if point has moved to another buffer. + (unless (eq isearch--current-buffer (current-buffer)) + (when (buffer-live-p isearch--current-buffer) + (with-current-buffer isearch--current-buffer (isearch-exit)))) (force-mode-line-update)) (defun isearch-quote-char (&optional count) From 3492cc36f23c99344a6533a5ba4c6080b10d35a1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 00:04:13 +0200 Subject: [PATCH 031/128] Remove redundant #' before lambda in {calendar,erc,mh-e}/*.el * lisp/calendar/icalendar.el (icalendar--get-most-recent-observance): * lisp/calendar/parse-time.el (parse-time-rules): * lisp/erc/erc-dcc.el (pcomplete/erc-mode/DCC): * lisp/erc/erc-track.el (erc-modified-channels-display): * lisp/erc/erc.el (erc-toggle-debug-irc-protocol) (erc-cmd-IGNORE, erc-cmd-JOIN, erc-default-server-handler) (erc-banlist-update): * lisp/mh-e/mh-search.el (mh-search, mh-mairix-convert-to-sop*) (mh-index-create-sequences): * lisp/mh-e/mh-thread.el (mh-toggle-threads, mh-thread-generate) (mh-thread-prune-containers, mh-thread-sort-containers): * lisp/mh-e/mh-utils.el (mh-sub-folders): Remove redundant #' before lambda. --- lisp/calendar/icalendar.el | 26 ++++++++-------- lisp/calendar/parse-time.el | 62 ++++++++++++++++++------------------- lisp/erc/erc-dcc.el | 24 +++++++------- lisp/erc/erc-track.el | 6 ++-- lisp/erc/erc.el | 26 ++++++++-------- lisp/mh-e/mh-search.el | 40 ++++++++++++------------ lisp/mh-e/mh-thread.el | 36 ++++++++++----------- lisp/mh-e/mh-utils.el | 4 +-- 8 files changed, 112 insertions(+), 112 deletions(-) diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 04b525efc8a..6eb086aa14d 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -581,19 +581,19 @@ ALIST is a VTIMEZONE potentially containing historical records." (list (car (sort components - #'(lambda (a b) - (let* ((get-recent (lambda (n) - (car - (sort - (delq nil - (mapcar (lambda (p) - (and (memq (car p) '(DTSTART RDATE)) - (car (cddr p)))) - n)) - 'string-greaterp)))) - (a-recent (funcall get-recent (car (cddr a)))) - (b-recent (funcall get-recent (car (cddr b))))) - (string-greaterp a-recent b-recent)))))))) + (lambda (a b) + (let* ((get-recent (lambda (n) + (car + (sort + (delq nil + (mapcar (lambda (p) + (and (memq (car p) '(DTSTART RDATE)) + (car (cddr p)))) + n)) + 'string-greaterp)))) + (a-recent (funcall get-recent (car (cddr a)))) + (b-recent (funcall get-recent (car (cddr b))))) + (string-greaterp a-recent b-recent)))))))) (defun icalendar--convert-all-timezones (icalendar) "Convert all timezones in the ICALENDAR into an alist. diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index aa3236cf256..5a3d2706afd 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -103,46 +103,46 @@ letters, digits, plus or minus signs or colons." ((4) parse-time-months) ((5) (100)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 8) - (= (aref parse-time-elt 2) ?:) - (= (aref parse-time-elt 5) ?:))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 8) + (= (aref parse-time-elt 2) ?:) + (= (aref parse-time-elt 5) ?:))) [0 2] [3 5] [6 8]) ((8 7) parse-time-zoneinfo - ,#'(lambda () (car parse-time-val)) - ,#'(lambda () (cadr parse-time-val))) + ,(lambda () (car parse-time-val)) + ,(lambda () (cadr parse-time-val))) ((8) - ,#'(lambda () - (and (stringp parse-time-elt) - (= 5 (length parse-time-elt)) - (or (= (aref parse-time-elt 0) ?+) - (= (aref parse-time-elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) - (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) - (if (= (aref parse-time-elt 0) ?-) -1 1)))) + ,(lambda () + (and (stringp parse-time-elt) + (= 5 (length parse-time-elt)) + (or (= (aref parse-time-elt 0) ?+) + (= (aref parse-time-elt 0) ?-)))) + ,(lambda () (* 60 (+ (cl-parse-integer parse-time-elt :start 3 :end 5) + (* 60 (cl-parse-integer parse-time-elt :start 1 :end 3))) + (if (= (aref parse-time-elt 0) ?-) -1 1)))) ((5 4 3) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 10) - (= (aref parse-time-elt 4) ?-) - (= (aref parse-time-elt 7) ?-))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 10) + (= (aref parse-time-elt 4) ?-) + (= (aref parse-time-elt 7) ?-))) [0 4] [5 7] [8 10]) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 5) - (= (aref parse-time-elt 2) ?:))) - [0 2] [3 5] ,#'(lambda () 0)) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 5) + (= (aref parse-time-elt 2) ?:))) + [0 2] [3 5] ,(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 4) - (= (aref parse-time-elt 1) ?:))) - [0 1] [2 4] ,#'(lambda () 0)) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 4) + (= (aref parse-time-elt 1) ?:))) + [0 1] [2 4] ,(lambda () 0)) ((2 1 0) - ,#'(lambda () (and (stringp parse-time-elt) - (= (length parse-time-elt) 7) - (= (aref parse-time-elt 1) ?:))) + ,(lambda () (and (stringp parse-time-elt) + (= (length parse-time-elt) 7) + (= (aref parse-time-elt 1) ?:))) [0 1] [2 4] [5 7]) - ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt))) - ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt)))) + ((5) (50 110) ,(lambda () (+ 1900 parse-time-elt))) + ((5) (0 49) ,(lambda () (+ 2000 parse-time-elt)))) "(slots predicate extractor...)") ;;;###autoload(put 'parse-time-rules 'risky-local-variable t) diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 234b4b5a71d..219af3741fa 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -415,33 +415,33 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcase (intern (downcase (pcomplete-arg 1))) ('chat (mapcar (lambda (elt) (plist-get elt :nick)) (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'CHAT)) + (lambda (elt) + (eq (plist-get elt :type) 'CHAT)) erc-dcc-list))) ('close (delete-dups (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) erc-dcc-list))) ('get (mapcar #'erc-dcc-nick (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'GET)) + (lambda (elt) + (eq (plist-get elt :type) 'GET)) erc-dcc-list))) ('send (pcomplete-erc-all-nicks)))) (pcomplete-here (pcase (intern (downcase (pcomplete-arg 2))) ('get (mapcar (lambda (elt) (plist-get elt :file)) (cl-remove-if-not - #'(lambda (elt) - (and (eq (plist-get elt :type) 'GET) - (erc-nick-equal-p (erc-extract-nick - (plist-get elt :nick)) - (pcomplete-arg 1)))) + (lambda (elt) + (and (eq (plist-get elt :type) 'GET) + (erc-nick-equal-p (erc-extract-nick + (plist-get elt :nick)) + (pcomplete-arg 1)))) erc-dcc-list))) ('close (mapcar #'erc-dcc-nick (cl-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) - (intern (upcase (pcomplete-arg 1))))) + (lambda (elt) + (eq (plist-get elt :type) + (intern (upcase (pcomplete-arg 1))))) erc-dcc-list))) ('send (pcomplete-entries))))) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 8be55558823..9985b6a02f0 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -686,9 +686,9 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (let* ((buffers (mapcar #'car erc-modified-channels-alist)) (counts (mapcar #'cadr erc-modified-channels-alist)) (faces (mapcar #'cddr erc-modified-channels-alist)) - (long-names (mapcar #'(lambda (buf) - (or (buffer-name buf) - "")) + (long-names (mapcar (lambda (buf) + (or (buffer-name buf) + "")) buffers)) (short-names (if (functionp erc-track-shorten-function) (funcall erc-track-shorten-function diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 2f6e48dce1a..f0144de8446 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2321,7 +2321,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." (use-local-map (make-sparse-keymap)) (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) (add-hook 'kill-buffer-hook - #'(lambda () (setq erc-debug-irc-protocol nil)) + (lambda () (setq erc-debug-irc-protocol nil)) nil 'local) (goto-char (point-max)) (let ((inhibit-read-only t)) @@ -2945,9 +2945,9 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (if (null (erc-with-server-buffer erc-ignore-list)) (erc-display-line (erc-make-notice "Ignore list is empty") 'active) (erc-display-line (erc-make-notice "Ignore list:") 'active) - (mapc #'(lambda (item) - (erc-display-line (erc-make-notice item) - 'active)) + (mapc (lambda (item) + (erc-display-line (erc-make-notice item) + 'active)) (erc-with-server-buffer erc-ignore-list)))) t) @@ -3129,8 +3129,8 @@ were most recently invited. See also `invitation'." (when chnl ;; Prevent double joining of same channel on same server. (let* ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) + (mapcar (lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) (erc-channel-list erc-server-process))) (server (with-current-buffer (process-buffer erc-server-process) (or erc-session-server erc-server-announced-name))) @@ -4149,9 +4149,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'." (mapconcat #'identity (let (res) - (mapc #'(lambda (x) - (if (stringp x) - (setq res (append res (list x))))) + (mapc (lambda (x) + (if (stringp x) + (setq res (append res (list x))))) parsed) res) " "))) @@ -4539,10 +4539,10 @@ See also: `erc-echo-notice-in-user-buffers', ;; Remove the unbanned masks from the ban list (setq erc-channel-banlist (cl-delete-if - #'(lambda (y) - (member (upcase (cdr y)) - (mapcar #'upcase - (cdr (split-string mode))))) + (lambda (y) + (member (upcase (cdr y)) + (mapcar #'upcase + (cdr (split-string mode))))) erc-channel-banlist))) ((string-match "^\\+" mode) ;; Add the banned mask(s) to the ban list diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index aece03ef0f3..cb8f8e34558 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -274,23 +274,23 @@ folder containing the index search results." t))) ;; Copy the search results over. - (maphash #'(lambda (folder msgs) - (let ((cur (car (mh-translate-range folder "cur"))) - (msgs (sort (cl-loop - for msg being the hash-keys of msgs - collect msg) - #'<))) - (mh-exec-cmd "refile" msgs "-src" folder - "-link" index-folder) - ;; Restore cur to old value, that refile changed - (when cur - (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" - "-sequence" - "cur" (format "%s" cur))) - (cl-loop for msg in msgs - do (cl-incf result-count) - (setf (gethash result-count origin-map) - (cons folder msg))))) + (maphash (lambda (folder msgs) + (let ((cur (car (mh-translate-range folder "cur"))) + (msgs (sort (cl-loop + for msg being the hash-keys of msgs + collect msg) + #'<))) + (mh-exec-cmd "refile" msgs "-src" folder + "-link" index-folder) + ;; Restore cur to old value, that refile changed + (when cur + (mh-exec-cmd-quiet nil "mark" folder "-add" "-zero" + "-sequence" + "cur" (format "%s" cur))) + (cl-loop for msg in msgs + do (cl-incf result-count) + (setf (gethash result-count origin-map) + (cons folder msg))))) folder-results-map) ;; Vist the results folder. @@ -1136,10 +1136,10 @@ REGEXP-LIST is an alist of fields and values." ((atom (cadr expr)) `(or (and ,expr))) ((eq (caadr expr) 'not) (mh-mairix-convert-to-sop* (cadadr expr))) ((eq (caadr expr) 'and) (mh-mairix-convert-to-sop* - `(or ,@(mapcar #'(lambda (x) `(not ,x)) + `(or ,@(mapcar (lambda (x) `(not ,x)) (cdadr expr))))) ((eq (caadr expr) 'or) (mh-mairix-convert-to-sop* - `(and ,@(mapcar #'(lambda (x) `(not ,x)) + `(and ,@(mapcar (lambda (x) `(not ,x)) (cdadr expr))))) (t (error "Unreachable: %s" expr)))) @@ -1620,7 +1620,7 @@ garbled." (cl-loop for seq in seq-list do (apply #'mh-exec-cmd "mark" mh-current-folder "-sequence" (symbol-name (car seq)) "-add" - (mapcar #'(lambda (x) (format "%s" x)) (cdr seq)))))) + (mapcar (lambda (x) (format "%s" x)) (cdr seq)))))) ;;;###mh-autoload (defun mh-create-sequence-map (seq-list) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index a7878aaae9b..01b6863038b 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -233,7 +233,7 @@ sibling." (push index msg-list))) (forward-line)) (mh-scan-folder mh-current-folder - (mapcar #'(lambda (x) (format "%s" x)) + (mapcar (lambda (x) (format "%s" x)) (mh-coalesce-msg-list msg-list)) t)) (when mh-index-data @@ -591,7 +591,7 @@ Only information about messages in MSG-LIST are added to the tree." #'call-process (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil "-width" "10000" "-format" "%(msg)\n%{message-id}\n%{references}\n%{in-reply-to}\n%{subject}\n" - folder (mapcar #'(lambda (x) (format "%s" x)) msg-list))) + folder (mapcar (lambda (x) (format "%s" x)) msg-list))) (goto-char (point-min)) (let ((roots ()) (case-fold-search t)) @@ -635,9 +635,9 @@ Only information about messages in MSG-LIST are added to the tree." (mh-thread-remove-parent-link id) (mh-thread-add-link (car ancestors) id))) (mh-thread-add-link (car ancestors) (cadr ancestors))))))) - (maphash #'(lambda (_k v) - (when (null (mh-container-parent v)) - (push v roots))) + (maphash (lambda (_k v) + (when (null (mh-container-parent v)) + (push v roots))) mh-thread-id-table) (setq roots (mh-thread-prune-containers roots)) (prog1 (setq roots (mh-thread-group-by-subject roots)) @@ -720,25 +720,25 @@ For now it will take the last string inside angles." mh-thread-history) (mh-thread-remove-parent-link node))))) (let ((results ())) - (maphash #'(lambda (_k v) - (when (and (null (mh-container-parent v)) - (gethash (mh-message-id (mh-container-message v)) - mh-thread-id-index-map)) - (push v results))) + (maphash (lambda (_k v) + (when (and (null (mh-container-parent v)) + (gethash (mh-message-id (mh-container-message v)) + mh-thread-id-index-map)) + (push v results))) mh-thread-id-table) (mh-thread-sort-containers results)))) (defun mh-thread-sort-containers (containers) "Sort a list of message CONTAINERS to be in ascending order wrt index." (sort containers - #'(lambda (x y) - (when (and (mh-container-message x) (mh-container-message y)) - (let* ((id-x (mh-message-id (mh-container-message x))) - (id-y (mh-message-id (mh-container-message y))) - (index-x (gethash id-x mh-thread-id-index-map)) - (index-y (gethash id-y mh-thread-id-index-map))) - (and (integerp index-x) (integerp index-y) - (< index-x index-y))))))) + (lambda (x y) + (when (and (mh-container-message x) (mh-container-message y)) + (let* ((id-x (mh-message-id (mh-container-message x))) + (id-y (mh-message-id (mh-container-message y))) + (index-x (gethash id-x mh-thread-id-index-map)) + (index-y (gethash id-y mh-thread-id-index-map))) + (and (integerp index-x) (integerp index-y) + (< index-x index-y))))))) (defvar mh-thread-last-ancestor) diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index be66e62a1d7..e73c1db9e45 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -544,8 +544,8 @@ nested folders within them." (mh-sub-folders-actual folder))) (t match)))) (if add-trailing-slash-flag - (mapcar #'(lambda (x) - (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) + (mapcar (lambda (x) + (if (cdr x) (cons (concat (car x) "/") (cdr x)) x)) sub-folders) sub-folders))) From a4575655d271353a70287c497cf81efd4b8beb82 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Apr 2021 19:34:57 -0400 Subject: [PATCH 032/128] * lisp/shadowfile.el: Use lexical-binding Delete redundant `:group` args. (shadow-hashtable): Make it an actual hash-table. (shadow-shadows-of, shadow-invalidate-hashtable): Adjust accordingly. (shadow-insert-var): Strength-reduce `eval` to `symbol-value`. (shadow--save-buffers-kill-emacs): New function extracted from `shadow-save-buffers-kill-emacs`. (shadow-save-buffers-kill-emacs): Use it and use `save-buffers-kill-emacs`. (shadow-initialize, shadowfile-unload-function): Use `advice-add/remove` rather than override `save-buffers-kill-emacs` with `defalias`. --- lisp/shadowfile.el | 87 ++++++++++++++++++---------------------------- 1 file changed, 33 insertions(+), 54 deletions(-) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index b5e7d444c51..f39f17329f2 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -1,4 +1,4 @@ -;;; shadowfile.el --- automatic file copying +;;; shadowfile.el --- automatic file copying -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -90,27 +90,23 @@ "If t, always copy shadow files without asking. If nil (the default), always ask. If not nil and not t, ask only if there is no buffer currently visiting the file." - :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe)) - :group 'shadow) + :type '(choice (const t) (const nil) (other :tag "Ask if no buffer" maybe))) (defcustom shadow-inhibit-message nil "If non-nil, do not display a message when a file needs copying." - :type 'boolean - :group 'shadow) + :type 'boolean) (defcustom shadow-inhibit-overload nil "If non-nil, shadowfile won't redefine \\[save-buffers-kill-emacs]. Normally it overloads the function `save-buffers-kill-emacs' to check for files that have been changed and need to be copied to other systems." - :type 'boolean - :group 'shadow) + :type 'boolean) (defcustom shadow-info-file (locate-user-emacs-file "shadows" ".shadows") "File to keep shadow information in. The `shadow-info-file' should be shadowed to all your accounts to ensure consistency. Default: ~/.emacs.d/shadows" :type 'file - :group 'shadow :version "26.2") (defcustom shadow-todo-file @@ -122,13 +118,12 @@ remember and ask you again in your next Emacs session. This file must NOT be shadowed to any other system, it is host-specific. Default: ~/.emacs.d/shadow_todo" :type 'file - :group 'shadow :version "26.2") -;;; The following two variables should in most cases initialize themselves -;;; correctly. They are provided as variables in case the defaults are wrong -;;; on your machine (and for efficiency). +;; The following two variables should in most cases initialize themselves +;; correctly. They are provided as variables in case the defaults are wrong +;; on your machine (and for efficiency). (defvar shadow-system-name (concat "/" (system-name) ":") "The identification for local files on this machine.") @@ -160,7 +155,7 @@ created by `shadow-define-regexp-group'.") (defvar shadow-files-to-copy nil) ; List of files that need to ; be copied to remote hosts. -(defvar shadow-hashtable nil) ; for speed +(defvar shadow-hashtable (make-hash-table :test #'equal)) ; for speed (defvar shadow-info-buffer nil) ; buf visiting shadow-info-file (defvar shadow-todo-buffer nil) ; buf visiting shadow-todo-file @@ -191,11 +186,11 @@ PREFIX." ;;; Clusters and sites ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; I use the term `site' to refer to a string which may be the -;;; cluster identification "/name:", a remote identification -;;; "/method:user@host:", or "/system-name:" (the value of -;;; `shadow-system-name') for the location of local files. All -;;; user-level commands should accept either. +;; I use the term `site' to refer to a string which may be the +;; cluster identification "/name:", a remote identification +;; "/method:user@host:", or "/system-name:" (the value of +;; `shadow-system-name') for the location of local files. All +;; user-level commands should accept either. (cl-defstruct (shadow-cluster (:type list) :named) name primary regexp) @@ -580,7 +575,7 @@ be shadowed), and list of SITES." Filename should have clusters expanded, but otherwise can have any format. Return value is a list of dotted pairs like (from . to), where from and to are absolute file names." - (or (symbol-value (intern-soft file shadow-hashtable)) + (or (gethash file shadow-hashtable) (let* ((absolute-file (shadow-expand-file-name (or (shadow-local-file file) file) shadow-homedir)) @@ -598,7 +593,7 @@ and to are absolute file names." "shadow-shadows-of: %s %s %s %s %s" file (shadow-local-file file) shadow-homedir absolute-file canonical-file)) - (set (intern file shadow-hashtable) shadows)))) + (puthash file shadows shadow-hashtable)))) (defun shadow-shadows-of-1 (file groups regexp) "Return list of FILE's shadows in GROUPS. @@ -735,7 +730,7 @@ With non-nil argument also saves the buffer." (sit-for 1)))))) (defun shadow-invalidate-hashtable () - (setq shadow-hashtable (make-vector 37 0))) + (clrhash shadow-hashtable)) (defun shadow-insert-var (variable) "Build a `setq' to restore VARIABLE. @@ -744,17 +739,17 @@ will restore VARIABLE to its current setting. VARIABLE must be the name of a variable whose value is a list." (let ((standard-output (current-buffer))) (insert (format "(setq %s" variable)) - (cond ((consp (eval variable)) + (cond ((consp (symbol-value variable)) (insert "\n '(") - (prin1 (car (eval variable))) - (let ((rest (cdr (eval variable)))) + (prin1 (car (symbol-value variable))) + (let ((rest (cdr (symbol-value variable)))) (while rest (insert "\n ") (prin1 (car rest)) (setq rest (cdr rest))) (insert "))\n\n"))) (t (insert " ") - (prin1 (eval variable)) + (prin1 (symbol-value variable)) (insert ")\n\n"))))) (defun shadow-save-buffers-kill-emacs (&optional arg) @@ -763,6 +758,11 @@ With prefix arg, silently save all file-visiting buffers, then kill. Extended by shadowfile to automatically save `shadow-todo-file' and look for files that have been changed and need to be copied to other systems." + (interactive "P") + (shadow--save-buffers-kill-emacs arg) + (save-buffers-kill-emacs arg)) + +(defun shadow--save-buffers-kill-emacs (&optional arg &rest _) ;; This function is necessary because we need to get control and save ;; the todo file /after/ saving other files, but /before/ the warning ;; message about unsaved buffers (because it can get modified by the @@ -770,27 +770,10 @@ look for files that have been changed and need to be copied to other systems." ;; because it is not called at the correct time, and also because it is ;; called when the terminal is disconnected and we cannot ask whether ;; to copy files. - (interactive "P") (shadow-save-todo-file) (save-some-buffers arg t) (shadow-copy-files) - (shadow-save-todo-file) - (and (or (not (memq t (mapcar (lambda (buf) (and (buffer-file-name buf) - (buffer-modified-p buf))) - (buffer-list)))) - (yes-or-no-p "Modified buffers exist; exit anyway? ")) - (or (not (fboundp 'process-list)) - ;; `process-list' is not defined on MSDOS. - (let ((processes (process-list)) - active) - (while processes - (and (memq (process-status (car processes)) '(run stop open listen)) - (process-query-on-exit-flag (car processes)) - (setq active t)) - (setq processes (cdr processes))) - (or (not active) - (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) - (kill-emacs))) + (shadow-save-todo-file)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Hook us up @@ -809,19 +792,15 @@ look for files that have been changed and need to be copied to other systems." (message "Shadowfile information files not found - aborting") (beep) (sit-for 3)) - (when (and (not shadow-inhibit-overload) - (not (fboundp 'shadow-orig-save-buffers-kill-emacs))) - (defalias 'shadow-orig-save-buffers-kill-emacs - (symbol-function 'save-buffers-kill-emacs)) - (defalias 'save-buffers-kill-emacs 'shadow-save-buffers-kill-emacs)) - (add-hook 'write-file-functions 'shadow-add-to-todo) - (define-key ctl-x-4-map "s" 'shadow-copy-files))) + (unless shadow-inhibit-overload + (advice-add 'save-buffers-kill-emacs :before + #'shadow--save-buffers-kill-emacs)) + (add-hook 'write-file-functions #'shadow-add-to-todo) + (define-key ctl-x-4-map "s" #'shadow-copy-files))) (defun shadowfile-unload-function () - (substitute-key-definition 'shadow-copy-files nil ctl-x-4-map) - (when (fboundp 'shadow-orig-save-buffers-kill-emacs) - (fset 'save-buffers-kill-emacs - (symbol-function 'shadow-orig-save-buffers-kill-emacs))) + (substitute-key-definition #'shadow-copy-files nil ctl-x-4-map) + (advice-remove 'save-buffers-kill-emacs #'shadow--save-buffers-kill-emacs) ;; continue standard unloading nil) From 9a604501f04a430b0b48af500b7c177e0c30d633 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 01:42:41 +0200 Subject: [PATCH 033/128] Revert "Load all generic-x.el modes unconditionally" This reverts commit 0161c9df6edc02db6bd8871b00df522dd0699157. --- etc/NEWS | 5 - lisp/generic-x.el | 335 +++++++++++++++++++++++++++++----------------- 2 files changed, 209 insertions(+), 131 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 8d7b3a6c46e..a0f05d8cf15 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2408,11 +2408,6 @@ parameter. 'previous-system-time-locale' have been removed, as they were created by mistake and were not useful to Lisp code. ---- -** Loading 'generic-x' unconditionally loads all modes. -The user option 'generic-extras-enable-list' is now obsolete, and -setting it has no effect. - --- ** The 'load-dangerous-libraries' variable is now obsolete. It was used to allow loading Lisp libraries compiled by XEmacs, a diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 0f4e1ae4a6e..4505d8513f9 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -32,6 +32,17 @@ ;; ;; (require 'generic-x) ;; +;; You can decide which modes to load by setting the variable +;; `generic-extras-enable-list'. Its default value is platform- +;; specific. The recommended way to set this variable is through +;; customize: +;; +;; M-x customize-option RET generic-extras-enable-list RET +;; +;; This lets you select generic modes from the list of available +;; modes. If you manually set `generic-extras-enable-list' in your +;; .emacs, do it BEFORE loading generic-x with (require 'generic-x). +;; ;; You can also send in new modes; if the file types are reasonably ;; common, we would like to install them. ;; @@ -173,7 +184,88 @@ This hook will be installed if the variable ;; Other Generic modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; If you add a generic mode to this file, put it in one of these four +;; lists as well. + +(defconst generic-default-modes + '(apache-conf-generic-mode + apache-log-generic-mode + hosts-generic-mode + java-manifest-generic-mode + java-properties-generic-mode + javascript-generic-mode + show-tabs-generic-mode + vrml-generic-mode) + "List of generic modes that are defined by default.") + +(defconst generic-mswindows-modes + '(bat-generic-mode + inf-generic-mode + ini-generic-mode + rc-generic-mode + reg-generic-mode + rul-generic-mode) + "List of generic modes that are defined by default on MS-Windows.") + +(defconst generic-unix-modes + '(alias-generic-mode + ansible-inventory-generic-mode + etc-fstab-generic-mode + etc-modules-conf-generic-mode + etc-passwd-generic-mode + etc-services-generic-mode + etc-sudoers-generic-mode + fvwm-generic-mode + inetd-conf-generic-mode + mailagent-rules-generic-mode + mailrc-generic-mode + named-boot-generic-mode + named-database-generic-mode + prototype-generic-mode + resolve-conf-generic-mode + samba-generic-mode + x-resource-generic-mode + xmodmap-generic-mode) + "List of generic modes that are defined by default on Unix.") + +(defconst generic-other-modes + '(astap-generic-mode + ibis-generic-mode + pkginfo-generic-mode + spice-generic-mode) + "List of generic modes that are not defined by default.") + +(defcustom generic-extras-enable-list + (append generic-default-modes + (if (memq system-type '(windows-nt ms-dos)) + generic-mswindows-modes + generic-unix-modes) + nil) + "List of generic modes to define. +Each entry in the list should be a symbol. If you set this variable +directly, without using customize, you must reload generic-x to put +your changes into effect." + :type (let (list) + (dolist (mode + (sort (append generic-default-modes + generic-mswindows-modes + generic-unix-modes + generic-other-modes + nil) + (lambda (a b) + (string< (symbol-name b) + (symbol-name a)))) + (cons 'set list)) + (push `(const ,mode) list))) + :set (lambda (s v) + (set-default s v) + (unless load-in-progress + (load "generic-x"))) + :version "22.1") + ;;; Apache +(when (memq 'apache-conf-generic-mode generic-extras-enable-list) + (define-generic-mode apache-conf-generic-mode '(?#) nil @@ -186,7 +278,9 @@ This hook will be installed if the variable '((nil "^\\([-A-Za-z0-9_]+\\)" 1) ("*Directories*" "^\\s-*]+\\)>" 1) ("*Locations*" "^\\s-*]+\\)>" 1))))) - "Generic mode for Apache or HTTPD configuration files.") + "Generic mode for Apache or HTTPD configuration files.")) + +(when (memq 'apache-log-generic-mode generic-extras-enable-list) (define-generic-mode apache-log-generic-mode nil @@ -197,9 +291,11 @@ This hook will be installed if the variable (2 font-lock-variable-name-face))) '("access_log\\'") nil - "Generic mode for Apache log files.") + "Generic mode for Apache log files.")) ;;; Samba +(when (memq 'samba-generic-mode generic-extras-enable-list) + (define-generic-mode samba-generic-mode '(?\; ?#) nil @@ -209,11 +305,13 @@ This hook will be installed if the variable (2 font-lock-type-face))) '("smb\\.conf\\'") '(generic-bracket-support) - "Generic mode for Samba configuration files.") + "Generic mode for Samba configuration files.")) ;;; Fvwm ;; This is pretty basic. Also, modes for other window managers could ;; be defined as well. +(when (memq 'fvwm-generic-mode generic-extras-enable-list) + (define-generic-mode fvwm-generic-mode '(?#) '("AddToMenu" @@ -232,28 +330,33 @@ This hook will be installed if the variable nil '("\\.fvwmrc\\'" "\\.fvwm2rc\\'") nil - "Generic mode for FVWM configuration files.") + "Generic mode for FVWM configuration files.")) ;;; X Resource ;; I'm pretty sure I've seen an actual mode to do this, but I don't ;; think it's standard with Emacs +(when (memq 'x-resource-generic-mode generic-extras-enable-list) + (define-generic-mode x-resource-generic-mode '(?!) nil '(("^\\([^:\n]+:\\)" 1 font-lock-variable-name-face)) '("\\.Xdefaults\\'" "\\.Xresources\\'" "\\.Xenvironment\\'" "\\.ad\\'") nil - "Generic mode for X Resource configuration files.") + "Generic mode for X Resource configuration files.")) +(if (memq 'xmodmap-generic-mode generic-extras-enable-list) (define-generic-mode xmodmap-generic-mode '(?!) '("add" "clear" "keycode" "keysym" "remove" "pointer") nil '("[xX]modmap\\(rc\\)?\\'") nil - "Simple mode for xmodmap files.") + "Simple mode for xmodmap files.")) ;;; Hosts +(when (memq 'hosts-generic-mode generic-extras-enable-list) + (define-generic-mode hosts-generic-mode '(?#) '("localhost") @@ -261,20 +364,27 @@ This hook will be installed if the variable ("\\<\\([0-9A-Fa-f:]+\\)\\>" 1 font-lock-constant-face)) '("[hH][oO][sS][tT][sS]\\'") nil - "Generic mode for HOSTS files.") + "Generic mode for HOSTS files.")) ;;; Windows INF files +;; If i-g-m-f-f-h is defined, then so is i-g-m. +(declare-function ini-generic-mode "generic-x") + +(when (memq 'inf-generic-mode generic-extras-enable-list) + (define-generic-mode inf-generic-mode '(?\;) nil '(("^\\(\\[.*\\]\\)" 1 font-lock-constant-face)) '("\\.[iI][nN][fF]\\'") '(generic-bracket-support) - "Generic mode for MS-Windows INF files.") + "Generic mode for MS-Windows INF files.")) ;;; Windows INI files ;; Should define escape character as well! +(when (memq 'ini-generic-mode generic-extras-enable-list) + (define-generic-mode ini-generic-mode '(?\;) nil @@ -301,9 +411,13 @@ like an INI file. You can add this hook to `find-file-hook'." (goto-char (point-min)) (and (looking-at "^\\s-*\\[.*\\]") (ini-generic-mode))))) +(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook + 'ini-generic-mode-find-file-hook "28.1")) ;;; Windows REG files ;;; Unfortunately, Windows 95 and Windows NT have different REG file syntax! +(when (memq 'reg-generic-mode generic-extras-enable-list) + (define-generic-mode reg-generic-mode '(?\;) '("key" "classes_root" "REGEDIT" "REGEDIT4") @@ -314,11 +428,19 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\s-*\\(.*\\)\\s-*=" 1))))) - "Generic mode for MS-Windows Registry files.") + "Generic mode for MS-Windows Registry files.")) + +(declare-function w32-shell-name "w32-fns" ()) + +;;; DOS/Windows BAT files +(when (memq 'bat-generic-mode generic-extras-enable-list) + (define-obsolete-function-alias 'bat-generic-mode 'bat-mode "24.4")) ;;; Mailagent ;; Mailagent is a Unix mail filtering program. Anyone wanna do a ;; generic mode for procmail? +(when (memq 'mailagent-rules-generic-mode generic-extras-enable-list) + (define-generic-mode mailagent-rules-generic-mode '(?#) '("SAVE" "DELETE" "PIPE" "ANNOTATE" "REJECT") @@ -329,9 +451,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "\\s-/\\([^/]+\\)/[i, \t\n]" 1))))) - "Generic mode for Mailagent rules files.") + "Generic mode for Mailagent rules files.")) ;; Solaris/Sys V prototype files +(when (memq 'prototype-generic-mode generic-extras-enable-list) + (define-generic-mode prototype-generic-mode '(?#) nil @@ -350,9 +474,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("prototype\\'") nil - "Generic mode for Sys V prototype files.") + "Generic mode for Sys V prototype files.")) ;; Solaris/Sys V pkginfo files +(when (memq 'pkginfo-generic-mode generic-extras-enable-list) + (define-generic-mode pkginfo-generic-mode '(?#) nil @@ -361,9 +487,17 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("pkginfo\\'") nil - "Generic mode for Sys V pkginfo files.") + "Generic mode for Sys V pkginfo files.")) + +;; Javascript mode +;; Obsolete; defer to js-mode from js.el. +(when (memq 'javascript-generic-mode generic-extras-enable-list) + (define-obsolete-function-alias 'javascript-generic-mode 'js-mode "24.3") + (define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3")) ;; VRML files +(when (memq 'vrml-generic-mode generic-extras-enable-list) + (define-generic-mode vrml-generic-mode '(?#) '("DEF" @@ -411,9 +545,11 @@ like an INI file. You can add this hook to `find-file-hook'." ("*Definitions*" "DEF\\s-+\\([-A-Za-z0-9_]+\\)\\s-+\\([A-Za-z0-9]+\\)\\s-*{" 1))))) - "Generic Mode for VRML files.") + "Generic Mode for VRML files.")) ;; Java Manifests +(when (memq 'java-manifest-generic-mode generic-extras-enable-list) + (define-generic-mode java-manifest-generic-mode '(?#) '("Name" @@ -430,9 +566,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-constant-face))) '("[mM][aA][nN][iI][fF][eE][sS][tT]\\.[mM][fF]\\'") nil - "Generic mode for Java Manifest files.") + "Generic mode for Java Manifest files.")) ;; Java properties files +(when (memq 'java-properties-generic-mode generic-extras-enable-list) + (define-generic-mode java-properties-generic-mode '(?! ?#) nil @@ -458,9 +596,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\([^#! \t\n\r=:]+\\)" 1))))) - "Generic mode for Java properties files.") + "Generic mode for Java properties files.")) ;; C shell alias definitions +(when (memq 'alias-generic-mode generic-extras-enable-list) + (define-generic-mode alias-generic-mode '(?#) '("alias" "unalias") @@ -473,9 +613,11 @@ like an INI file. You can add this hook to `find-file-hook'." (lambda () (setq imenu-generic-expression '((nil "^\\(alias\\|unalias\\)\\s-+\\([-a-zA-Z0-9_]+\\)" 2))))) - "Generic mode for C Shell alias files.") + "Generic mode for C Shell alias files.")) ;; Ansible inventory files +(when (memq 'ansible-inventory-generic-mode generic-extras-enable-list) + (define-generic-mode ansible-inventory-generic-mode '(?#) nil @@ -494,10 +636,12 @@ like an INI file. You can add this hook to `find-file-hook'." (setq imenu-generic-expression '((nil "^\\s-*\\[\\(.*\\)\\]" 1) ("*Variables*" "\\s-+\\([^ =\n\r]+\\)=" 1))))) - "Generic mode for Ansible inventory files.") + "Generic mode for Ansible inventory files.")) ;;; Windows RC files ;; Contributed by ACorreir@pervasive-sw.com (Alfred Correira) +(when (memq 'rc-generic-mode generic-extras-enable-list) + (define-generic-mode rc-generic-mode ;; '(?\/) '("//") @@ -577,13 +721,15 @@ like an INI file. You can add this hook to `find-file-hook'." '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-constant-face) (2 font-lock-variable-name-face nil t)))) - '("\\.[rR][cC]\\'") - nil - "Generic mode for MS-Windows Resource files.") + '("\\.[rR][cC]\\'") + nil + "Generic mode for MS-Windows Resource files.")) ;; InstallShield RUL files ;; Contributed by Alfred.Correira@Pervasive.Com ;; Bugfixes by "Rolf Sandau" +(when (memq 'rul-generic-mode generic-extras-enable-list) + (eval-when-compile ;;; build the regexp strings using regexp-opt @@ -1226,9 +1372,11 @@ like an INI file. You can add this hook to `find-file-hook'." > "begin" \n > _ \n resume: - > "end;") + > "end;")) ;; Additions by ACorreir@pervasive-sw.com (Alfred Correira) +(when (memq 'mailrc-generic-mode generic-extras-enable-list) + (define-generic-mode mailrc-generic-mode '(?#) '("alias" @@ -1250,9 +1398,11 @@ like an INI file. You can add this hook to `find-file-hook'." (2 font-lock-variable-name-face))) '("\\.mailrc\\'") nil - "Mode for mailrc files.") + "Mode for mailrc files.")) ;; Inetd.conf +(when (memq 'inetd-conf-generic-mode generic-extras-enable-list) + (define-generic-mode inetd-conf-generic-mode '(?#) '("stream" @@ -1267,9 +1417,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) ;; Services +(when (memq 'etc-services-generic-mode generic-extras-enable-list) + (define-generic-mode etc-services-generic-mode '(?#) '("tcp" @@ -1282,9 +1434,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\)" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\)" 1))))))) ;; Password and Group files +(when (memq 'etc-passwd-generic-mode generic-extras-enable-list) + (define-generic-mode etc-passwd-generic-mode nil ;; No comment characters '("root") ;; Only one keyword @@ -1322,9 +1476,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([-A-Za-z0-9_]+\\):" 1)))))) + '((nil "^\\([-A-Za-z0-9_]+\\):" 1))))))) ;; Fstab +(when (memq 'etc-fstab-generic-mode generic-extras-enable-list) + (define-generic-mode etc-fstab-generic-mode '(?#) '("adfs" @@ -1436,9 +1592,11 @@ like an INI file. You can add this hook to `find-file-hook'." (list (lambda () (setq imenu-generic-expression - '((nil "^\\([^# \t]+\\)\\s-+" 1)))))) + '((nil "^\\([^# \t]+\\)\\s-+" 1))))))) ;; /etc/sudoers +(when (memq 'etc-sudoers-generic-mode generic-extras-enable-list) + (define-generic-mode etc-sudoers-generic-mode '(?#) '("User_Alias" "Runas_Alias" "Host_Alias" "Cmnd_Alias" @@ -1449,9 +1607,11 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\<\\(%[A-Za-z0-9_]+\\)\\>" 1 font-lock-variable-name-face)) '("/etc/sudoers\\'") nil - "Generic mode for sudoers configuration files.") + "Generic mode for sudoers configuration files.")) ;; From Jacques Duthen +(when (memq 'show-tabs-generic-mode generic-extras-enable-list) + (eval-when-compile (defconst show-tabs-generic-mode-font-lock-defaults-1 @@ -1489,12 +1649,14 @@ like an INI file. You can add this hook to `find-file-hook'." nil ;; no auto-mode-alist ;; '(show-tabs-generic-mode-hook-fun) nil - "Generic mode to show tabs and trailing spaces.") + "Generic mode to show tabs and trailing spaces.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DNS modes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(when (memq 'named-boot-generic-mode generic-extras-enable-list) + (define-generic-mode named-boot-generic-mode ;; List of comment characters '(?\;) @@ -1510,7 +1672,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/named\\.boot\\'") ;; List of set up functions to call - nil) + nil)) + +(when (memq 'named-database-generic-mode generic-extras-enable-list) (define-generic-mode named-database-generic-mode ;; List of comment characters @@ -1531,7 +1695,9 @@ like an INI file. You can add this hook to `find-file-hook'." (defun named-database-print-serial () "Print a serial number based on the current date." (interactive) - (insert (format-time-string named-database-time-string))) + (insert (format-time-string named-database-time-string)))) + +(when (memq 'resolve-conf-generic-mode generic-extras-enable-list) (define-generic-mode resolve-conf-generic-mode ;; List of comment characters @@ -1543,12 +1709,14 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional auto-mode-alist expressions '("/etc/resolve?\\.conf\\'") ;; List of set up functions to call - nil) + nil)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modes for spice and common electrical engineering circuit netlist formats ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(when (memq 'spice-generic-mode generic-extras-enable-list) + (define-generic-mode spice-generic-mode nil '("and" @@ -1584,7 +1752,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for SPICE circuit netlist files.") + "Generic mode for SPICE circuit netlist files.")) + +(when (memq 'ibis-generic-mode generic-extras-enable-list) (define-generic-mode ibis-generic-mode '(?|) @@ -1593,7 +1763,9 @@ like an INI file. You can add this hook to `find-file-hook'." ("\\(\\(_\\|\\w\\)+\\)\\s-*=" 1 font-lock-variable-name-face)) '("\\.[iI][bB][sS]\\'") '(generic-bracket-support) - "Generic mode for IBIS circuit netlist files.") + "Generic mode for IBIS circuit netlist files.")) + +(when (memq 'astap-generic-mode generic-extras-enable-list) (define-generic-mode astap-generic-mode nil @@ -1627,7 +1799,9 @@ like an INI file. You can add this hook to `find-file-hook'." ;; Make keywords case-insensitive (lambda () (setq font-lock-defaults '(generic-font-lock-keywords nil t)))) - "Generic mode for ASTAP circuit netlist files.") + "Generic mode for ASTAP circuit netlist files.")) + +(when (memq 'etc-modules-conf-generic-mode generic-extras-enable-list) (define-generic-mode etc-modules-conf-generic-mode ;; List of comment characters @@ -1669,98 +1843,7 @@ like an INI file. You can add this hook to `find-file-hook'." ;; List of additional automode-alist expressions '("/etc/modules\\.conf" "/etc/conf\\.modules") ;; List of set up functions to call - nil) - -;; Obsolete - -(define-obsolete-function-alias 'javascript-generic-mode #'js-mode "24.3") -(define-obsolete-variable-alias 'javascript-generic-mode-hook 'js-mode-hook "24.3") - -(define-obsolete-function-alias 'bat-generic-mode #'bat-mode "24.4") - -(define-obsolete-function-alias 'generic-mode-ini-file-find-file-hook - #'ini-generic-mode-find-file-hook "28.1") - -(defconst generic-default-modes - '(apache-conf-generic-mode - apache-log-generic-mode - hosts-generic-mode - java-manifest-generic-mode - java-properties-generic-mode - javascript-generic-mode - show-tabs-generic-mode - vrml-generic-mode) - "List of generic modes that are defined by default.") -(make-obsolete-variable 'generic-default-modes "no longer used." "28.1") - -(defconst generic-mswindows-modes - '(bat-generic-mode - inf-generic-mode - ini-generic-mode - rc-generic-mode - reg-generic-mode - rul-generic-mode) - "List of generic modes that are defined by default on MS-Windows.") -(make-obsolete-variable 'generic-mswindows-modes "no longer used." "28.1") - -(defconst generic-unix-modes - '(alias-generic-mode - ansible-inventory-generic-mode - etc-fstab-generic-mode - etc-modules-conf-generic-mode - etc-passwd-generic-mode - etc-services-generic-mode - etc-sudoers-generic-mode - fvwm-generic-mode - inetd-conf-generic-mode - mailagent-rules-generic-mode - mailrc-generic-mode - named-boot-generic-mode - named-database-generic-mode - prototype-generic-mode - resolve-conf-generic-mode - samba-generic-mode - x-resource-generic-mode - xmodmap-generic-mode) - "List of generic modes that are defined by default on Unix.") -(make-obsolete-variable 'generic-unix-modes "no longer used." "28.1") - -(defconst generic-other-modes - '(astap-generic-mode - ibis-generic-mode - pkginfo-generic-mode - spice-generic-mode) - "List of generic modes that are not defined by default.") -(make-obsolete-variable 'generic-other-modes "no longer used." "28.1") - -(defcustom generic-extras-enable-list - (append generic-default-modes - (if (memq system-type '(windows-nt ms-dos)) - generic-mswindows-modes - generic-unix-modes) - nil) - "List of generic modes to define. -Each entry in the list should be a symbol. If you set this variable -directly, without using customize, you must reload generic-x to put -your changes into effect." - :type (let (list) - (dolist (mode - (sort (append generic-default-modes - generic-mswindows-modes - generic-unix-modes - generic-other-modes - nil) - (lambda (a b) - (string< (symbol-name b) - (symbol-name a)))) - (cons 'set list)) - (push `(const ,mode) list))) - :set (lambda (s v) - (set-default s v) - (unless load-in-progress - (load "generic-x"))) - :version "22.1") -(make-obsolete-variable 'generic-extras-enable-list "no longer used." "28.1") + nil)) (provide 'generic-x) From 5b1e7af7bf7b47ab3eabc9ccd1d5419554c95d0c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 24 Mar 2021 22:59:52 -0400 Subject: [PATCH 034/128] * lisp/progmodes/vhdl-mode.el: Use lexical-binding Use #' to quote function names to get better compiler diagnostics. Wrap some lines to avoid arguments "hidden" in positions that are easy to misread. Prefix unused arguments with a semi-colon to silence compiler warnings. Fix a few comments that used ;;; even though they were not headings. (vhdl-emacs-21): Delete variable. Replace all uses with (not (featurep 'xemacs)) instead since `vhdl-mode` has been incompatible with Emacs<21 for more than 10 years already. (vhdl-prepare-search-1): Add Edebug declaration. (vhdl-prepare-search-2): Add Edebug declaration and use `with-syntax-table`. (vhdl-visit-file): Add Edebug and indentation declaration. Move the bulk of the code to a function for easier debugging. (vhdl--visit-file): New function extracted from `vhdl-visit-file`. Be careful not to modify syntax tables in unrelated buffers. (vhdl-speedbar-refresh): Remove unused var `pos`. (vhdl-backward-sexp): Remove unused var `last-forward`. (vhdl-electric-tab, vhdl-minibuffer-tab, vhdl-line-expand): Rename arg to avoid conflict with the `prefix-arg` global variable. (vhdl-align-region-1): Remove unused var `indent`. (vhdl-character-to-event): Actually give a body to that poor function. (vhdl-template-context): Remove unused vars `entity-exists` and `string`. (vhdl-template-group): Remove unused var `start`. (vhdl-template-argument-list): Remove unused var `start`. (vhdl-port-paste-context-clause): Remove unused var `margin`. (vhdl-port-paste-testbench): Remove unused var `source-buffer`. (vhdl-hs-minor-mode): Declare function `hs-hide-all`. (vhdl-get-hierarchy): Rename arguments `ent-alist`, `conf-alist`, and `conf-key` and bind those dynamically scoped var via `let` instead since arguments can't be dynamically scoped. (vhdl-speedbar-insert-hierarchy, vhdl-compose-configuration-architecture): Same thing with arguments `ent-alist` and `conf-alist`. (vhdl-cache-version): Declare variable. (speedbar-expand-line, speedbar-edit-line): Declare functions. (vhdl-speedbar-update-current-unit): Declare before first use. (vhdl-compose-new-component): Remove unused var `project`. (lazy-lock-minimum-size): Declare variable. (vhdl-submit-bug-report): Declare variable `reporter-prompt-for-summary-p`. --- lisp/progmodes/vhdl-mode.el | 855 +++++++++++++++++++----------------- 1 file changed, 448 insertions(+), 407 deletions(-) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index f4a39c29ca5..be98066a620 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -1,4 +1,4 @@ -;;; vhdl-mode.el --- major mode for editing VHDL code +;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*- ;; Copyright (C) 1992-2021 Free Software Foundation, Inc. @@ -77,7 +77,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation -;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. +;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21. ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation ;; or into an arbitrary directory that is added to the load path by the @@ -92,7 +92,7 @@ ;; Add the following lines to the `site-start.el' file in the `site-lisp' ;; directory of your Emacs installation or to your Emacs start-up file `.emacs' -;; (not required in Emacs 20 and higher): +;; (not required in Emacs): ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) ;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) @@ -136,12 +136,9 @@ (when (< emacs-major-version 25) (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) -;; Emacs 21+ handling -(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 21, 22, ... is used.") ;; Emacs 22+ handling (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) - "Non-nil if GNU Emacs 22, ... is used.") + "Non-nil if GNU Emacs >= 22, ... is used.") (defvar compilation-file-regexp-alist) (defvar conf-alist) @@ -490,7 +487,7 @@ NOTE: Activate new error and file message regexps and reflect the new setting (const :tag "Upcase" upcase) (const :tag "Downcase" downcase)))))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-update-mode-menu)) + (vhdl-custom-set variable value #'vhdl-update-mode-menu)) :version "24.4" :group 'vhdl-compile) @@ -668,8 +665,8 @@ NOTE: Reflect the new setting in the choice list of option `vhdl-project' :format "%t\n%v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-update-mode-menu - 'vhdl-speedbar-refresh)) + #'vhdl-update-mode-menu + #'vhdl-speedbar-refresh)) :group 'vhdl-project) (defcustom vhdl-project nil @@ -713,7 +710,7 @@ All project setup files that match the file names specified in option \(alphabetically) last loaded setup of the first `vhdl-project-file-name' entry is activated. A project setup file can be obtained by exporting a project (see menu). - At startup: project setup file is loaded at Emacs startup" + At startup: project setup file is loaded at Emacs startup." :type '(set (const :tag "At startup" startup)) :group 'vhdl-project) @@ -751,12 +748,12 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (const :tag "Math packages" math))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-template-map-init - 'vhdl-mode-abbrev-table-init - 'vhdl-template-construct-alist-init - 'vhdl-template-package-alist-init - 'vhdl-update-mode-menu - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-template-map-init + #'vhdl-mode-abbrev-table-init + #'vhdl-template-construct-alist-init + #'vhdl-template-package-alist-init + #'vhdl-update-mode-menu + #'vhdl-words-init 'vhdl-font-lock-init)) :group 'vhdl-style) (defcustom vhdl-basic-offset 2 @@ -770,7 +767,7 @@ This value is used by + and - symbols in `vhdl-offsets-alist'." This is done when typed or expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-types nil @@ -778,7 +775,7 @@ This is done when typed or expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-attributes nil @@ -786,7 +783,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-enum-values nil @@ -794,7 +791,7 @@ This is done when expanded or by the fix case functions." This is done when expanded or by the fix case functions." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-upper-case-constants t @@ -802,7 +799,7 @@ This is done when expanded or by the fix case functions." This is done when expanded." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) + (vhdl-custom-set variable value #'vhdl-abbrev-list-init)) :group 'vhdl-style) (defcustom vhdl-use-direct-instantiation 'standard @@ -909,7 +906,7 @@ follows: :type '(set (const :tag "VHDL keywords" vhdl) (const :tag "User model keywords" user)) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) + (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init)) :group 'vhdl-template) (defcustom vhdl-optional-labels 'process @@ -1192,10 +1189,10 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry (string :tag "Keyword " :format "%t: %v\n"))) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-model-map-init - 'vhdl-model-defun - 'vhdl-mode-abbrev-table-init - 'vhdl-update-mode-menu)) + #'vhdl-model-map-init + #'vhdl-model-defun + #'vhdl-mode-abbrev-table-init + #'vhdl-update-mode-menu)) :group 'vhdl-model) @@ -1598,7 +1595,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-names t @@ -1615,7 +1612,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-special-words nil @@ -1628,7 +1625,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-forbidden-words nil @@ -1643,7 +1640,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-verilog-keywords nil @@ -1656,7 +1653,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'boolean :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-translate-off nil @@ -1670,7 +1667,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu entry \"Fontify Buffer\")." :type 'boolean :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-highlight-case-sensitive nil @@ -1724,7 +1721,7 @@ NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu (string :tag "Color (dark) ") (boolean :tag "In comments "))) :set (lambda (variable value) - (vhdl-custom-set variable value 'vhdl-font-lock-init)) + (vhdl-custom-set variable value #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-words '() @@ -1737,7 +1734,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-forbidden-syntax "" @@ -1752,7 +1749,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type 'regexp :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) (defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") @@ -1763,7 +1760,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu :type '(repeat (string :format "%v")) :set (lambda (variable value) (vhdl-custom-set variable value - 'vhdl-words-init 'vhdl-font-lock-init)) + #'vhdl-words-init #'vhdl-font-lock-init)) :group 'vhdl-highlight) @@ -2238,11 +2235,11 @@ Ignore byte-compiler warnings you might see." ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") (defun regexp-opt (strings &optional paren) (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) - (concat open (mapconcat 'regexp-quote strings "\\|") close)))) + (concat open (mapconcat #'regexp-quote strings "\\|") close)))) ;; `match-string-no-properties' undefined (XEmacs, what else?) (unless (fboundp 'match-string-no-properties) - (defalias 'match-string-no-properties 'match-string)) + (defalias 'match-string-no-properties #'match-string)) ;; `subst-char-in-string' undefined (XEmacs) (unless (fboundp 'subst-char-in-string) @@ -2269,7 +2266,7 @@ Ignore byte-compiler warnings you might see." (let* ((nondir (file-name-nondirectory pattern)) (dirpart (file-name-directory pattern)) (dirs (if (and dirpart (string-match "[[*?]" dirpart)) - (mapcar 'file-name-as-directory + (mapcar #'file-name-as-directory (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) contents) @@ -2296,7 +2293,7 @@ Ignore byte-compiler warnings you might see." ;; `member-ignore-case' undefined (XEmacs) (unless (fboundp 'member-ignore-case) - (defalias 'member-ignore-case 'member)) + (defalias 'member-ignore-case #'member)) ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different ;; behavior in XEmacs @@ -2495,6 +2492,7 @@ current buffer if no project is defined." "Enable case insensitive search and switch to syntax table that includes `_', then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t)) ; case insensitive search ;; use extended syntax table (with-syntax-table vhdl-mode-ext-syntax-table @@ -2504,55 +2502,59 @@ consistent searching." "Enable case insensitive search, switch to syntax table that includes `_', arrange to ignore `intangible' overlays, then execute BODY, and finally restore the old environment. Used for consistent searching." + (declare (debug t)) `(let ((case-fold-search t) ; case insensitive search - (current-syntax-table (syntax-table)) (inhibit-point-motion-hooks t)) ;; use extended syntax table - (set-syntax-table vhdl-mode-ext-syntax-table) - ;; execute BODY safely - (unwind-protect - (progn ,@body) - ;; restore syntax table - (set-syntax-table current-syntax-table)))) + (with-syntax-table vhdl-mode-ext-syntax-table + ;; execute BODY safely + (progn ,@body)))) (defmacro vhdl-visit-file (file-name issue-error &rest body) "Visit file FILE-NAME and execute BODY." - `(if (null ,file-name) - (progn ,@body) - (unless (file-directory-p ,file-name) - (let ((source-buffer (current-buffer)) - (visiting-buffer (find-buffer-visiting ,file-name)) - file-opened) - (when (or (and visiting-buffer (set-buffer visiting-buffer)) - (condition-case () - (progn (set-buffer (create-file-buffer ,file-name)) - (setq file-opened t) - (vhdl-insert-file-contents ,file-name) - ;; FIXME: This modifies a global syntax-table! - (modify-syntax-entry ?\- ". 12" (syntax-table)) - (modify-syntax-entry ?\n ">" (syntax-table)) - (modify-syntax-entry ?\^M ">" (syntax-table)) - (modify-syntax-entry ?_ "w" (syntax-table)) - t) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) - (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) - nil)))) - (condition-case info - (progn ,@body) - (error - (if ,issue-error - (progn - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer) - (error (cadr info))) - (vhdl-warning (cadr info)))))) - (when file-opened (kill-buffer (current-buffer))) - (set-buffer source-buffer))))) + (declare (debug t) (indent 2)) + `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body))) + +(defun vhdl--visit-file (file-name issue-error body-fun) + (if (null file-name) + (funcall body-fun) + (unless (file-directory-p file-name) + (let ((source-buffer (current-buffer)) + (visiting-buffer (find-buffer-visiting file-name)) + file-opened) + (when (or (and visiting-buffer (set-buffer visiting-buffer)) + (condition-case () + (progn (set-buffer (create-file-buffer file-name)) + (setq file-opened t) + (vhdl-insert-file-contents file-name) + (let ((st (copy-syntax-table (syntax-table)))) + (modify-syntax-entry ?\- ". 12" st) + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\^M ">" st) + (modify-syntax-entry ?_ "w" st) + ;; FIXME: We should arguably reset the + ;; syntax-table after running `body-fun'. + (set-syntax-table st)) + t) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error "ERROR: File cannot be opened: \"%s\"" file-name)) + (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t) + nil)))) + (condition-case info + (funcall body-fun) + (error + (if issue-error + (progn + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer) + (error (cadr info))) + (vhdl-warning (cadr info)))))) + (when file-opened (kill-buffer (current-buffer))) + (set-buffer source-buffer))))) (defun vhdl-insert-file-contents (filename) "Nicked from `insert-file-contents-literally', but allow coding system @@ -2600,7 +2602,7 @@ conversion." "Refresh directory or project with name KEY." (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) - (let ((pos (point)) + (let (;; (pos (point)) (last-frame (selected-frame))) (if (null key) (speedbar-refresh) @@ -2677,96 +2679,96 @@ elements > `vhdl-menu-max-size'." "Initialize `vhdl-template-map'." (setq vhdl-template-map (make-sparse-keymap)) ;; key bindings for VHDL templates - (define-key vhdl-template-map "al" 'vhdl-template-alias) - (define-key vhdl-template-map "ar" 'vhdl-template-architecture) - (define-key vhdl-template-map "at" 'vhdl-template-assert) - (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) - (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) - (define-key vhdl-template-map "bl" 'vhdl-template-block) - (define-key vhdl-template-map "ca" 'vhdl-template-case-is) - (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) - (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) - (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) - (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) - (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) - (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) - (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) - (define-key vhdl-template-map "co" 'vhdl-template-constant) - (define-key vhdl-template-map "ct" 'vhdl-template-context) - (define-key vhdl-template-map "di" 'vhdl-template-disconnect) - (define-key vhdl-template-map "el" 'vhdl-template-else) - (define-key vhdl-template-map "ei" 'vhdl-template-elsif) - (define-key vhdl-template-map "en" 'vhdl-template-entity) - (define-key vhdl-template-map "ex" 'vhdl-template-exit) - (define-key vhdl-template-map "fi" 'vhdl-template-file) - (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) - (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) - (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) - (define-key vhdl-template-map "fb" 'vhdl-template-function-body) - (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) - (define-key vhdl-template-map "ge" 'vhdl-template-generic) - (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) - (define-key vhdl-template-map "gt" 'vhdl-template-group-template) - (define-key vhdl-template-map "\C-h" 'vhdl-template-header) - (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) - (define-key vhdl-template-map "it" 'vhdl-template-if-then) - (define-key vhdl-template-map "li" 'vhdl-template-library) - (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) - (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) - (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) - (define-key vhdl-template-map "ma" 'vhdl-template-map) - (define-key vhdl-template-map "ne" 'vhdl-template-next) - (define-key vhdl-template-map "ot" 'vhdl-template-others) - (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) - (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) - (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) - (define-key vhdl-template-map "po" 'vhdl-template-port) - (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) - (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) - (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) - (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) - (define-key vhdl-template-map "rp" 'vhdl-template-report) - (define-key vhdl-template-map "rt" 'vhdl-template-return) - (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) - (define-key vhdl-template-map "si" 'vhdl-template-signal) - (define-key vhdl-template-map "su" 'vhdl-template-subtype) - (define-key vhdl-template-map "ty" 'vhdl-template-type) - (define-key vhdl-template-map "us" 'vhdl-template-use) - (define-key vhdl-template-map "va" 'vhdl-template-variable) - (define-key vhdl-template-map "wa" 'vhdl-template-wait) - (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) - (define-key vhdl-template-map "wi" 'vhdl-template-with) - (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) - (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) - (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) - (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) - (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) - (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) - (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) - (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) - (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) - (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) - (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) - (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) - (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) - (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) - (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) + (define-key vhdl-template-map "al" #'vhdl-template-alias) + (define-key vhdl-template-map "ar" #'vhdl-template-architecture) + (define-key vhdl-template-map "at" #'vhdl-template-assert) + (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl) + (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec) + (define-key vhdl-template-map "bl" #'vhdl-template-block) + (define-key vhdl-template-map "ca" #'vhdl-template-case-is) + (define-key vhdl-template-map "cd" #'vhdl-template-component-decl) + (define-key vhdl-template-map "ci" #'vhdl-template-component-inst) + (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst) + (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration) + (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf) + (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl) + (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec) + (define-key vhdl-template-map "co" #'vhdl-template-constant) + (define-key vhdl-template-map "ct" #'vhdl-template-context) + (define-key vhdl-template-map "di" #'vhdl-template-disconnect) + (define-key vhdl-template-map "el" #'vhdl-template-else) + (define-key vhdl-template-map "ei" #'vhdl-template-elsif) + (define-key vhdl-template-map "en" #'vhdl-template-entity) + (define-key vhdl-template-map "ex" #'vhdl-template-exit) + (define-key vhdl-template-map "fi" #'vhdl-template-file) + (define-key vhdl-template-map "fg" #'vhdl-template-for-generate) + (define-key vhdl-template-map "fl" #'vhdl-template-for-loop) + (define-key vhdl-template-map "\C-f" #'vhdl-template-footer) + (define-key vhdl-template-map "fb" #'vhdl-template-function-body) + (define-key vhdl-template-map "fd" #'vhdl-template-function-decl) + (define-key vhdl-template-map "ge" #'vhdl-template-generic) + (define-key vhdl-template-map "gd" #'vhdl-template-group-decl) + (define-key vhdl-template-map "gt" #'vhdl-template-group-template) + (define-key vhdl-template-map "\C-h" #'vhdl-template-header) + (define-key vhdl-template-map "ig" #'vhdl-template-if-generate) + (define-key vhdl-template-map "it" #'vhdl-template-if-then) + (define-key vhdl-template-map "li" #'vhdl-template-library) + (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop) + (define-key vhdl-template-map "\C-m" #'vhdl-template-modify) + (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date) + (define-key vhdl-template-map "ma" #'vhdl-template-map) + (define-key vhdl-template-map "ne" #'vhdl-template-next) + (define-key vhdl-template-map "ot" #'vhdl-template-others) + (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl) + (define-key vhdl-template-map "Pb" #'vhdl-template-package-body) + (define-key vhdl-template-map "(" #'vhdl-template-paired-parens) + (define-key vhdl-template-map "po" #'vhdl-template-port) + (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body) + (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl) + (define-key vhdl-template-map "pc" #'vhdl-template-process-comb) + (define-key vhdl-template-map "ps" #'vhdl-template-process-seq) + (define-key vhdl-template-map "rp" #'vhdl-template-report) + (define-key vhdl-template-map "rt" #'vhdl-template-return) + (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst) + (define-key vhdl-template-map "si" #'vhdl-template-signal) + (define-key vhdl-template-map "su" #'vhdl-template-subtype) + (define-key vhdl-template-map "ty" #'vhdl-template-type) + (define-key vhdl-template-map "us" #'vhdl-template-use) + (define-key vhdl-template-map "va" #'vhdl-template-variable) + (define-key vhdl-template-map "wa" #'vhdl-template-wait) + (define-key vhdl-template-map "wl" #'vhdl-template-while-loop) + (define-key vhdl-template-map "wi" #'vhdl-template-with) + (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait) + (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit) + (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std) + (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164) + (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith) + (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc) + (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed) + (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio) + (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned) + (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio) + (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on) + (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off) + (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on) + (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off) + (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt) (when (vhdl-standard-p 'ams) - (define-key vhdl-template-map "br" 'vhdl-template-break) - (define-key vhdl-template-map "cu" 'vhdl-template-case-use) - (define-key vhdl-template-map "iu" 'vhdl-template-if-use) - (define-key vhdl-template-map "lm" 'vhdl-template-limit) - (define-key vhdl-template-map "na" 'vhdl-template-nature) - (define-key vhdl-template-map "pa" 'vhdl-template-procedural) - (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) - (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) - (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) - (define-key vhdl-template-map "sn" 'vhdl-template-subnature) - (define-key vhdl-template-map "te" 'vhdl-template-terminal) + (define-key vhdl-template-map "br" #'vhdl-template-break) + (define-key vhdl-template-map "cu" #'vhdl-template-case-use) + (define-key vhdl-template-map "iu" #'vhdl-template-if-use) + (define-key vhdl-template-map "lm" #'vhdl-template-limit) + (define-key vhdl-template-map "na" #'vhdl-template-nature) + (define-key vhdl-template-map "pa" #'vhdl-template-procedural) + (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free) + (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch) + (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source) + (define-key vhdl-template-map "sn" #'vhdl-template-subnature) + (define-key vhdl-template-map "te" #'vhdl-template-terminal) ) (when (vhdl-standard-p 'math) - (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) - (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) + (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex) + (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real) )) ;; initialize template map for VHDL Mode @@ -2812,119 +2814,120 @@ STRING are replaced by `-' and substrings are converted to lower case." ;; model key bindings (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) ;; standard key bindings - (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) - (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) - (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) - (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) - (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) - (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) - (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) + (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement) + (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement) + (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp) + (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp) + (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list) + (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent) + (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent) (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs - (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) - (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) - (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) + (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun)) + (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp) + (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation) ;; mode specific key bindings - (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) - (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) - (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) - (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) - (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) - (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) - (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) - (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) - (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) - (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) - (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) - (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) - (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) - (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) - (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) - (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) - (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs - (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) - (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) - (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) - (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) - (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) - (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) - (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) - (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) - (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) - (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) - (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) - (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) - (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) - (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) - (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) - (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) - (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) - (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) - (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) - (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) - (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) - (define-key vhdl-mode-map "\M-\C-\\" 'indent-region) - (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) - (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) - (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) - (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) - (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) - (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) - (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) - (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) - (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) - (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) - (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) - (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) - (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) - (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) - (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) - (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) - (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) - (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) - (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) - (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) - (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) - (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) - (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) - (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) - (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) - (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) - (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) - (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) - (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) - (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) - (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) - (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) - (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) - (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) - (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) - (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) - (define-key vhdl-mode-map "\M-\t" 'insert-tab) + (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode) + (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode) + (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project) + (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project) + (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project) + (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project) + (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler) + (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile) + (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make) + (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile) + (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy) + (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity) + (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component) + (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance) + (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals) + (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants) + (define-key vhdl-mode-map + ;; `... C-g' not allowed in XEmacs. + (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g") + #'vhdl-port-paste-generic-map) + (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations) + (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench) + (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten) + (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction) + (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy) + (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration) + (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body) + (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call) + (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten) + (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component) + (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component) + (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components) + (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration) + (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package) + (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region) + (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline) + (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line) + (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode) + (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group) + (define-key vhdl-mode-map "\M-\C-\\" #'indent-region) + (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group) + (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent) + (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list) + (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations) + (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region) + (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer) + (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group) + (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region) + (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list) + (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group) + (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent) + (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region) + (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill) + (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy) + (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank) + (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand) + (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next) + (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous) + (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open) + (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line) + (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line) + (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region) + (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer) + (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause) + (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region) + (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer) + (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region) + (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer) + (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region) + (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer) + (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process) + (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer) + (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer) + (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages) + (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode) + (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version) + (define-key vhdl-mode-map "\M-\t" #'insert-tab) ;; insert commands bindings - (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) - (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) - (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) - (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) + (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct) + (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package) + (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive) + (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert) ;; electric key bindings - (define-key vhdl-mode-map " " 'vhdl-electric-space) + (define-key vhdl-mode-map " " #'vhdl-electric-space) (when vhdl-intelligent-tab - (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) - (define-key vhdl-mode-map "\r" 'vhdl-electric-return) - (define-key vhdl-mode-map "-" 'vhdl-electric-dash) - (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) - (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) - (define-key vhdl-mode-map "'" 'vhdl-electric-quote) - (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) - (define-key vhdl-mode-map "," 'vhdl-electric-comma) - (define-key vhdl-mode-map "." 'vhdl-electric-period) + (define-key vhdl-mode-map "\t" #'vhdl-electric-tab)) + (define-key vhdl-mode-map "\r" #'vhdl-electric-return) + (define-key vhdl-mode-map "-" #'vhdl-electric-dash) + (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket) + (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket) + (define-key vhdl-mode-map "'" #'vhdl-electric-quote) + (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon) + (define-key vhdl-mode-map "," #'vhdl-electric-comma) + (define-key vhdl-mode-map "." #'vhdl-electric-period) (when (vhdl-standard-p 'ams) - (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) + (define-key vhdl-mode-map "=" #'vhdl-electric-equal))) ;; initialize mode map for VHDL Mode (vhdl-mode-map-init) @@ -2935,7 +2938,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (let ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (when vhdl-word-completion-in-minibuffer - (define-key map "\t" 'vhdl-minibuffer-tab)) + (define-key map "\t" #'vhdl-minibuffer-tab)) map) "Keymap for minibuffer used in VHDL Mode.") @@ -3168,7 +3171,8 @@ STRING are replaced by `-' and substrings are converted to lower case." (unless (equal keyword "") (push (list keyword "" (vhdl-function-name - "vhdl-model" (nth 0 elem) "hook") 0 'system) + "vhdl-model" (nth 0 elem) "hook") + 0 'system) abbrev-list))) abbrev-list))))) @@ -4885,7 +4889,7 @@ Key bindings: (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) + (set (make-local-variable 'indent-line-function) #'vhdl-indent-line) (set (make-local-variable 'comment-start) "--") (set (make-local-variable 'comment-end) "") (set (make-local-variable 'comment-column) vhdl-inline-comment-column) @@ -4898,13 +4902,13 @@ Key bindings: ;; setup the comment indent variable in an Emacs version portable way ;; ignore any byte compiler warnings you might get here (when (boundp 'comment-indent-function) - (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) + (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent)) ;; initialize font locking (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line)) (if (eval-when-compile (fboundp 'syntax-propertize-rules)) (set (make-local-variable 'syntax-propertize-function) (syntax-propertize-rules @@ -4913,7 +4917,7 @@ Key bindings: ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) (set (make-local-variable 'font-lock-syntactic-keywords) vhdl-font-lock-syntactic-keywords)) - (unless vhdl-emacs-21 + (when (featurep 'xemacs) (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) @@ -4959,10 +4963,10 @@ Key bindings: (defun vhdl-write-file-hooks-init () "Add/remove hooks when buffer is saved." (if vhdl-modify-date-on-saving - (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) - (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) + (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t) + (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t)) (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) - (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) + (add-hook 'after-save-hook #'vhdl-add-modified-file nil t)) (defun vhdl-process-command-line-option (option) "Process command line options for VHDL Mode." @@ -5745,7 +5749,7 @@ negative, skip forward otherwise." ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ (unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) - (defalias 'vhdl-forward-comment 'forward-comment)) + (defalias 'vhdl-forward-comment #'forward-comment)) (defun vhdl-back-to-indentation () "Move point to the first non-whitespace character on this line." @@ -5809,7 +5813,7 @@ negative, skip forward otherwise." state))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-in-literal 'vhdl-win-il)) + (fset 'vhdl-in-literal #'vhdl-win-il)) ;; Skipping of "syntactic whitespace". Syntactic whitespace is ;; defined as lexical whitespace or comments. Search no farther back @@ -5847,9 +5851,9 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) + (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws)) -(defun vhdl-beginning-of-macro (&optional lim) +(defun vhdl-beginning-of-macro (&optional _lim) "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5862,7 +5866,7 @@ negative, skip forward otherwise." (goto-char here) nil))) -(defun vhdl-beginning-of-directive (&optional lim) +(defun vhdl-beginning-of-directive (&optional _lim) "Go to the beginning of a directive (nicked from `cc-engine')." (let ((here (point))) (beginning-of-line) @@ -5906,7 +5910,7 @@ negative, skip forward otherwise." (t (setq stop t)))))) (and (string-match "Win-Emacs" emacs-version) - (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) + (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws)) ;; Functions to help finding the correct indentation column: @@ -6054,7 +6058,7 @@ keyword." t) )) -(defun vhdl-corresponding-mid (&optional lim) +(defun vhdl-corresponding-mid (&optional _lim) (cond ((looking-at "is\\|block\\|generate\\|process\\|procedural") "begin") @@ -6270,7 +6274,7 @@ of an identifier that just happens to contain an \"end\" keyword." "A regular expression for searching backward that matches all known \"statement\" keywords.") -(defun vhdl-statement-p (&optional lim) +(defun vhdl-statement-p (&optional _lim) "Return t if we are looking at a real \"statement\" keyword. Assumes that the caller will make sure that we are looking at vhdl-statement-fwd-re, and are not inside a literal, and that we are not @@ -6462,7 +6466,7 @@ searches." ;; internal-p controls where the statement keyword can ;; be found. (internal-p (aref begin-vec 3)) - (last-backward (point)) last-forward + (last-backward (point)) ;; last-forward foundp literal keyword) ;; Look for the statement keyword. (while (and (not foundp) @@ -6497,7 +6501,7 @@ searches." (setq begin-re (concat "\\b\\(" begin-re "\\)\\b[^_]")) (save-excursion - (setq last-forward (point)) + ;; (setq last-forward (point)) ;; Look for the supplementary keyword ;; (bounded by the backward search start ;; point). @@ -6549,7 +6553,7 @@ With argument, do this that many times." (setq target (point))) (goto-char target))) -(defun vhdl-end-of-defun (&optional count) +(defun vhdl-end-of-defun (&optional _count) "Move forward to the end of a VHDL defun." (interactive) (let ((case-fold-search t)) @@ -7321,7 +7325,7 @@ after the containing paren which starts the arglist." (current-column)))) (- ce-curcol cs-curcol -1)))) -(defun vhdl-lineup-comment (langelem) +(defun vhdl-lineup-comment (_langelem) "Support old behavior for comment indentation. We look at vhdl-comment-only-line-offset to decide how to indent comment only-lines." @@ -7389,7 +7393,7 @@ only-lines." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation commands -(defun vhdl-electric-tab (&optional prefix-arg) +(defun vhdl-electric-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else if right of non whitespace on line then insert tab, else if last command was a tab or return then dedent one step or if a comment @@ -7409,12 +7413,12 @@ else indent `correctly'." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab ((> (current-column) (current-indentation)) (insert-tab)) @@ -7473,7 +7477,7 @@ indentation change." (setq syntax (vhdl-get-syntactic-context))))) (when is-comment (push (cons 'comment nil) syntax)) - (apply '+ (mapcar 'vhdl-get-offset syntax))) + (apply #'+ (mapcar #'vhdl-get-offset syntax))) ;; indent like previous nonblank line (save-excursion (beginning-of-line) (re-search-backward "^[^\n]" nil t) @@ -7677,7 +7681,7 @@ parentheses." ;; run FUNCTION (funcall function beg end spacing))) -(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) +(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent) "Attempt to align a range of lines based on the content of the lines. The definition of `alignment-list' determines the matching order and the manner in which the lines are aligned. If ALIGNMENT-LIST @@ -7687,12 +7691,15 @@ indentation is done before aligning." (setq alignment-list (or alignment-list vhdl-align-alist)) (setq spacing (or spacing 1)) (save-excursion - (let (bol indent) + (let (bol) ;; indent (goto-char end) (setq end (point-marker)) (goto-char begin) (setq bol (setq begin (progn (beginning-of-line) (point)))) - (when indent + ;; FIXME: The `indent' arg is not used, and I think it's because + ;; the let binding commented out above `indent' was hiding it, so + ;; the test below should maybe still test `indent'? + (when nil ;; indent (indent-region bol end nil)))) (let ((copy (copy-alist alignment-list))) (vhdl-prepare-search-2 @@ -8015,7 +8022,7 @@ empty lines are aligned individually, if `vhdl-align-groups' is non-nil." (tabify orig end)) (unless no-message (message "Aligning inline comments...done"))))) -(defun vhdl-align-inline-comment-group (&optional spacing) +(defun vhdl-align-inline-comment-group (&optional _spacing) "Align inline comments within a group of lines between empty lines." (interactive) (save-excursion @@ -8125,10 +8132,10 @@ depending on parameter UPPER-CASE." (when pr (progress-reporter-update pr (point)))) (when pr (progress-reporter-done pr)))))) -(defun vhdl-fix-case-region (beg end &optional arg) +(defun vhdl-fix-case-region (beg end &optional _arg) "Convert all VHDL words in region to lower or upper case, depending on options vhdl-upper-case-{keywords,types,attributes,enum-values}." - (interactive "r\nP") + (interactive "r") (vhdl-fix-case-region-1 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) (vhdl-fix-case-region-1 @@ -8174,11 +8181,11 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." ;; - force each statement to be on a separate line except when on same line ;; with 'end' keyword -(defun vhdl-fix-statement-region (beg end &optional arg) +(defun vhdl-fix-statement-region (beg end &optional _arg) "Force statements in region on separate line except when on same line with `end' keyword (necessary for correct indentation). Currently supported keywords: `begin', `if'." - (interactive "r\nP") + (interactive "r") (vhdl-prepare-search-2 (let (point) (save-excursion @@ -8230,9 +8237,9 @@ with `end' keyword (necessary for correct indentation)." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Trailing spaces -(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) +(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg) "Remove trailing spaces in region." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char end) (setq end (point-marker)) @@ -8495,7 +8502,7 @@ buffer." (delete-region sens-beg sens-end) (when read-list (insert " ()") (backward-char))) - (setq read-list (sort read-list 'string<)) + (setq read-list (sort read-list #'string<)) (when read-list (setq margin (current-column)) (insert (car read-list)) @@ -8527,7 +8534,7 @@ buffer." (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) "." (file-name-extension (buffer-file-name))))) (vhdl-visit-file - file-name t + file-name t (vhdl-prepare-search-2 (goto-char (point-min)) (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) @@ -8535,7 +8542,8 @@ buffer." (when (setq beg (vhdl-re-search-forward "\\" nil t)) t)) + (re-search-forward "^end\\>" nil t)) + t)) (setq end (save-excursion (backward-char) (forward-sexp) (point))) (vhdl-forward-syntactic-ws) @@ -8667,9 +8675,9 @@ buffer." Used for undoing after template abortion.") ;; correct different behavior of function `unread-command-events' in XEmacs -(defun vhdl-character-to-event (arg)) +(defun vhdl-character-to-event (_arg) nil) (defalias 'vhdl-character-to-event - (if (fboundp 'character-to-event) 'character-to-event 'identity)) + (if (fboundp 'character-to-event) #'character-to-event #'identity)) (defun vhdl-work-library () "Return the working library name of the current project or \"work\" if no @@ -9126,7 +9134,8 @@ a configuration declaration if not within a design unit." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "configuration" "(b)lock or (c)omponent configuration?" t) ?c) + "configuration" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) (t (vhdl-template-configuration-decl))))) ; otherwise @@ -9235,7 +9244,7 @@ a configuration declaration if not within a design unit." (interactive) (let ((margin (current-indentation)) (start (point)) - entity-exists string name position) + name position) ;; entity-exists string (vhdl-insert-keyword "CONTEXT ") (when (setq name (vhdl-template-field "name" nil t start (point))) (vhdl-insert-keyword " IS\n") @@ -9391,7 +9400,8 @@ otherwise." (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) (equal "CONFIGURATION" (upcase (match-string 1)))) (if (eq (vhdl-decision-query - "for" "(b)lock or (c)omponent configuration?" t) ?c) + "for" "(b)lock or (c)omponent configuration?" t) + ?c) (vhdl-template-component-conf) (vhdl-template-block-configuration))) ((and (save-excursion @@ -9506,11 +9516,12 @@ otherwise." (defun vhdl-template-group () "Insert group or group template declaration." (interactive) - (let ((start (point))) - (if (eq (vhdl-decision-query - "group" "(d)eclaration or (t)emplate declaration?" t) ?t) - (vhdl-template-group-template) - (vhdl-template-group-decl)))) + ;; (let ((start (point))) + (if (eq (vhdl-decision-query + "group" "(d)eclaration or (t)emplate declaration?" t) + ?t) + (vhdl-template-group-template) + (vhdl-template-group-decl))) ;; ) (defun vhdl-template-group-decl () "Insert group declaration." @@ -10451,7 +10462,8 @@ specification, if not already there." (and (not (bobp)) (re-search-backward (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" - library "\\|end\\)\\>") nil t) + library "\\|end\\)\\>") + nil t) (match-string 2)))) (equal (downcase library) "work")) (vhdl-insert-keyword "LIBRARY ") @@ -10811,9 +10823,9 @@ If starting after end-comment-column, start a new line." (vhdl-line-kill-entire))))) (goto-char final-pos)))) -(defun vhdl-comment-uncomment-region (beg end &optional arg) +(defun vhdl-comment-uncomment-region (beg end &optional _arg) "Comment out region if not commented out, uncomment otherwise." - (interactive "r\nP") + (interactive "r") (save-excursion (goto-char (1- end)) (end-of-line) @@ -10890,7 +10902,7 @@ Point is left between them." "Read from user a procedure or function argument list." (insert " (") (let ((margin (current-column)) - (start (point)) + ;; (start (point)) (end-pos (point)) not-empty interface semicolon-pos) (unless vhdl-argument-list-indent @@ -10899,7 +10911,8 @@ Point is left between them." (indent-to margin)) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t)) + (unless is-function " | VARIABLE") "]") + " " t)) (while (vhdl-template-field "[names]" nil t) (setq not-empty t) (insert " : ") @@ -10916,7 +10929,8 @@ Point is left between them." (indent-to margin) (setq interface (vhdl-template-field (concat "[CONSTANT | SIGNAL" - (unless is-function " | VARIABLE") "]") " " t))) + (unless is-function " | VARIABLE") "]") + " " t))) (delete-region end-pos (point)) (when semicolon-pos (goto-char semicolon-pos)) (if not-empty @@ -11136,7 +11150,7 @@ with double-quotes is to be inserted. DEFAULT specifies a default string." "Adjust case of following NUM words." (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) -(defun vhdl-minibuffer-tab (&optional prefix-arg) +(defun vhdl-minibuffer-tab (&optional arg) "If preceding character is part of a word or a paren then hippie-expand, else insert tab (used for word completion in VHDL minibuffer)." (interactive "P") @@ -11149,12 +11163,12 @@ else insert tab (used for word completion in VHDL minibuffer)." (or (and (boundp 'hippie-expand-only-buffers) hippie-expand-only-buffers) '(vhdl-mode)))) - (vhdl-expand-abbrev prefix-arg))) + (vhdl-expand-abbrev arg))) ;; expand parenthesis ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) (case-replace nil)) - (vhdl-expand-paren prefix-arg))) + (vhdl-expand-paren arg))) ;; insert tab (t (insert-tab)))) @@ -11541,7 +11555,8 @@ but not if inside a comment or quote." (unless (equal model-keyword "") (eval `(defun ,(vhdl-function-name - "vhdl-model" model-name "hook") () + "vhdl-model" model-name "hook") + () (vhdl-hooked-abbrev ',(vhdl-function-name "vhdl-model" model-name))))) (setq model-alist (cdr model-alist))))) @@ -11837,7 +11852,7 @@ reflected in a subsequent paste operation." (defun vhdl-port-paste-context-clause (&optional exclude-pack-name) "Paste a context clause." - (let ((margin (current-indentation)) + (let (;; (margin (current-indentation)) (clause-list (nth 3 vhdl-port-list)) clause) (while clause-list @@ -11847,7 +11862,8 @@ reflected in a subsequent paste operation." (save-excursion (re-search-backward (concat "^\\s-*use\\s-+" (car clause) - "." (cdr clause) "\\>") nil t))) + "." (cdr clause) "\\>") + nil t))) (vhdl-template-standard-package (car clause) (cdr clause)) (insert "\n")) (setq clause-list (cdr clause-list))))) @@ -12239,7 +12255,8 @@ reflected in a subsequent paste operation." (cond ((and vhdl-include-direction-comments (nth 2 port)) (format "%-6s" (concat "[" (nth 2 port) "] "))) (vhdl-include-direction-comments " ")) - (when vhdl-include-port-comments (nth 4 port))) t)) + (when vhdl-include-port-comments (nth 4 port))) + t)) (setq port-list (cdr port-list)) (when port-list (insert "\n") (indent-to margin))) ;; align signal list @@ -12293,7 +12310,7 @@ reflected in a subsequent paste operation." (let ((case-fold-search t) (ent-name (vhdl-replace-string vhdl-testbench-entity-name (nth 0 vhdl-port-list))) - (source-buffer (current-buffer)) + ;; (source-buffer (current-buffer)) arch-name config-name ent-file-name arch-file-name ent-buffer arch-buffer position) ;; open entity file @@ -12794,7 +12811,7 @@ expressions (e.g. for index ranges of types and signals)." ;; override `he-list-beg' from `hippie-exp' (unless (and (boundp 'viper-mode) viper-mode) - (defalias 'he-list-beg 'vhdl-he-list-beg)) + (defalias 'he-list-beg #'vhdl-he-list-beg)) ;; function for expanding abbrevs and dabbrevs (defalias 'vhdl-expand-abbrev (make-hippie-expand-function @@ -12841,14 +12858,14 @@ expressions (e.g. for index ranges of types and signals)." (beginning-of-line) (yank)) -(defun vhdl-line-expand (&optional prefix-arg) +(defun vhdl-line-expand (&optional arg) "Hippie-expand current line." (interactive "P") (require 'hippie-exp) (let ((case-fold-search t) (case-replace nil) (hippie-expand-try-functions-list '(try-expand-line try-expand-line-all-buffers))) - (hippie-expand prefix-arg))) + (hippie-expand arg))) (defun vhdl-line-transpose-next (&optional arg) "Interchange this line with next line." @@ -12970,7 +12987,7 @@ File statistics: \"%s\"\n\ # total lines : %5d\n" (buffer-file-name) no-stats no-code-lines no-empty-lines no-comm-lines no-comments no-lines) - (unless vhdl-emacs-21 (vhdl-show-messages)))) + (when (featurep 'xemacs) (vhdl-show-messages)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Help functions @@ -13019,7 +13036,7 @@ File statistics: \"%s\"\n\ (customize-set-variable 'vhdl-project vhdl-project) (customize-save-customized)) -(defun vhdl-toggle-project (name token indent) +(defun vhdl-toggle-project (name _token _indent) "Set current project to NAME or unset if NAME is current project." (vhdl-set-project (if (equal name vhdl-project) "" name))) @@ -13223,6 +13240,7 @@ File statistics: \"%s\"\n\ "Toggle hideshow minor mode and update menu bar." (interactive "P") (require 'hideshow) + (declare-function hs-hide-all "hideshow" ()) ;; check for hideshow version 5.x (if (not (boundp 'hs-block-start-mdata-select)) (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") @@ -13234,8 +13252,8 @@ File statistics: \"%s\"\n\ hs-special-modes-alist))) (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) (if vhdl-hide-all-init - (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) - (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) + (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t) + (remove-hook 'hs-minor-mode-hook #'hs-hide-all t)) (hs-minor-mode arg) (force-mode-line-update))) ; hack to update menu bar @@ -13502,6 +13520,8 @@ This does background highlighting of translate-off regions.") (while syntax-alist (setq name (vhdl-function-name "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) + ;; FIXME: This `defvar' shouldn't be needed: just quote the face + ;; name when you use it. (eval `(defvar ,name ',name ,(concat "Face name to use for " (nth 0 (car syntax-alist)) "."))) @@ -13714,7 +13734,7 @@ This does background highlighting of translate-off regions.") (when (boundp 'ps-print-color-p) (vhdl-ps-print-settings)) (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) - (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) + (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -13886,7 +13906,7 @@ hierarchy otherwise.") pack-list pack-body-list inst-list inst-ent-list) ;; scan file (vhdl-visit-file - file-name nil + file-name nil (vhdl-prepare-search-2 (save-excursion ;; scan for design units @@ -14061,7 +14081,8 @@ hierarchy otherwise.") "component[ \t\n\r\f]+\\(\\w+\\)\\|" "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" "\\(\\(for\\|if\\)\\>[^;:]+\\\\|block\\>\\)\\)\\|" - "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) + "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") + end-of-unit t) (or (not limit-hier-inst-no) (<= (if (or (match-string 14) (match-string 16)) @@ -14423,12 +14444,15 @@ of PROJECT." ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker ;; comp-lib-name level) -(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key - conf-inst-alist level indent - &optional include-top ent-hier) +(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key + conf-key-arg conf-inst-alist level indent + &optional include-top ent-hier) "Get instantiation hierarchy beginning in architecture ARCH-KEY of entity ENT-KEY." - (let* ((ent-entry (vhdl-aget ent-alist ent-key)) + (let* ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (conf-key conf-key-arg) + (ent-entry (vhdl-aget ent-alist ent-key)) (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) (cdar (last (nth 3 ent-entry))))) (inst-alist (nth 3 arch-entry)) @@ -14560,6 +14584,8 @@ entity ENT-KEY." (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") (sit-for 2))))) +(defvar vhdl-cache-version) + (defun vhdl-save-cache (key) "Save current hierarchy cache to file." (let* ((orig-buffer (current-buffer)) @@ -14646,7 +14672,7 @@ entity ENT-KEY." (file-dir-name (expand-file-name file-name directory)) vhdl-cache-version) (unless (memq 'vhdl-save-caches kill-emacs-hook) - (add-hook 'kill-emacs-hook 'vhdl-save-caches)) + (add-hook 'kill-emacs-hook #'vhdl-save-caches)) (when (file-exists-p file-dir-name) (condition-case () (progn (load-file file-dir-name) @@ -14686,6 +14712,8 @@ if required." (declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) (declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(declare-function speedbar-expand-line "speedbar" (&optional arg)) +(declare-function speedbar-edit-line "speedbar" ()) (defun vhdl-speedbar-initialize () "Initialize speedbar." @@ -14710,19 +14738,19 @@ if required." ;; keymap (unless vhdl-speedbar-mode-map (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) - (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) - (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) - (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) - (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) - (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) - (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) - (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) - (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) - (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) - (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) - (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) + (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line) + (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line) + (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level) + (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all) + (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy) + (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component) + (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration) + (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra) + (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design) + (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy) + (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches) (let ((key 0)) (while (<= key 9) (define-key vhdl-speedbar-mode-map (int-to-string key) @@ -14793,7 +14821,7 @@ if required." (setq speedbar-initial-expansion-list-name "vhdl directory")) (when (eq vhdl-speedbar-display-mode 'project) (setq speedbar-initial-expansion-list-name "vhdl project")) - (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) + (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy))) (defun vhdl-speedbar (&optional arg) "Open/close speedbar." @@ -14821,7 +14849,7 @@ if required." (declare-function speedbar-directory-buttons "speedbar" (directory _index)) (declare-function speedbar-file-lists "speedbar" (directory)) -(defun vhdl-speedbar-display-directory (directory depth &optional rescan) +(defun vhdl-speedbar-display-directory (directory depth &optional _rescan) "Display directory and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects nil) (setq speedbar-ignored-directory-regexp @@ -14842,7 +14870,7 @@ if required." (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) -(defun vhdl-speedbar-display-projects (project depth &optional rescan) +(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan) "Display projects and hierarchy information in speedbar." (setq vhdl-speedbar-show-projects t) (setq speedbar-ignored-directory-regexp ".") @@ -14858,6 +14886,8 @@ if required." (declare-function speedbar-make-tag-line "speedbar" (type char func data tag tfunc tdata tface depth)) +(defvar vhdl-speedbar-update-current-unit) + (defun vhdl-speedbar-insert-projects () "Insert all projects in speedbar." (vhdl-speedbar-make-title-line "Projects:") @@ -14868,9 +14898,9 @@ if required." ;; insert projects (while project-alist (speedbar-make-tag-line - 'angle ?+ 'vhdl-speedbar-expand-project + 'angle ?+ #'vhdl-speedbar-expand-project (caar project-alist) (caar project-alist) - 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) + #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) (setq project-alist (cdr project-alist))) (setq project-alist vhdl-project-alist) ;; expand projects @@ -14917,12 +14947,14 @@ otherwise use cached data." (vhdl-speedbar-expand-units directory) (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) -(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist - ent-inst-list depth) +(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist + ent-inst-list depth) "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." (if (not (or ent-alist conf-alist pack-alist)) (vhdl-speedbar-make-title-line "No VHDL design units!" depth) - (let (ent-entry conf-entry pack-entry) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + ent-entry conf-entry pack-entry) ;; insert entities (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) (while ent-alist @@ -14983,7 +15015,7 @@ otherwise use cached data." (declare-function speedbar-goto-this-file "speedbar" (file)) -(defun vhdl-speedbar-expand-dirs (directory) +(defun vhdl-speedbar-expand-dirs (_directory) "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." ;; (nicked from `speedbar-default-directory-list') @@ -15022,7 +15054,8 @@ otherwise use cached data." (goto-char position) (when (re-search-forward (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" - (car arch-alist) "\\>\\)") nil t) + (car arch-alist) "\\>\\)") + nil t) (beginning-of-line) (when (looking-at "^[0-9]+:\\s-*{") (goto-char (match-end 0)) @@ -15391,6 +15424,7 @@ otherwise use cached data." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Display help functions +;; FIXME: This `defvar' should be moved before its first use. (defvar vhdl-speedbar-update-current-unit t "Non-nil means to run `vhdl-speedbar-update-current-unit'.") @@ -15826,7 +15860,7 @@ NO-POSITION non-nil means do not re-position cursor." (abbreviate-file-name (file-name-as-directory (speedbar-line-directory indent))))) -(defun vhdl-speedbar-line-project (&optional indent) +(defun vhdl-speedbar-line-project (&optional _indent) "Get currently displayed project name." (and vhdl-speedbar-show-projects (save-excursion @@ -15896,7 +15930,7 @@ NO-POSITION non-nil means do not re-position cursor." ;; speedbar loads dframe at runtime. (declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) -(defun vhdl-speedbar-find-file (text token indent) +(defun vhdl-speedbar-find-file (_text token _indent) "When user clicks on TEXT, load file with name and position in TOKEN. Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file is already shown in a buffer." @@ -15924,12 +15958,12 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (goto-char (point-min)) - (forward-line (1- (cdr token))) - (end-of-line) - (if is-entity - (vhdl-port-copy) - (vhdl-subprog-copy))))) + (goto-char (point-min)) + (forward-line (1- (cdr token))) + (end-of-line) + (if is-entity + (vhdl-port-copy) + (vhdl-subprog-copy)))) (error (error "ERROR: %s not scanned successfully\n (%s)" (if is-entity "Port" "Interface") (cadr info)))) (error "ERROR: No entity/component or subprogram on current line"))))) @@ -16119,7 +16153,7 @@ expansion function)." ;; initialize speedbar (if (not (boundp 'speedbar-frame)) - (with-no-warnings (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)) + (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize)) (vhdl-speedbar-initialize) (when speedbar-frame (vhdl-speedbar-refresh))) @@ -16147,7 +16181,7 @@ expansion function)." (read-from-minibuffer "architecture name: " nil vhdl-minibuffer-local-map) (vhdl-replace-string vhdl-compose-architecture-name ent-name))) - ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) + ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project (message "Creating component \"%s(%s)\"..." ent-name arch-name) ;; open entity file (unless (eq vhdl-compose-create-files 'none) @@ -16347,7 +16381,7 @@ component instantiation." (if comp-name ;; ... from component declaration (vhdl-visit-file - (when vhdl-use-components-package pack-file-name) t + (when vhdl-use-components-package pack-file-name) t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) @@ -16358,7 +16392,7 @@ component instantiation." (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) "." (file-name-extension (buffer-file-name)))) (vhdl-visit-file - comp-ent-file-name t + comp-ent-file-name t (save-excursion (goto-char (point-min)) (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) @@ -16631,6 +16665,8 @@ component instantiation." (vhdl-comment-insert-inline (nth 4 entry) t)) (insert "\n")) +(defvar lazy-lock-minimum-size) + (defun vhdl-compose-components-package () "Generate a package containing component declarations for all entities in the current project/directory." @@ -16683,10 +16719,10 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (goto-char (point-min)) - (forward-line (1- (nth 3 (car ent-alist)))) - (end-of-line) - (vhdl-port-copy))) + (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) + (end-of-line) + (vhdl-port-copy)) (goto-char component-pos) (vhdl-port-paste-component t) (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) @@ -16700,13 +16736,16 @@ current project/directory." (message "Generating components package \"%s\"...done\n File created: \"%s\"" pack-name pack-file-name))) -(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist - conf-alist inst-alist - &optional insert-conf) +(defun vhdl-compose-configuration-architecture ( _ent-name arch-name + ent-alist-arg conf-alist-arg + inst-alist + &optional insert-conf) "Generate block configuration for architecture." - (let ((margin (current-indentation)) + (let ((ent-alist ent-alist-arg) + (conf-alist conf-alist-arg) + (margin (current-indentation)) (beg (point-at-bol)) - ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) + ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key ;; insert block configuration (for architecture) (vhdl-insert-keyword "FOR ") (insert arch-name "\n") (setq margin (+ margin vhdl-basic-offset)) @@ -17057,7 +17096,7 @@ do not print any file names." (file-relative-name (buffer-file-name)))) (when (and (= 0 (nth 1 (nth 10 compiler))) (= 0 (nth 1 (nth 11 compiler)))) - (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) + (setq compilation-process-setup-function #'vhdl-compile-print-file-name)) ;; run compilation (if options (when command @@ -17131,7 +17170,7 @@ specified by a target." vhdl-error-regexp-emacs-alist))) (when vhdl-emacs-22 - (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) + (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Makefile generation @@ -17410,7 +17449,7 @@ specified by a target." (setq tmp-list rule-alist) (while tmp-list ; pre-sort rule targets (setq cell (cdar tmp-list)) - (setcar cell (sort (car cell) 'string<)) + (setcar cell (sort (car cell) #'string<)) (setq tmp-list (cdr tmp-list))) (setq rule-alist ; sort by first rule target (sort rule-alist @@ -17500,9 +17539,9 @@ specified by a target." ;; insert rule for each library unit (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") (while prim-list - (setq second-list (sort (nth 1 (car prim-list)) 'string<)) + (setq second-list (sort (nth 1 (car prim-list)) #'string<)) (setq subcomp-list - (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) + (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<)) (setq unit-key (caar prim-list) unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) (nth 0 (vhdl-aget conf-alist unit-key)) @@ -17532,7 +17571,7 @@ specified by a target." (vhdl-get-compile-options project compiler (nth 0 rule) t)) ;; insert rule if file is supposed to be compiled (setq target-list (nth 1 rule) - depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) + depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<)) ;; insert targets (setq tmp-list target-list) (while target-list @@ -17555,7 +17594,8 @@ specified by a target." (if (eq options 'default) "$(OPTIONS)" options) " " (nth 0 rule) (if (equal vhdl-compile-post-command "") "" - " $(POST-COMPILE)") "\n") + " $(POST-COMPILE)") + "\n") (insert "\n")) (unless (and options mapping-exist) (setq tmp-list target-list) @@ -17595,6 +17635,7 @@ specified by a target." "Submit via mail a bug report on VHDL Mode." (interactive) ;; load in reporter + (defvar reporter-prompt-for-summary-p) (and (y-or-n-p "Do you want to submit a report on VHDL Mode? ") (let ((reporter-prompt-for-summary-p t)) From dfdec267aece1e3b4da378d347b6d18d52366060 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Apr 2021 22:55:04 -0400 Subject: [PATCH 035/128] * test/lisp/shadowfile-tests.el: Fix recent test failures (shadow--tests-cleanup): `shadow-hashtable` is now a hash table (duh!). --- test/lisp/shadowfile-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el index 0c2d7123dd7..7b9c2ff63b2 100644 --- a/test/lisp/shadowfile-tests.el +++ b/test/lisp/shadowfile-tests.el @@ -117,8 +117,8 @@ (ignore-errors (delete-file shadow-info-file)) (ignore-errors (delete-file shadow-todo-file)) ;; Reset variables. + (shadow-invalidate-hashtable) (setq shadow-info-buffer nil - shadow-hashtable nil shadow-todo-buffer nil shadow-files-to-copy nil)) From 1d42f4800bc3759ac961b97b2a66d4b73e520eb5 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Fri, 9 Apr 2021 09:57:06 +0200 Subject: [PATCH 036/128] Fix hostname completion on MS Windows * lisp/net/tramp.el (tramp-completion-file-name-regexp-default): Handle volume letter being added to paths for file name completion on W32 systems. This fixes hostname (and method) autocomplete on W32. Copyright-paperwork-exempt: yes --- lisp/net/tramp.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b2c650f6e1a..e61c3b1e44c 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1078,7 +1078,13 @@ initial value is overwritten by the car of `tramp-file-name-structure'.") (defconst tramp-completion-file-name-regexp-default (concat - "\\`/\\(" + "\\`" + ;; `file-name-completion' uses absolute paths for matching. This + ;; means that on W32 systems, something like "/ssh:host:~/path" + ;; becomes "c:/ssh:host:~/path". See also `tramp-drop-volume-letter'. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]+:[^/|:]*|\\)*" ;; Last hop. From 612d73167688a9a9742478373933c4af5e3f8720 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 8 Apr 2021 22:48:02 +0200 Subject: [PATCH 037/128] Self-TCO in `condition-case` error handlers * lisp/emacs-lisp/cl-macs.el (cl--self-tco): Recognise `condition-case` handlers as being in the tail position. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Extend test. --- lisp/emacs-lisp/cl-macs.el | 7 +++++++ test/lisp/emacs-lisp/cl-macs-tests.el | 14 ++++++++++++-- 2 files changed, 19 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 27ed07b6673..68211ec4106 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous ones. ;; tail-called any more. (not (memq var shadowings))))) `(,(car exp) ,bindings . ,(funcall opt-exps exps))) + ((and `(condition-case ,err-var ,bodyform . ,handlers) + (guard (not (eq err-var var)))) + `(condition-case ,err-var + (progn (setq ,retvar ,bodyform) nil) + . ,(mapcar (lambda (h) + (cons (car h) (funcall opt-exps (cdr h)))) + handlers))) ('nil nil) ;No need to set `retvar' to return nil. (_ `(progn (setq ,retvar ,exp) nil)))))) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index dd6487603d3..5c3e603b92e 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -629,14 +629,24 @@ collection clause." (let (n1) (and xs (progn (setq n1 (1+ n)) - (len2 (cdr xs) n1))))))) + (len2 (cdr xs) n1)))))) + ;; Tail call in error handler. + (len3 (xs n) + (if xs + (condition-case nil + (/ 1 0) + (arith-error (len3 (cdr xs) (1+ n)))) + n))) (should (equal (len nil 0) 0)) (should (equal (len2 nil 0) 0)) + (should (equal (len3 nil 0) 0)) (should (equal (len list-42 0) 42)) (should (equal (len2 list-42 0) 42)) + (should (equal (len3 list-42 0) 42)) ;; Should not bump into stack depth limits. (should (equal (len list-42k 0) 42000)) - (should (equal (len2 list-42k 0) 42000)))) + (should (equal (len2 list-42k 0) 42000)) + (should (equal (len3 list-42k 0) 42000)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) From 841dcfa7c351118aef402e58c3a204b671e1fe13 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 13:44:44 +0200 Subject: [PATCH 038/128] Use lexical-binding in loadhist.el and add tests * lisp/loadhist.el: Use lexical-binding. * test/lisp/loadhist-tests.el: New file. --- lisp/loadhist.el | 2 +- test/lisp/loadhist-tests.el | 57 +++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 1 deletion(-) create mode 100644 test/lisp/loadhist-tests.el diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 59c002d3078..0b12bdad058 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -1,4 +1,4 @@ -;;; loadhist.el --- lisp functions for working with feature groups +;;; loadhist.el --- lisp functions for working with feature groups -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1998, 2000-2021 Free Software Foundation, Inc. diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el new file mode 100644 index 00000000000..b29796da42d --- /dev/null +++ b/test/lisp/loadhist-tests.el @@ -0,0 +1,57 @@ +;;; loadhist-tests.el --- Tests for loadhist.el -*- lexical-binding:t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; Author: Stefan Kangas + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'ert) +(require 'loadhist) + +(ert-deftest loadhist-tests-feature-symbols () + (should (equal (file-name-base (car (feature-symbols 'loadhist))) "loadhist")) + (should-not (feature-symbols 'non-existent-feature))) + +(ert-deftest loadhist-tests-feature-file () + (should (equal (file-name-base (feature-file 'loadhist)) "loadhist")) + (should-error (feature-file 'non-existent-feature))) + +(ert-deftest loadhist-tests-file-loadhist-lookup () + ;; This should probably be extended... + (should (listp (file-loadhist-lookup "loadhist")))) + +(ert-deftest loadhist-tests-file-provides () + (should (eq (car (file-provides "loadhist")) 'loadhist))) + +(ert-deftest loadhist-tests-file-requires () + (should-not (file-requires "loadhist"))) + +(ert-deftest loadhist-tests-file-dependents () + (require 'dired-x) + (let ((deps (file-dependents "dired"))) + (should (member "dired-x" (mapcar #'file-name-base deps))))) + +(ert-deftest loadhist-tests-unload-feature () + (require 'dired-x) + (should-error (unload-feature 'dired)) + (unload-feature 'dired-x)) + +;;; loadhist-tests.el ends here From 064d933e20a007e6fbf0f2ce9e6554ca9710ed57 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 14:54:04 +0200 Subject: [PATCH 039/128] Use lexical-binding in foldout.el * lisp/foldout.el: Use lexical-binding. Doc and formatting fixes. Quote function symbols as such. --- lisp/foldout.el | 52 +++++++++++++++++++++++-------------------------- 1 file changed, 24 insertions(+), 28 deletions(-) diff --git a/lisp/foldout.el b/lisp/foldout.el index 3419d7f5981..cadf2746ba1 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -1,4 +1,4 @@ -;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode +;;; foldout.el --- folding extensions for outline-mode and outline-minor-mode -*- lexical-binding: t -*- ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. @@ -33,7 +33,7 @@ ;; hidden under one of these headings. Normally you'd do C-c C-e (show-entry) ;; to expose the body or C-c C-i to expose the child (level-2) headings. ;; -;; With foldout, you do C-c C-z (foldout-zoom-subtree). This exposes the body +;; With foldout, you do C-c C-z (`foldout-zoom-subtree'). This exposes the body ;; and child subheadings and narrows the buffer so that only the level-1 ;; heading, the body and the level-2 headings are visible. If you now want to ;; look under one of the level-2 headings, position the cursor on it and do C-c @@ -57,7 +57,7 @@ ;; zoomed-in heading. This is useful for restricting changes to a particular ;; chapter or section of your document. ;; -;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold). This hides +;; You unzoom (exit) a fold by doing C-c C-x (`foldout-exit-fold'). This hides ;; all the text and subheadings under the top-level heading and returns you to ;; the previous view of the buffer. Specifying a numeric argument exits that ;; many folds. Specifying a zero argument exits *all* folds. @@ -216,6 +216,8 @@ An end marker of nil means the fold ends after (point-max).") (defvar-local foldout-mode-line-string nil "Mode line string announcing that we are in an outline fold.") +;; FIXME: This should be rewritten as a proper minor mode. + ;; put our minor mode string immediately following outline-minor-mode's (or (assq 'foldout-mode-line-string minor-mode-alist) (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist) @@ -227,8 +229,7 @@ An end marker of nil means the fold ends after (point-max).") (error "Can't find outline-minor-mode in minor-mode-alist")) ;; slip our fold announcement into the list - (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))) - )) + (setcdr outl-entry (nconc foldout-entry (cdr outl-entry))))) @@ -275,16 +276,14 @@ optional arg EXPOSURE \(interactively with prefix arg) changes this:- ((> exposure-value 0) (outline-show-children exposure-value)) (t - (outline-show-subtree)) - ) + (outline-show-subtree))) ;; save the location of the fold we are entering (setq foldout-fold-list (cons (cons start-marker end-marker) foldout-fold-list)) ;; update the mode line - (foldout-update-mode-line) - ))) + (foldout-update-mode-line)))) (defun foldout-exit-fold (&optional num-folds) @@ -308,8 +307,7 @@ exited and text is left visible." ;; have we been told not to hide the fold? ((< num-folds 0) (setq hide-fold nil - num-folds (- num-folds))) - ) + num-folds (- num-folds)))) ;; limit the number of folds if we've been told to exit too many (setq num-folds (min num-folds (length foldout-fold-list))) @@ -482,8 +480,8 @@ Signal an error if the final event isn't the same type as the first one." event) (defun foldout-mouse-goto-heading (event) - "Go to the heading where the mouse event started. Signal an error -if the event didn't occur on a heading." + "Go to the heading where the mouse EVENT started. +Signal an error if the event didn't occur on a heading." (goto-char (posn-point (event-start event))) (or (outline-on-heading-p) ;; outline.el sometimes treats beginning-of-buffer as a heading @@ -505,17 +503,16 @@ M-C-down-mouse-{1,2,3}. Valid modifiers are shift, control, meta, alt, hyper and super.") -(if foldout-inhibit-key-bindings - () - (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree) - (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold) +(unless foldout-inhibit-key-bindings + (define-key outline-mode-map "\C-c\C-z" #'foldout-zoom-subtree) + (define-key outline-mode-map "\C-c\C-x" #'foldout-exit-fold) (let ((map (lookup-key outline-minor-mode-map outline-minor-mode-prefix))) (unless map (setq map (make-sparse-keymap)) (define-key outline-minor-mode-map outline-minor-mode-prefix map)) - (define-key map "\C-z" 'foldout-zoom-subtree) - (define-key map "\C-x" 'foldout-exit-fold)) - (let* ((modifiers (apply 'concat + (define-key map "\C-z" #'foldout-zoom-subtree) + (define-key map "\C-x" #'foldout-exit-fold)) + (let* ((modifiers (apply #'concat (mapcar (lambda (modifier) (vector (cond @@ -525,7 +522,7 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") ((eq modifier 'alt) ?A) ((eq modifier 'hyper) ?H) ((eq modifier 'super) ?s) - (t (error "invalid mouse modifier %s" + (t (error "Invalid mouse modifier %s" modifier))) ?-)) foldout-mouse-modifiers))) @@ -533,14 +530,13 @@ Valid modifiers are shift, control, meta, alt, hyper and super.") (mouse-2 (vector (intern (concat modifiers "down-mouse-2")))) (mouse-3 (vector (intern (concat modifiers "down-mouse-3"))))) - (define-key outline-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit) + (define-key outline-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-mode-map mouse-3 #'foldout-mouse-hide-or-exit) - (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom) - (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show) - (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit) - )) + (define-key outline-minor-mode-map mouse-1 #'foldout-mouse-zoom) + (define-key outline-minor-mode-map mouse-2 #'foldout-mouse-show) + (define-key outline-minor-mode-map mouse-3 #'foldout-mouse-hide-or-exit))) ;; Obsolete. From caeb86b439cae30c04f4d2b92f598bca2649218f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 15:06:32 +0200 Subject: [PATCH 040/128] * lisp/progmodes/cmacexp.el: Use lexical-binding. --- lisp/progmodes/cmacexp.el | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index 820867ab41f..edcd88ce24e 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -1,7 +1,6 @@ -;;; cmacexp.el --- expand C macros in a region +;;; cmacexp.el --- expand C macros in a region -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1994, 1996, 2000-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2021 Free Software Foundation, Inc. ;; Author: Francesco Potortì ;; Adapted-By: ESR @@ -33,20 +32,20 @@ ;; USAGE ============================================================= -;; In C mode C-C C-e is bound to c-macro-expand. The result of the +;; In C mode C-c C-e is bound to `c-macro-expand'. The result of the ;; expansion is put in a separate buffer. A user option allows the ;; window displaying the buffer to be optimally sized. ;; -;; When called with a C-u prefix, c-macro-expand replaces the selected +;; When called with a C-u prefix, `c-macro-expand' replaces the selected ;; region with the expansion. Both the preprocessor name and the -;; initial flag can be set by the user. If c-macro-prompt-flag is set +;; initial flag can be set by the user. If `c-macro-prompt-flag' is set ;; to a non-nil value the user is offered to change the options to the -;; preprocessor each time c-macro-expand is invoked. Preprocessor -;; arguments default to the last ones entered. If c-macro-prompt-flag +;; preprocessor each time `c-macro-expand' is invoked. Preprocessor +;; arguments default to the last ones entered. If `c-macro-prompt-flag' ;; is nil, one must use M-x set-variable to set a different value for -;; c-macro-cppflags. +;; `c-macro-cppflags'. -;; A c-macro-expansion function is provided for non-interactive use. +;; A `c-macro-expansion' function is provided for non-interactive use. ;; INSTALLATION ====================================================== @@ -54,18 +53,22 @@ ;; If you want the *Macroexpansion* window to be not higher than ;; necessary: -;;(setq c-macro-shrink-window-flag t) +;; +;; (setq c-macro-shrink-window-flag t) ;; ;; If you use a preprocessor other than /lib/cpp (be careful to set a ;; -C option or equivalent in order to make the preprocessor not to ;; strip the comments): -;;(setq c-macro-preprocessor "gpp -C") +;; +;; (setq c-macro-preprocessor "gpp -C") ;; ;; If you often use a particular set of flags: -;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG" +;; +;; (setq c-macro-cppflags "-I /usr/include/local -DDEBUG" ;; ;; If you want the "Preprocessor arguments: " prompt: -;;(setq c-macro-prompt-flag t) +;; +;; (setq c-macro-prompt-flag t) ;; BUG REPORTS ======================================================= @@ -87,16 +90,12 @@ (require 'cc-mode) -(provide 'cmacexp) - (defvar msdos-shells) - (defgroup c-macro nil "Expand C macros in a region." :group 'c) - (defcustom c-macro-shrink-window-flag nil "Non-nil means shrink the *Macroexpansion* window to fit its contents." :type 'boolean) @@ -392,4 +391,6 @@ Optional arg DISPLAY non-nil means show messages in the echo area." ;; Cleanup. (kill-buffer outbuf)))) +(provide 'cmacexp) + ;;; cmacexp.el ends here From fb596973b96408dc2fbdb5cfd4e16e818af27fbb Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 16:12:35 +0200 Subject: [PATCH 041/128] Use lexical-binding in cmuscheme.el * lisp/cmuscheme.el: Use lexical-binding. Doc fixes. Remove redundant :group args. Quote function symbols as such. --- lisp/cmuscheme.el | 103 +++++++++++++++++++--------------------------- 1 file changed, 43 insertions(+), 60 deletions(-) diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index d43cdb15c0d..18087da9ac9 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -1,7 +1,6 @@ -;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el +;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1994, 1997, 2001-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988-2021 Free Software Foundation, Inc. ;; Author: Olin Shivers ;; Maintainer: emacs-devel@gnu.org @@ -26,20 +25,18 @@ ;; This is a customization of comint-mode (see comint.el) ;; -;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces +;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces ;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al.. ;; 8/88 ;; ;; Please send me bug reports, bug fixes, and extensions, so that I can ;; merge them into the master source. ;; -;; The changelog is at the end of this file. -;; ;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user ;; interface that communicates process state back to the superior emacs by -;; outputting special control sequences. The Emacs package, xscheme.el, has +;; outputting special control sequences. The Emacs package, xscheme.el, has ;; lots and lots of special purpose code to read these control sequences, and -;; so is very tightly integrated with the cscheme process. The cscheme +;; so is very tightly integrated with the cscheme process. The cscheme ;; interrupt handler and debugger read single character commands in cbreak ;; mode; when this happens, xscheme.el switches to special keymaps that bind ;; the single letter command keys to emacs functions that directly send the @@ -49,18 +46,18 @@ ;; ;; Here's a summary of the pros and cons, as I see them. ;; xscheme: Tightly integrated with inferior cscheme process! A few commands -;; not in cmuscheme. But. Integration is a bit of a hack. Input -;; history only keeps the immediately prior input. Bizarre +;; not in cmuscheme. But. Integration is a bit of a hack. Input +;; history only keeps the immediately prior input. Bizarre ;; keybindings. ;; ;; cmuscheme: Not tightly integrated with inferior cscheme process. But. ;; Carefully integrated functionality with the entire suite of -;; comint-derived CMU process modes. Keybindings reminiscent of -;; Zwei and Hemlock. Good input history. A few commands not in +;; comint-derived CMU process modes. Keybindings reminiscent of +;; Zwei and Hemlock. Good input history. A few commands not in ;; xscheme. ;; -;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme -;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* +;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme +;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very* ;; Cscheme-specific; you must use cmuscheme.el. Interested parties are ;; invited to port xscheme functionality on top of comint mode... @@ -70,18 +67,18 @@ ;; Created. ;; ;; 2/15/89 Olin -;; Removed -emacs flag from process invocation. It's only useful for +;; Removed -emacs flag from process invocation. It's only useful for ;; cscheme, and makes cscheme assume it's running under xscheme.el, -;; which messes things up royally. A bug. +;; which messes things up royally. A bug. ;; ;; 5/22/90 Olin ;; - Upgraded to use comint-send-string and comint-send-region. ;; - run-scheme now offers to let you edit the command line if -;; you invoke it with a prefix-arg. M-x scheme is redundant, and +;; you invoke it with a prefix-arg. M-x scheme is redundant, and ;; has been removed. ;; - Explicit references to process "scheme" have been replaced with -;; (scheme-proc). This allows better handling of multiple process bufs. -;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. +;; (scheme-proc). This allows better handling of multiple process bufs. +;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention. ;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist ;; and friends, but interested hackers might find a useful application ;; of this facility. @@ -95,42 +92,37 @@ (require 'scheme) (require 'comint) - (defgroup cmuscheme nil "Run a scheme process in a buffer." :group 'scheme) -;;; INFERIOR SCHEME MODE STUFF -;;;============================================================================ - (defcustom inferior-scheme-mode-hook nil "Hook for customizing inferior-scheme mode." - :type 'hook - :group 'cmuscheme) + :type 'hook) (defvar inferior-scheme-mode-map (let ((m (make-sparse-keymap))) - (define-key m "\M-\C-x" 'scheme-send-definition) ;gnu convention - (define-key m "\C-x\C-e" 'scheme-send-last-sexp) - (define-key m "\C-c\C-l" 'scheme-load-file) - (define-key m "\C-c\C-k" 'scheme-compile-file) + (define-key m "\M-\C-x" #'scheme-send-definition) ;gnu convention + (define-key m "\C-x\C-e" #'scheme-send-last-sexp) + (define-key m "\C-c\C-l" #'scheme-load-file) + (define-key m "\C-c\C-k" #'scheme-compile-file) (scheme-mode-commands m) m)) ;; Install the process communication commands in the scheme-mode keymap. -(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention -(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention -(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition) -(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go) -(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region) -(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go) -(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition) -(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go) -(define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure) -(define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form) -(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme) -(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file) -(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile" +(define-key scheme-mode-map "\M-\C-x" #'scheme-send-definition);gnu convention +(define-key scheme-mode-map "\C-x\C-e" #'scheme-send-last-sexp);gnu convention +(define-key scheme-mode-map "\C-c\C-e" #'scheme-send-definition) +(define-key scheme-mode-map "\C-c\M-e" #'scheme-send-definition-and-go) +(define-key scheme-mode-map "\C-c\C-r" #'scheme-send-region) +(define-key scheme-mode-map "\C-c\M-r" #'scheme-send-region-and-go) +(define-key scheme-mode-map "\C-c\M-c" #'scheme-compile-definition) +(define-key scheme-mode-map "\C-c\C-c" #'scheme-compile-definition-and-go) +(define-key scheme-mode-map "\C-c\C-t" #'scheme-trace-procedure) +(define-key scheme-mode-map "\C-c\C-x" #'scheme-expand-current-form) +(define-key scheme-mode-map "\C-c\C-z" #'switch-to-scheme) +(define-key scheme-mode-map "\C-c\C-l" #'scheme-load-file) +(define-key scheme-mode-map "\C-c\C-k" #'scheme-compile-file) ;k for "kompile" (let ((map (lookup-key scheme-mode-map [menu-bar scheme]))) (define-key map [separator-eval] '("--")) @@ -157,8 +149,7 @@ (define-key map [send-region] '("Evaluate Region" . scheme-send-region)) (define-key map [send-sexp] - '("Evaluate Last S-expression" . scheme-send-last-sexp)) - ) + '("Evaluate Last S-expression" . scheme-send-last-sexp))) (defvar scheme-buffer) @@ -209,8 +200,7 @@ to continue it." (defcustom inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'" "Input matching this regexp are not saved on the history list. Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters." - :type 'regexp - :group 'cmuscheme) + :type 'regexp) (defun scheme-input-filter (str) "Don't save anything matching `inferior-scheme-filter-regexp'." @@ -242,7 +232,7 @@ is run). scheme-program-name))) (if (not (comint-check-proc "*scheme*")) (let ((cmdlist (split-string-and-unquote cmd))) - (set-buffer (apply 'make-comint "scheme" (car cmdlist) + (set-buffer (apply #'make-comint "scheme" (car cmdlist) (scheme-start-file (car cmdlist)) (cdr cmdlist))) (inferior-scheme-mode))) (setq scheme-program-name cmd) @@ -282,8 +272,7 @@ in this order. Return nil if no start file found." (defcustom scheme-compile-exp-command "(compile '%s)" "Template for issuing commands to compile arbitrary Scheme expressions." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-compile-region (start end) "Compile the current region in the inferior Scheme process. @@ -311,15 +300,12 @@ For PLT-Scheme, e.g., one should use (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\") For Scheme 48 and Scsh use \",trace %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defcustom scheme-untrace-command "(untrace %s)" "Template for switching off tracing of a Scheme procedure. Scheme 48 and Scsh users should set this variable to \",untrace %s\"." - - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-trace-procedure (proc &optional untrace) "Trace procedure PROC in the inferior Scheme process. @@ -341,8 +327,7 @@ With a prefix argument switch off tracing of procedure PROC." (defcustom scheme-macro-expand-command "(expand %s)" "Template for macro-expanding a Scheme form. For Scheme 48 and Scsh use \",expand %s\"." - :type 'string - :group 'cmuscheme) + :type 'string) (defun scheme-expand-current-form () "Macro-expand the form at point in the inferior Scheme process." @@ -410,8 +395,7 @@ Then switch to the process buffer." If it's loaded into a buffer that is in one of these major modes, it's considered a scheme source file by `scheme-load-file' and `scheme-compile-file'. Used by these commands to determine defaults." - :type '(repeat function) - :group 'cmuscheme) + :type '(repeat function)) (defvar scheme-prev-l/c-dir/file nil "Caches the last (directory . file) pair. @@ -514,8 +498,7 @@ command to run." (defcustom cmuscheme-load-hook nil "This hook is run when cmuscheme is loaded in. This is a good place to put keybindings." - :type 'hook - :group 'cmuscheme) + :type 'hook) (make-obsolete-variable 'cmuscheme-load-hook "use `with-eval-after-load' instead." "28.1") From 22515134ae83b625964f7719e172435f016be0f2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 16:16:42 +0200 Subject: [PATCH 042/128] Use lexical-binding in winner.el * lisp/winner.el: Use lexical-binding. Remove redundant :group args. (winner-set, winner-mode-map): Quote function symbols as such. --- lisp/winner.el | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/lisp/winner.el b/lisp/winner.el index 9506ac53bb2..f30fa6cf5cf 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -1,4 +1,4 @@ -;;; winner.el --- Restore old window configurations +;;; winner.el --- Restore old window configurations -*- lexical-binding: t -*- ;; Copyright (C) 1997-1998, 2001-2021 Free Software Foundation, Inc. @@ -33,14 +33,13 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'ring) (defun winner-active-region () (declare (gv-setter (lambda (store) `(if ,store (activate-mark) (deactivate-mark))))) (region-active-p)) -(require 'ring) - (defgroup winner nil "Restoring window configurations." :group 'windows) @@ -273,7 +272,7 @@ You may want to include buffer names such as *Help*, *Apropos*, (let* ((buffers nil) (alive ;; Possibly update `winner-point-alist' - (cl-loop for buf in (mapcar 'cdr (cdr conf)) + (cl-loop for buf in (mapcar #'cdr (cdr conf)) for pos = (winner-get-point buf nil) if (and pos (not (memq buf buffers))) do (push buf buffers) @@ -317,7 +316,7 @@ You may want to include buffer names such as *Help*, *Apropos*, ;; Return t if this is still a possible configuration. (or (null xwins) (progn - (mapc 'delete-window (cdr xwins)) ; delete all but one + (mapc #'delete-window (cdr xwins)) ; delete all but one (unless (one-window-p t) (delete-window (car xwins)) t)))))) @@ -328,22 +327,20 @@ You may want to include buffer names such as *Help*, *Apropos*, (defcustom winner-mode-hook nil "Functions to run whenever Winner mode is turned on or off." - :type 'hook - :group 'winner) + :type 'hook) (define-obsolete-variable-alias 'winner-mode-leave-hook 'winner-mode-off-hook "24.3") (defcustom winner-mode-off-hook nil "Functions to run whenever Winner mode is turned off." - :type 'hook - :group 'winner) + :type 'hook) (defvar winner-mode-map (let ((map (make-sparse-keymap))) (unless winner-dont-bind-my-keys - (define-key map [(control c) left] 'winner-undo) - (define-key map [(control c) right] 'winner-redo)) + (define-key map [(control c) left] #'winner-undo) + (define-key map [(control c) right] #'winner-redo)) map) "Keymap for Winner mode.") From cdd72c5d89cb9920f7cd36dfd08429d29ce8e881 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 18:25:08 +0200 Subject: [PATCH 043/128] Don't preserve window-line in tabulated-list-print * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print): Don't try to preserve window-line. (Bug#42747) --- lisp/emacs-lisp/tabulated-list.el | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 0c299b48b90..0b10dfdc0af 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -410,8 +410,7 @@ specified by `tabulated-list-sort-key'. It then erases the buffer and inserts the entries with `tabulated-list-printer'. Optional argument REMEMBER-POS, if non-nil, means to move point -to the entry with the same ID element as the current line and -recenter window line accordingly. +to the entry with the same ID element as the current line. Non-nil UPDATE argument means to use an alternative printing method which is faster if most entries haven't changed since the @@ -424,18 +423,10 @@ changing `tabulated-list-sort-key'." (funcall tabulated-list-entries) tabulated-list-entries)) (sorter (tabulated-list--get-sorter)) - entry-id saved-pt saved-col window-line) + entry-id saved-pt saved-col) (and remember-pos (setq entry-id (tabulated-list-get-id)) - (setq saved-col (current-column)) - (when (eq (window-buffer) (current-buffer)) - (setq window-line - (save-excursion - (save-restriction - (widen) - (narrow-to-region (window-start) (point)) - (goto-char (point-min)) - (vertical-motion (buffer-size))))))) + (setq saved-col (current-column))) ;; Sort the entries, if necessary. (when sorter (setq entries (sort entries sorter))) @@ -490,9 +481,7 @@ changing `tabulated-list-sort-key'." ;; If REMEMBER-POS was specified, move to the "old" location. (if saved-pt (progn (goto-char saved-pt) - (move-to-column saved-col) - (when window-line - (recenter window-line))) + (move-to-column saved-col)) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) From 512ec97bcf5aaaf0696f2e816ff764324bb67185 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 00:14:12 +0200 Subject: [PATCH 044/128] Remove redundant #' before lambda in ibuf-*.el * lisp/ibuf-ext.el (ibuffer-included-in-filters-p) (ibuffer-included-in-filter-p-1, ibuffer-do-kill-lines) (ibuffer-jump-to-buffer, ibuffer-mark-on-buffer) (ibuffer-mark-by-name-regexp, ibuffer-mark-by-mode-regexp) (ibuffer-mark-by-content-regexp, ibuffer-mark-by-mode) (ibuffer-mark-modified-buffers, ibuffer-mark-unsaved-buffers) (ibuffer-mark-dissociated-buffers, ibuffer-mark-help-buffers) (ibuffer-mark-compressed-file-buffers, ibuffer-mark-old-buffers) (ibuffer-mark-special-buffers, ibuffer-mark-read-only-buffers) (ibuffer-mark-dired-buffers, ibuffer-do-occur): * lisp/ibuf-macs.el (ibuffer-save-marks, define-ibuffer-sorter) (define-ibuffer-op): Remove redundant #' before lambda. --- lisp/ibuf-ext.el | 150 +++++++++++++++++++++++----------------------- lisp/ibuf-macs.el | 32 +++++----- 2 files changed, 91 insertions(+), 91 deletions(-) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 44574abd46a..48f9e8a990d 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -687,8 +687,8 @@ specifications with the same structure as `ibuffer-filtering-qualifiers'." (not (memq nil ;; a filter will return nil if it failed - (mapcar #'(lambda (filter) - (ibuffer-included-in-filter-p buf filter)) + (mapcar (lambda (filter) + (ibuffer-included-in-filter-p buf filter)) filters)))) (defun ibuffer-unary-operand (filter) @@ -724,8 +724,8 @@ specification, with the same structure as an element of the list ;; (dolist (filter-spec (cdr filter) nil) ;; (when (ibuffer-included-in-filter-p buf filter-spec) ;; (throw 'has-match t)))) - (memq t (mapcar #'(lambda (x) - (ibuffer-included-in-filter-p buf x)) + (memq t (mapcar (lambda (x) + (ibuffer-included-in-filter-p buf x)) (cdr filter)))) ('and (catch 'no-match @@ -1589,8 +1589,8 @@ to move by. The default is `ibuffer-marked-char'." (message "No buffers marked; use `m' to mark a buffer") (let ((count (ibuffer-map-marked-lines - #'(lambda (_buf _mark) - 'kill)))) + (lambda (_buf _mark) + 'kill)))) (message "Killed %s lines" count)))) ;;;###autoload @@ -1609,8 +1609,8 @@ a prefix argument reverses the meaning of that variable." (when current-prefix-arg (setq only-visible (not only-visible))) (if only-visible - (let ((table (mapcar #'(lambda (x) - (buffer-name (car x))) + (let ((table (mapcar (lambda (x) + (buffer-name (car x))) (ibuffer-current-state-list)))) (when (null table) (error "No buffers!")) @@ -1621,10 +1621,10 @@ a prefix argument reverses the meaning of that variable." (let (buf-point) ;; Blindly search for our buffer: it is very likely that it is ;; not in a hidden filter group. - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t nil) (when (and (null buf-point) @@ -1635,10 +1635,10 @@ a prefix argument reverses the meaning of that variable." (dolist (group ibuffer-hidden-filter-groups) (ibuffer-jump-to-filter-group group) (ibuffer-toggle-filter-group) - (ibuffer-map-lines #'(lambda (buf _marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) + (ibuffer-map-lines (lambda (buf _marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) t group) (if buf-point (throw 'found nil) @@ -1775,11 +1775,11 @@ You can then feed the file name(s) to other commands with \\[yank]." (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group) (let ((count (ibuffer-map-lines - #'(lambda (buf _mark) - (when (funcall func buf) - (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark - ibuffer-marked-char)) - t)) + (lambda (buf _mark) + (when (funcall func buf) + (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark + ibuffer-marked-char)) + t)) nil group))) (ibuffer-redisplay t) @@ -1791,8 +1791,8 @@ You can then feed the file name(s) to other commands with \\[yank]." "Mark all buffers whose name matches REGEXP." (interactive "sMark by name (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (string-match regexp (buffer-name buf))))) + (lambda (buf) + (string-match regexp (buffer-name buf))))) (defun ibuffer-locked-buffer-p (&optional buf) "Return non-nil if BUF is locked. @@ -1816,9 +1816,9 @@ When BUF nil, default to the buffer at current line." "Mark all buffers whose major mode matches REGEXP." (interactive "sMark by major mode (regexp): ") (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (string-match regexp (format-mode-line mode-name nil nil buf)))))) + (lambda (buf) + (with-current-buffer buf + (string-match regexp (format-mode-line mode-name nil nil buf)))))) ;;;###autoload (defun ibuffer-mark-by-file-name-regexp (regexp) @@ -1840,21 +1840,21 @@ Otherwise buffers whose name matches an element of (interactive (let ((reg (read-string "Mark by content (regexp): "))) (list reg current-prefix-arg))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (let ((mode (with-current-buffer buf major-mode)) - res) - (cond ((and (not all-buffers) - (or - (memq mode ibuffer-never-search-content-mode) - (cl-dolist (x ibuffer-never-search-content-name nil) - (when-let ((found (string-match x (buffer-name buf)))) - (cl-return found))))) - (setq res nil)) - (t - (with-current-buffer buf - (save-mark-and-excursion - (goto-char (point-min)) - (setq res (re-search-forward regexp nil t)))))) res)))) + (lambda (buf) + (let ((mode (with-current-buffer buf major-mode)) + res) + (cond ((and (not all-buffers) + (or + (memq mode ibuffer-never-search-content-mode) + (cl-dolist (x ibuffer-never-search-content-name nil) + (when-let ((found (string-match x (buffer-name buf)))) + (cl-return found))))) + (setq res nil)) + (t + (with-current-buffer buf + (save-mark-and-excursion + (goto-char (point-min)) + (setq res (re-search-forward regexp nil t)))))) res)))) ;;;###autoload (defun ibuffer-mark-by-mode (mode) @@ -1869,92 +1869,92 @@ Otherwise buffers whose name matches an element of (format-prompt "Mark by major mode" default) (ibuffer-list-buffer-modes) nil t nil nil default))))) (ibuffer-mark-on-buffer - #'(lambda (buf) - (eq (buffer-local-value 'major-mode buf) mode)))) + (lambda (buf) + (eq (buffer-local-value 'major-mode buf) mode)))) ;;;###autoload (defun ibuffer-mark-modified-buffers () "Mark all modified buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-modified-p buf)))) + (lambda (buf) (buffer-modified-p buf)))) ;;;###autoload (defun ibuffer-mark-unsaved-buffers () "Mark all modified buffers that have an associated file." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (and (buffer-local-value 'buffer-file-name buf) - (buffer-modified-p buf))))) + (lambda (buf) (and (buffer-local-value 'buffer-file-name buf) + (buffer-modified-p buf))))) ;;;###autoload (defun ibuffer-mark-dissociated-buffers () "Mark all buffers whose associated file does not exist." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (or - (and buffer-file-name - (not (file-exists-p buffer-file-name))) - (and (eq major-mode 'dired-mode) - (boundp 'dired-directory) - (stringp dired-directory) - (not (file-exists-p (file-name-directory dired-directory))))))))) + (lambda (buf) + (with-current-buffer buf + (or + (and buffer-file-name + (not (file-exists-p buffer-file-name))) + (and (eq major-mode 'dired-mode) + (boundp 'dired-directory) + (stringp dired-directory) + (not (file-exists-p (file-name-directory dired-directory))))))))) ;;;###autoload (defun ibuffer-mark-help-buffers () "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (memq major-mode ibuffer-help-buffer-modes))))) + (lambda (buf) + (with-current-buffer buf + (memq major-mode ibuffer-help-buffer-modes))))) ;;;###autoload (defun ibuffer-mark-compressed-file-buffers () "Mark buffers whose associated file is compressed." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (and buffer-file-name - (string-match ibuffer-compressed-file-name-regexp - buffer-file-name)))))) + (lambda (buf) + (with-current-buffer buf + (and buffer-file-name + (string-match ibuffer-compressed-file-name-regexp + buffer-file-name)))))) ;;;###autoload (defun ibuffer-mark-old-buffers () "Mark buffers which have not been viewed in `ibuffer-old-time' hours." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) - (with-current-buffer buf - (when buffer-display-time - (time-less-p - (* 60 60 ibuffer-old-time) - (time-since buffer-display-time))))))) + (lambda (buf) + (with-current-buffer buf + (when buffer-display-time + (time-less-p + (* 60 60 ibuffer-old-time) + (time-since buffer-display-time))))))) ;;;###autoload (defun ibuffer-mark-special-buffers () "Mark all buffers whose name begins and ends with `*'." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (string-match "^\\*.+\\*$" - (buffer-name buf))))) + (lambda (buf) (string-match "^\\*.+\\*$" + (buffer-name buf))))) ;;;###autoload (defun ibuffer-mark-read-only-buffers () "Mark all read-only buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (buffer-local-value 'buffer-read-only buf)))) + (lambda (buf) (buffer-local-value 'buffer-read-only buf)))) ;;;###autoload (defun ibuffer-mark-dired-buffers () "Mark all `dired' buffers." (interactive) (ibuffer-mark-on-buffer - #'(lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) + (lambda (buf) (eq (buffer-local-value 'major-mode buf) 'dired-mode)))) ;;;###autoload (defun ibuffer-do-occur (regexp &optional nlines) @@ -1970,8 +1970,8 @@ defaults to one." (let ((ibuffer-do-occur-bufs nil)) ;; Accumulate a list of marked buffers (ibuffer-map-marked-lines - #'(lambda (buf _mark) - (push buf ibuffer-do-occur-bufs))) + (lambda (buf _mark) + (push buf ibuffer-do-occur-bufs))) (occur-1 regexp nlines ibuffer-do-occur-bufs))) (provide 'ibuf-ext) diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index be09c6582ce..fcc4f9e751c 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -66,8 +66,8 @@ During evaluation of body, bind `it' to the value returned by TEST." (ibuffer-redisplay-engine ;; Get rid of dead buffers (delq nil - (mapcar #'(lambda (e) (when (buffer-live-p (car e)) - e)) + (mapcar (lambda (e) (when (buffer-live-p (car e)) + e)) ibuffer-save-marks-tmp-mark-list))) (ibuffer-redisplay t)))))) @@ -154,8 +154,8 @@ value if and only if `a' is \"less than\" `b'. (ibuffer-redisplay t) (setq ibuffer-last-sorting-mode ',name)) (push (list ',name ,description - #'(lambda (a b) - ,@body)) + (lambda (a b) + ,@body)) ibuffer-sorting-functions-alist) :autoload-end)) @@ -259,18 +259,18 @@ buffer object. 'ibuffer-map-deletion-lines) (_ 'ibuffer-map-marked-lines)) - #'(lambda (buf mark) - ;; Silence warning for code that doesn't - ;; use `mark'. - (ignore mark) - ,(if (eq modifier-p :maybe) - `(let ((ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (prog1 ,inner-body - (when (not (eq ibuffer-tmp-previous-buffer-modification - (buffer-modified-p buf))) - (setq ibuffer-did-modification t)))) - inner-body))))) + (lambda (buf mark) + ;; Silence warning for code that doesn't + ;; use `mark'. + (ignore mark) + ,(if (eq modifier-p :maybe) + `(let ((ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (prog1 ,inner-body + (when (not (eq ibuffer-tmp-previous-buffer-modification + (buffer-modified-p buf))) + (setq ibuffer-did-modification t)))) + inner-body))))) ,finish))) (if dangerous `(when (ibuffer-confirm-operation-on ,active-opstring marked-names) From 40db60563c6b259e1208b6931f0a343849026814 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 9 Apr 2021 18:42:14 +0200 Subject: [PATCH 045/128] Make refer-every into obsolete alias for seq-every-p * lisp/textmodes/refer.el (refer-every): Make into obsolete function alias for seq-every-p. Update single caller. --- lisp/textmodes/refer.el | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 53519ac3386..e710180d5f5 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -245,10 +245,10 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (forward-paragraph 1) (setq end (point)) (setq found - (refer-every (lambda (keyword) - (goto-char begin) - (re-search-forward keyword end t)) - keywords-list)) + (seq-every-p (lambda (keyword) + (goto-char begin) + (re-search-forward keyword end t)) + keywords-list)) (if (not found) (progn (setq begin end) @@ -260,12 +260,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (progn (message "Scanning %s... not found" file) nil)))) -(defun refer-every (pred l) - (cond ((null l) nil) - ((funcall pred (car l)) - (or (null (cdr l)) - (refer-every pred (cdr l)))))) - (defun refer-convert-string-to-list-of-strings (s) (let ((current (current-buffer)) (temp-buffer (get-buffer-create "*refer-temp*"))) @@ -391,4 +385,6 @@ found on the last `refer-find-entry' or `refer-find-next-entry'." (setq refer-bib-files files)) files)) +(define-obsolete-function-alias 'refer-every #'seq-every-p "28.1") + ;;; refer.el ends here From a2a7cfde29aa71f9ea503b8dc467d694f6e5b69f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 9 Apr 2021 18:42:12 +0200 Subject: [PATCH 046/128] Clean up bytecomp-tests.el Now all test cases are run with both lexical and dynamic binding where applicable, comparing interpreted against compiled results. Previously, almost all tests were only run with dynamic binding which was definitely not intended. * test/lisp/emacs-lisp/bytecomp-tests.el (byte-opt-testsuite-arith-data): Rename to bytecomp-tests--test-cases. (bytecomp-check-1, bytecomp-explain-1, bytecomp-tests) (bytecomp-lexbind-tests, bytecomp-lexbind-check-1) (bytecomp-lexbind-explain-1): Remove. (bytecomp-tests--eval-interpreted, bytecomp-tests--eval-compiled) (bytecomp-tests-lexbind, bytecomp-tests-dynbind) (bytecomp-tests--test-cases-lexbind-only): New. --- test/lisp/emacs-lisp/bytecomp-tests.el | 146 ++++++++----------------- 1 file changed, 45 insertions(+), 101 deletions(-) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 0f7a0ccc851..b1377e59f77 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -41,7 +41,7 @@ "Identity, but hidden from some optimisations." x) -(defconst byte-opt-testsuite-arith-data +(defconst bytecomp-tests--test-cases '( ;; some functional tests (let ((a most-positive-fixnum) (b 1) (c 1.0)) (+ a b c)) @@ -430,69 +430,54 @@ (list s x i)) (let ((x 2)) - (list (or (bytecomp-test-identity 'a) (setq x 3)) x))) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") + (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + ) + "List of expressions for cross-testing interpreted and compiled code.") -(defun bytecomp-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." +(defconst bytecomp-tests--test-cases-lexbind-only + `( + ;; This would infloop (and exhaust stack) with dynamic binding. + (let ((f #'car)) + (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) + (funcall f '(1 . 2)))) + ) + "List of expressions for cross-testing interpreted and compiled code. +These are only tested with lexical binding.") + +(defun bytecomp-tests--eval-interpreted (form) + "Evaluate FORM using the Lisp interpreter, returning errors as a +special value." + (condition-case err + (eval form lexical-binding) + (error (list 'bytecomp-check-error (car err))))) + +(defun bytecomp-tests--eval-compiled (form) + "Evaluate FORM using the Lisp byte-code compiler, returning errors as a +special value." (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) + (byte-compile-warnings nil)) + (condition-case err + (funcall (byte-compile (list 'lambda nil form))) + (error (list 'bytecomp-check-error (car err)))))) -(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) +(ert-deftest bytecomp-tests-lexbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with lexical binding." + (let ((lexical-binding t)) + (dolist (form (append bytecomp-tests--test-cases-lexbind-only + bytecomp-tests--test-cases)) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) -(defun bytecomp-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (byte-compile (list 'lambda nil pat))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-tests () - "Test the Emacs byte compiler." - (dolist (pat byte-opt-testsuite-arith-data) - (should (bytecomp-check-1 pat)))) - -(defun test-byte-opt-arithmetic (&optional arg) - "Unit test for byte-opt arithmetic operations. -Subtests signal errors if something goes wrong." - (interactive "P") - (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (pass-face '((t :foreground "green"))) - (fail-face '((t :foreground "red"))) - (print-escape-nonascii t) - (print-escape-newlines t) - (print-quoted t) - v0 v1) - (dolist (pat byte-opt-testsuite-arith-data) - (condition-case err - (setq v0 (eval pat)) - (error (setq v0 (list 'bytecomp-check-error (car err))))) - (condition-case err - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 (list 'bytecomp-check-error (car err))))) - (insert (format "%s" pat)) - (indent-to-column 65) - (if (equal v0 v1) - (insert (propertize "OK" 'face pass-face)) - (insert (propertize "FAIL\n" 'face fail-face)) - (indent-to-column 55) - (insert (propertize (format "[%s] vs [%s]" v0 v1) - 'face fail-face))) - (insert "\n")))) +(ert-deftest bytecomp-tests-dynbind () + "Check that various expressions behave the same when interpreted and +byte-compiled. Run with dynamic binding." + (let ((lexical-binding nil)) + (dolist (form bytecomp-tests--test-cases) + (ert-info ((prin1-to-string form) :prefix "form: ") + (should (equal (bytecomp-tests--eval-interpreted form) + (bytecomp-tests--eval-compiled form))))))) (defun test-byte-comp-compile-and-load (compile &rest forms) (declare (indent 1)) @@ -813,47 +798,6 @@ Subtests signal errors if something goes wrong." (defun def () (m)))) (should (equal (funcall 'def) 4))) -(defconst bytecomp-lexbind-tests - `( - (let ((f #'car)) - (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) - (funcall f '(1 . 2)))) - ) - "List of expression for test. -Each element will be executed by interpreter and with -bytecompiled code, and their results compared.") - -(defun bytecomp-lexbind-check-1 (pat) - "Return non-nil if PAT is the same whether directly evalled or compiled." - (let ((warning-minimum-log-level :emergency) - (byte-compile-warnings nil) - (v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile `(lambda nil ,pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (equal v0 v1))) - -(put 'bytecomp-lexbind-check-1 'ert-explainer 'bytecomp-lexbind-explain-1) - -(defun bytecomp-lexbind-explain-1 (pat) - (let ((v0 (condition-case err - (eval pat t) - (error (list 'bytecomp-check-error (car err))))) - (v1 (condition-case err - (funcall (let ((lexical-binding t)) - (byte-compile (list 'lambda nil pat)))) - (error (list 'bytecomp-check-error (car err)))))) - (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." - pat v0 v1))) - -(ert-deftest bytecomp-lexbind-tests () - "Test the Emacs byte compiler lexbind handling." - (dolist (pat bytecomp-lexbind-tests) - (should (bytecomp-lexbind-check-1 pat)))) - (defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) (declare (indent 1)) (cl-check-type file-name-var symbol) From b7a7e879d02570cbf74aa87686b6b0ed4e6b0c3b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 9 Apr 2021 18:49:16 +0200 Subject: [PATCH 047/128] Better compiler warning tests These changes allow all bytecomp-tests to be run interactively. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp--with-warning-test) (bytecomp--define-warning-file-test): Interpret any space in the pattern as arbitrary whitespace to tolerate line breaks. Don't abuse the expected-failure mechanism when checking for the expected absense of a warning. (bytecomp/*.el): Rewrite patterns to work with line breaks in the middle. --- test/lisp/emacs-lisp/bytecomp-tests.el | 49 +++++++++++++------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index b1377e59f77..1953878d6f5 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -569,8 +569,8 @@ byte-compiled. Run with dynamic binding." `(with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile ,@form) - (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning))))) + (ert-info ((prin1-to-string (buffer-string)) :prefix "buffer: ") + (should (re-search-forward ,(string-replace " " "[ \n]+" re-warning)))))) (ert-deftest bytecomp-warn-wrong-args () (bytecomp--with-warning-test "remq.*3.*2" @@ -596,12 +596,13 @@ byte-compiled. Run with dynamic binding." (defmacro bytecomp--define-warning-file-test (file re-warning &optional reverse) `(ert-deftest ,(intern (format "bytecomp/%s" file)) () - :expected-result ,(if reverse :failed :passed) (with-current-buffer (get-buffer-create "*Compile-Log*") (let ((inhibit-read-only t)) (erase-buffer)) (byte-compile-file ,(ert-resource-file file)) (ert-info ((buffer-string) :prefix "buffer: ") - (should (re-search-forward ,re-warning)))))) + (,(if reverse 'should-not 'should) + (re-search-forward ,(string-replace " " "[ \n]+" re-warning) + nil t)))))) (bytecomp--define-warning-file-test "error-lexical-var-with-add-hook.el" "add-hook.*lexical var") @@ -643,10 +644,10 @@ byte-compiled. Run with dynamic binding." "free.*foo") (bytecomp--define-warning-file-test "warn-free-variable-reference.el" - "free.*bar") + "free variable .bar") (bytecomp--define-warning-file-test "warn-make-variable-buffer-local.el" - "make-variable-buffer-local.*not called at toplevel") + "make-variable-buffer-local. not called at toplevel") (bytecomp--define-warning-file-test "warn-interactive-only.el" "next-line.*interactive use only.*forward-line") @@ -655,19 +656,19 @@ byte-compiled. Run with dynamic binding." "malformed interactive spec") (bytecomp--define-warning-file-test "warn-obsolete-defun.el" - "foo-obsolete.*obsolete function.*99.99") + "foo-obsolete. is an obsolete function (as of 99.99)") (defvar bytecomp--tests-obsolete-var nil) (make-obsolete-variable 'bytecomp--tests-obsolete-var nil "99.99") (bytecomp--define-warning-file-test "warn-obsolete-hook.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-same-file.el" "foo-obs.*obsolete.*99.99" t) (bytecomp--define-warning-file-test "warn-obsolete-variable.el" - "bytecomp--tests-obs.*obsolete[^z-a]*99.99") + "bytecomp--tests-obsolete-var. is an obsolete variable (as of 99.99)") (bytecomp--define-warning-file-test "warn-obsolete-variable-bound.el" "bytecomp--tests-obs.*obsolete.*99.99" t) @@ -698,64 +699,64 @@ byte-compiled. Run with dynamic binding." (bytecomp--define-warning-file-test "warn-wide-docstring-autoload.el" - "autoload.*foox.*wider than.*characters") + "autoload .foox. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-custom-declare-variable.el" - "custom-declare-variable.*foo.*wider than.*characters") + "custom-declare-variable .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defalias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defconst.el" - "defconst.*foo.*wider than.*characters") + "defconst .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-abbrev-table.el" - "define-abbrev.*foo.*wider than.*characters") + "define-abbrev-table .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-function-alias.el" - "defalias.*foo.*wider than.*characters") + "defalias .foo. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-define-obsolete-variable-alias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo. docstring wider than .* characters") ;; TODO: We don't yet issue warnings for defuns. (bytecomp--define-warning-file-test "warn-wide-docstring-defun.el" - "wider than.*characters" 'reverse) + "wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-defvar.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-defvaralias.el" - "defvaralias.*foo.*wider than.*characters") + "defvaralias .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-fill-column.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore-override.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-ignore.el" - "defvar.*foo.*wider than.*characters" 'reverse) + "defvar .foo-bar. docstring wider than .* characters" 'reverse) (bytecomp--define-warning-file-test "warn-wide-docstring-multiline-first.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "warn-wide-docstring-multiline.el" - "defvar.*foo.*wider than.*characters") + "defvar .foo-bar. docstring wider than .* characters") (bytecomp--define-warning-file-test "nowarn-inline-after-defvar.el" From 59342f689eaa4839b0fc15351ae48b4f1074a6fc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 9 Apr 2021 18:59:09 +0200 Subject: [PATCH 048/128] Fix condition-case optimiser bug * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't perform incorrect optimisations when a condition-case variable shadows another lexical variable. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): New test case. --- lisp/emacs-lisp/byte-opt.el | 10 ++++++++-- test/lisp/emacs-lisp/bytecomp-tests.el | 6 ++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index db8d825cfec..e5265375314 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -528,8 +528,14 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") `(condition-case ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) - `(,(car clause) - ,@(byte-optimize-body (cdr clause) for-effect))) + (let ((byte-optimize--lexvars + (and lexical-binding + (if var + (cons (list var t) + byte-optimize--lexvars) + byte-optimize--lexvars)))) + (cons (car clause) + (byte-optimize-body (cdr clause) for-effect)))) clauses)))) (`(unwind-protect ,exp . ,exps) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 1953878d6f5..94e33a7770e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -431,6 +431,12 @@ (let ((x 2)) (list (or (bytecomp-test-identity 'a) (setq x 3)) x)) + + (let* ((x 1) + (y (condition-case x + (/ 1 0) + (arith-error x)))) + (list x y)) ) "List of expressions for cross-testing interpreted and compiled code.") From f493a9bef46dc48f7282e296996186d6d8f77684 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Fri, 9 Apr 2021 20:52:49 +0000 Subject: [PATCH 049/128] CC Mode: fix c-where-wrt-brace-construct to cope with class declarations Make the function correctly recognize a brace block preceded by an introductory line without a parameter list. * lisp/progmodes/cc-cmds.el (c-where-wrt-brace-contruct): Reintroduce the use of c-beginning-of-decl-1, which was removed some weeks ago, in place of a c-syntactic-skip-backward. Reformulate the code generally. --- lisp/progmodes/cc-cmds.el | 47 ++++++++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 1754436d132..c8949448271 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1639,7 +1639,8 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (knr-start knr-res + (let* (kluge-start + knr-start knr-res decl-result brace-decl-p (start (point)) (paren-state (c-parse-state)) @@ -1670,12 +1671,20 @@ No indentation or other \"electric\" behavior is performed." (not (looking-at c-defun-type-name-decl-key)))))) 'at-function-end) (t + ;; Kluge so that c-beginning-of-decl-1 won't go back if we're already + ;; at a declaration. + (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" + (not (c-looking-at-non-alphnumspace))) + (forward-char)) + (setq kluge-start (point)) + (if (and least-enclosing (eq (char-after least-enclosing) ?\()) (c-go-list-forward least-enclosing)) (c-forward-syntactic-ws) (setq knr-start (point)) - (if (c-syntactic-re-search-forward "{" nil t t) + (if (and (c-syntactic-re-search-forward "[;{]" nil t t) + (eq (char-before) ?\{)) (progn (backward-char) (cond @@ -1689,19 +1698,27 @@ No indentation or other \"electric\" behavior is performed." ((and knr-res (goto-char knr-res) (c-backward-syntactic-ws))) ; Always returns nil. - ((and (eq (char-before) ?\)) - (c-go-list-backward)) - (c-syntactic-skip-backward "^;" start t) - (if (eq (point) start) - (if (progn (c-backward-syntactic-ws) - (memq (char-before) '(?\; ?} nil))) - (if (progn (c-forward-syntactic-ws) - (eq (point) start)) - 'at-header - 'outwith-function) - 'in-header) - 'outwith-function)) - (t 'outwith-function))) + (t + (when (eq (char-before) ?\)) + ;; The `c-go-list-backward' is a precaution against + ;; `c-beginning-of-decl-1' spuriously finding a C++ lambda + ;; function inside the parentheses. + (c-go-list-backward)) + (setq decl-result + (car (c-beginning-of-decl-1 + (and least-enclosing + (c-safe-position + least-enclosing paren-state))))) + (cond + ((> (point) start) + 'outwith-function) + ((eq decl-result 'same) + (if (eq (point) start) + 'at-header + 'in-header)) + (t (error + "c-where-wrt-brace-construct: c-beginning-of-decl-1 returned %s" + decl-result)))))) 'outwith-function)))))) (defun c-backward-to-nth-BOF-{ (n where) From 0db2126d7176b0bd1b13d4b0d1cd958c8cf55714 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 10 Apr 2021 01:51:39 +0300 Subject: [PATCH 050/128] Don't stop when before space or closing paren * lisp/progmodes/elisp-mode.el (elisp-completion-at-point): Don't stop when before space or closing paren (bug#47665). --- lisp/progmodes/elisp-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 8ade718640c..203712f45db 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -496,7 +496,7 @@ functions are annotated with \"\" via the (end (unless (or (eq beg (point-max)) (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) + '(?\" ?\())) (condition-case nil (save-excursion (goto-char beg) From c50b5907e0113f7dbb2cc501c54dc365fd01a12b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 10 Apr 2021 11:19:26 +0100 Subject: [PATCH 051/128] Fail earlier if stale Flymake report functions called If a Flymake backend calls a "stale" report function, flymake--handle-report might be called for a backend function that is no longer in the flymake--backend-state hash table. This patch makes that erroneous situation slightly more explicit. * lisp/progmodes/flymake.el (flymake--handle-report): Improve error reporting. --- lisp/progmodes/flymake.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 8481a27775f..e10602ab081 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -741,7 +741,10 @@ to handle a report even if TOKEN was not expected. REGION is a (BEG . END) pair of buffer positions indicating that this report applies to that region." (let* ((state (gethash backend flymake--backend-state)) - (first-report (not (flymake--backend-state-reported-p state)))) + first-report) + (unless state + (error "Can't find state for %s in `flymake--backend-state'" backend)) + (setf first-report (not (flymake--backend-state-reported-p state))) (setf (flymake--backend-state-reported-p state) t) (let (expected-token new-diags) From c975258abf346fcc0186892b84ae32ebce8b70d2 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Sat, 10 Apr 2021 13:16:13 +0200 Subject: [PATCH 052/128] Further fix of hostname completion on MS Windows * lisp/net/tramp.el (tramp-completion-file-name-regexp-simplified) (tramp-completion-file-name-regexp-separate): Fix W32 hostname/method completion for simplified and separate syntaxes (same as the previous change to default syntax). Copyright-paperwork-exempt: yes --- lisp/net/tramp.el | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e61c3b1e44c..578fa148a24 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1103,7 +1103,13 @@ On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-simplified (concat - "\\`/\\(" + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(" ;; Optional multi hop. "\\([^/|:]*|\\)*" ;; Last hop. @@ -1119,7 +1125,14 @@ See `tramp-file-name-structure' for more explanations. On W32 systems, the volume letter must be ignored.") (defconst tramp-completion-file-name-regexp-separate - "\\`/\\(\\[[^]]*\\)?\\'" + (concat + "\\`" + ;; Allow the volume letter at the beginning of the path. See the + ;; comment in `tramp-completion-file-name-regexp-default' for more + ;; details. + (when (eq system-type 'windows-nt) + "\\(?:[[:alpha:]]:\\)?") + "/\\(\\[[^]]*\\)?\\'") "Value for `tramp-completion-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") From ca1ddef2627e2d71539467c9042f78d9d560ea9d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 10 Apr 2021 14:46:58 +0200 Subject: [PATCH 053/128] Tramp: fix location of files on W32 * lisp/net/tramp.el: * lisp/net/tramp-sh.el: Use (eq system-type 'windows-nt) where appropriate. (tramp-completion-function-alist-ssh): Fix location of files on W32. --- lisp/net/tramp-sh.el | 34 ++++++++++++++++++++++++++-------- lisp/net/tramp.el | 8 ++++---- 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 8db9dd9d822..0e6a2bb04af 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -401,16 +401,34 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-ssh - '((tramp-parse-rhosts "/etc/hosts.equiv") + `((tramp-parse-rhosts "/etc/hosts.equiv") (tramp-parse-rhosts "/etc/shosts.equiv") - (tramp-parse-shosts "/etc/ssh_known_hosts") - (tramp-parse-sconfig "/etc/ssh_config") + ;; On W32 systems, the ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + "ssh/ssh_known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) + (tramp-parse-sconfig ,(expand-file-name + "ssh/ssh_config" + (or (and (eq system-type 'windows-nt) + (getenv "ProgramData")) + "/etc/"))) (tramp-parse-shostkeys "/etc/ssh2/hostkeys") (tramp-parse-sknownhosts "/etc/ssh2/knownhosts") (tramp-parse-rhosts "~/.rhosts") (tramp-parse-rhosts "~/.shosts") - (tramp-parse-shosts "~/.ssh/known_hosts") - (tramp-parse-sconfig "~/.ssh/config") + ;; On W32 systems, the .ssh directory is located somewhere else. + (tramp-parse-shosts ,(expand-file-name + ".ssh/known_hosts" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) + (tramp-parse-sconfig ,(expand-file-name + ".ssh/config" + (or (and (eq system-type 'windows-nt) + (getenv "USERPROFILE")) + "~/"))) (tramp-parse-shostkeys "~/.ssh2/hostkeys") (tramp-parse-sknownhosts "~/.ssh2/knownhosts")) "Default list of (FUNCTION FILE) pairs to be examined for ssh methods.") @@ -433,7 +451,7 @@ The string is used in `tramp-methods'.") ;;;###tramp-autoload (defconst tramp-completion-function-alist-putty `((tramp-parse-putty - ,(if (memq system-type '(windows-nt)) + ,(if (eq system-type 'windows-nt) "HKEY_CURRENT_USER\\Software\\SimonTatham\\PuTTY\\Sessions" "~/.putty/sessions"))) "Default list of (FUNCTION REGISTRY) pairs to be examined for putty sessions.") @@ -5764,7 +5782,7 @@ function cell is returned to be applied on a buffer." ;; slashes as directory separators. (cond ((and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s | \"%s\")") ((string-match-p "local" prop) "(%s | %s)") (t "(%s | %s >%%s)")) @@ -5775,7 +5793,7 @@ function cell is returned to be applied on a buffer." ;; the pipe symbol be quoted if they use forward ;; slashes as directory separators. (if (and (string-match-p "local" prop) - (memq system-type '(windows-nt))) + (eq system-type 'windows-nt)) "(%s <%%s | \"%s\")" "(%s <%%s | %s)") compress coding)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 578fa148a24..8da94ec9d9e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -488,7 +488,7 @@ interpreted as a regular expression which always matches." ;; either lower case or upper case letters. See ;; . (defcustom tramp-restricted-shell-hosts-alist - (when (memq system-type '(windows-nt)) + (when (eq system-type 'windows-nt) (list (format "\\`\\(%s\\|%s\\)\\'" (regexp-quote (downcase tramp-system-name)) (regexp-quote (upcase tramp-system-name))))) @@ -558,7 +558,7 @@ usually suffice.") the remote shell.") (defcustom tramp-local-end-of-line - (if (memq system-type '(windows-nt)) "\r\n" "\n") + (if (eq system-type 'windows-nt) "\r\n" "\n") "String used for end of line in local processes." :version "24.1" :type 'string) @@ -3138,7 +3138,7 @@ User may be nil." (defun tramp-parse-putty (registry-or-dirname) "Return a list of (user host) tuples allowed to access. User is always nil." - (if (memq system-type '(windows-nt)) + (if (eq system-type 'windows-nt) (with-tramp-connection-property nil "parse-putty" (with-temp-buffer (when (zerop (tramp-call-process @@ -4990,7 +4990,7 @@ VEC is used for tracing." (let ((candidates '("en_US.utf8" "C.utf8" "en_US.UTF-8")) locale) (with-temp-buffer - (unless (or (memq system-type '(windows-nt)) + (unless (or (eq system-type 'windows-nt) (not (zerop (tramp-call-process nil "locale" nil t nil "-a")))) (while candidates From 84c1940d42d2b25fa5e2f88d93780a3ffc4d041e Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 10 Apr 2021 12:35:06 +0000 Subject: [PATCH 054/128] Autoload list-colors-display. * lisp/facemenu.el (list-colors-display): Autoload, it is mentioned in (info "(emacs)Colors for Faces"), and to be generally available. --- lisp/facemenu.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 2d06658b55c..8db1b42db44 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -539,6 +539,7 @@ filter out the color from the output." This is installed as a `revert-buffer-function' in the *Colors* buffer." (list-colors-display nil (buffer-name) list-colors-callback)) +;;;###autoload (defun list-colors-display (&optional list buffer-name callback) "Display names of defined colors, and show what they look like. If the optional argument LIST is non-nil, it should be a list of From 649e5c26edc89373778016898652faaaf9a7275c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 09:52:09 -0400 Subject: [PATCH 055/128] * lisp/ps-mule.el: Use lexical-binding (ps-mule-encode-header-string, ps-mule-begin-job): Use `pcase`. --- lisp/ps-mule.el | 46 +++++++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index db86f9400e7..a8b5210e965 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -1,4 +1,4 @@ -;;; ps-mule.el --- provide multi-byte character facility to ps-print +;;; ps-mule.el --- provide multi-byte character facility to ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. @@ -612,7 +612,7 @@ f2, f3, h0, h1, and H0 respectively." (push (/ code 256) code-list) (push (% code 256) code-list)))) (forward-char 1))) - (apply 'unibyte-string (nreverse code-list)))) + (apply #'unibyte-string (nreverse code-list)))) (defun ps-mule-plot-composition (composition font-spec-table) "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE." @@ -1041,10 +1041,11 @@ Any other value is treated as \"/H0\"." (list (ps-mule-encode-region (point-min) (point-max) (aref ps-mule-font-spec-tables (aref ps-mule-font-number-to-type - (cond ((string= fonttag "/h0") 4) - ((string= fonttag "/h1") 5) - ((string= fonttag "/L0") 6) - (t 0)))))))) + (pcase fonttag + ("/h0" 4) + ("/h1" 5) + ("/L0" 6) + (_ 0)))))))) ;;;###autoload (defun ps-mule-begin-job (from to) @@ -1055,20 +1056,17 @@ It checks if all multi-byte characters in the region are printable or not." (goto-char from) (= (skip-chars-forward "\x00-\x7F" to) to))) ;; All characters can be printed by normal PostScript fonts. - (setq ps-basic-plot-string-function 'ps-basic-plot-string + (setq ps-basic-plot-string-function #'ps-basic-plot-string ;; FIXME: Doesn't ps-encode-header-string-function take 2 args? - ps-encode-header-string-function 'identity) - (setq ps-basic-plot-string-function 'ps-mule-plot-string - ps-encode-header-string-function 'ps-mule-encode-header-string + ps-encode-header-string-function #'identity) + (setq ps-basic-plot-string-function #'ps-mule-plot-string + ps-encode-header-string-function #'ps-mule-encode-header-string ps-mule-font-info-database - (cond ((eq ps-multibyte-buffer 'non-latin-printer) - ps-mule-font-info-database-ps) - ((eq ps-multibyte-buffer 'bdf-font) - ps-mule-font-info-database-bdf) - ((eq ps-multibyte-buffer 'bdf-font-except-latin) - ps-mule-font-info-database-ps-bdf) - (t - ps-mule-font-info-database-default))) + (pcase ps-multibyte-buffer + ('non-latin-printer ps-mule-font-info-database-ps) + ('bdf-font ps-mule-font-info-database-bdf) + ('bdf-font-except-latin ps-mule-font-info-database-ps-bdf) + (_ ps-mule-font-info-database-default))) ;; Be sure to have font information for Latin-1. (or (assq 'iso-8859-1 ps-mule-font-info-database) @@ -1112,10 +1110,12 @@ It checks if all multi-byte characters in the region are printable or not." id-max (1+ id-max)) (if (ps-mule-check-font font-spec) (aset font-spec-vec - (cond ((eq (car e) 'normal) 0) - ((eq (car e) 'bold) 1) - ((eq (car e) 'italic) 2) - (t 3)) font-spec))) + (pcase (car e) + ('normal 0) + ('bold 1) + ('italic 2) + (_ 3)) + font-spec))) (when (aref font-spec-vec 0) (or (aref font-spec-vec 3) (aset font-spec-vec 3 (or (aref font-spec-vec 1) @@ -1182,7 +1182,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n" (let ((output-head (list t)) (ps-mule-output-list (list t))) (dotimes (i 4) - (map-char-table 'ps-mule-prepare-glyph + (map-char-table #'ps-mule-prepare-glyph (aref ps-mule-font-spec-tables i))) (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head) (ps-output-prologue (cdr output-head))) From 3c051db646b34995c144327ed462a92ffbb41f86 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 12:08:36 -0400 Subject: [PATCH 056/128] * lisp/files-x.el: Use lexical-binding --- lisp/files-x.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/files-x.el b/lisp/files-x.el index 23e4562f4b1..9e1954256a6 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -1,4 +1,4 @@ -;;; files-x.el --- extended file handling commands +;;; files-x.el --- extended file handling commands -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2021 Free Software Foundation, Inc. @@ -602,7 +602,7 @@ PROFILES is a list of connection profiles (symbols).") "Normalize plist CRITERIA according to properties. Return a reordered plist." (apply - 'append + #'append (mapcar (lambda (property) (when (and (plist-member criteria property) (plist-get criteria property)) From 6b81f7c1ddd3c00ad74a82584a3bc2c3743eddd5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 12:18:22 -0400 Subject: [PATCH 057/128] * lisp/edmacro.el: Use lexical-binding (edmacro-finish-edit, edmacro-parse-keys): Use `match-string`. --- lisp/edmacro.el | 36 +++++++++++++++--------------------- 1 file changed, 15 insertions(+), 21 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 3d7db44a86d..84de69a2ce1 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -1,4 +1,4 @@ -;;; edmacro.el --- keyboard macro editor +;;; edmacro.el --- keyboard macro editor -*- lexical-binding: t; -*- ;; Copyright (C) 1993-1994, 2001-2021 Free Software Foundation, Inc. @@ -74,8 +74,8 @@ Default nil means to write characters above \\177 in octal notation." (defvar edmacro-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'edmacro-finish-edit) - (define-key map "\C-c\C-q" 'edmacro-insert-key) + (define-key map "\C-c\C-c" #'edmacro-finish-edit) + (define-key map "\C-c\C-q" #'edmacro-insert-key) map)) (defvar edmacro-store-hook) @@ -177,8 +177,8 @@ With a prefix argument, format the macro in a more concise way." (set-buffer-modified-p nil)) (run-hooks 'edmacro-format-hook))))) -;;; The next two commands are provided for convenience and backward -;;; compatibility. +;; The next two commands are provided for convenience and backward +;; compatibility. ;;;###autoload (defun edit-last-kbd-macro (&optional prefix) @@ -237,8 +237,7 @@ or nil, use a compact 80-column format." ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Command\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq cmd (and (not (equal str "none")) (intern str))) @@ -253,8 +252,7 @@ or nil, use a compact 80-column format." (when edmacro-store-hook (error "\"Key\" line not allowed in this context")) (let ((key (edmacro-parse-keys - (buffer-substring (match-beginning 1) - (match-end 1))))) + (match-string 1)))) (unless (equal key "") (if (equal key "none") (setq no-keys t) @@ -274,16 +272,14 @@ or nil, use a compact 80-column format." ((looking-at "Counter:[ \t]*\\([^ \t\n]*\\)[ \t]*$") (when edmacro-store-hook (error "\"Counter\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-counter (string-to-number str)))) t) ((looking-at "Format:[ \t]*\"\\([^\n]*\\)\"[ \t]*$") (when edmacro-store-hook (error "\"Format\" line not allowed in this context")) - (let ((str (buffer-substring (match-beginning 1) - (match-end 1)))) + (let ((str (match-string 1))) (unless (equal str "") (setq mac-format str))) t) @@ -475,7 +471,7 @@ doubt, use whitespace." (and (not (memq (aref rest-mac i) pkeys)) (prog1 (vconcat "C-u " (cl-subseq rest-mac 1 i) " ") (cl-callf cl-subseq rest-mac i))))))) - (bind-len (apply 'max 1 + (bind-len (apply #'max 1 (cl-loop for map in maps for b = (lookup-key map rest-mac) when b collect b))) @@ -506,7 +502,7 @@ doubt, use whitespace." finally return i)) desc) (if (stringp bind) (setq bind nil)) - (cond ((and (eq bind 'self-insert-command) (not prefix) + (cond ((and (eq bind #'self-insert-command) (not prefix) (> text 1) (integerp first) (> first 32) (<= first maxkey) (/= first 92) (progn @@ -520,11 +516,11 @@ doubt, use whitespace." desc)))) (when (or (string-match "^\\^.$" desc) (member desc res-words)) - (setq desc (mapconcat 'char-to-string desc " "))) + (setq desc (mapconcat #'char-to-string desc " "))) (when verbose (setq bind (format "%s * %d" bind text))) (setq bind-len text)) - ((and (eq bind 'execute-extended-command) + ((and (eq bind #'execute-extended-command) (> text bind-len) (memq (aref rest-mac text) '(return 13)) (progn @@ -667,10 +663,8 @@ This function assumes that the events can be stored in a string." (substring word 2 -2) "\r"))) ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word) (progn - (setq word (concat (substring word (match-beginning 1) - (match-end 1)) - (substring word (match-beginning 3) - (match-end 3)))) + (setq word (concat (match-string 1 word) + (match-string 3 word))) (not (string-match "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$" word)))) From b72571ca49dd16be174f02ed14b460c136c9aaf2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 12:19:16 -0400 Subject: [PATCH 058/128] * lisp/gnus/nnagent.el: Fix spurious empty line at BOB --- lisp/gnus/nnagent.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 56ca2e14b6f..76a7e21567a 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -1,4 +1,3 @@ - ;;; nnagent.el --- offline backend for Gnus -*- lexical-binding: t; -*- ;; Copyright (C) 1997-2021 Free Software Foundation, Inc. From 53dfd85a7f971875e716a55f010ee508bce89eed Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 18 Mar 2021 12:40:08 +0100 Subject: [PATCH 059/128] Edebug: Disable backtracking when hitting a &define keyword. Edebug doesn't deal well with backtracking out of definitions, see Bug#41988. Rather than trying to support this rare situation (e.g. by implementing a multipass parser), prevent it by adding an implicit gate. * lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op): Disable backtracking when hitting a &define keyword. * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-duplicate-&define): New unit test. (edebug-tests--duplicate-&define): New helper macro. * doc/lispref/edebug.texi (Backtracking): Mention &define in the list of constructs that disable backtracking. * etc/NEWS: Document new behavior. --- doc/lispref/edebug.texi | 10 +++++----- etc/NEWS | 3 +++ lisp/emacs-lisp/edebug.el | 18 ++++++++++-------- test/lisp/emacs-lisp/edebug-tests.el | 25 +++++++++++++++++++++++++ 4 files changed, 43 insertions(+), 13 deletions(-) diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index 8942f55affb..323130f2378 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1510,11 +1510,11 @@ form specifications (that is, @code{form}, @code{body}, @code{def-form}, and must be in the form itself rather than at a higher level. Backtracking is also disabled after successfully matching a quoted -symbol or string specification, since this usually indicates a -recognized construct. But if you have a set of alternative constructs that -all begin with the same symbol, you can usually work around this -constraint by factoring the symbol out of the alternatives, e.g., -@code{["foo" &or [first case] [second case] ...]}. +symbol, string specification, or @code{&define} keyword, since this +usually indicates a recognized construct. But if you have a set of +alternative constructs that all begin with the same symbol, you can +usually work around this constraint by factoring the symbol out of the +alternatives, e.g., @code{["foo" &or [first case] [second case] ...]}. Most needs are satisfied by these two ways that backtracking is automatically disabled, but occasionally it is useful to explicitly diff --git a/etc/NEWS b/etc/NEWS index a0f05d8cf15..9ae37404823 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2524,6 +2524,9 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', ** The 'values' variable is now obsolete. +** The '&define' keyword in an Edebug specification now disables +backtracking. + * Lisp Changes in Emacs 28.1 diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index f1455ffe73b..365bc748741 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1942,14 +1942,16 @@ a sequence of elements." ;; Normally, &define is interpreted specially other places. ;; This should only be called inside of a spec list to match the remainder ;; of the current list. e.g. ("lambda" &define args def-body) - (edebug-make-form-wrapper - cursor - (edebug-before-offset cursor) - ;; Find the last offset in the list. - (let ((offsets (edebug-cursor-offsets cursor))) - (while (consp offsets) (setq offsets (cdr offsets))) - offsets) - specs)) + (prog1 (edebug-make-form-wrapper + cursor + (edebug-before-offset cursor) + ;; Find the last offset in the list. + (let ((offsets (edebug-cursor-offsets cursor))) + (while (consp offsets) (setq offsets (cdr offsets))) + offsets) + specs) + ;; Stop backtracking here (Bug#41988). + (setq edebug-gate t))) (cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs) "Compute the name for `&name SPEC FUN` spec operator. diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index dcb261c2eb9..7d45432e57e 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -1061,5 +1061,30 @@ backtracking (Bug#42701)." "edebug-anon10001" "edebug-tests-duplicate-symbol-backtrack")))))) +(defmacro edebug-tests--duplicate-&define (_arg) + "Helper macro for the ERT test `edebug-tests-duplicate-&define'. +The Edebug specification is similar to the one used by `cl-flet' +previously; see Bug#41988." + (declare (debug (&or (&define name function-form) (defun))))) + +(ert-deftest edebug-tests-duplicate-&define () + "Check that Edebug doesn't backtrack out of `&define' forms. +This avoids potential duplicate definitions (Bug#41988)." + (with-temp-buffer + (print '(defun edebug-tests-duplicate-&define () + (edebug-tests--duplicate-&define + (edebug-tests-duplicate-&define-inner () nil))) + (current-buffer)) + (let* ((edebug-all-defs t) + (edebug-initial-mode 'Go-nonstop) + (instrumented-names ()) + (edebug-new-definition-function + (lambda (name) + (when (memq name instrumented-names) + (error "Duplicate definition of `%s'" name)) + (push name instrumented-names) + (edebug-new-definition name)))) + (should-error (eval-buffer) :type 'invalid-read-syntax)))) + (provide 'edebug-tests) ;;; edebug-tests.el ends here From be8328acf9aa464f848e682e63e417a18529af9e Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 14 Dec 2020 21:25:11 +0100 Subject: [PATCH 060/128] Add support for --seccomp command-line option. When passing this option on GNU/Linux, Emacs installs a Secure Computing kernel system call filter. See Bug#45198. * configure.ac: Check for seccomp header. * src/emacs.c (usage_message): Document --seccomp option. (emacs_seccomp): New wrapper for 'seccomp' syscall. (load_seccomp, maybe_load_seccomp): New helper functions. (main): Potentially load seccomp filters during startup. (standard_args): Add --seccomp option. * lisp/startup.el (command-line): Detect and ignore --seccomp option. * test/src/emacs-tests.el (emacs-tests/seccomp/absent-file) (emacs-tests/seccomp/empty-file) (emacs-tests/seccomp/file-too-large) (emacs-tests/seccomp/invalid-file-size): New unit tests. (emacs-tests--with-temp-file): New helper macro. * etc/NEWS: Document new --seccomp option. --- configure.ac | 5 +- etc/NEWS | 10 +++ lisp/startup.el | 5 +- src/emacs.c | 167 +++++++++++++++++++++++++++++++++++++++- test/src/emacs-tests.el | 131 +++++++++++++++++++++++++++++++ 5 files changed, 314 insertions(+), 4 deletions(-) create mode 100644 test/src/emacs-tests.el diff --git a/configure.ac b/configure.ac index 2c62a9fe6f7..684788a4d33 100644 --- a/configure.ac +++ b/configure.ac @@ -4179,6 +4179,8 @@ fi AC_SUBST([BLESSMAIL_TARGET]) AC_SUBST([LIBS_MAIL]) +AC_CHECK_HEADERS([linux/seccomp.h], [HAVE_SECCOMP=yes]) + OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ @@ -5672,7 +5674,8 @@ optsep= emacs_config_features= for opt in ACL CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTINGS \ HARFBUZZ IMAGEMAGICK JPEG JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 \ - M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SOUND THREADS TIFF \ + M17N_FLT MODULES NOTIFY NS OLDXMENU PDUMPER PNG RSVG SECCOMP SOUND \ + THREADS TIFF \ TOOLKIT_SCROLL_BARS UNEXEC X11 XAW3D XDBE XFT XIM XPM XWIDGETS X_TOOLKIT \ ZLIB; do diff --git a/etc/NEWS b/etc/NEWS index 9ae37404823..0956084fc1a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,6 +90,16 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". +** On GNU/Linux systems, Emacs now supports loading a Secure Computing +filter. To use this, you can pass a --seccomp=FILE command-line +option to Emacs. FILE must name a binary file containing an array of +'struct sock_filter' structures. Emacs will then install that list of +Secure Computing filters into its own process early during the startup +process. You can use this functionality to put an Emacs process in a +sandbox to avoid security issues when executing untrusted code. See +the manual page for 'seccomp' for details about Secure Computing +filters. + * Changes in Emacs 28.1 diff --git a/lisp/startup.el b/lisp/startup.el index b173d619733..4d4c65e6c41 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1097,7 +1097,7 @@ please check its value") ("--no-x-resources") ("--debug-init") ("--user") ("--iconic") ("--icon-type") ("--quick") ("--no-blinking-cursor") ("--basic-display") - ("--dump-file") ("--temacs"))) + ("--dump-file") ("--temacs") ("--seccomp"))) (argi (pop args)) (orig-argi argi) argval) @@ -1149,7 +1149,8 @@ please check its value") (push '(visibility . icon) initial-frame-alist)) ((member argi '("-nbc" "-no-blinking-cursor")) (setq no-blinking-cursor t)) - ((member argi '("-dump-file" "-temacs")) ; Handled in C + ((member argi '("-dump-file" "-temacs" "-seccomp")) + ;; Handled in C (or argval (pop args)) (setq argval nil)) ;; Push the popped arg back on the list of arguments. diff --git a/src/emacs.c b/src/emacs.c index fd08667f3fd..b956e9ca34b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -61,6 +61,13 @@ along with GNU Emacs. If not, see . */ # include #endif +#ifdef HAVE_LINUX_SECCOMP_H +# include +# include +# include +# include +#endif + #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER #endif /* HAVE_WINDOW_SYSTEM */ @@ -240,6 +247,11 @@ Initialization options:\n\ "\ --dump-file FILE read dumped state from FILE\n\ ", +#endif +#ifdef HAVE_LINUX_SECCOMP_H + "\ +--sandbox=FILE read Seccomp BPF filter from FILE\n\ +" #endif "\ --no-build-details do not add build details such as time stamps\n\ @@ -938,6 +950,149 @@ load_pdump (int argc, char **argv) } #endif /* HAVE_PDUMPER */ +#ifdef HAVE_LINUX_SECCOMP_H + +/* Wrapper function for the `seccomp' system call on GNU/Linux. This + system call usually doesn't have a wrapper function. See the + manual page of `seccomp' for the signature. */ + +static int +emacs_seccomp (unsigned int operation, unsigned int flags, void *args) +{ +#ifdef SYS_seccomp + return syscall (SYS_seccomp, operation, flags, args); +#else + errno = ENOSYS; + return -1; +#endif +} + +/* Attempt to load Secure Computing filters from FILE. Return false + if that doesn't work for some reason. */ + +static bool +load_seccomp (const char *file) +{ + bool success = false; + void *buffer = NULL; + int fd + = emacs_open_noquit (file, O_RDONLY | O_CLOEXEC | O_BINARY, 0); + if (fd < 0) + { + emacs_perror ("open"); + goto out; + } + struct stat stat; + if (fstat (fd, &stat) != 0) + { + emacs_perror ("fstat"); + goto out; + } + if (! S_ISREG (stat.st_mode)) + { + fprintf (stderr, "seccomp file %s is not regular\n", file); + goto out; + } + enum + { + /* See MAX_RW_COUNT in sysdep.c. */ +#ifdef MAX_RW_COUNT + max_read_size = MAX_RW_COUNT +#else + max_read_size = INT_MAX >> 18 << 18 +#endif + }; + struct sock_fprog program; + if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size + || PTRDIFF_MAX <= stat.st_size || max_read_size < stat.st_size + || stat.st_size % sizeof *program.filter != 0) + { + fprintf (stderr, "seccomp filter %s has invalid size %ld\n", + file, (long) stat.st_size); + goto out; + } + size_t size = stat.st_size; + size_t count = size / sizeof *program.filter; + eassert (0 < count && count < SIZE_MAX); + if (USHRT_MAX < count) + { + fprintf (stderr, "seccomp filter %s is too big\n", file); + goto out; + } + /* Try reading one more byte to detect file size changes. */ + buffer = malloc (size + 1); + if (buffer == NULL) + { + emacs_perror ("malloc"); + goto out; + } + ptrdiff_t read = emacs_read (fd, buffer, size + 1); + if (read < 0) + { + emacs_perror ("read"); + goto out; + } + if (read != count) + { + fprintf (stderr, + "seccomp filter %s changed size while reading\n", + file); + goto out; + } + if (emacs_close (fd) < 0) + emacs_perror ("close"); /* not a fatal error */ + fd = -1; + program.len = count; + program.filter = buffer; + + /* See man page of `seccomp' why this is necessary. Note that we + intentionally don't check the return value: a parent process + might have made this call before, in which case it would fail; + or, if enabling privilege-restricting mode fails, the `seccomp' + syscall will fail anyway. */ + prctl (PR_SET_NO_NEW_PRIVS, 1, 0, 0, 0); + /* Install the filter. Make sure that potential other threads can't + escape it. */ + if (emacs_seccomp (SECCOMP_SET_MODE_FILTER, + SECCOMP_FILTER_FLAG_TSYNC, &program) + != 0) + { + emacs_perror ("seccomp"); + goto out; + } + success = true; + + out: + if (fd < 0) + emacs_close (fd); + free (buffer); + return success; +} + +/* Load Secure Computing filter from file specified with the --seccomp + option. Exit if that fails. */ + +static void +maybe_load_seccomp (int argc, char **argv) +{ + int skip_args = 0; + char *file = NULL; + while (skip_args < argc - 1) + { + if (argmatch (argv, argc, "-seccomp", "--seccomp", 9, &file, + &skip_args) + || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args)) + break; + ++skip_args; + } + if (file == NULL) + return; + if (! load_seccomp (file)) + fatal ("cannot enable seccomp filter from %s", file); +} + +#endif /* HAVE_LINUX_SECCOMP_H */ + int main (int argc, char **argv) { @@ -945,6 +1100,13 @@ main (int argc, char **argv) for pointers. */ void *stack_bottom_variable; + /* First, check whether we should apply a seccomp filter. This + should come at the very beginning to allow the filter to protect + the initialization phase. */ +#ifdef HAVE_LINUX_SECCOMP_H + maybe_load_seccomp (argc, argv); +#endif + bool no_loadup = false; char *junk = 0; char *dname_arg = 0; @@ -2133,12 +2295,15 @@ static const struct standard_args standard_args[] = { "-color", "--color", 5, 0}, { "-no-splash", "--no-splash", 3, 0 }, { "-no-desktop", "--no-desktop", 3, 0 }, - /* The following two must be just above the file-name args, to get + /* The following three must be just above the file-name args, to get them out of our way, but without mixing them with file names. */ { "-temacs", "--temacs", 1, 1 }, #ifdef HAVE_PDUMPER { "-dump-file", "--dump-file", 1, 1 }, #endif +#ifdef HAVE_LINUX_SECCOMP_H + { "-seccomp", "--seccomp", 1, 1 }, +#endif #ifdef HAVE_NS { "-NSAutoLaunch", 0, 5, 1 }, { "-NXAutoLaunch", 0, 5, 1 }, diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el new file mode 100644 index 00000000000..7618a9c6752 --- /dev/null +++ b/test/src/emacs-tests.el @@ -0,0 +1,131 @@ +;;; emacs-tests.el --- unit tests for emacs.c -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 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: + +;; Unit tests for src/emacs.c. + +;;; Code: + +(require 'cl-lib) +(require 'ert) +(require 'rx) + +(ert-deftest emacs-tests/seccomp/absent-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (should-not (file-exists-p "/does-not-exist.bpf")) + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + "--seccomp=/does-not-exist.bpf") + 0)))) + +(cl-defmacro emacs-tests--with-temp-file + (var (prefix &optional suffix text) &rest body) + "Evaluate BODY while a new temporary file exists. +Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT +to `make-temp-file', which see." + (declare (indent 2) (debug (symbolp (form form form) body))) + (cl-check-type var symbol) + ;; Use an uninterned symbol so that the code still works if BODY + ;; changes VAR. + (let ((filename (make-symbol "filename"))) + `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text))) + (unwind-protect + (let ((,var ,filename)) + ,@body) + (delete-file ,filename))))) + +(ert-deftest emacs-tests/seccomp/empty-file () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; According to the Seccomp man page, a filter must have at + ;; least one element, so Emacs should reject an empty file. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/file-too-large () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil) + ;; This value should be correct on all supported systems. + (ushort-max #xFFFF) + ;; Either 8 or 16, but 16 should be large enough in all cases. + (filter-size 16)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file + filter ("seccomp-too-large-" ".bpf" + (make-string (* (1+ ushort-max) filter-size) ?a)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The filter count must fit into an `unsigned short'. A bigger + ;; file should be rejected. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +(ert-deftest emacs-tests/seccomp/invalid-file-size () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf" + "123456") + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't + ;; work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + ;; The Seccomp filter file must have a file size that's a + ;; multiple of the size of struct sock_filter, which is 8 or 16, + ;; but never 6. + (should-not + (eql (call-process emacs nil nil nil + "--quick" "--batch" + (concat "--seccomp=" filter)) + 0))))) + +;;; emacs-tests.el ends here From 15122b31040f8945d0998510abd52c7735b36bc7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Apr 2021 21:17:09 +0300 Subject: [PATCH 061/128] ; * etc/NEWS: Fix the wording of a recently added entry. --- etc/NEWS | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 0956084fc1a..328c38c1189 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -90,14 +90,15 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". -** On GNU/Linux systems, Emacs now supports loading a Secure Computing -filter. To use this, you can pass a --seccomp=FILE command-line -option to Emacs. FILE must name a binary file containing an array of -'struct sock_filter' structures. Emacs will then install that list of -Secure Computing filters into its own process early during the startup -process. You can use this functionality to put an Emacs process in a -sandbox to avoid security issues when executing untrusted code. See -the manual page for 'seccomp' for details about Secure Computing +** Emacs now supports loading a Secure Computing filter. +This is supported only on capable GNU/Linux systems. To use this, +use the '--seccomp=FILE' command-line option when starting Emacs. +FILE must name a binary file containing an array of 'struct sock_filter' +structures. Emacs will then install that list of Secure Computing +filters into its own process early during the startup process. You +can use this functionality to put an Emacs process in a sandbox to +avoid security issues when executing untrusted code. See the manual +page for 'seccomp' system call, for details about Secure Computing filters. From 8a84f97abed548e4a254a9b855c3f79dac8c3d5d Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 14 Dec 2020 21:25:11 +0100 Subject: [PATCH 062/128] Read file in a loop if necessary. This allows for short reads from 'emacs_read'. * src/emacs.c (read_full): New helper function. (load_seccomp): Use it. --- src/emacs.c | 50 +++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 39 insertions(+), 11 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index b956e9ca34b..8658b1886ed 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -967,6 +967,43 @@ emacs_seccomp (unsigned int operation, unsigned int flags, void *args) #endif } +/* Read SIZE bytes into BUFFER. Return the number of bytes read, or + -1 if reading failed altogether. */ + +static ptrdiff_t +read_full (int fd, void *buffer, ptrdiff_t size) +{ + enum + { + /* See MAX_RW_COUNT in sysdep.c. */ +#ifdef MAX_RW_COUNT + max_size = MAX_RW_COUNT +#else + max_size = INT_MAX >> 18 << 18 +#endif + }; + if (PTRDIFF_MAX < size || max_size < size) + { + errno = EFBIG; + return -1; + } + char *ptr = buffer; + ptrdiff_t read = 0; + while (size != 0) + { + ptrdiff_t n = emacs_read (fd, ptr, size); + if (n < 0) + return -1; + if (n == 0) + break; /* Avoid infinite loop on encountering EOF. */ + eassert (n <= size); + size -= n; + ptr += n; + read += n; + } + return read; +} + /* Attempt to load Secure Computing filters from FILE. Return false if that doesn't work for some reason. */ @@ -993,18 +1030,9 @@ load_seccomp (const char *file) fprintf (stderr, "seccomp file %s is not regular\n", file); goto out; } - enum - { - /* See MAX_RW_COUNT in sysdep.c. */ -#ifdef MAX_RW_COUNT - max_read_size = MAX_RW_COUNT -#else - max_read_size = INT_MAX >> 18 << 18 -#endif - }; struct sock_fprog program; if (stat.st_size <= 0 || SIZE_MAX <= stat.st_size - || PTRDIFF_MAX <= stat.st_size || max_read_size < stat.st_size + || PTRDIFF_MAX <= stat.st_size || stat.st_size % sizeof *program.filter != 0) { fprintf (stderr, "seccomp filter %s has invalid size %ld\n", @@ -1026,7 +1054,7 @@ load_seccomp (const char *file) emacs_perror ("malloc"); goto out; } - ptrdiff_t read = emacs_read (fd, buffer, size + 1); + ptrdiff_t read = read_full (fd, buffer, size + 1); if (read < 0) { emacs_perror ("read"); From 2d17e0124e4232db6344b18cec466eb31920e675 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 10 Apr 2021 20:35:06 +0200 Subject: [PATCH 063/128] * src/emacs.c (load_seccomp): Fix condition. --- src/emacs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index 8658b1886ed..cb1361fe46d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1060,7 +1060,7 @@ load_seccomp (const char *file) emacs_perror ("read"); goto out; } - if (read != count) + if (read != size) { fprintf (stderr, "seccomp filter %s changed size while reading\n", From 1060289f51ee1bf269bb45940892eb272d35af97 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 17 Dec 2020 11:20:55 +0100 Subject: [PATCH 064/128] Add a helper binary to create a basic Secure Computing filter. The binary uses the 'seccomp' helper library. The library isn't needed to load the generated Secure Computing filter. * configure.ac: Check for 'seccomp' header and library. * lib-src/seccomp-filter.c: New helper binary to generate a generic Secure Computing filter for GNU/Linux. * lib-src/Makefile.in (DONT_INSTALL): Add 'seccomp-filter' helper binary if possible. (all): Add Secure Computing filter file if possible. (seccomp-filter$(EXEEXT)): Compile helper binary. (seccomp-filter.bpf seccomp-filter.pfc): Generate filter files. * test/src/emacs-tests.el (emacs-tests/seccomp/allows-stdout) (emacs-tests/seccomp/forbids-subprocess): New unit tests. * test/Makefile.in (src/emacs-tests.log): Add dependency on the helper binary. --- .gitignore | 5 + configure.ac | 5 + lib-src/Makefile.in | 19 ++ lib-src/seccomp-filter.c | 321 ++++++++++++++++++++ test/Makefile.in | 2 + test/src/emacs-resources/seccomp-filter.bpf | 1 + test/src/emacs-tests.el | 49 +++ 7 files changed, 402 insertions(+) create mode 100644 lib-src/seccomp-filter.c create mode 120000 test/src/emacs-resources/seccomp-filter.bpf diff --git a/.gitignore b/.gitignore index b653ef215b9..ecf768dc4d6 100644 --- a/.gitignore +++ b/.gitignore @@ -188,6 +188,7 @@ lib-src/make-docfile lib-src/make-fingerprint lib-src/movemail lib-src/profile +lib-src/seccomp-filter lib-src/test-distrib lib-src/update-game-score nextstep/Cocoa/Emacs.base/Contents/Info.plist @@ -301,3 +302,7 @@ nt/emacs.rc nt/emacsclient.rc src/gdb.ini /var/ + +# Seccomp filter files. +lib-src/seccomp-filter.bpf +lib-src/seccomp-filter.pfc diff --git a/configure.ac b/configure.ac index 684788a4d33..0c4772a2b96 100644 --- a/configure.ac +++ b/configure.ac @@ -4181,6 +4181,11 @@ AC_SUBST([LIBS_MAIL]) AC_CHECK_HEADERS([linux/seccomp.h], [HAVE_SECCOMP=yes]) +LIBSECCOMP= +AC_CHECK_HEADER([seccomp.h], + [AC_CHECK_LIB([seccomp], [seccomp_init], [LIBSECCOMP=-lseccomp])]) +AC_SUBST([LIBSECCOMP]) + OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" AC_CHECK_FUNCS(accept4 fchdir gethostname \ diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 05eb524d19b..1942882004e 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -189,6 +189,12 @@ LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) +LIBSECCOMP=@LIBSECCOMP@ + +ifneq ($(LIBSECCOMP),) +DONT_INSTALL += seccomp-filter$(EXEEXT) +endif + ## Extra libraries to use when linking movemail. LIBS_MOVE = $(LIBS_MAIL) $(KRB4LIB) $(DESLIB) $(KRB5LIB) $(CRYPTOLIB) \ $(COM_ERRLIB) $(LIBHESIOD) $(LIBRESOLV) $(LIB_WSOCK32) $(LIBS_ETAGS) @@ -218,6 +224,10 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} +ifneq ($(LIBSECCOMP),) +all: seccomp-filter.bpf +endif + .PHONY: all need-blessmail maybe-blessmail LOADLIBES = ../lib/libgnu.a $(LIBS_SYSTEM) @@ -400,4 +410,13 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< +ifneq ($(LIBSECCOMP),) +seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) + $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $< $(LIBSECCOMP) -o $@ + +seccomp-filter.bpf seccomp-filter.pfc: seccomp-filter$(EXEEXT) + $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ + seccomp-filter.bpf seccomp-filter.pfc +endif + ## Makefile ends here. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c new file mode 100644 index 00000000000..9918fb025ef --- /dev/null +++ b/lib-src/seccomp-filter.c @@ -0,0 +1,321 @@ +/* Generate a Secure Computing filter definition file. + +Copyright (C) 2020 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 +. */ + +/* This program creates a small Secure Computing filter usable for a +typical minimal Emacs sandbox. See the man page for `seccomp' for +details about Secure Computing filters. This program requires the +`libseccomp' library. However, the resulting filter file requires +only a Linux kernel supporting the Secure Computing extension. + +Usage: + + seccomp-filter out.bpf out.pfc + +This writes the raw `struct sock_filter' array to out.bpf and a +human-readable representation to out.pfc. */ + +#include "config.h" + +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "verify.h" + +static ATTRIBUTE_FORMAT_PRINTF (2, 3) _Noreturn void +fail (int error, const char *format, ...) +{ + va_list ap; + va_start (ap, format); + if (error == 0) + vfprintf (stderr, format, ap); + else + { + char buffer[1000]; + vsnprintf (buffer, sizeof buffer, format, ap); + errno = error; + perror (buffer); + } + va_end (ap); + fflush (NULL); + exit (EXIT_FAILURE); +} + +/* This binary is trivial, so we use a single global filter context + object that we release using `atexit'. */ + +static scmp_filter_ctx ctx; + +static void +release_context (void) +{ + seccomp_release (ctx); +} + +/* Wrapper functions and macros for libseccomp functions. We exit + immediately upon any error to avoid error checking noise. */ + +static void +set_attribute (enum scmp_filter_attr attr, uint32_t value) +{ + int status = seccomp_attr_set (ctx, attr, value); + if (status < 0) + fail (-status, "seccomp_attr_set (ctx, %u, %u)", attr, value); +} + +/* Like `seccomp_rule_add (ACTION, SYSCALL, ...)', except that you + don't have to specify the number of comparator arguments, and any + failure will exit the process. */ + +#define RULE(action, syscall, ...) \ + do \ + { \ + const struct scmp_arg_cmp arg_array[] = {__VA_ARGS__}; \ + enum { arg_cnt = sizeof arg_array / sizeof *arg_array }; \ + int status = seccomp_rule_add_array (ctx, (action), (syscall), \ + arg_cnt, arg_array); \ + if (status < 0) \ + fail (-status, "seccomp_rule_add_array (%s, %s, %d, {%s})", \ + #action, #syscall, arg_cnt, #__VA_ARGS__); \ + } \ + while (false) + +static void +export_filter (const char *file, + int (*function) (const scmp_filter_ctx, int), + const char *name) +{ + int fd = TEMP_FAILURE_RETRY ( + open (file, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | O_CLOEXEC, + 0644)); + if (fd < 0) + fail (errno, "open %s", file); + int status = function (ctx, fd); + if (status < 0) + fail (-status, "%s", name); + if (close (fd) != 0) + fail (errno, "close"); +} + +#define EXPORT_FILTER(file, function) \ + export_filter ((file), (function), #function) + +int +main (int argc, char **argv) +{ + if (argc != 3) + fail (0, "usage: %s out.bpf out.pfc", argv[0]); + + /* Any unhandled syscall should abort the Emacs process. */ + ctx = seccomp_init (SCMP_ACT_KILL_PROCESS); + if (ctx == NULL) + fail (0, "seccomp_init"); + atexit (release_context); + + /* We want to abort immediately if the architecture is unknown. */ + set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS); + set_attribute (SCMP_FLTATR_CTL_NNP, 1); + set_attribute (SCMP_FLTATR_CTL_TSYNC, 1); + set_attribute (SCMP_FLTATR_CTL_LOG, 0); + + verify (CHAR_BIT == 8); + verify (sizeof (int) == 4 && INT_MIN == INT32_MIN + && INT_MAX == INT32_MAX); + verify (sizeof (void *) == 8); + verify ((uintptr_t) NULL == 0); + + /* Allow a clean exit. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (exit_group)); + + /* Allow `mmap' and friends. This is necessary for dynamic loading, + reading the portable dump file, and thread creation. We don't + allow pages to be both writable and executable. */ + verify (MAP_PRIVATE != 0); + verify (MAP_SHARED != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. Also + allow allocating thread stacks. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_FILE | MAP_ANONYMOUS + | MAP_FIXED | MAP_DENYWRITE | MAP_STACK + | MAP_NORESERVE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mmap), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_EXEC)), + /* Only support known flags. MAP_DENYWRITE is ignored, but + some versions of the dynamic loader still use it. */ + SCMP_A3_32 (SCMP_CMP_MASKED_EQ, + ~(MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED + | MAP_DENYWRITE), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (munmap)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (mprotect), + /* Don't allow making pages executable. */ + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(PROT_NONE | PROT_READ | PROT_WRITE), 0)); + + /* Futexes are used everywhere. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex), + SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE)); + + /* Allow basic dynamic memory management. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (brk)); + + /* Allow some status inquiries. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (uname)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp)); + + /* Allow operations on open file descriptors. File descriptors are + capabilities, and operating on them shouldn't cause security + issues. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (read)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (write)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (close)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lseek)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (dup2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstat)); + + /* Allow read operations on the filesystem. If necessary, these + should be further restricted using mount namespaces. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (access)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (faccessat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (stat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (lstat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fstatat64)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (newfstatat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlink)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (readlinkat)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getcwd)); + + /* Allow opening files, assuming they are only opened for + reading. */ + verify (O_WRONLY != 0); + verify (O_RDWR != 0); + verify (O_CREAT != 0); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (open), + SCMP_A1_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat), + SCMP_A2_32 (SCMP_CMP_MASKED_EQ, + ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH + | O_DIRECTORY), + 0)); + + /* Allow `tcgetpgrp'. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (ioctl), + SCMP_A0_32 (SCMP_CMP_EQ, STDIN_FILENO), + SCMP_A1_32 (SCMP_CMP_EQ, TIOCGPGRP)); + + /* Allow reading (but not setting) file flags. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (fcntl64), + SCMP_A1_32 (SCMP_CMP_EQ, F_GETFL)); + + /* Allow reading random numbers from the kernel. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrandom)); + + /* Changing the umask is uncritical. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (umask)); + + /* Allow creation of pipes. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (pipe2)); + + /* Allow reading (but not changing) resource limits. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (getrlimit)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_EQ, 0) /* new_limit == NULL */); + + /* Block changing resource limits, but don't crash. */ + RULE (SCMP_ACT_ERRNO (EPERM), SCMP_SYS (prlimit64), + SCMP_A0_32 (SCMP_CMP_EQ, 0) /* pid == 0 (current process) */, + SCMP_A2_64 (SCMP_CMP_NE, 0) /* new_limit != NULL */); + + /* Emacs installs signal handlers, which is harmless. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigaction)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); + + /* Allow timer support. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); + + /* Allow thread creation. See the NOTES section in the manual page + for the `clone' function. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone), + SCMP_A0_64 (SCMP_CMP_MASKED_EQ, + /* Flags needed to create threads. See + create_thread in libc. */ + ~(CLONE_VM | CLONE_FS | CLONE_FILES + | CLONE_SYSVSEM | CLONE_SIGHAND | CLONE_THREAD + | CLONE_SETTLS | CLONE_PARENT_SETTID + | CLONE_CHILD_CLEARTID), + 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list)); + + /* Allow setting the process name for new threads. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NAME)); + + /* Allow some event handling functions used by glib. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (eventfd2)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (wait4)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (poll)); + + /* Don't allow creating sockets (network access would be extremely + dangerous), but also don't crash. */ + RULE (SCMP_ACT_ERRNO (EACCES), SCMP_SYS (socket)); + + EXPORT_FILTER (argv[1], seccomp_export_bpf); + EXPORT_FILTER (argv[2], seccomp_export_pfc); +} diff --git a/test/Makefile.in b/test/Makefile.in index ba354289e28..91a8ea141c3 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -276,6 +276,8 @@ $(test_module): $(test_module:${SO}=.c) ../src/emacs-module.h $(srcdir)/../lib/timespec.c $(srcdir)/../lib/gettime.c endif +src/emacs-tests.log: ../lib-src/seccomp-filter.c + ## Check that there is no 'automated' subdirectory, which would ## indicate an incomplete merge from an older version of Emacs where ## the tests were arranged differently. diff --git a/test/src/emacs-resources/seccomp-filter.bpf b/test/src/emacs-resources/seccomp-filter.bpf new file mode 120000 index 00000000000..b3d603d0aeb --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter.bpf \ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 7618a9c6752..89d811f8b4e 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -25,7 +25,9 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) (require 'rx) +(require 'subr-x) (ert-deftest emacs-tests/seccomp/absent-file () (skip-unless (string-match-p (rx bow "SECCOMP" eow) @@ -128,4 +130,51 @@ to `make-temp-file', which see." (concat "--seccomp=" filter)) 0))))) +(ert-deftest emacs-tests/seccomp/allows-stdout () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" '(message "Hi"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + +(ert-deftest emacs-tests/seccomp/forbids-subprocess () + (skip-unless (string-match-p (rx bow "SECCOMP" eow) + system-configuration-features)) + (let ((emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter.bpf")) + (process-environment nil)) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + ;; The --seccomp option is processed early, without filename + ;; handlers. Therefore remote or quoted filenames wouldn't work. + (should-not (file-remote-p filter)) + (cl-callf file-name-unquote filter) + (with-temp-buffer + (let ((status + (call-process + emacs nil t nil + "--quick" "--batch" + (concat "--seccomp=" filter) + (format "--eval=%S" `(call-process ,emacs nil nil nil + "--version"))))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should-not (eql status 0))))))) + ;;; emacs-tests.el ends here From 3f5fe0cdfc77b537d2faf148c614d9f8043bf33d Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Sat, 10 Apr 2021 19:18:28 +0000 Subject: [PATCH 065/128] Convert CC Mode to lexical binding in Emacs lisp/progmodes/cc-align.el, lisp/progmodes/cc-awk.el, lisp/progmodes/cc-bytecomp.el, lisp/progmodes/cc-cmds.el, lisp/progmodes/cc-defs.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-fonts.el, lisp/progmodes/cc-guess.el, lisp/progmodes/cc-langs.el, lisp/progmodes/cc-menus.el, lisp/progmodes/cc-mode.el, lisp/progmodes/cc-styles.el, lisp/progmodes/cc-subword.el, lisp/progmodes/cc-vars.el: Mark these files with a `lexical-binding' setting in line 1. lisp/progmodes/cc-align.el, lisp/progmodes/cc-engine.el, lisp/progmodes/cc-vars.el (c-syntactic-context, c-syntactic-element): Declare these as special variables. lisp/progmodes/cc-bytecomp.el (cc-bytecomp-debug-msg): prefix the parameter ARGS with a _, and remove an `ignore' call. lisp/progmodes/cc-cmds.el (c-where-wrt-brace-construct): Remove `kluge-start', an unused variable. (c-while-widening-to-decl-block): Add an extra parameter, which suppresses the generation of a setting of variable `where'. (c-defun-name-and-limits): Remove variable `where' from the function and use the new argument to the previous macro. lisp/progmodes/cc-engine.el (c-cache-to-parse-ps-state): Remove two unneeded variables, `last' and `intermediate'. lisp/progmodes/cc-fonts.el (c-font-lock-c++-using): Remove unused variable. lisp/progmodes/cc-langs.el (c-vsemi-status-unknown-p-fn): Replace the doc string with the more precise one from stand-alone CC Mode. lisp/progmodes/cc-styles.el (c-set-offset): Give the `ignored' parameter a leading _. --- lisp/progmodes/cc-align.el | 5 ++++- lisp/progmodes/cc-awk.el | 2 +- lisp/progmodes/cc-bytecomp.el | 5 ++--- lisp/progmodes/cc-cmds.el | 39 +++++++++++++++++++---------------- lisp/progmodes/cc-defs.el | 2 +- lisp/progmodes/cc-engine.el | 17 ++++++++------- lisp/progmodes/cc-fonts.el | 8 +++---- lisp/progmodes/cc-guess.el | 2 +- lisp/progmodes/cc-langs.el | 16 +++++++------- lisp/progmodes/cc-menus.el | 2 +- lisp/progmodes/cc-mode.el | 2 +- lisp/progmodes/cc-styles.el | 4 ++-- lisp/progmodes/cc-vars.el | 5 ++++- 13 files changed, 58 insertions(+), 51 deletions(-) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 51d51deef71..9234d0b19b9 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -1,4 +1,4 @@ -;;; cc-align.el --- custom indentation functions for CC Mode +;;; cc-align.el --- custom indentation functions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -44,6 +44,9 @@ (cc-require 'cc-vars) (cc-require 'cc-engine) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + ;; Standard line-up functions ;; diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 32289443725..84cc5b115e7 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -1,4 +1,4 @@ -;;; cc-awk.el --- AWK specific code within cc-mode. +;;; cc-awk.el --- AWK specific code within cc-mode. -*- lexical-binding: t -*- ;; Copyright (C) 1988, 1994, 1996, 2000-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 3f7caf3c2e9..29f4b81637d 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -1,4 +1,4 @@ -;;; cc-bytecomp.el --- compile time setup for proper compilation +;;; cc-bytecomp.el --- compile time setup for proper compilation -*- lexical-binding: t -*- ;; Copyright (C) 2000-2021 Free Software Foundation, Inc. @@ -85,8 +85,7 @@ (defvar cc-bytecomp-environment-set nil) -(defmacro cc-bytecomp-debug-msg (&rest args) - (ignore args) +(defmacro cc-bytecomp-debug-msg (&rest _args) ; Change to ARGS when needed. ;;`(message ,@args) ) diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index c8949448271..bee87b68499 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1,4 +1,4 @@ -;;; cc-cmds.el --- user level commands for CC Mode +;;; cc-cmds.el --- user level commands for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -49,12 +49,11 @@ ; which looks at this. (cc-bytecomp-defun electric-pair-post-self-insert-function) (cc-bytecomp-defvar c-indent-to-body-directives) +(defvar c-syntactic-context) ;; Indentation / Display syntax functions (defvar c-fix-backslashes t) -(defvar c-syntactic-context) - (defun c-indent-line (&optional syntax quiet ignore-point-pos) "Indent the current line according to the syntactic context, if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the @@ -1220,9 +1219,9 @@ numeric argument is supplied, or the point is inside a literal." (self-insert-command (prefix-numeric-value arg))) (setq final-pos (point)) -;;;; 2010-01-31: There used to be code here to put a syntax-table text -;;;; property on the new < or > and its mate (if any) when they are template -;;;; parens. This is now done in an after-change function. +;;;; 2010-01-31: There used to be code here to put a syntax-table text +;;;; property on the new < or > and its mate (if any) when they are template +;;;; parens. This is now done in an after-change function. (when (and (not arg) (not literal)) ;; Have we got a delimiter on a #include directive? @@ -1639,9 +1638,8 @@ No indentation or other \"electric\" behavior is performed." ;; ;; This function might do hidden buffer changes. (save-excursion - (let* (kluge-start - knr-start knr-res - decl-result brace-decl-p + (let* (knr-start knr-res + decl-result (start (point)) (paren-state (c-parse-state)) (least-enclosing (c-least-enclosing-brace paren-state))) @@ -1676,7 +1674,6 @@ No indentation or other \"electric\" behavior is performed." (if (or (and (eolp) (not (eobp))) ; EOL is matched by "\\s>" (not (c-looking-at-non-alphnumspace))) (forward-char)) - (setq kluge-start (point)) (if (and least-enclosing (eq (char-after least-enclosing) ?\()) @@ -1827,12 +1824,14 @@ No indentation or other \"electric\" behavior is performed." nil))) (eval-and-compile - (defmacro c-while-widening-to-decl-block (condition) + (defmacro c-while-widening-to-decl-block (condition &optional no-where) ;; Repeatedly evaluate CONDITION until it returns nil. After each ;; evaluation, if `c-defun-tactic' is set appropriately, widen to innards ;; of the next enclosing declaration block (e.g. namespace, class), or the ;; buffer's original restriction. ;; + ;; If NO-WHERE is non-nil, don't compile in a `(setq where ....)'. + ;; ;; This is a very special purpose macro, which assumes the existence of ;; several variables. It is for use only in c-beginning-of-defun and ;; c-end-of-defun. @@ -1843,7 +1842,8 @@ No indentation or other \"electric\" behavior is performed." (setq paren-state (c-whack-state-after lim paren-state)) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) - (setq where 'in-block)))) + ,@(if (not no-where) + `((setq where 'in-block)))))) (def-edebug-spec c-while-widening-to-decl-block t) @@ -2324,11 +2324,11 @@ with a brace block, at the outermost level of nesting." (c-save-buffer-state ((paren-state (c-parse-state)) (orig-point-min (point-min)) (orig-point-max (point-max)) - lim name limits where) + lim name limits) (setq lim (c-widen-to-enclosing-decl-scope paren-state orig-point-min orig-point-max)) (and lim (setq lim (1- lim))) - (c-while-widening-to-decl-block (not (setq name (c-defun-name-1)))) + (c-while-widening-to-decl-block (not (setq name (c-defun-name-1))) t) (when name (setq limits (c-declaration-limits-1 near)) (cons name limits))) @@ -2944,10 +2944,13 @@ function does not require the declaration to contain a brace block." (c-looking-at-special-brace-list))) (or allow-early-stop (/= here last)) (save-excursion ; Is this a check that we're NOT at top level? -;;;; NO! This seems to check that (i) EITHER we're at the top level; OR (ii) The next enclosing -;;;; level of bracketing is a '{'. HMM. Doesn't seem to make sense. -;;;; 2003/8/8 This might have something to do with the GCC extension "Statement Expressions", e.g. -;;;; while ({stmt1 ; stmt2 ; exp ;}). This form excludes such Statement Expressions. +;;;; NO! This seems to check that (i) EITHER we're at the top level; +;;;; OR (ii) The next enclosing level of bracketing is a '{'. HMM. +;;;; Doesn't seem to make sense. +;;;; 2003/8/8 This might have something to do with the GCC extension +;;;; "Statement Expressions", e.g. +;;;; while ({stmt1 ; stmt2 ; exp ;}). +;;;; This form excludes such Statement Expressions. (or (not (c-safe (up-list -1) t)) (= (char-after) ?{)))) (goto-char last) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 536e6766261..20dc97db5d7 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1,4 +1,4 @@ -;;; cc-defs.el --- compile time definitions for CC Mode +;;; cc-defs.el --- compile time definitions for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index cc9833a434e..747a6fd4eda 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,4 +1,4 @@ -;;; cc-engine.el --- core syntax guessing engine for CC mode -*- coding: utf-8 -*- +;;; cc-engine.el --- core syntax guessing engine for CC mode -*- lexical-binding:t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -163,6 +163,8 @@ (defvar c-doc-line-join-re) (defvar c-doc-bright-comment-start-re) (defvar c-doc-line-join-end-ch) +(defvar c-syntactic-context) +(defvar c-syntactic-element) (cc-bytecomp-defvar c-min-syn-tab-mkr) (cc-bytecomp-defvar c-max-syn-tab-mkr) (cc-bytecomp-defun c-clear-syn-tab) @@ -2717,9 +2719,9 @@ comment at the start of cc-engine.el for more info." ;; two char construct (such as a comment opener or an escaped character).) (if (and (consp elt) (>= (length elt) 3)) ;; Inside a string or comment - (let ((depth 0) (containing nil) (last nil) + (let ((depth 0) (containing nil) in-string in-comment - (min-depth 0) com-style com-str-start (intermediate nil) + (min-depth 0) com-style com-str-start (char-1 (nth 3 elt)) ; first char of poss. 2-char construct (pos (car elt)) (type (cadr elt))) @@ -2736,14 +2738,13 @@ comment at the start of cc-engine.el for more info." (1- pos) pos)) (if (memq 'pps-extended-state c-emacs-features) - (list depth containing last + (list depth containing nil in-string in-comment nil min-depth com-style com-str-start - intermediate nil) - (list depth containing last + nil nil) + (list depth containing nil in-string in-comment nil - min-depth com-style com-str-start - intermediate))) + min-depth com-style com-str-start nil))) ;; Not in a string or comment. (if (memq 'pps-extended-state c-emacs-features) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 4e283764ceb..433b4dcf4a8 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1,4 +1,4 @@ -;;; cc-fonts.el --- font lock support for CC Mode +;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. @@ -2287,7 +2287,7 @@ need for `c-font-lock-extra-types'.") ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let (pos after-name) + (let (pos) (while (c-syntactic-re-search-forward c-using-key limit 'end) (while ; Do one declarator of a comma separated list, each time around. (progn @@ -2295,7 +2295,6 @@ need for `c-font-lock-extra-types'.") (setq pos (point)) ; token after "using". (when (and (c-on-identifier) (c-forward-name)) - (setq after-name (point)) (cond ((eq (char-after) ?=) ; using foo = ; (goto-char pos) @@ -2305,7 +2304,8 @@ need for `c-font-lock-extra-types'.") (c-go-up-list-backward) (eq (char-after) ?{) (eq (car (c-beginning-of-decl-1 - (c-determine-limit 1000))) 'same) + (c-determine-limit 1000))) + 'same) (looking-at c-colon-type-list-re))) ;; Inherited protected member: leave unfontified ) diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index 1b852ec4910..0824af66b43 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -1,4 +1,4 @@ -;;; cc-guess.el --- guess indentation values by scanning existing code +;;; cc-guess.el --- guess indentation values by scanning existing code -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2006, 2011-2021 Free Software ;; Foundation, Inc. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index fa4e73087ef..28a15654277 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1,4 +1,4 @@ -;;; cc-langs.el --- language specific settings for CC Mode -*- coding: utf-8 -*- +;;; cc-langs.el --- language specific settings for CC Mode -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -579,14 +579,12 @@ don't have EOL terminated statements. " (c-lang-defvar c-at-vsemi-p-fn (c-lang-const c-at-vsemi-p-fn)) (c-lang-defconst c-vsemi-status-unknown-p-fn - "Contains a predicate regarding the presence of virtual semicolons. -More precisely, the function answers the question, \"are we unsure whether a -virtual semicolon exists on this line?\". The (admittedly kludgy) purpose of -such a function is to prevent an infinite recursion in -`c-beginning-of-statement-1' when point starts at a `while' token. The function -MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', even -indirectly. This variable contains nil for languages which don't have EOL -terminated statements." + "A function \"are we unsure whether there is a virtual semicolon on this line?\". +The (admittedly kludgy) purpose of such a function is to prevent an infinite +recursion in c-beginning-of-statement-1 when point starts at a `while' token. +The function MUST NOT UNDER ANY CIRCUMSTANCES call `c-beginning-of-statement-1', +even indirectly. This variable contains nil for languages which don't have +EOL terminated statements." t nil (c c++ objc) 'c-macro-vsemi-status-unknown-p awk 'c-awk-vsemi-status-unknown-p) diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 0ff6efb7d37..a099ec1de95 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -1,4 +1,4 @@ -;;; cc-menus.el --- imenu support for CC Mode +;;; cc-menus.el --- imenu support for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index cfb23d0d45e..dae0062efb5 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,4 +1,4 @@ -;;; cc-mode.el --- major mode for editing C and similar languages +;;; cc-mode.el --- major mode for editing C and similar languages -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 29cbe54c3bd..77cad77711a 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -1,4 +1,4 @@ -;;; cc-styles.el --- support for styles in CC Mode +;;; cc-styles.el --- support for styles in CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -464,7 +464,7 @@ STYLE using `c-set-style' if the optional SET-P flag is non-nil." offset)) ;;;###autoload -(defun c-set-offset (symbol offset &optional ignored) +(defun c-set-offset (symbol offset &optional _ignored) "Change the value of a syntactic element symbol in `c-offsets-alist'. SYMBOL is the syntactic element symbol to change and OFFSET is the new offset for that syntactic element. The optional argument is not used diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 88ee092da79..b33fea0b48c 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1,4 +1,4 @@ -;;; cc-vars.el --- user customization variables for CC Mode +;;; cc-vars.el --- user customization variables for CC Mode -*- lexical-binding: t -*- ;; Copyright (C) 1985, 1987, 1992-2021 Free Software Foundation, Inc. @@ -42,6 +42,9 @@ (cc-require 'cc-defs) +(defvar c-syntactic-context) +(defvar c-syntactic-element) + (cc-eval-when-compile (require 'custom) (require 'widget)) From 81ffc433838ce43a12e3629adaefafc6413dd126 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 10 Apr 2021 12:24:09 -0700 Subject: [PATCH 066/128] ; Fix copyright years --- lib-src/seccomp-filter.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 9918fb025ef..eeca75fddfb 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -1,6 +1,6 @@ /* Generate a Secure Computing filter definition file. -Copyright (C) 2020 Free Software Foundation, Inc. +Copyright (C) 2020-2021 Free Software Foundation, Inc. This file is part of GNU Emacs. From 1d474ad69d19d01b047012734530fb4c5eb82144 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 10 Apr 2021 21:54:12 +0200 Subject: [PATCH 067/128] * etc/NEWS: Extend paragraph about &define form and backtracking --- etc/NEWS | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 328c38c1189..5e37b38b90e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2535,8 +2535,11 @@ back in Emacs 23.1. The affected functions are: 'make-obsolete', ** The 'values' variable is now obsolete. -** The '&define' keyword in an Edebug specification now disables -backtracking. ++++ +** The '&define' keyword in an Edebug specification now disables backtracking. +The implementation was buggy, and multiple &define forms in an &or +form should be exceedingly rare. See the Info node 'Backtracking' in +the Emacs Lisp reference manual for background. * Lisp Changes in Emacs 28.1 From cb6b810dfd721894cb8843e8b2a96b93ae4edce4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 16:25:28 -0400 Subject: [PATCH 068/128] * lisp/jka-compr.el: Use lexical-binding Prefer #' to quote function names. --- lisp/jka-compr.el | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 8aebcd0ec4d..a6223646c11 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -1,7 +1,6 @@ -;;; jka-compr.el --- reading/writing/loading compressed files +;;; jka-compr.el --- reading/writing/loading compressed files -*- lexical-binding: t; -*- -;; Copyright (C) 1993-1995, 1997, 1999-2021 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-2021 Free Software Foundation, Inc. ;; Author: Jay K. Adams ;; Maintainer: emacs-devel@gnu.org @@ -120,7 +119,7 @@ data appears to be compressed already.") (widen) (erase-buffer) (insert (format "Error while executing \"%s %s < %s\"\n\n" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") infile)) (and errfile @@ -170,7 +169,7 @@ to keep: LEN chars starting BEG chars from the beginning." (format "%s %s 2> %s | \"%s\" bs=%d skip=%d %s 2> %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file jka-compr-dd-program jka-compr-dd-blocksize @@ -218,7 +217,7 @@ to keep: LEN chars starting BEG chars from the beginning." "-c" (format "%s %s 2> %s %s" prog - (mapconcat 'identity args " ") + (mapconcat #'identity args " ") err-file (if (stringp output) (concat "> " output) @@ -227,7 +226,7 @@ to keep: LEN chars starting BEG chars from the beginning." (jka-compr-error prog args infile message err-file)) (delete-file err-file))) (or (eq 0 - (apply 'call-process + (apply #'call-process prog infile (if (stringp output) temp output) nil args)) (jka-compr-error prog args infile message)) @@ -622,12 +621,12 @@ There should be no more than seven characters after the final `/'." (substring file 0 (string-match (jka-compr-info-regexp info) file))) file))) -(put 'write-region 'jka-compr 'jka-compr-write-region) -(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents) -(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy) -(put 'load 'jka-compr 'jka-compr-load) +(put 'write-region 'jka-compr #'jka-compr-write-region) +(put 'insert-file-contents 'jka-compr #'jka-compr-insert-file-contents) +(put 'file-local-copy 'jka-compr #'jka-compr-file-local-copy) +(put 'load 'jka-compr #'jka-compr-load) (put 'byte-compiler-base-file-name 'jka-compr - 'jka-compr-byte-compiler-base-file-name) + #'jka-compr-byte-compiler-base-file-name) ;;;###autoload (defvar jka-compr-inhibit nil @@ -649,7 +648,7 @@ It is not recommended to set this variable permanently to anything but nil.") ;; to prevent the primitive from calling our handler again. (defun jka-compr-run-real-handler (operation args) (let ((inhibit-file-name-handlers - (cons 'jka-compr-handler + (cons #'jka-compr-handler (and (eq inhibit-file-name-operation operation) inhibit-file-name-handlers))) (inhibit-file-name-operation operation)) @@ -674,7 +673,7 @@ by `jka-compr-installed'." (last fnha)) (while (cdr last) - (if (eq (cdr (car (cdr last))) 'jka-compr-handler) + (if (eq (cdr (car (cdr last))) #'jka-compr-handler) (setcdr last (cdr (cdr last))) (setq last (cdr last)))) From 5ad3893ebaf8190e1e262caf33bc736e79a0d07b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 16:58:11 -0400 Subject: [PATCH 069/128] * lisp/loadup.el: Use lexical-binding --- lisp/loadup.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/loadup.el b/lisp/loadup.el index 4a0b8f508c7..d6cfcd6fc81 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,4 +1,4 @@ -;;; loadup.el --- load up standardly loaded Lisp files for Emacs +;;; loadup.el --- load up standardly loaded Lisp files for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1986, 1992, 1994, 2001-2021 Free Software ;; Foundation, Inc. @@ -112,7 +112,7 @@ (if (eq t purify-flag) ;; Hash consing saved around 11% of pure space in my tests. - (setq purify-flag (make-hash-table :test 'equal :size 80000))) + (setq purify-flag (make-hash-table :test #'equal :size 80000))) (message "Using load-path %s" load-path) @@ -134,7 +134,7 @@ ;; Do it after subr, since both after-load-functions and add-hook are ;; implemented in subr.el. -(add-hook 'after-load-functions (lambda (f) (garbage-collect))) +(add-hook 'after-load-functions (lambda (_) (garbage-collect))) (load "version") @@ -151,7 +151,7 @@ ;; variable its advertised default value (it starts as nil, see ;; xdisp.c). (setq resize-mini-windows 'grow-only) -(setq load-source-file-function 'load-with-code-conversion) +(setq load-source-file-function #'load-with-code-conversion) (load "files") ;; Load-time macro-expansion can only take effect after setting @@ -186,7 +186,7 @@ ;; In case loaddefs hasn't been generated yet. (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test 'equal))) +(let ((new (make-hash-table :test #'equal))) ;; Now that loaddefs has populated definition-prefixes, purify its contents. (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) definition-prefixes) @@ -399,7 +399,7 @@ lost after dumping"))) emacs-repository-branch (ignore-errors (emacs-repository-get-branch))) ;; A constant, so we shouldn't change it with `setq'. (defconst emacs-build-number - (if versions (1+ (apply 'max versions)) 1)))) + (if versions (1+ (apply #'max versions)) 1)))) (message "Finding pointers to doc strings...") @@ -429,11 +429,11 @@ lost after dumping"))) ;; We keep the load-history data in PURE space. ;; Make sure that the spine of the list is not in pure space because it can ;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar 'purecopy load-history)) +(setq load-history (mapcar #'purecopy load-history)) (set-buffer-modified-p nil) -(remove-hook 'after-load-functions (lambda (f) (garbage-collect))) +(remove-hook 'after-load-functions (lambda (_) (garbage-collect))) (if (boundp 'load--prefer-newer) (progn @@ -540,7 +540,7 @@ lost after dumping"))) ;; Otherwise, it breaks a lot of code which does things like ;; (or load-file-name byte-compile-current-file). (setq load-file-name nil) -(eval top-level) +(eval top-level t) ;; Local Variables: From edf8497ce3dc0fe0a137c37ca279528b46185ed5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 17:01:01 -0400 Subject: [PATCH 070/128] * lisp/informat.el: Use lexical-binding --- lisp/informat.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/informat.el b/lisp/informat.el index 3da23516333..bac09752b70 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -1,4 +1,4 @@ -;;; informat.el --- info support functions package for Emacs +;;; informat.el --- info support functions package for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986, 2001-2021 Free Software Foundation, Inc. @@ -140,7 +140,7 @@ (or (bolp) (newline)) (insert "\^_\f\nTag table:\n") - (if (eq major-mode 'info-mode) + (if (derived-mode-p 'info-mode) (move-marker Info-tag-table-marker (point))) (setq tag-list (nreverse tag-list)) (while tag-list From 8b92897633e8c3630c4f4a9f8840e8a4bf973dec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 17:03:11 -0400 Subject: [PATCH 071/128] * lisp/ps-bdf.el: Use lexical-binding --- lisp/ps-bdf.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 7bf2f71822a..72cbcf8bd68 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -1,4 +1,4 @@ -;;; ps-bdf.el --- BDF font file handler for ps-print +;;; ps-bdf.el --- BDF font file handler for ps-print -*- lexical-binding: t; -*- ;; Copyright (C) 1998-1999, 2001-2021 Free Software Foundation, Inc. ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, @@ -138,7 +138,7 @@ See the documentation of the function `bdf-read-font-info' for more detail." (defun bdf-initialize () "Initialize `bdf' library." (and (bdf-read-cache) - (add-hook 'kill-emacs-hook 'bdf-write-cache))) + (add-hook 'kill-emacs-hook #'bdf-write-cache))) (defun bdf-compact-code (code code-range) (if (or (< code (aref code-range 4)) From 496a46b32db9a3c32a846b8a3c872891303a1ec4 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 10 Apr 2021 21:19:50 +0200 Subject: [PATCH 072/128] * src/emacs.c (load_seccomp): Fix condition. --- src/emacs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index cb1361fe46d..1fecf1fa4b4 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1091,7 +1091,7 @@ load_seccomp (const char *file) success = true; out: - if (fd < 0) + if (0 <= fd) emacs_close (fd); free (buffer); return success; From 2db03e3e53af3ce5c87f64d163ab2be96aee2c0f Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 10 Apr 2021 21:21:08 +0200 Subject: [PATCH 073/128] * src/emacs.c (load_seccomp): Add a useful assertion. --- src/emacs.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/emacs.c b/src/emacs.c index 1fecf1fa4b4..92f6bfe636f 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1060,6 +1060,7 @@ load_seccomp (const char *file) emacs_perror ("read"); goto out; } + eassert (read <= SIZE_MAX); if (read != size) { fprintf (stderr, From 26e1d854d1d40a63896272162f299a90e5a31043 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 17:07:58 -0400 Subject: [PATCH 074/128] * lisp/misearch.el: Use lexical-binding (multi-isearch-read-buffers, multi-isearch-read-files): Replace `add-to-list` with `cl-pushnew` for use on a local variable. --- lisp/misearch.el | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/lisp/misearch.el b/lisp/misearch.el index 668c711922a..8b6238a8266 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -1,4 +1,4 @@ -;;; misearch.el --- isearch extensions for multi-buffer search +;;; misearch.el --- isearch extensions for multi-buffer search -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2021 Free Software Foundation, Inc. @@ -28,6 +28,8 @@ ;;; Code: +(require 'cl-lib) + ;;; Search multiple buffers ;;;###autoload (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -40,8 +42,7 @@ (defcustom multi-isearch-search t "Non-nil enables searching multiple related buffers, in certain modes." :type 'boolean - :version "23.1" - :group 'multi-isearch) + :version "23.1") (defcustom multi-isearch-pause t "A choice defining where to pause the search. @@ -53,8 +54,7 @@ If t, pause in all buffers that contain the search string." (const :tag "Don't pause" nil) (const :tag "Only in initial buffer" initial) (const :tag "All buffers" t)) - :version "23.1" - :group 'multi-isearch) + :version "23.1") ;;;###autoload (defvar multi-isearch-next-buffer-function nil @@ -119,10 +119,10 @@ Intended to be added to `isearch-mode-hook'." (default-value 'isearch-wrap-function) multi-isearch-orig-push-state (default-value 'isearch-push-state-function)) - (setq-default isearch-search-fun-function 'multi-isearch-search-fun - isearch-wrap-function 'multi-isearch-wrap - isearch-push-state-function 'multi-isearch-push-state) - (add-hook 'isearch-mode-end-hook 'multi-isearch-end))) + (setq-default isearch-search-fun-function #'multi-isearch-search-fun + isearch-wrap-function #'multi-isearch-wrap + isearch-push-state-function #'multi-isearch-push-state) + (add-hook 'isearch-mode-end-hook #'multi-isearch-end))) (defun multi-isearch-end () "Clean up the multi-buffer search after terminating isearch." @@ -133,7 +133,7 @@ Intended to be added to `isearch-mode-hook'." (setq-default isearch-search-fun-function multi-isearch-orig-search-fun isearch-wrap-function multi-isearch-orig-wrap isearch-push-state-function multi-isearch-orig-push-state) - (remove-hook 'isearch-mode-end-hook 'multi-isearch-end)) + (remove-hook 'isearch-mode-end-hook #'multi-isearch-end)) (defun multi-isearch-search-fun () "Return the proper search function, for isearch in multiple buffers." @@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (while (not (string-equal (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) - (add-to-list 'bufs buf) + (cl-pushnew buf bufs) (setq ido-ignore-item-temp-list bufs)) (nreverse bufs))) @@ -322,7 +322,7 @@ Every next/previous file in the defined sequence is visited by default-directory default-directory)) default-directory)) - (add-to-list 'files file)) + (cl-pushnew file files :test #'equal)) (nreverse files))) ;; A regexp is not the same thing as a file glob - does this matter? @@ -381,7 +381,7 @@ whose file names match the specified wildcard." (defun multi-isearch-unload-function () "Remove autoloaded variables from `unload-function-defs-list'. Also prevent the feature from being reloaded via `isearch-mode-hook'." - (remove-hook 'isearch-mode-hook 'multi-isearch-setup) + (remove-hook 'isearch-mode-hook #'multi-isearch-setup) (let ((defs (list (car unload-function-defs-list))) (auto '(multi-isearch-next-buffer-function multi-isearch-next-buffer-current-function @@ -395,7 +395,7 @@ Also prevent the feature from being reloaded via `isearch-mode-hook'." ;; . nil)) -(defalias 'misearch-unload-function 'multi-isearch-unload-function) +(defalias 'misearch-unload-function #'multi-isearch-unload-function) (provide 'multi-isearch) From 56e8d969f545446c00a82af6f2e5bc7ad535a359 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 17:11:58 -0400 Subject: [PATCH 075/128] * lisp/cus-dep.el: Use lexical-binding --- lisp/cus-dep.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index f0b108b77d6..c14a45ca775 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -1,4 +1,4 @@ -;;; cus-dep.el --- find customization dependencies +;;; cus-dep.el --- find customization dependencies -*- lexical-binding: t; -*- ;; ;; Copyright (C) 1997, 2001-2021 Free Software Foundation, Inc. ;; @@ -131,7 +131,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" 'custom-where name) ;; Eval to get the 'custom-group, -tag, ;; -version, group-documentation etc properties. - (eval expr)) + (eval expr t)) ;; Eval failed for some reason. Eg maybe the ;; defcustom uses something defined earlier ;; in the file (we haven't loaded the file). @@ -163,7 +163,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" (let ((members (get symbol 'custom-group)) where found) (when members - (dolist (member (mapcar 'car members)) + (dolist (member (mapcar #'car members)) (setq where (get member 'custom-where)) (unless (or (null where) (member where found)) From d6aa50f74c65c96846c774cb8f949387bf07a9ed Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 14 Dec 2020 21:25:11 +0100 Subject: [PATCH 076/128] * src/emacs.c (read_full): Add a few assertions. --- src/emacs.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/emacs.c b/src/emacs.c index 92f6bfe636f..9d7b21cc76a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -973,6 +973,9 @@ emacs_seccomp (unsigned int operation, unsigned int flags, void *args) static ptrdiff_t read_full (int fd, void *buffer, ptrdiff_t size) { + eassert (0 <= fd); + eassert (buffer != NULL); + eassert (0 <= size); enum { /* See MAX_RW_COUNT in sysdep.c. */ From ffd12743bd8ef6e10cf0d96bc1ae08992075cbf1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 18:07:37 -0400 Subject: [PATCH 077/128] * lisp/misearch.el (multi-isearch-read-buffers): Fix last change These are not buffers but buffer names. --- lisp/misearch.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/misearch.el b/lisp/misearch.el index 8b6238a8266..1f0dd315508 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -238,7 +238,7 @@ set in `multi-isearch-buffers' or `multi-isearch-buffers-regexp'." (while (not (string-equal (setq buf (read-buffer (multi-occur--prompt) nil t)) "")) - (cl-pushnew buf bufs) + (cl-pushnew buf bufs :test #'equal) (setq ido-ignore-item-temp-list bufs)) (nreverse bufs))) From 5761e9004aa73d3aa7c34be9a064a1e768c3129c Mon Sep 17 00:00:00 2001 From: Gregory Heytings Date: Sat, 10 Apr 2021 11:47:45 +0100 Subject: [PATCH 078/128] Add new icomplete-vertical-mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: João Távora * lisp/icomplete.el (icomplete-completions): Consider icomplete-vertical-mode. (icomplete-vertical-mode-minibuffer-map): New map. (icomplete--vertical-minibuffer-setup): New helper. (icomplete-vertical-mode): New minor mode. * doc/emacs/buffers.texi (Icomplete): Mention icomplete-vertical-mode. * etc/NEWS: Mention icomplete-vertical-mode --- doc/emacs/buffers.texi | 9 +++++++++ etc/NEWS | 7 +++++++ lisp/icomplete.el | 42 ++++++++++++++++++++++++++++++++++++++---- 3 files changed, 54 insertions(+), 4 deletions(-) diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index 3a166e404a8..bec7f37547c 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -765,6 +765,15 @@ your initialization file (@pxref{Init File}): the variable @code{fido-mode} to @code{t} (@pxref{Easy Customization}). +@findex icomplete-vertical-mode +@cindex Icomplete vertical mode + + Icomplete mode and Fido mode display the possible completions on the +same line as the prompt by default. To display the completion candidates +vertically under the prompt, type @kbd{M-x icomplete-vertical-mode}, or +customize the variable @code{icomplete-vertical-mode} to @code{t} +(@pxref{Easy Customization}). + @node Buffer Menus @subsection Customizing Buffer Menus diff --git a/etc/NEWS b/etc/NEWS index 5e37b38b90e..aaf38022c58 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -494,6 +494,13 @@ documented. SMIE is now always enabled and 'ruby-use-smie' only controls whether indentation is done using SMIE or with the old ad-hoc code. +** Icomplete + ++++ +*** New minor mode Icomplete-Vertical mode. +This mode is intended to be used with Icomplete or Fido, to display the +list of completions candidates vertically instead of horizontally. + --- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has diff --git a/lisp/icomplete.el b/lisp/icomplete.el index da589c00649..d5b6f76d7b2 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -562,6 +562,37 @@ Usually run by inclusion in `minibuffer-setup-hook'." (completion--cache-all-sorted-completions beg end (cons comp all)))) finally return all))) +(defvar icomplete-vertical-mode-minibuffer-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-n") 'icomplete-forward-completions) + (define-key map (kbd "C-p") 'icomplete-backward-completions) + map) + "Keymap used by `icomplete-vertical-mode' in the minibuffer.") + +(defun icomplete--vertical-minibuffer-setup () + "Setup the minibuffer for vertical display of completion candidates." + (use-local-map (make-composed-keymap icomplete-vertical-mode-minibuffer-map + (current-local-map))) + (setq-local icomplete-separator "\n" + icomplete-hide-common-prefix nil + ;; Ask `icomplete-completions' to return enough completions candidates. + icomplete-prospects-height 25 + redisplay-adhoc-scroll-in-resize-mini-windows nil)) + +;;;###autoload +(define-minor-mode icomplete-vertical-mode + "Toggle vertical candidate display in `icomplete-mode' or `fido-mode'. + +As many completion candidates as possible are displayed, depending on +the value of `max-mini-window-height', and the way the mini-window is +resized depends on `resize-mini-windows'." + :global t + (remove-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup) + (when icomplete-vertical-mode + (add-hook 'icomplete-minibuffer-setup-hook + #'icomplete--vertical-minibuffer-setup))) + @@ -784,10 +815,13 @@ matches exist." (if last (setcdr last base-size)) (if prospects (concat determ - "{" - (mapconcat 'identity prospects icomplete-separator) - (and limit (concat icomplete-separator ellipsis)) - "}") + (if icomplete-vertical-mode " \n" "{") + (mapconcat 'identity prospects (if icomplete-vertical-mode + "\n" + icomplete-separator)) + (unless icomplete-vertical-mode + (concat (and limit (concat icomplete-separator ellipsis)) + "}"))) (concat determ " [Matched]")))))) ;;; Iswitchb compatibility From d55d07af701d7e082a729c6dc69448f32f3935bc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Apr 2021 20:06:21 -0400 Subject: [PATCH 079/128] * lisp/net/shr.el (shr-insert-document): Explain why bidi-display-reordering --- lisp/net/shr.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index c122a19e90c..d1544764404 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -313,6 +313,11 @@ DOM should be a parse tree as generated by (* (frame-char-width) 2)) 1)))) (max-specpdl-size max-specpdl-size) + ;; `bidi-display-reordering' is supposed to be only used for + ;; debugging purposes, but Shr's naïve filling algorithm + ;; cannot cope with the complexity of RTL text in an LTR + ;; paragraph, when a long line has been continued, so... + ;; this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width From 0f494760d3344201f0c01723c246ba0ad2d15d90 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Apr 2021 09:35:09 +0300 Subject: [PATCH 080/128] ; * lisp/net/shr.el (shr-insert-document): Fix last change. --- lisp/net/shr.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index d1544764404..7c15eb1ca0b 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -316,8 +316,9 @@ DOM should be a parse tree as generated by ;; `bidi-display-reordering' is supposed to be only used for ;; debugging purposes, but Shr's naïve filling algorithm ;; cannot cope with the complexity of RTL text in an LTR - ;; paragraph, when a long line has been continued, so... - ;; this is the best we could do :-( + ;; paragraph, when a long line has been continued, and for + ;; most scripts the character metrics don't change when they + ;; are reordered, so... this is the best we could do :-( bidi-display-reordering) ;; Adjust for max width specification. (when (and shr-max-width From 3cf9e2a6e33599bb12a949a3b5bd1847f39ab948 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Apr 2021 12:12:45 +0300 Subject: [PATCH 081/128] Fix handling of mouse clicks on tab-bar buttons * src/xdisp.c (note_mouse_highlight): Don't attempt to highlight tab-bar buttons. (note_tab_bar_highlight): Function deleted: it had no effect on display of tab-bar buttons. (tab_bar_item_info): Mention all arguments in the commentary. (get_tab_bar_item): Don't pay attention to mouse-highlight information; instead, compare the button's index with the one recorded in f->last_tab_bar_item. (handle_tab_bar_click): Don't attempt to show tab-bar buttons in pressed or released state: that isn't supported. Determine whether to generate a tab-bar button click based on DOWN_P argument, not on mouse-highlight, which has no effect on tab-bar display. (Bug#47581) --- src/xdisp.c | 147 ++++------------------------------------------------ 1 file changed, 10 insertions(+), 137 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index a405d51f803..50d9040057a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -13607,8 +13607,9 @@ redisplay_tab_bar (struct frame *f) /* Get information about the tab-bar item which is displayed in GLYPH on frame F. Return in *PROP_IDX the index where tab-bar item - properties start in F->tab_bar_items. Value is false if - GLYPH doesn't display a tab-bar item. */ + properties start in F->tab_bar_items. Return in CLOSE_P an + indication whether the click was on the close-tab icon of the tab. + Value is false if GLYPH doesn't display a tab-bar item. */ static bool tab_bar_item_info (struct frame *f, struct glyph *glyph, @@ -13654,7 +13655,6 @@ static int get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, int *hpos, int *vpos, int *prop_idx, bool *close_p) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tab_bar_window); int area; @@ -13668,18 +13668,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct glyph **glyph, if (!tab_bar_item_info (f, *glyph, prop_idx, close_p)) return -1; - /* Is mouse on the highlighted item? */ - if (EQ (f->tab_bar_window, hlinfo->mouse_face_window) - && *vpos >= hlinfo->mouse_face_beg_row - && *vpos <= hlinfo->mouse_face_end_row - && (*vpos > hlinfo->mouse_face_beg_row - || *hpos >= hlinfo->mouse_face_beg_col) - && (*vpos < hlinfo->mouse_face_end_row - || *hpos < hlinfo->mouse_face_end_col - || hlinfo->mouse_face_past_end)) - return 0; - - return 1; + return *prop_idx == f->last_tab_bar_item ? 0 : 1; } @@ -13693,7 +13682,6 @@ void handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, int modifiers) { - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); struct window *w = XWINDOW (f->tab_bar_window); int hpos, vpos, prop_idx; bool close_p; @@ -13701,47 +13689,27 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, Lisp_Object enabled_p; int ts; - /* If not on the highlighted tab-bar item, and mouse-highlight is - non-nil, return. This is so we generate the tab-bar button - click only when the mouse button is released on the same item as - where it was pressed. However, when mouse-highlight is disabled, - generate the click when the button is released regardless of the - highlight, since tab-bar items are not highlighted in that - case. */ frame_to_window_pixel_xy (w, &x, &y); ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); if (ts == -1 - || (ts != 0 && !NILP (Vmouse_highlight))) + /* If the button is released on a tab other than the one where + it was pressed, don't generate the tab-bar button click event. */ + || (ts != 0 && !down_p)) return; - /* When mouse-highlight is off, generate the click for the item - where the button was pressed, disregarding where it was - released. */ - if (NILP (Vmouse_highlight) && !down_p) - prop_idx = f->last_tab_bar_item; - /* If item is disabled, do nothing. */ enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); if (NILP (enabled_p)) return; if (down_p) - { - /* Show item in pressed state. */ - if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_SUNKEN); - f->last_tab_bar_item = prop_idx; - } + f->last_tab_bar_item = prop_idx; /* record the pressed tab */ else { Lisp_Object key, frame; struct input_event event; EVENT_INIT (event); - /* Show item in released state. */ - if (!NILP (Vmouse_highlight)) - show_mouse_face (hlinfo, DRAW_IMAGE_RAISED); - key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY); XSETFRAME (frame, f); @@ -13754,97 +13722,6 @@ handle_tab_bar_click (struct frame *f, int x, int y, bool down_p, } } - -/* Possibly highlight a tab-bar item on frame F when mouse moves to - tab-bar window-relative coordinates X/Y. Called from - note_mouse_highlight. */ - -static void -note_tab_bar_highlight (struct frame *f, int x, int y) -{ - Lisp_Object window = f->tab_bar_window; - struct window *w = XWINDOW (window); - Mouse_HLInfo *hlinfo = MOUSE_HL_INFO (f); - int hpos, vpos; - struct glyph *glyph; - struct glyph_row *row; - int i; - Lisp_Object enabled_p; - int prop_idx; - bool close_p; - enum draw_glyphs_face draw = DRAW_IMAGE_RAISED; - int rc; - - /* Function note_mouse_highlight is called with negative X/Y - values when mouse moves outside of the frame. */ - if (x <= 0 || y <= 0) - { - clear_mouse_face (hlinfo); - return; - } - - rc = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p); - if (rc < 0) - { - /* Not on tab-bar item. */ - clear_mouse_face (hlinfo); - return; - } - else if (rc == 0) - /* On same tab-bar item as before. */ - goto set_help_echo; - - clear_mouse_face (hlinfo); - - bool mouse_down_p = false; -#ifndef HAVE_NS - /* Mouse is down, but on different tab-bar item? */ - Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f); - mouse_down_p = (gui_mouse_grabbed (dpyinfo) - && f == dpyinfo->last_mouse_frame); - - if (mouse_down_p && f->last_tab_bar_item != prop_idx) - return; -#endif - draw = mouse_down_p ? DRAW_IMAGE_SUNKEN : DRAW_IMAGE_RAISED; - - /* If tab-bar item is not enabled, don't highlight it. */ - enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P); - if (!NILP (enabled_p) && !NILP (Vmouse_highlight)) - { - /* Compute the x-position of the glyph. In front and past the - image is a space. We include this in the highlighted area. */ - row = MATRIX_ROW (w->current_matrix, vpos); - for (i = x = 0; i < hpos; ++i) - x += row->glyphs[TEXT_AREA][i].pixel_width; - - /* Record this as the current active region. */ - hlinfo->mouse_face_beg_col = hpos; - hlinfo->mouse_face_beg_row = vpos; - hlinfo->mouse_face_beg_x = x; - hlinfo->mouse_face_past_end = false; - - hlinfo->mouse_face_end_col = hpos + 1; - hlinfo->mouse_face_end_row = vpos; - hlinfo->mouse_face_end_x = x + glyph->pixel_width; - hlinfo->mouse_face_window = window; - hlinfo->mouse_face_face_id = TAB_BAR_FACE_ID; - - /* Display it as active. */ - show_mouse_face (hlinfo, draw); - } - - set_help_echo: - - /* Set help_echo_string to a help string to display for this tab-bar item. - XTread_socket does the rest. */ - help_echo_object = help_echo_window = Qnil; - help_echo_pos = -1; - help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_HELP); - if (NILP (help_echo_string)) - help_echo_string = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION); -} - #endif /* HAVE_WINDOW_SYSTEM */ /* Find the tab-bar item at X coordinate and return its information. */ @@ -33537,13 +33414,9 @@ note_mouse_highlight (struct frame *f, int x, int y) frame_to_window_pixel_xy (w, &x, &y); #if defined (HAVE_WINDOW_SYSTEM) - /* Handle tab-bar window differently since it doesn't display a - buffer. */ + /* We don't highlight tab-bar buttons. */ if (EQ (window, f->tab_bar_window)) - { - note_tab_bar_highlight (f, x, y); - return; - } + return; #endif #if defined (HAVE_WINDOW_SYSTEM) && ! defined (HAVE_EXT_TOOL_BAR) From 25937821bc445235d984c4db8cb18dfbacd6a4ff Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 12:00:35 +0200 Subject: [PATCH 082/128] Also check for needed seccomp macros. It looks like these are not available on some versions of GNU/Linux, breaking the build. * configure.ac: Also check for needed seccomp macros. * src/emacs.c (SECCOMP_USABLE): New macro. (usage_message, main, standard_args): Use it. --- configure.ac | 10 +++++++++- src/emacs.c | 20 ++++++++++++++------ 2 files changed, 23 insertions(+), 7 deletions(-) diff --git a/configure.ac b/configure.ac index 0c4772a2b96..be623c96548 100644 --- a/configure.ac +++ b/configure.ac @@ -4179,7 +4179,15 @@ fi AC_SUBST([BLESSMAIL_TARGET]) AC_SUBST([LIBS_MAIL]) -AC_CHECK_HEADERS([linux/seccomp.h], [HAVE_SECCOMP=yes]) +HAVE_SECCOMP=no +AC_CHECK_HEADERS( + [linux/seccomp.h], + [AC_CHECK_DECLS( + [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC], + [HAVE_SECCOMP=yes], [], + [[ + #include + ]])]) LIBSECCOMP= AC_CHECK_HEADER([seccomp.h], diff --git a/src/emacs.c b/src/emacs.c index 9d7b21cc76a..bd01d7bb461 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -61,7 +61,15 @@ along with GNU Emacs. If not, see . */ # include #endif -#ifdef HAVE_LINUX_SECCOMP_H +#if defined HAVE_LINUX_SECCOMP_H \ + && HAVE_DECL_SECCOMP_SET_MODE_FILTER \ + && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC +# define SECCOMP_USABLE 1 +#else +# define SECCOMP_USABLE 0 +#endif + +#if SECCOMP_USABLE # include # include # include @@ -248,7 +256,7 @@ Initialization options:\n\ --dump-file FILE read dumped state from FILE\n\ ", #endif -#ifdef HAVE_LINUX_SECCOMP_H +#if SECCOMP_USABLE "\ --sandbox=FILE read Seccomp BPF filter from FILE\n\ " @@ -950,7 +958,7 @@ load_pdump (int argc, char **argv) } #endif /* HAVE_PDUMPER */ -#ifdef HAVE_LINUX_SECCOMP_H +#if SECCOMP_USABLE /* Wrapper function for the `seccomp' system call on GNU/Linux. This system call usually doesn't have a wrapper function. See the @@ -1123,7 +1131,7 @@ maybe_load_seccomp (int argc, char **argv) fatal ("cannot enable seccomp filter from %s", file); } -#endif /* HAVE_LINUX_SECCOMP_H */ +#endif /* SECCOMP_USABLE */ int main (int argc, char **argv) @@ -1135,7 +1143,7 @@ main (int argc, char **argv) /* First, check whether we should apply a seccomp filter. This should come at the very beginning to allow the filter to protect the initialization phase. */ -#ifdef HAVE_LINUX_SECCOMP_H +#if SECCOMP_USABLE maybe_load_seccomp (argc, argv); #endif @@ -2333,7 +2341,7 @@ static const struct standard_args standard_args[] = #ifdef HAVE_PDUMPER { "-dump-file", "--dump-file", 1, 1 }, #endif -#ifdef HAVE_LINUX_SECCOMP_H +#if SECCOMP_USABLE { "-seccomp", "--seccomp", 1, 1 }, #endif #ifdef HAVE_NS From 0334fa0532e63f22486b5142fa399decf54b18c0 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 12:26:13 +0200 Subject: [PATCH 083/128] Add another check for the required header . * configure.ac: Also check for . * src/emacs.c (SECCOMP_USABLE): Also check for . --- configure.ac | 2 +- src/emacs.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index be623c96548..cb4a9ab2876 100644 --- a/configure.ac +++ b/configure.ac @@ -4181,7 +4181,7 @@ AC_SUBST([LIBS_MAIL]) HAVE_SECCOMP=no AC_CHECK_HEADERS( - [linux/seccomp.h], + [linux/seccomp.h linux/filter.h], [AC_CHECK_DECLS( [SECCOMP_SET_MODE_FILTER, SECCOMP_FILTER_FLAG_TSYNC], [HAVE_SECCOMP=yes], [], diff --git a/src/emacs.c b/src/emacs.c index bd01d7bb461..694d975ec3d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -61,8 +61,8 @@ along with GNU Emacs. If not, see . */ # include #endif -#if defined HAVE_LINUX_SECCOMP_H \ - && HAVE_DECL_SECCOMP_SET_MODE_FILTER \ +#if defined HAVE_LINUX_SECCOMP_H && defined HAVE_LINUX_FILTER_H \ + && HAVE_DECL_SECCOMP_SET_MODE_FILTER \ && HAVE_DECL_SECCOMP_FILTER_FLAG_TSYNC # define SECCOMP_USABLE 1 #else From 01a513bf0beb9478e2ef801ca28ebc992455fe3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 11 Apr 2021 12:38:37 +0200 Subject: [PATCH 084/128] Fix typo in cconv * lisp/emacs-lisp/cconv.el (cconv-convert): Typo. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add test case. --- lisp/emacs-lisp/cconv.el | 2 +- test/lisp/emacs-lisp/bytecomp-tests.el | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index afaa13a8695..b37cfebab31 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -498,7 +498,7 @@ places where they originally did not directly appear." (let* ((class (and var (cconv--var-classification (list var) form))) (newenv (cond ((eq class :captured+mutated) - (cons `(,var . (car-save ,var)) env)) + (cons `(,var . (car-safe ,var)) env)) ((assq var env) (cons `(,var) env)) (t env))) (msg (when (eq class :unused) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 94e33a7770e..a11832d805e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -437,6 +437,13 @@ (/ 1 0) (arith-error x)))) (list x y)) + + (funcall + (condition-case x + (/ 1 0) + (arith-error (prog1 (lambda (y) (+ y x)) + (setq x 10)))) + 4) ) "List of expressions for cross-testing interpreted and compiled code.") From 686c366f8a63c448d06e5f08d604374fb316bc57 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 10 Apr 2021 15:10:35 -0400 Subject: [PATCH 085/128] Fix calculator-string-to-number yet again (bug#47694) * lisp/calculator.el (calculator-string-to-number): The last bugfix changed the code to just blindly replace ".e". This has some minor problems like making "-." parse as 0.0 instead of -0.0, and ".1.e1" is parsed as 1 instead of 0.1. Instead, replace the first "." that is followed by a non-digit with ".0". Since this has had several problems over the years, add some tests too. (Also, restore the original if-indentation style.) --- lisp/calculator.el | 9 ++++--- test/lisp/calculator-tests.el | 51 +++++++++++++++++++++++++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-) create mode 100644 test/lisp/calculator-tests.el diff --git a/lisp/calculator.el b/lisp/calculator.el index 6dd8d9a7ec1..99c9b6290c4 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -836,10 +836,11 @@ The result should not exceed the screen width." "Convert the given STR to a number, according to the value of `calculator-input-radix'." (if calculator-input-radix - (string-to-number str (cadr (assq calculator-input-radix - '((bin 2) (oct 8) (hex 16))))) - ;; Allow entry of "1.e3". - (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str))) + (string-to-number str (cadr (assq calculator-input-radix + '((bin 2) (oct 8) (hex 16))))) + ;; parse numbers similarly to calculators + ;; (see tests in test/lisp/calculator-tests.el) + (let ((str (replace-regexp-in-string "\\.\\([^0-9].*\\)?$" ".0\\1" str))) (float (string-to-number str))))) (defun calculator-push-curnum () diff --git a/test/lisp/calculator-tests.el b/test/lisp/calculator-tests.el new file mode 100644 index 00000000000..9551b1a4c61 --- /dev/null +++ b/test/lisp/calculator-tests.el @@ -0,0 +1,51 @@ +;;; calculator-tests.el --- Test suite for calculator. -*- 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 . + +;;; Code: +(require 'ert) +(require 'calculator) + +(ert-deftest calculator-test-calculator-string-to-number () + (dolist (x '(("" 0.0) + ("+" 0.0) + ("-" 0.0) + ("." 0.0) + ("+." 0.0) + ("-." -0.0) + (".-" 0.0) + ("--." 0.0) + ("-0.0e" -0.0) + ("1e1" 10.0) + ("1e+1" 10.0) + ("1e-1" 0.1) + ("+1e1" 10.0) + ("-1e1" -10.0) + ("+1e-1" 0.1) + ("-1e-1" -0.1) + (".1.e1" 0.1) + (".1..e1" 0.1) + ("1e+1.1" 10.0) + ("-2e-1.1" -0.2))) + (pcase x + (`(,str ,expected) + (let ((calculator-input-radix nil)) + (should (equal (calculator-string-to-number str) expected))))))) + +(provide 'calculator-tests) +;; calculator-tests.el ends here From dac5af2ba15ee8006ba0c223b11e1dfb237e2255 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Sun, 11 Apr 2021 14:14:42 +0200 Subject: [PATCH 086/128] * doc/lispref/elisp.texi (Top): Add missing entry. --- doc/lispref/elisp.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index dade8555187..be0c835b035 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -531,6 +531,7 @@ Scoping Rules for Variable Bindings * Dynamic Binding Tips:: Avoiding problems with dynamic binding. * Lexical Binding:: A different type of local variable binding. * Using Lexical Binding:: How to enable lexical binding. +* Converting to Lexical Binding:: Convert existing code to lexical binding. Buffer-Local Variables From 553783628892a5363aacf58ce238969cb60a1c3a Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 16:02:05 +0200 Subject: [PATCH 087/128] * lib-src/seccomp-filter.c: Print trailing newline. --- lib-src/seccomp-filter.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index eeca75fddfb..77e4413d3d4 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -60,7 +60,10 @@ fail (int error, const char *format, ...) va_list ap; va_start (ap, format); if (error == 0) - vfprintf (stderr, format, ap); + { + vfprintf (stderr, format, ap); + fputc ('\n', stderr); + } else { char buffer[1000]; From 6b3ca89cac15f56c1d7980727bce8e24834d4949 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Apr 2021 17:04:07 +0300 Subject: [PATCH 088/128] ; * etc/NEWS: Minor copyedits. --- etc/NEWS | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index aaf38022c58..7483a6e5b75 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -91,9 +91,9 @@ true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". ** Emacs now supports loading a Secure Computing filter. -This is supported only on capable GNU/Linux systems. To use this, -use the '--seccomp=FILE' command-line option when starting Emacs. -FILE must name a binary file containing an array of 'struct sock_filter' +This is supported only on capable GNU/Linux systems. To activate, +invoke Emacs with the '--seccomp=FILE' command-line option. FILE must +name a binary file containing an array of 'struct sock_filter' structures. Emacs will then install that list of Secure Computing filters into its own process early during the startup process. You can use this functionality to put an Emacs process in a sandbox to From 9dc26d4a8add5b3f2a5fce7907af4f9673ae82c0 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 16:22:54 +0200 Subject: [PATCH 089/128] Only attempt to generate seccomp filter files on x86-64 systems. The seccomp filters are always architecture-specific, and seccomp-filter.c right now only supports x86-64. * lib-src/Makefile.in (SECCOMP_FILTER): New variable. (DONT_INSTALL, all, seccomp-filter$(EXEEXT)): Use it. --- lib-src/Makefile.in | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 1942882004e..5870286cd5c 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -191,7 +191,14 @@ LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) LIBSECCOMP=@LIBSECCOMP@ +# Currently, we can only generate seccomp filter files for x86-64. ifneq ($(LIBSECCOMP),) +ifeq ($(shell uname -m),x86_64) +SECCOMP_FILTER=1 +endif +endif + +ifeq ($(SECCOMP_FILTER),1) DONT_INSTALL += seccomp-filter$(EXEEXT) endif @@ -224,7 +231,7 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} -ifneq ($(LIBSECCOMP),) +ifeq ($(SECCOMP_FILTER),1) all: seccomp-filter.bpf endif @@ -410,7 +417,7 @@ update-game-score${EXEEXT}: ${srcdir}/update-game-score.c $(NTLIB) $(config_h) emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico $(AM_V_RC)$(WINDRES) -O coff --include-dir=$(NTINC)/.. -o $@ $< -ifneq ($(LIBSECCOMP),) +ifeq ($(SECCOMP_FILTER),1) seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $< $(LIBSECCOMP) -o $@ From d06c54db1b3504caed8673216a72b117d0692351 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 16:41:44 +0200 Subject: [PATCH 090/128] Remove SCMP_FLTATR_CTL_LOG attribute from Seccomp filter. Whether or not we log failing syscalls isn't security-critical, and we shouldn't care. * lib-src/seccomp-filter.c (main): Remove log attribute. --- lib-src/seccomp-filter.c | 1 - 1 file changed, 1 deletion(-) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 77e4413d3d4..e4d56e01b4d 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -151,7 +151,6 @@ main (int argc, char **argv) set_attribute (SCMP_FLTATR_ACT_BADARCH, SCMP_ACT_KILL_PROCESS); set_attribute (SCMP_FLTATR_CTL_NNP, 1); set_attribute (SCMP_FLTATR_CTL_TSYNC, 1); - set_attribute (SCMP_FLTATR_CTL_LOG, 0); verify (CHAR_BIT == 8); verify (sizeof (int) == 4 && INT_MIN == INT32_MIN From 725fc96b706c57ef8ceca5e7d82b175d9a72e845 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 16:50:29 +0200 Subject: [PATCH 091/128] Use pkg-config to check for libseccomp. We need at list version 2.4.0 of libseccomp for seccomp-filter.c to build cleanly. * configure.ac: Use pkg-config to check for libseccomp. * lib-src/Makefile.in (HAVE_LIBSECCOMP, LIBSECCOMP_LIBS) (LIBSECCOMP_CFLAGS): New variables. (SECCOMP_FILTER, seccomp-filter$(EXEEXT)): Use them. --- configure.ac | 8 ++++---- lib-src/Makefile.in | 9 ++++++--- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/configure.ac b/configure.ac index cb4a9ab2876..681c25b052c 100644 --- a/configure.ac +++ b/configure.ac @@ -4189,10 +4189,10 @@ AC_CHECK_HEADERS( #include ]])]) -LIBSECCOMP= -AC_CHECK_HEADER([seccomp.h], - [AC_CHECK_LIB([seccomp], [seccomp_init], [LIBSECCOMP=-lseccomp])]) -AC_SUBST([LIBSECCOMP]) +EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0]) +AC_SUBST([HAVE_LIBSECCOMP]) +AC_SUBST([LIBSECCOMP_LIBS]) +AC_SUBST([LIBSECCOMP_CFLAGS]) OLD_LIBS=$LIBS LIBS="$LIB_PTHREAD $LIB_MATH $LIBS" diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 5870286cd5c..b4143b33554 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -189,10 +189,12 @@ LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) -LIBSECCOMP=@LIBSECCOMP@ +HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@ +LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@ +LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@ # Currently, we can only generate seccomp filter files for x86-64. -ifneq ($(LIBSECCOMP),) +ifeq ($(HAVE_LIBSECCOMP),yes) ifeq ($(shell uname -m),x86_64) SECCOMP_FILTER=1 endif @@ -419,7 +421,8 @@ emacsclient.res: ../nt/emacsclient.rc $(NTINC)/../icons/emacs.ico ifeq ($(SECCOMP_FILTER),1) seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) - $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $< $(LIBSECCOMP) -o $@ + $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \ + $(LIBSECCOMP_LIBS) -o $@ seccomp-filter.bpf seccomp-filter.pfc: seccomp-filter$(EXEEXT) $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ From 751e801f90339480ea43fc2237fc45c8eb39bd6f Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Sun, 11 Apr 2021 17:23:22 +0200 Subject: [PATCH 092/128] Fix check for timer_getoverrun * configure.ac (timer_getoverrun): Move check after gnulib checks and use $LIB_TIMER_TIME during check. --- configure.ac | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 681c25b052c..169ffc55341 100644 --- a/configure.ac +++ b/configure.ac @@ -4201,7 +4201,7 @@ getrusage get_current_dir_name \ lrand48 random rint trunc \ select getpagesize setlocale newlocale \ getrlimit setrlimit shutdown \ -pthread_sigmask strsignal setitimer timer_getoverrun \ +pthread_sigmask strsignal setitimer \ sendto recvfrom getsockname getifaddrs freeifaddrs \ gai_strerror sync \ getpwent endpwent getgrent endgrent \ @@ -5498,6 +5498,12 @@ gl_INIT CFLAGS=$SAVE_CFLAGS LIBS=$SAVE_LIBS +# timer_getoverrun needs the same libarary as timer_settime +OLD_LIBS=$LIBS +LIBS="$LIB_TIMER_TIME $LIBS" +AC_CHECK_FUNCS(timer_getoverrun) +LIBS=$OLD_LIBS + if test "${opsys}" = "mingw32"; then CPPFLAGS="$CPPFLAGS -DUSE_CRT_DLL=1 -I \${abs_top_srcdir}/nt/inc" # Remove unneeded switches from the value of CC that goes to Makefiles From ea5ea09244b762008bba509d8c58bad5835fb949 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 19:42:44 +0200 Subject: [PATCH 093/128] Seccomp filter: allow reading the current time (Bug#47708). * lib-src/seccomp-filter.c (main): Allow reading the current time. --- lib-src/seccomp-filter.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index e4d56e01b4d..9d25a5fe142 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -40,6 +40,7 @@ human-readable representation to out.pfc. */ #include #include #include +#include #include #include @@ -286,6 +287,12 @@ main (int argc, char **argv) RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigprocmask)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (rt_sigprocmask)); + /* Allow reading the current time. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (clock_gettime), + SCMP_A0_32 (SCMP_CMP_EQ, CLOCK_REALTIME)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (time)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettimeofday)); + /* Allow timer support. */ RULE (SCMP_ACT_ALLOW, SCMP_SYS (timer_create)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (timerfd_create)); From 9a57897ea1a125782ff332814d3f978c38162cf8 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 19:35:39 +0200 Subject: [PATCH 094/128] Don't attempt to generate Seccomp filter file in Linux < 4.14. Only Linux 4.14 and later contain the required support for SECCOMP_RET_KILL_PROCESS. * lib-src/Makefile.in (SECCOMP_FILTER): Define only if we run at least Linux 4.14. --- lib-src/Makefile.in | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index b4143b33554..35cfa56d8be 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -196,9 +196,15 @@ LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@ # Currently, we can only generate seccomp filter files for x86-64. ifeq ($(HAVE_LIBSECCOMP),yes) ifeq ($(shell uname -m),x86_64) +# We require SECCOMP_RET_KILL_PROCESS, which is only available in +# Linux 4.14 and later. +ifeq ($(shell { echo 4.14; uname -r | cut -d . -f 1-2; } | \ + sort -C -t . -n -k 1,1 -k 2,2 && \ + echo 1),1) SECCOMP_FILTER=1 endif endif +endif ifeq ($(SECCOMP_FILTER),1) DONT_INSTALL += seccomp-filter$(EXEEXT) From cf0701eff0f3b06e0324be07f7810cbaf261f7f3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 21:14:09 +0200 Subject: [PATCH 095/128] * lib-src/seccomp-filter.c (main): Also allow O_NOFOLLOW. --- lib-src/seccomp-filter.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index 9d25a5fe142..a5f2e0adbca 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -241,12 +241,12 @@ main (int argc, char **argv) RULE (SCMP_ACT_ALLOW, SCMP_SYS (open), SCMP_A1_32 (SCMP_CMP_MASKED_EQ, ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH - | O_DIRECTORY), + | O_DIRECTORY | O_NOFOLLOW), 0)); RULE (SCMP_ACT_ALLOW, SCMP_SYS (openat), SCMP_A2_32 (SCMP_CMP_MASKED_EQ, ~(O_RDONLY | O_BINARY | O_CLOEXEC | O_PATH - | O_DIRECTORY), + | O_DIRECTORY | O_NOFOLLOW), 0)); /* Allow `tcgetpgrp'. */ From c8d542fd593f06b85d4b7b712378a4f84ec4d2b3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 19:47:36 +0200 Subject: [PATCH 096/128] Add a variant of the Seccomp filter file that allows 'execve'. This is useful when starting Emacs with a Seccomp filter enabled, e.g. using 'bwrap'. * lib-src/seccomp-filter.c (main): Generate new Seccomp files. * lib-src/Makefile.in (all) (seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc): Generate new Seccomp files. * .gitignore: Ignore new Seccomp files. * test/src/emacs-tests.el (emacs-tests/bwrap/allows-stdout): New unit test. --- .gitignore | 2 + lib-src/Makefile.in | 7 ++-- lib-src/seccomp-filter.c | 39 +++++++++++++++++-- .../emacs-resources/seccomp-filter-exec.bpf | 1 + test/src/emacs-tests.el | 33 ++++++++++++++++ 5 files changed, 75 insertions(+), 7 deletions(-) create mode 120000 test/src/emacs-resources/seccomp-filter-exec.bpf diff --git a/.gitignore b/.gitignore index ecf768dc4d6..a1e3cb92f87 100644 --- a/.gitignore +++ b/.gitignore @@ -306,3 +306,5 @@ src/gdb.ini # Seccomp filter files. lib-src/seccomp-filter.bpf lib-src/seccomp-filter.pfc +lib-src/seccomp-filter-exec.bpf +lib-src/seccomp-filter-exec.pfc diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 35cfa56d8be..091f4fb0199 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -240,7 +240,7 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} ifeq ($(SECCOMP_FILTER),1) -all: seccomp-filter.bpf +all: seccomp-filter.bpf seccomp-filter-exec.bpf endif .PHONY: all need-blessmail maybe-blessmail @@ -430,9 +430,10 @@ seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \ $(LIBSECCOMP_LIBS) -o $@ -seccomp-filter.bpf seccomp-filter.pfc: seccomp-filter$(EXEEXT) +seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT) $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ - seccomp-filter.bpf seccomp-filter.pfc + seccomp-filter.bpf seccomp-filter.pfc \ + seccomp-filter-exec.bpf seccomp-filter-exec.pfc endif ## Makefile ends here. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index a5f2e0adbca..ed362bc18d9 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -26,10 +26,12 @@ only a Linux kernel supporting the Secure Computing extension. Usage: - seccomp-filter out.bpf out.pfc + seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc This writes the raw `struct sock_filter' array to out.bpf and a -human-readable representation to out.pfc. */ +human-readable representation to out.pfc. Additionally, it writes +variants of those files that can be used to sandbox Emacs before +'execve' to out-exec.bpf and out-exec.pfc. */ #include "config.h" @@ -42,6 +44,7 @@ human-readable representation to out.pfc. */ #include #include +#include #include #include #include @@ -139,8 +142,9 @@ export_filter (const char *file, int main (int argc, char **argv) { - if (argc != 3) - fail (0, "usage: %s out.bpf out.pfc", argv[0]); + if (argc != 5) + fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc", + argv[0]); /* Any unhandled syscall should abort the Emacs process. */ ctx = seccomp_init (SCMP_ACT_KILL_PROCESS); @@ -156,6 +160,8 @@ main (int argc, char **argv) verify (CHAR_BIT == 8); verify (sizeof (int) == 4 && INT_MIN == INT32_MIN && INT_MAX == INT32_MAX); + verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN + && LONG_MAX == INT64_MAX); verify (sizeof (void *) == 8); verify ((uintptr_t) NULL == 0); @@ -327,4 +333,29 @@ main (int argc, char **argv) EXPORT_FILTER (argv[1], seccomp_export_bpf); EXPORT_FILTER (argv[2], seccomp_export_pfc); + + /* When applying a Seccomp filter before executing the Emacs binary + (e.g. using the `bwrap' program), we need to allow further system + calls. Firstly, the wrapper binary will need to `execve' the + Emacs binary. Furthermore, the C library requires some system + calls at startup time to set up thread-local storage. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), + SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs)); + + /* We want to allow starting the Emacs binary itself with the + --seccomp flag, so we need to allow the `prctl' and `seccomp' + system calls. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS), + SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0), + SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp), + SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER), + SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC)); + + EXPORT_FILTER (argv[3], seccomp_export_bpf); + EXPORT_FILTER (argv[4], seccomp_export_pfc); } diff --git a/test/src/emacs-resources/seccomp-filter-exec.bpf b/test/src/emacs-resources/seccomp-filter-exec.bpf new file mode 120000 index 00000000000..5b0e9978221 --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter-exec.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter-exec.bpf \ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 89d811f8b4e..09f9a248efb 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -177,4 +177,37 @@ to `make-temp-file', which see." (ert-info ((format "Process output: %s" (buffer-string))) (should-not (eql status 0))))))) +(ert-deftest emacs-tests/bwrap/allows-stdout () + (let ((bash (executable-find "bash")) + (bwrap (executable-find "bwrap")) + (emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter-exec.bpf")) + (process-environment nil)) + (skip-unless bash) + (skip-unless bwrap) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + (should-not (file-remote-p bwrap)) + (should-not (file-remote-p emacs)) + (should-not (file-remote-p filter)) + (with-temp-buffer + (let* ((command + (concat + (mapconcat #'shell-quote-argument + `(,(file-name-unquote bwrap) + "--ro-bind" "/" "/" + "--seccomp" "20" + "--" + ,(file-name-unquote emacs) + "--quick" "--batch" + ,(format "--eval=%S" '(message "Hi"))) + " ") + " 20< " + (shell-quote-argument (file-name-unquote filter)))) + (status (call-process bash nil t nil "-c" command))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + ;;; emacs-tests.el ends here From d37f0f3ac34f09830a881280131980f875d075d3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 14 Dec 2020 21:25:11 +0100 Subject: [PATCH 097/128] * src/emacs.c (load_seccomp): Consistently check for nonzero result --- src/emacs.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/emacs.c b/src/emacs.c index 694d975ec3d..362e4a2cc5a 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1079,7 +1079,7 @@ load_seccomp (const char *file) file); goto out; } - if (emacs_close (fd) < 0) + if (emacs_close (fd) != 0) emacs_perror ("close"); /* not a fatal error */ fd = -1; program.len = count; From 4315a0bb267e8fca16552001e3ab897f69ef8d70 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 18:02:34 -0400 Subject: [PATCH 098/128] * lisp/progmodes/bug-reference.el: Avoid old-style `define-minor-mode` (bug-reference-mode, bug-reference-prog-mode): Remove redundant args. --- lisp/progmodes/bug-reference.el | 6 ------ 1 file changed, 6 deletions(-) diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 4d4becf780a..e467d98303e 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -440,9 +440,6 @@ and set it if applicable." ;;;###autoload (define-minor-mode bug-reference-mode "Toggle hyperlinking bug references in the buffer (Bug Reference mode)." - nil - "" - nil :after-hook (bug-reference--run-auto-setup) (if bug-reference-mode (jit-lock-register #'bug-reference-fontify) @@ -454,9 +451,6 @@ and set it if applicable." ;;;###autoload (define-minor-mode bug-reference-prog-mode "Like `bug-reference-mode', but only buttonize in comments and strings." - nil - "" - nil :after-hook (bug-reference--run-auto-setup) (if bug-reference-prog-mode (jit-lock-register #'bug-reference-fontify) From 28a5932e745faee66ce7b23f4c102d29083519e7 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:27:25 -0400 Subject: [PATCH 099/128] * lisp/vc/log-edit.el (log-edit-diff-function): Give non-nil default (log-edit-show-diff): Simplify accordingly. --- lisp/vc/log-edit.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 56b31662210..eabbaba32c0 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -191,7 +191,8 @@ when this variable is set to nil.") (defconst log-edit-files-buf "*log-edit-files*") (defvar log-edit-initial-files nil) (defvar log-edit-callback nil) -(defvar log-edit-diff-function nil) +(defvar log-edit-diff-function + (lambda () (error "Diff functionality has not been setup"))) (defvar log-edit-listfun nil) (defvar log-edit-parent-buffer nil) @@ -659,9 +660,7 @@ Also saves its contents in the comment history and hides (defun log-edit-show-diff () "Show the diff for the files to be committed." (interactive) - (if (functionp log-edit-diff-function) - (funcall log-edit-diff-function) - (error "Diff functionality has not been setup"))) + (funcall log-edit-diff-function)) (defun log-edit-show-files () "Show the list of files to be committed." From 828e688bef468fb80b291739529e3d4e2d79eddd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:34:58 -0400 Subject: [PATCH 100/128] * lisp/progmodes/sql.el (sql-mode-ansi-font-lock-keywords): Fix declaration --- lisp/progmodes/sql.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 6224b3b5f3f..6e53a04f72d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1545,9 +1545,7 @@ statement. The format of variable should be a valid ;; `sql-font-lock-keywords-builder' function and follow the ;; implementation pattern used for the other products in this file. -(eval-when-compile - (defvar sql-mode-ansi-font-lock-keywords) - (setq sql-mode-ansi-font-lock-keywords nil)) +(defvar sql-mode-ansi-font-lock-keywords) (eval-and-compile (defun sql-font-lock-keywords-builder (face boundaries &rest keywords) From 954ce51d7a30e7d20bebbb3205c69e9b80181c34 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:38:34 -0400 Subject: [PATCH 101/128] * lisp/mail/rmailmm.el (rmail-mime): Simplify interactive spec --- lisp/mail/rmailmm.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index cdb994a5c8e..e08500a1898 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1402,7 +1402,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'. By default, this displays text and multipart messages, and offers to download attachments as specified by `rmail-mime-attachment-dirs-alist'. The arguments ARG and STATE have no effect in this case." - (interactive (list current-prefix-arg nil)) + (interactive) (if rmail-enable-mime (with-current-buffer rmail-buffer (if (or (rmail-mime-message-p) From 24073c6479b2aefa13f7f9c87697ad38e0144203 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:42:36 -0400 Subject: [PATCH 102/128] * lisp/eshell/esh-proc.el (eshell-kill-process-function): Use `remove-hook` Also remove redundant `:group` args --- lisp/eshell/esh-proc.el | 38 +++++++++++++------------------------- 1 file changed, 13 insertions(+), 25 deletions(-) diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index 369382906c8..96c9a60deab 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -37,23 +37,19 @@ finish." (defcustom eshell-proc-load-hook nil "A hook that gets run when `eshell-proc' is loaded." :version "24.1" ; removed eshell-proc-initialize - :type 'hook - :group 'eshell-proc) + :type 'hook) (defcustom eshell-process-wait-seconds 0 "The number of seconds to delay waiting for a synchronous process." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-process-wait-milliseconds 50 "The number of milliseconds to delay waiting for a synchronous process." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-done-messages-in-minibuffer t "If non-nil, subjob \"Done\" messages will display in minibuffer." - :type 'boolean - :group 'eshell-proc) + :type 'boolean) (defcustom eshell-delete-exited-processes t "If nil, process entries will stick around until `jobs' is run. @@ -72,14 +68,12 @@ subjob is done is that it will no longer appear in the Note that Eshell will have to be restarted for a change in this variable's value to take effect." - :type 'boolean - :group 'eshell-proc) + :type 'boolean) (defcustom eshell-reset-signals "^\\(interrupt\\|killed\\|quit\\|stopped\\)" "If a termination signal matches this regexp, the terminal will be reset." - :type 'regexp - :group 'eshell-proc) + :type 'regexp) (defcustom eshell-exec-hook nil "Called each time a process is exec'd by `eshell-gather-process-output'. @@ -88,8 +82,7 @@ It is useful for things that must be done each time a process is executed in an eshell mode buffer (e.g., `set-process-query-on-exit-flag'). In contrast, `eshell-mode-hook' is only executed once, when the buffer is created." - :type 'hook - :group 'eshell-proc) + :type 'hook) (defcustom eshell-kill-hook nil "Called when a process run by `eshell-gather-process-output' has ended. @@ -99,8 +92,7 @@ nil, in which case the user attempted to send a signal, but there was no relevant process. This can be used for displaying help information, for example." :version "24.1" ; removed eshell-reset-after-proc - :type 'hook - :group 'eshell-proc) + :type 'hook) ;;; Internal Variables: @@ -126,8 +118,7 @@ information, for example." Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments PROC and STATUS to functions on the latter." ;; Was there till 24.1, but it is not optional. - (if (memq #'eshell-reset-after-proc eshell-kill-hook) - (setq eshell-kill-hook (delq #'eshell-reset-after-proc eshell-kill-hook))) + (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) (eshell-reset-after-proc status) (run-hook-with-args 'eshell-kill-hook proc status)) @@ -165,7 +156,7 @@ The signals which will cause this to happen are matched by eshell-process-wait-milliseconds)))) (setq procs (cdr procs)))) -(defalias 'eshell/wait 'eshell-wait-for-process) +(defalias 'eshell/wait #'eshell-wait-for-process) (defun eshell/jobs (&rest _args) "List processes, if there are any." @@ -457,8 +448,7 @@ If QUERY is non-nil, query the user with QUERY before calling FUNC." (defcustom eshell-kill-process-wait-time 5 "Seconds to wait between sending termination signals to a subprocess." - :type 'integer - :group 'eshell-proc) + :type 'integer) (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) "Signals used to kill processes when an Eshell buffer exits. @@ -466,8 +456,7 @@ Eshell calls each of these signals in order when an Eshell buffer is killed; if the process is still alive afterwards, Eshell waits a number of seconds defined by `eshell-kill-process-wait-time', and tries the next signal in the list." - :type '(repeat symbol) - :group 'eshell-proc) + :type '(repeat symbol)) (defcustom eshell-kill-processes-on-exit nil "If non-nil, kill active processes when exiting an Eshell buffer. @@ -489,8 +478,7 @@ long to delay between signals." :type '(choice (const :tag "Kill all, don't ask" t) (const :tag "Ask before killing" ask) (const :tag "Ask for each process" every) - (const :tag "Don't kill subprocesses" nil)) - :group 'eshell-proc) + (const :tag "Don't kill subprocesses" nil))) (defun eshell-round-robin-kill (&optional query) "Kill current process by trying various signals in sequence. From a89da3f00840bf95d92f9959f62fd1a0f7d26566 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:46:48 -0400 Subject: [PATCH 103/128] * lisp/eshell/esh-util.el: Require `seq` Also remove redundant `:group` args and tweak comment --- lisp/eshell/esh-util.el | 164 +++++++++++++++++++--------------------- 1 file changed, 76 insertions(+), 88 deletions(-) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index a48f62654d5..30104816f07 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -23,6 +23,7 @@ ;;; Code: +(require 'seq) (eval-when-compile (require 'cl-lib)) (defgroup eshell-util nil @@ -37,25 +38,21 @@ If nil, t will be represented only in the exit code of the function, and not printed as a string. This causes Lisp functions to behave similarly to external commands, as far as successful result output." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-group-file "/etc/group" "If non-nil, the name of the group file on your system." - :type '(choice (const :tag "No group file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No group file" nil) file)) (defcustom eshell-passwd-file "/etc/passwd" "If non-nil, the name of the passwd file on your system." - :type '(choice (const :tag "No passwd file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No passwd file" nil) file)) (defcustom eshell-hosts-file "/etc/hosts" "The name of the /etc/hosts file. Use `pcomplete-hosts-file' instead; this variable is obsolete and has no effect." - :type '(choice (const :tag "No hosts file" nil) file) - :group 'eshell-util) + :type '(choice (const :tag "No hosts file" nil) file)) ;; Don't make it into an alias, because it doesn't really work with ;; custom and risks creating duplicate entries. Just point users to ;; the other variable, which is less frustrating. @@ -64,25 +61,21 @@ has no effect." (defcustom eshell-handle-errors t "If non-nil, Eshell will handle errors itself. Setting this to nil is offered as an aid to debugging only." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-private-file-modes 384 ; umask 177 "The file-modes value to use for creating \"private\" files." - :type 'integer - :group 'eshell-util) + :type 'integer) (defcustom eshell-private-directory-modes 448 ; umask 077 "The file-modes value to use for creating \"private\" directories." - :type 'integer - :group 'eshell-util) + :type 'integer) (defcustom eshell-tar-regexp "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" "Regular expression used to match tar file names." :version "24.1" ; added xz - :type 'regexp - :group 'eshell-util) + :type 'regexp) (defcustom eshell-convert-numeric-arguments t "If non-nil, converting arguments of numeric form to Lisp numbers. @@ -99,16 +92,14 @@ following in your init file: Any function with the property `eshell-no-numeric-conversions' set to a non-nil value, will be passed strings, not numbers, even when an argument matches `eshell-number-regexp'." - :type 'boolean - :group 'eshell-util) + :type 'boolean) (defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" "Regular expression used to match numeric arguments. If `eshell-convert-numeric-arguments' is non-nil, and an argument matches this regexp, it will be converted to a Lisp number, using the function `string-to-number'." - :type 'regexp - :group 'eshell-util) + :type 'regexp) (defcustom eshell-ange-ls-uids nil "List of user/host/id strings, used to determine remote ownership." @@ -116,8 +107,7 @@ function `string-to-number'." (string :tag "Hostname") (repeat (cons :tag "User/UID List" (string :tag "Username") - (repeat :tag "UIDs" string))))) - :group 'eshell-util) + (repeat :tag "UIDs" string)))))) ;;; Internal Variables: @@ -308,11 +298,11 @@ Prepend remote identification of `default-directory', if any." (defsubst eshell-stringify-list (args) "Convert each element of ARGS into a string value." - (mapcar 'eshell-stringify args)) + (mapcar #'eshell-stringify args)) (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat 'eshell-stringify (flatten-tree args) " ")) + (mapconcat #'eshell-stringify (flatten-tree args) " ")) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." @@ -471,7 +461,7 @@ list." (defsubst eshell-copy-environment () "Return an unrelated copy of `process-environment'." - (mapcar 'concat process-environment)) + (mapcar #'concat process-environment)) (defun eshell-subgroups (groupsym) "Return all of the subgroups of GROUPSYM." @@ -619,70 +609,68 @@ gid format. Valid values are `string' and `integer', defaulting to "If the `processp' function does not exist, PROC is not a process." (and (fboundp 'processp) (processp proc))) -; (defun eshell-copy-file -; (file newname &optional ok-if-already-exists keep-date) -; "Copy FILE to NEWNAME. See docs for `copy-file'." -; (let (copied) -; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) -; (let ((front (match-string 1 file)) -; (back (match-string 2 file)) -; buffer) -; (if (and front (string-match eshell-tar-regexp front) -; (setq buffer (find-file-noselect front))) -; (with-current-buffer buffer -; (goto-char (point-min)) -; (if (re-search-forward (concat " " (regexp-quote back) -; "$") nil t) -; (progn -; (tar-copy (if (file-directory-p newname) -; (expand-file-name -; (file-name-nondirectory back) newname) -; newname)) -; (setq copied t)) -; (error "%s not found in tar file %s" back front)))))) -; (unless copied -; (copy-file file newname ok-if-already-exists keep-date)))) +;; (defun eshell-copy-file +;; (file newname &optional ok-if-already-exists keep-date) +;; "Copy FILE to NEWNAME. See docs for `copy-file'." +;; (let (copied) +;; (if (string-match "\\`\\([^:]+\\):\\(.*\\)" file) +;; (let ((front (match-string 1 file)) +;; (back (match-string 2 file)) +;; buffer) +;; (if (and front (string-match eshell-tar-regexp front) +;; (setq buffer (find-file-noselect front))) +;; (with-current-buffer buffer +;; (goto-char (point-min)) +;; (if (re-search-forward (concat " " (regexp-quote back) +;; "$") nil t) +;; (progn +;; (tar-copy (if (file-directory-p newname) +;; (expand-file-name +;; (file-name-nondirectory back) newname) +;; newname)) +;; (setq copied t)) +;; (error "%s not found in tar file %s" back front)))))) +;; (unless copied +;; (copy-file file newname ok-if-already-exists keep-date)))) -; (defun eshell-file-attributes (filename) -; "Return a list of attributes of file FILENAME. -; See the documentation for `file-attributes'." -; (let (result) -; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) -; (let ((front (match-string 1 filename)) -; (back (match-string 2 filename)) -; buffer) -; (when (and front (string-match eshell-tar-regexp front) -; (setq buffer (find-file-noselect front))) -; (with-current-buffer buffer -; (goto-char (point-min)) -; (when (re-search-forward (concat " " (regexp-quote back) -; "\\s-*$") nil t) -; (let* ((descrip (tar-current-descriptor)) -; (tokens (tar-desc-tokens descrip))) -; (setq result -; (list -; (cond -; ((eq (tar-header-link-type tokens) 5) -; t) -; ((eq (tar-header-link-type tokens) t) -; (tar-header-link-name tokens))) -; 1 -; (tar-header-uid tokens) -; (tar-header-gid tokens) -; (tar-header-date tokens) -; (tar-header-date tokens) -; (tar-header-date tokens) -; (tar-header-size tokens) -; (concat -; (cond -; ((eq (tar-header-link-type tokens) 5) "d") -; ((eq (tar-header-link-type tokens) t) "l") -; (t "-")) -; (tar-grind-file-mode (tar-header-mode tokens) -; (make-string 9 ? ) 0)) -; nil nil nil)))))))) -; (or result -; (file-attributes filename)))) +;; (defun eshell-file-attributes (filename) +;; "Return a list of attributes of file FILENAME. +;; See the documentation for `file-attributes'." +;; (let (result) +;; (when (string-match "\\`\\([^:]+\\):\\(.*\\)\\'" filename) +;; (let ((front (match-string 1 filename)) +;; (back (match-string 2 filename)) +;; buffer) +;; (when (and front (string-match eshell-tar-regexp front) +;; (setq buffer (find-file-noselect front))) +;; (with-current-buffer buffer +;; (goto-char (point-min)) +;; (when (re-search-forward (concat " " (regexp-quote back) +;; "\\s-*$") nil t) +;; (let* ((descrip (tar-current-descriptor)) +;; (tokens (tar-desc-tokens descrip))) +;; (setq result +;; (list +;; (cond +;; ((eq (tar-header-link-type tokens) 5) +;; t) +;; ((eq (tar-header-link-type tokens) t) +;; (tar-header-link-name tokens))) +;; 1 +;; (tar-header-uid tokens) +;; (tar-header-gid tokens) +;; (tar-header-date tokens) +;; (tar-header-date tokens) +;; (tar-header-date tokens) +;; (tar-header-size tokens) +;; (file-modes-number-to-symbolic +;; (logior (tar-header-mode tokens) +;; (cond +;; ((eq (tar-header-link-type tokens) 5) 16384) +;; ((eq (tar-header-link-type tokens) t) 32768)))) +;; nil nil nil)))))))) +;; (or result +;; (file-attributes filename)))) ;; Obsolete. From ccfd6a975e377db6f0ebb9ad6eb0798cff169ce9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 22:55:18 -0400 Subject: [PATCH 104/128] * lisp/gnus/message.el: Give non-nil defaults for function vars MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also prefer #' to quote functions. (message-send-rename-function, message-reply-to-function) (message-wide-reply-to-function, message-followup-to-function): Use a non-nil default value so it can be used with `add-function`. (message-do-send-housekeeping): Tweak accordingly. (message-get-reply-headers): Simplify by η-reduction. --- lisp/gnus/message.el | 166 +++++++++++++++++++++---------------------- 1 file changed, 83 insertions(+), 83 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fad4ef3dcf6..f3b830cf849 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -120,12 +120,13 @@ :group 'message-buffers :type 'integer) -(defcustom message-send-rename-function nil +(defcustom message-send-rename-function #'message-default-send-rename-function "Function called to rename the buffer after sending it." :group 'message-buffers - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-fcc-handler-function 'message-output +(defcustom message-fcc-handler-function #'message-output "A function called to save outgoing articles. This function will be called with the name of the file to store the article in. The default function is `message-output' which saves in Unix @@ -418,7 +419,7 @@ you can explicitly override this setting by calling :type 'string :group 'message-various) -(defcustom message-cross-post-note-function 'message-cross-post-insert-note +(defcustom message-cross-post-note-function #'message-cross-post-insert-note "Function to use to insert note about Crosspost or Followup-To. The function will be called with four arguments. The function should not only insert a note, but also ensure old notes are deleted. See the documentation @@ -756,7 +757,7 @@ See also `send-mail-function'." :link '(custom-manual "(message)Mail Variables") :group 'message-mail) -(defcustom message-send-news-function 'message-send-news +(defcustom message-send-news-function #'message-send-news "Function to call to send the current buffer as news. The headers should be delimited by a line whose contents match the variable `mail-header-separator'." @@ -765,29 +766,32 @@ variable `mail-header-separator'." :link '(custom-manual "(message)News Variables") :type 'function) -(defcustom message-reply-to-function nil +(defcustom message-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-wide-reply-to-function nil +(defcustom message-wide-reply-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Wide Reply") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) -(defcustom message-followup-to-function nil +(defcustom message-followup-to-function #'ignore "If non-nil, function that should return a list of headers. This function should pick out addresses from the To, Cc, and From headers and respond with new To and Cc headers." :group 'message-interface :link '(custom-manual "(message)Followup") - :type '(choice function (const nil))) + :version "28.1" + :type 'function) (defcustom message-extra-wide-headers nil "If non-nil, a list of additional address headers. @@ -1021,7 +1025,7 @@ the signature is inserted." :version "22.1" :group 'message-various) -(defcustom message-citation-line-function 'message-insert-citation-line +(defcustom message-citation-line-function #'message-insert-citation-line "Function called to insert the \"Whomever writes:\" line. Predefined functions include `message-insert-citation-line' and @@ -1103,7 +1107,7 @@ Used by `message-yank-original' via `message-yank-cite'." :link '(custom-manual "(message)Insertion Variables") :type 'integer) -(defcustom message-cite-function 'message-cite-original-without-signature +(defcustom message-cite-function #'message-cite-original-without-signature "Function for citing an original message. Predefined functions include `message-cite-original' and `message-cite-original-without-signature'. @@ -1116,7 +1120,7 @@ Note that these functions use `mail-citation-hook' if that is non-nil." :version "22.3" ;; Gnus 5.10.12 (changed default) :group 'message-insertion) -(defcustom message-indent-citation-function 'message-indent-citation +(defcustom message-indent-citation-function #'message-indent-citation "Function for modifying a citation just inserted in the mail buffer. This can also be a list of functions. Each function can find the citation between (point) and (mark t). And each function should leave @@ -2847,79 +2851,79 @@ Consider adding this function to `message-header-setup-hook'" (unless message-mode-map (setq message-mode-map (make-keymap)) (set-keymap-parent message-mode-map text-mode-map) - (define-key message-mode-map "\C-c?" 'describe-mode) + (define-key message-mode-map "\C-c?" #'describe-mode) - (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from) - (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) + (define-key message-mode-map "\C-c\C-f\C-t" #'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-o" #'message-goto-from) + (define-key message-mode-map "\C-c\C-f\C-b" #'message-goto-bcc) + (define-key message-mode-map "\C-c\C-f\C-w" #'message-goto-fcc) + (define-key message-mode-map "\C-c\C-f\C-c" #'message-goto-cc) + (define-key message-mode-map "\C-c\C-f\C-s" #'message-goto-subject) + (define-key message-mode-map "\C-c\C-f\C-r" #'message-goto-reply-to) + (define-key message-mode-map "\C-c\C-f\C-n" #'message-goto-newsgroups) + (define-key message-mode-map "\C-c\C-f\C-d" #'message-goto-distribution) + (define-key message-mode-map "\C-c\C-f\C-f" #'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-m" #'message-goto-mail-followup-to) + (define-key message-mode-map "\C-c\C-f\C-k" #'message-goto-keywords) + (define-key message-mode-map "\C-c\C-f\C-u" #'message-goto-summary) (define-key message-mode-map "\C-c\C-f\C-i" - 'message-insert-or-toggle-importance) + #'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\C-f\C-a" - 'message-generate-unsubscribed-mail-followup-to) + #'message-generate-unsubscribed-mail-followup-to) ;; modify headers (and insert notes in body) - (define-key message-mode-map "\C-c\C-fs" 'message-change-subject) + (define-key message-mode-map "\C-c\C-fs" #'message-change-subject) ;; - (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to) + (define-key message-mode-map "\C-c\C-fx" #'message-cross-post-followup-to) ;; prefix+message-cross-post-followup-to = same w/o cross-post - (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc) - (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header) + (define-key message-mode-map "\C-c\C-ft" #'message-reduce-to-to-cc) + (define-key message-mode-map "\C-c\C-fa" #'message-add-archive-header) ;; mark inserted text - (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region) - (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file) + (define-key message-mode-map "\C-c\M-m" #'message-mark-inserted-region) + (define-key message-mode-map "\C-c\M-f" #'message-mark-insert-file) - (define-key message-mode-map "\C-c\C-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) + (define-key message-mode-map "\C-c\C-b" #'message-goto-body) + (define-key message-mode-map "\C-c\C-i" #'message-goto-signature) - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - (define-key message-mode-map "\C-c\C-l" 'message-to-list-only) - (define-key message-mode-map "\C-c\C-f\C-e" 'message-insert-expires) + (define-key message-mode-map "\C-c\C-t" #'message-insert-to) + (define-key message-mode-map "\C-c\C-fw" #'message-insert-wide-reply) + (define-key message-mode-map "\C-c\C-n" #'message-insert-newsgroups) + (define-key message-mode-map "\C-c\C-l" #'message-to-list-only) + (define-key message-mode-map "\C-c\C-f\C-e" #'message-insert-expires) - (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance) + (define-key message-mode-map "\C-c\C-u" #'message-insert-or-toggle-importance) (define-key message-mode-map "\C-c\M-n" - 'message-insert-disposition-notification-to) + #'message-insert-disposition-notification-to) - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\M-h" 'message-insert-headers) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) + (define-key message-mode-map "\C-c\C-y" #'message-yank-original) + (define-key message-mode-map "\C-c\M-\C-y" #'message-yank-buffer) + (define-key message-mode-map "\C-c\C-q" #'message-fill-yanked-message) + (define-key message-mode-map "\C-c\C-w" #'message-insert-signature) + (define-key message-mode-map "\C-c\M-h" #'message-insert-headers) + (define-key message-mode-map "\C-c\C-r" #'message-caesar-buffer-body) + (define-key message-mode-map "\C-c\C-o" #'message-sort-headers) + (define-key message-mode-map "\C-c\M-r" #'message-rename-buffer) - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" 'message-send) - (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" 'message-dont-send) - (define-key message-mode-map "\C-c\n" 'gnus-delay-article) + (define-key message-mode-map "\C-c\C-c" #'message-send-and-exit) + (define-key message-mode-map "\C-c\C-s" #'message-send) + (define-key message-mode-map "\C-c\C-k" #'message-kill-buffer) + (define-key message-mode-map "\C-c\C-d" #'message-dont-send) + (define-key message-mode-map "\C-c\n" #'gnus-delay-article) - (define-key message-mode-map "\C-c\M-k" 'message-kill-address) - (define-key message-mode-map "\C-c\C-e" 'message-elide-region) - (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region) - (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature) - (define-key message-mode-map "\M-\r" 'message-newline-and-reformat) - (define-key message-mode-map [remap split-line] 'message-split-line) + (define-key message-mode-map "\C-c\M-k" #'message-kill-address) + (define-key message-mode-map "\C-c\C-e" #'message-elide-region) + (define-key message-mode-map "\C-c\C-v" #'message-delete-not-region) + (define-key message-mode-map "\C-c\C-z" #'message-kill-to-signature) + (define-key message-mode-map "\M-\r" #'message-newline-and-reformat) + (define-key message-mode-map [remap split-line] #'message-split-line) - (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) - (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot) + (define-key message-mode-map "\C-c\C-a" #'mml-attach-file) + (define-key message-mode-map "\C-c\C-p" #'message-insert-screenshot) - (define-key message-mode-map "\C-a" 'message-beginning-of-line) - (define-key message-mode-map "\t" 'message-tab) + (define-key message-mode-map "\C-a" #'message-beginning-of-line) + (define-key message-mode-map "\t" #'message-tab) - (define-key message-mode-map "\M-n" 'message-display-abbrev)) + (define-key message-mode-map "\M-n" #'message-display-abbrev)) (easy-menu-define message-mode-menu message-mode-map "Message Menu." @@ -3169,14 +3173,13 @@ Like `text-mode', but with these additional commands: ;; `electric-pair-mode', and C-M-* navigation by syntactically ;; excluding citations and other artifacts. ;; - (setq-local syntax-propertize-function 'message--syntax-propertize) + (setq-local syntax-propertize-function #'message--syntax-propertize) (setq-local parse-sexp-ignore-comments t) (setq-local message-encoded-mail-cache nil)) (defun message-setup-fill-variables () "Setup message fill variables." (setq-local fill-paragraph-function #'message-fill-paragraph) - (make-local-variable 'adaptive-fill-first-line-regexp) (let ((quote-prefix-regexp ;; User should change message-cite-prefix-regexp if ;; message-yank-prefix is set to an abnormal value. @@ -3287,7 +3290,7 @@ Like `text-mode', but with these additional commands: (push-mark) (message-position-on-field "Summary" "Subject")) -(define-obsolete-function-alias 'message-goto-body-1 'message-goto-body "27.1") +(define-obsolete-function-alias 'message-goto-body-1 #'message-goto-body "27.1") (defun message-goto-body (&optional interactive) "Move point to the beginning of the message body. Returns point." @@ -6662,9 +6665,8 @@ moved to the beginning " (not (buffer-modified-p buffer))) (kill-buffer buffer)))) ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (message-default-send-rename-function)) + (funcall (or message-send-rename-function + #'message-default-send-rename-function)) ;; Push the current buffer onto the list. (when message-max-buffers (setq message-buffer-list @@ -6763,8 +6765,9 @@ are not included." (defun message-setup-1 (headers &optional yank-action actions return-action) (dolist (action actions) (condition-case nil + ;; FIXME: Use functions rather than expressions! (add-to-list 'message-send-actions - `(apply ',(car action) ',(cdr action))))) + `(apply #',(car action) ',(cdr action))))) (setq message-return-action return-action) (setq message-reply-buffer (if (and (consp yank-action) @@ -6903,7 +6906,7 @@ are not included." ;;;###autoload (defun message-mail (&optional to subject other-headers continue switch-function yank-action send-actions - return-action &rest ignored) + return-action &rest _) "Start editing a mail message to be sent. OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION @@ -7127,15 +7130,12 @@ want to get rid of this query permanently."))) ;; specific, and just Cc-in the rest. (setq follow-to (list (cons 'To - (mapconcat - (lambda (addr) - (cdr addr)) recipients ", ")))) + (mapconcat #'cdr recipients ", ")))) ;; Put the first recipient in the To header. (setq follow-to (list (cons 'To (cdr (pop recipients))))) ;; Put the rest of the recipients in Cc. (when recipients - (setq recipients (mapconcat - (lambda (addr) (cdr addr)) recipients ", ")) + (setq recipients (mapconcat #'cdr recipients ", ")) (if (string-match "^ +" recipients) (setq recipients (substring recipients (match-end 0)))) (push (cons 'Cc recipients) follow-to))))) @@ -7862,7 +7862,7 @@ is for the internal use." (interactive) (setq rmail-enable-mime-composing t) (setq rmail-insert-mime-forwarded-message-function - 'message-forward-rmail-make-body)) + #'message-forward-rmail-make-body)) ;;;###autoload (defun message-resend (address) From c45bfd3c4abbfa585c9199f4866b6b8046945117 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Apr 2021 23:47:14 -0400 Subject: [PATCH 105/128] * lisp/**/*.el: Avoid positional args to `define-minor-mode` Back in Emacs-21.1, `define-minor-mode` grew keywords arguments to replace its old positional arguments. Let's make sure we don't use the old-style any more. * lisp/org/ox-beamer.el (org-beamer-mode-map): Move initialization into declaration. (org-beamer-mode): * lisp/textmodes/tildify.el (tildify-mode): * lisp/textmodes/sgml-mode.el (html-autoview-mode): * lisp/textmodes/rst.el (rst-minor-mode): * lisp/textmodes/remember.el (remember-notes-mode): * lisp/textmodes/ispell.el (ispell-minor-mode): * lisp/tar-mode.el (tar-subfile-mode): * lisp/strokes.el (strokes-mode): * lisp/so-long.el (so-long-minor-mode): * lisp/shell.el (shell-dirtrack-mode): * lisp/scroll-all.el (scroll-all-mode): * lisp/ruler-mode.el (ruler-mode): * lisp/rect.el (rectangle-mark-mode): * lisp/progmodes/sh-script.el (sh-electric-here-document-mode): * lisp/outline.el (outline-minor-mode): * lisp/org/org.el (org-cdlatex-mode): * lisp/org/org-table.el (org-table-header-line-mode) (org-table-follow-field-mode, orgtbl-mode): * lisp/org/org-src.el (org-src-mode): * lisp/org/org-list.el (org-list-checkbox-radio-mode): * lisp/org/org-indent.el (org-indent-mode): * lisp/org/org-capture.el (org-capture-mode): * lisp/obsolete/pc-select.el (pc-selection-mode): * lisp/obsolete/iswitchb.el (iswitchb-mode): * lisp/net/rcirc.el (rcirc-omit-mode, rcirc-multiline-minor-mode) (rcirc-track-minor-mode): * lisp/net/goto-addr.el (goto-address-mode, goto-address-prog-mode): * lisp/image-mode.el (image-minor-mode): * lisp/ibuf-ext.el (ibuffer-auto-mode): * lisp/gnus/gnus-cite.el (gnus-message-citation-mode): * lisp/font-core.el (font-lock-mode): * lisp/erc/erc.el (define-erc-module): * lisp/erc/erc-track.el (erc-track-minor-mode): * lisp/erc/erc-fill.el (erc-fill-mode): * lisp/epa-mail.el (epa-mail-mode): * lisp/emacs-lisp/checkdoc.el (checkdoc-minor-mode): * lisp/dirtrack.el (dirtrack-mode, dirtrack-debug-mode): * lisp/dired-aux.el (dired-isearch-filenames-mode): * lisp/cedet/semantic/idle.el (semantic-idle-scheduler-mode): * lisp/cedet/semantic/decorate/mode.el (semantic-decoration-mode): * lisp/autoarg.el (autoarg-mode, autoarg-kp-mode): * lisp/vc/pcvs.el (cvs-minor-mode): Avoid old-style positional args to `define-minor-mode`. --- lisp/autoarg.el | 4 ++-- lisp/cedet/semantic/decorate/mode.el | 2 +- lisp/cedet/semantic/idle.el | 3 ++- lisp/dired-aux.el | 2 +- lisp/dirtrack.el | 4 ++-- lisp/emacs-lisp/checkdoc.el | 2 +- lisp/emacs-lisp/macroexp.el | 3 ++- lisp/epa-mail.el | 2 +- lisp/erc/erc-fill.el | 1 - lisp/erc/erc-track.el | 3 --- lisp/erc/erc.el | 1 - lisp/font-core.el | 1 - lisp/gnus/gnus-cite.el | 4 +--- lisp/ibuf-ext.el | 2 +- lisp/image-mode.el | 3 +-- lisp/net/goto-addr.el | 8 ++------ lisp/net/rcirc.el | 7 +------ lisp/obsolete/iswitchb.el | 2 +- lisp/obsolete/pc-select.el | 2 -- lisp/org/org-capture.el | 2 +- lisp/org/org-indent.el | 2 +- lisp/org/org-list.el | 2 +- lisp/org/org-src.el | 2 +- lisp/org/org-table.el | 6 +++--- lisp/org/org.el | 2 +- lisp/org/ox-beamer.el | 8 +++++--- lisp/outline.el | 5 +++-- lisp/progmodes/sh-script.el | 2 +- lisp/rect.el | 2 +- lisp/ruler-mode.el | 2 -- lisp/scroll-all.el | 2 +- lisp/shell.el | 2 +- lisp/so-long.el | 2 +- lisp/strokes.el | 2 +- lisp/tar-mode.el | 2 +- lisp/textmodes/ispell.el | 2 +- lisp/textmodes/remember.el | 2 +- lisp/textmodes/rst.el | 12 +++++------- lisp/textmodes/sgml-mode.el | 2 +- lisp/textmodes/tildify.el | 2 +- lisp/vc/pcvs.el | 2 +- 41 files changed, 52 insertions(+), 71 deletions(-) diff --git a/lisp/autoarg.el b/lisp/autoarg.el index c2cb0c7051c..7c2c6f1030d 100644 --- a/lisp/autoarg.el +++ b/lisp/autoarg.el @@ -107,7 +107,7 @@ then invokes the normal binding of \\[autoarg-terminate]. `C-u \\[autoarg-terminate]' invokes the normal binding of \\[autoarg-terminate] four times. \\{autoarg-mode-map}" - nil " Aarg" autoarg-mode-map :global t :group 'keyboard) + :lighter" Aarg" :global t :group 'keyboard) ;;;###autoload (define-minor-mode autoarg-kp-mode @@ -118,7 +118,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys `kp-1' etc. to supply digit arguments. \\{autoarg-kp-mode-map}" - nil " Aakp" autoarg-kp-mode-map :global t :group 'keyboard + :lighter " Aakp" :global t :group 'keyboard (if autoarg-kp-mode (dotimes (i 10) (let ((sym (intern (format "kp-%d" i)))) diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 78950159199..c6bf15205fd 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -254,7 +254,7 @@ available and the current buffer was set up for parsing. Return non-nil if the minor mode is enabled." ;; ;;\\{semantic-decoration-map}" - nil nil nil + :lighter nil (if semantic-decoration-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 420a457b0ea..b883573a30f 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -171,7 +171,8 @@ date, and reparses while the user is idle (not typing.) The minor mode can be turned on only if semantic feature is available and the current buffer was set up for parsing. Return -non-nil if the minor mode is enabled." nil nil nil +non-nil if the minor mode is enabled." + :lighter nil (if semantic-idle-scheduler-mode (if (not (and (featurep 'semantic) (semantic-active-p))) (progn diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index d5f49108767..8fe612fa0b1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -2980,7 +2980,7 @@ a file name. Otherwise, it searches the whole buffer without restrictions." When on, Isearch skips matches outside file names using the predicate `dired-isearch-filter-filenames' that matches only at file names. When off, it uses the original predicate." - nil nil nil + :lighter nil (if dired-isearch-filenames-mode (add-function :before-while (local 'isearch-filter-predicate) #'dired-isearch-filter-filenames diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 7f76ef6653a..be8db75c967 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -184,7 +184,7 @@ working directory at all times, and that you set the variable This is an alternative to `shell-dirtrack-mode', which works by tracking `cd' and similar commands which change the shell working directory." - nil nil nil + :lighter nil (if dirtrack-mode (add-hook 'comint-preoutput-filter-functions 'dirtrack nil t) (remove-hook 'comint-preoutput-filter-functions 'dirtrack t))) @@ -192,7 +192,7 @@ directory." (define-minor-mode dirtrack-debug-mode "Toggle Dirtrack debugging." - nil nil nil + :lighter nil (if dirtrack-debug-mode (display-buffer (get-buffer-create dirtrack-debug-buffer)))) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 96b16f7ed45..00cc7777e1a 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1242,7 +1242,7 @@ bound to \\\\[checkdoc-eval-defun] and `checkdoc-eval-c checking of documentation strings. \\{checkdoc-minor-mode-map}" - nil checkdoc-minor-mode-string nil + :lighter checkdoc-minor-mode-string :group 'checkdoc) ;;; Subst utils diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 59ada5ec35a..df864464b77 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -394,7 +394,8 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; Record which arguments expect functions, so we can warn when those ;; are accidentally quoted with ' rather than with #' -(dolist (f '(funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash)) +(dolist (f '( funcall apply mapcar mapatoms mapconcat mapc cl-mapcar maphash + map-char-table map-keymap map-keymap-internal)) (put f 'funarg-positions '(1))) (dolist (f '( add-hook remove-hook advice-remove advice--remove-function defalias fset global-set-key run-after-idle-timeout diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 7e100569b0f..7eac1f89986 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -59,7 +59,7 @@ Otherwise, signal an error." ;;;###autoload (define-minor-mode epa-mail-mode "A minor-mode for composing encrypted/clearsigned mails." - nil " epa-mail" epa-mail-mode-map) + :lighter " epa-mail") ;;; Utilities diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index 0312d221ece..41256682c00 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -46,7 +46,6 @@ the mode if ARG is omitted or nil. ERC fill mode is a global minor mode. When enabled, messages in the channel buffers are filled." - nil nil nil :global t (if erc-fill-mode (erc-fill-enable) diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 9985b6a02f0..2364d45d6f3 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -464,9 +464,6 @@ ERC Track minor mode is a global minor mode. It exists for the sole purpose of providing the C-c C-SPC and C-c C-@ keybindings. Make sure that you have enabled the track module, otherwise the keybindings will not do anything useful." - :init-value nil - :lighter "" - :keymap erc-track-minor-mode-map :global t) (defun erc-track-minor-mode-maybe (&optional buffer) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index f0144de8446..e20aa8057de 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1289,7 +1289,6 @@ With a prefix argument ARG, enable %s if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. %s" name name doc) - nil nil nil ;; FIXME: We don't know if this group exists, so this `:group' may ;; actually just silence a valid warning about the fact that the var ;; is not associated with any group. diff --git a/lisp/font-core.el b/lisp/font-core.el index 4b695424977..db06a607660 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -126,7 +126,6 @@ buffer local value for `font-lock-defaults', via its mode hook. The above is the default behavior of `font-lock-mode'; you may specify your own function which is called when `font-lock-mode' is toggled via `font-lock-function'." - nil nil nil :after-hook (font-lock-initial-fontify) ;; Don't turn on Font Lock mode if we don't have a display (we're running a ;; batch job) or if the buffer is invisible (the name starts with a space). diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 4249b50b9ff..34947cece89 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1134,9 +1134,7 @@ Returns nil if there is no such line before LIMIT, t otherwise." (define-minor-mode gnus-message-citation-mode "Minor mode providing more font-lock support for nested citations. When enabled, it automatically turns on `font-lock-mode'." - nil ;; init-value - "" ;; lighter - nil ;; keymap + :lighter "" (when (derived-mode-p 'message-mode) ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car font-lock-defaults)) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 48f9e8a990d..1dc8acbe1f3 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -402,7 +402,7 @@ format. See `ibuffer-update-saved-filters-format' and ;;;###autoload (define-minor-mode ibuffer-auto-mode "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode)." - nil nil nil + :lighter nil (unless (derived-mode-p 'ibuffer-mode) (error "This buffer is not in Ibuffer mode")) (cond (ibuffer-auto-mode diff --git a/lisp/image-mode.el b/lisp/image-mode.el index f4ff35f9c41..69ef7015cce 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -713,8 +713,7 @@ Key bindings: Image minor mode provides the key \\\\[image-toggle-display], to switch back to `image-mode' and display an image file as the actual image." - nil (:eval (if image-type (format " Image[%s]" image-type) " Image")) - image-minor-mode-map + :lighter (:eval (if image-type (format " Image[%s]" image-type) " Image")) :group 'image :version "22.1" (if image-minor-mode diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index af12f6970a6..8992ef736a6 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -263,9 +263,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and ;;;###autoload (define-minor-mode goto-address-mode "Minor mode to buttonize URLs and e-mail addresses in the current buffer." - nil - "" - nil + :lighter "" (if goto-address-mode (jit-lock-register #'goto-address-fontify-region) (jit-lock-unregister #'goto-address-fontify-region) @@ -285,9 +283,7 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and ;;;###autoload (define-minor-mode goto-address-prog-mode "Like `goto-address-mode', but only for comments and strings." - nil - "" - nil + :lighter "" (if goto-address-prog-mode (jit-lock-register #'goto-address-fontify-region) (jit-lock-unregister #'goto-address-fontify-region) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 938fadfed74..7bb8ca671cf 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -196,7 +196,7 @@ If nil, no maximum is applied." Uninteresting lines are those whose responses are listed in `rcirc-omit-responses'." - nil " Omit" nil + :lighter " Omit" (if rcirc-omit-mode (progn (add-to-invisibility-spec '(rcirc-omit . nil)) @@ -1359,9 +1359,7 @@ Create the buffer if it doesn't exist." (define-minor-mode rcirc-multiline-minor-mode "Minor mode for editing multiple lines in rcirc." - :init-value nil :lighter " rcirc-mline" - :keymap rcirc-multiline-minor-mode-map :global nil (setq fill-column rcirc-max-message-length)) @@ -1863,9 +1861,6 @@ This function does not alter the INPUT string." ;;;###autoload (define-minor-mode rcirc-track-minor-mode "Global minor mode for tracking activity in rcirc buffers." - :init-value nil - :lighter "" - :keymap rcirc-track-minor-mode-map :global t (or global-mode-string (setq global-mode-string '(""))) ;; toggle the mode-line channel indicator diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 7ffee762eb2..a630baf3543 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1336,7 +1336,7 @@ See the variable `iswitchb-case' for details." Iswitchb mode is a global minor mode that enables switching between buffers using substrings. See `iswitchb' for details." - nil nil iswitchb-global-map :global t + :keymap iswitchb-global-map :global t (if iswitchb-mode (add-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup) (remove-hook 'minibuffer-setup-hook #'iswitchb-minibuffer-setup))) diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index 59828759e66..f999f507972 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -314,8 +314,6 @@ but before calling PC Selection mode): C-BACKSPACE backward-kill-word M-BACKSPACE undo" ;; FIXME: bring pc-bindings-mode here ? - nil nil nil - :global t (if pc-selection-mode diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index f40f2b335ef..7ae8fae3aab 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -521,7 +521,7 @@ for a capture buffer.") "Minor mode for special key bindings in a capture buffer. Turning on this mode runs the normal hook `org-capture-mode-hook'." - nil " Cap" org-capture-mode-map + :lighter " Cap" (setq-local header-line-format (substitute-command-keys diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index c6bf416564e..3475cadc42d 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -167,7 +167,7 @@ properties, after each buffer modification, on the modified zone. The process is synchronous. Though, initial indentation of buffer, which can take a few seconds on large buffers, is done during idle time." - nil " Ind" nil + :lighter " Ind" (cond (org-indent-mode ;; mode was turned on. diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index 39122e7ce41..f97164ee33b 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -2304,7 +2304,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ;;;###autoload (define-minor-mode org-list-checkbox-radio-mode "When turned on, use list checkboxes as radio buttons." - nil " CheckBoxRadio" nil + :lighter " CheckBoxRadio" (unless (eq major-mode 'org-mode) (user-error "Cannot turn this mode outside org-mode buffers"))) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 20acee4e662..cabedecb689 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -682,7 +682,7 @@ This minor mode is turned on in two situations: \\{org-src-mode-map} See also `org-src-mode-hook'." - nil " OrgSrc" nil + :lighter " OrgSrc" (when org-edit-src-persistent-message (setq header-line-format (substitute-command-keys diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 1248efabc15..0e93fb271f3 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -495,7 +495,7 @@ This may be useful when columns have been shrunk." ;;;###autoload (define-minor-mode org-table-header-line-mode "Display the first row of the table at point in the header line." - nil " TblHeader" nil + :lighter " TblHeader" (unless (eq major-mode 'org-mode) (user-error "Cannot turn org table header mode outside org-mode buffers")) (if org-table-header-line-mode @@ -1976,7 +1976,7 @@ lines." When this mode is active, the field editor window will always show the current field. The mode exits automatically when the cursor leaves the table (but see `org-table-exit-follow-field-mode-when-leaving-table')." - nil " TblFollow" nil + :lighter " TblFollow" (if org-table-follow-field-mode (add-hook 'post-command-hook 'org-table-follow-fields-with-editor 'append 'local) @@ -5149,7 +5149,7 @@ When LOCAL is non-nil, show references for the table at point." ;;;###autoload (define-minor-mode orgtbl-mode "The Org mode table editor as a minor mode for use in other modes." - :lighter " OrgTbl" :keymap orgtbl-mode-map + :lighter " OrgTbl" (org-load-modules-maybe) (cond ((derived-mode-p 'org-mode) diff --git a/lisp/org/org.el b/lisp/org/org.el index cebe1735bed..f560c65dc4f 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -15584,7 +15584,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved This mode supports entering LaTeX environment and math in LaTeX fragments in Org mode. \\{org-cdlatex-mode-map}" - nil " OCDL" nil + :lighter " OCDL" (when org-cdlatex-mode (require 'cdlatex) (run-hooks 'cdlatex-mode-hook) diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 1a1732b6836..6ed95e84d6b 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -895,14 +895,16 @@ holding export options." ;;; Minor Mode -(defvar org-beamer-mode-map (make-sparse-keymap) +(defvar org-beamer-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-b" 'org-beamer-select-environment) + map) "The keymap for `org-beamer-mode'.") -(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) ;;;###autoload (define-minor-mode org-beamer-mode "Support for editing Beamer oriented Org mode files." - nil " Bm" 'org-beamer-mode-map) + :lighter " Bm") (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords diff --git a/lisp/outline.el b/lisp/outline.el index 79029a6e5e7..bce9c6b9e4d 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -374,8 +374,9 @@ faces to major mode's faces." "Toggle Outline minor mode. See the command `outline-mode' for more information on this mode." - nil " Outl" (list (cons [menu-bar] outline-minor-mode-menu-bar-map) - (cons outline-minor-mode-prefix outline-mode-prefix-map)) + :lighter " Outl" + :keymap (list (cons [menu-bar] outline-minor-mode-menu-bar-map) + (cons outline-minor-mode-prefix outline-mode-prefix-map)) (if outline-minor-mode (progn (when (or outline-minor-mode-cycle outline-minor-mode-highlight) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ba59f9c6616..c6bd32a4a4b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -2967,7 +2967,7 @@ The document is bounded by `sh-here-document-word'." (define-minor-mode sh-electric-here-document-mode "Make << insert a here document skeleton." - nil nil nil + :lighter nil (if sh-electric-here-document-mode (add-hook 'post-self-insert-hook #'sh--maybe-here-document nil t) (remove-hook 'post-self-insert-hook #'sh--maybe-here-document t))) diff --git a/lisp/rect.el b/lisp/rect.el index cb941b46009..504be41b673 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -652,7 +652,7 @@ with a prefix argument, prompt for START-AT and FORMAT." "Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated." - nil nil nil + :lighter nil (rectangle--reset-crutches) (when rectangle-mark-mode (add-hook 'deactivate-mark-hook diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 11226fda020..a0d4f6e96c2 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -568,8 +568,6 @@ format first." ;;;###autoload (define-minor-mode ruler-mode "Toggle display of ruler in header line (Ruler mode)." - nil nil - ruler-mode-map :group 'ruler-mode :variable (ruler-mode . (lambda (enable) diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index 8ba0cc9e032..415244f9e92 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -108,7 +108,7 @@ ARG is like in `end-of-buffer'." When Scroll-All mode is enabled, scrolling commands invoked in one window apply to all visible windows in the same frame." - nil " *SL*" nil + :lighter " *SL*" :global t :group 'windows (if scroll-all-mode diff --git a/lisp/shell.el b/lisp/shell.el index cd99b008776..3098d3a14da 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -980,7 +980,7 @@ Environment variables are expanded, see function `substitute-in-file-name'." The `dirtrack' package provides an alternative implementation of this feature; see the function `dirtrack-mode'." - nil nil nil + :lighter nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode (add-hook 'comint-input-filter-functions #'shell-directory-tracker nil t) diff --git a/lisp/so-long.el b/lisp/so-long.el index f44d41dc5eb..f916b61b60f 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -1185,7 +1185,7 @@ current buffer, and buffer-local values are assigned to variables in accordance with `so-long-variable-overrides'. This minor mode is a standard `so-long-action' option." - nil nil nil + :lighter nil (if so-long-minor-mode ;; We are enabling the mode. (progn ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather diff --git a/lisp/strokes.el b/lisp/strokes.el index 4b682e99feb..4a018ff1993 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1393,7 +1393,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\[strokes-decode-buffer]. \\{strokes-mode-map}" - nil strokes-lighter strokes-mode-map :global t + :ligher strokes-lighter :global t (cond ((not (display-mouse-p)) (error "Can't use Strokes without a mouse")) (strokes-mode ; turn on strokes diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index fa9b47556f7..d9b2d421932 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -751,7 +751,7 @@ into the tar-file buffer that it came from. The changes will actually appear on disk when you save the tar-file's buffer." ;; Don't do this, because it is redundant and wastes mode line space. ;; :lighter " TarFile" - nil nil nil + :lighter nil (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) (error "This buffer is not an element of a tar file")) (cond (tar-subfile-mode diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index eb521134dc4..932308ee59d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -3744,7 +3744,7 @@ SPC. For spell-checking \"on the fly\", not just after typing SPC or RET, use `flyspell-mode'." - nil " Spell" ispell-minor-keymap) + :lighter " Spell" :keymap ispell-minor-keymap) (defun ispell-minor-check () "Check previous word, then continue with the normal binding of this key. diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index cd76bf80f19..8a0436afc64 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -607,7 +607,7 @@ This sets `buffer-save-without-query' so that `save-some-buffers' will save the notes buffer without asking. \\{remember-notes-mode-map}" - nil nil nil + :lighter nil (cond (remember-notes-mode (add-hook 'kill-buffer-query-functions diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 56cca840047..1471be0ecd6 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1408,13 +1408,11 @@ highlighting. When ReST minor mode is enabled, the ReST mode keybindings are installed on top of the major mode bindings. Use this for modes derived from Text mode, like Mail mode." - ;; The initial value. - nil - ;; The indicator for the mode line. - " ReST" - ;; The minor mode bindings. - rst-mode-map - :group 'rst) + ;; The indicator for the mode line. + :lighter " ReST" + ;; The minor mode bindings. + :keymap rst-mode-map + :group 'rst) ;; FIXME: can I somehow install these too? ;; :abbrev-table rst-mode-abbrev-table diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 6958ab8f658..67f731917e2 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -2440,7 +2440,7 @@ The third `match-string' will be the used in the menu.") HTML Autoview mode is a buffer-local minor mode for use with `html-mode'. If enabled, saving the file automatically runs `browse-url-of-buffer' to view it." - nil nil nil + :lighter nil (if html-autoview-mode (add-hook 'after-save-hook #'browse-url-of-buffer nil t) (remove-hook 'after-save-hook #'browse-url-of-buffer t))) diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 069c8e3f443..163978b4315 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -486,7 +486,7 @@ that space character is replaced by a hard space specified by When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space representation for current major mode, the `tildify-space-string' buffer-local variable will be set to the representation." - nil " ~" nil + :lighter " ~" (when tildify-mode (let ((space (with-suppressed-warnings ((obsolete tildify--pick-alist-entry)) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 6e039cc6256..42f531e4f75 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -331,7 +331,7 @@ the primary since reading the primary can deactivate it." "This mode is used for buffers related to a main *cvs* buffer. All the `cvs-mode' buffer operations are simply rebound under the \\[cvs-mode-map] prefix." - nil " CVS" + :lighter " CVS" :group 'pcl-cvs) (put 'cvs-minor-mode 'permanent-local t) From 17d20bb3cbb233ed0d94c3f1f9f3db768f526223 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 12 Apr 2021 09:15:59 +0200 Subject: [PATCH 106/128] Generate Seccomp filters only if we have the necessary constants. If we're missing SECCOMP_SET_MODE_FILTER, the seccomp-filter build fails. Reuse the existing HAVE_SECCOMP configuration variable, which checks for these macros. * configure.ac (HAVE_SECCOMP): Substitute in Makefile.in. * lib-src/Makefile.in (HAVE_SECCOMP): New variable. (SECCOMP_FILTER): Define only if HAVE_SECCOMP. --- configure.ac | 1 + lib-src/Makefile.in | 3 +++ 2 files changed, 4 insertions(+) diff --git a/configure.ac b/configure.ac index 169ffc55341..d3647bdc2a2 100644 --- a/configure.ac +++ b/configure.ac @@ -4188,6 +4188,7 @@ AC_CHECK_HEADERS( [[ #include ]])]) +AC_SUBST([HAVE_SECCOMP]) EMACS_CHECK_MODULES([LIBSECCOMP], [libseccomp >= 2.4.0]) AC_SUBST([HAVE_LIBSECCOMP]) diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 091f4fb0199..923d0cf5e72 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -189,11 +189,13 @@ LIB_WSOCK32=@LIB_WSOCK32@ ## Extra libraries for etags LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM) +HAVE_SECCOMP=@HAVE_SECCOMP@ HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@ LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@ LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@ # Currently, we can only generate seccomp filter files for x86-64. +ifeq ($(HAVE_SECCOMP),yes) ifeq ($(HAVE_LIBSECCOMP),yes) ifeq ($(shell uname -m),x86_64) # We require SECCOMP_RET_KILL_PROCESS, which is only available in @@ -205,6 +207,7 @@ SECCOMP_FILTER=1 endif endif endif +endif ifeq ($(SECCOMP_FILTER),1) DONT_INSTALL += seccomp-filter$(EXEEXT) From 104c5e3d57705cd4bd291b61d7f165def602ab5c Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Mon, 12 Apr 2021 09:20:51 +0200 Subject: [PATCH 107/128] * lib-src/seccomp-filter.c: Add missing headers. --- lib-src/seccomp-filter.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index ed362bc18d9..fc3c3a0c074 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -51,6 +51,8 @@ variants of those files that can be used to sandbox Emacs before #include #include #include +#include +#include #include #include #include From 636e9fd6a0c6b7801fd5a0d58fd42c93aab7332d Mon Sep 17 00:00:00 2001 From: Junya Takahashi Date: Mon, 12 Apr 2021 10:14:11 +0200 Subject: [PATCH 108/128] Fix args-out-of-range error in epa-file-insert-file-contents * lisp/epa-file.el (epa-file-insert-file-contents): Don't bug out on a region that's longer than the file (bug#47718). Copyright-paperwork-exempt: yes --- lisp/epa-file.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/epa-file.el b/lisp/epa-file.el index e46e3684c8a..33bf5adabe6 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -198,7 +198,9 @@ encryption is used." (mapcar #'car (epg-context-result-for context 'encrypted-to))) (if (or beg end) - (setq string (substring string (or beg 0) end))) + (setq string (substring string + (or beg 0) + (and end (min end (length string)))))) (save-excursion ;; If visiting, bind off buffer-file-name so that ;; file-locking will not ask whether we should From 9dc28e1fca03b124c53c2f99add3180591896696 Mon Sep 17 00:00:00 2001 From: Ralph Schleicher Date: Mon, 12 Apr 2021 10:31:46 +0200 Subject: [PATCH 109/128] Add command in eww to toggle images * lisp/net/eww.el (eww-toggle-images): New function. (eww-mode-map): Add key binding and menu entry. * lisp/net/shr.el (shr-inhibit-images): Make it customizable. * doc/misc/eww.texi (Basics): Document eww-toggle-images. Fix index entries for shr-use-fonts and shr-use-colors. (Advanced): Document shr-inhibit-images (bug#47705). --- doc/misc/eww.texi | 19 ++++++++++++++++--- lisp/net/eww.el | 10 ++++++++++ lisp/net/shr.el | 6 ++++-- 3 files changed, 30 insertions(+), 5 deletions(-) diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 6e82a97030e..cc546a92d63 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -124,17 +124,25 @@ which part of the document contains the ``readable'' text, and will only display this part. This usually gets rid of menus and the like. @findex eww-toggle-fonts -@findex shr-use-fonts +@vindex shr-use-fonts @kindex F The @kbd{F} command (@code{eww-toggle-fonts}) toggles whether to use variable-pitch fonts or not. This sets the @code{shr-use-fonts} variable. @findex eww-toggle-colors -@findex shr-use-colors -@kindex F +@vindex shr-use-colors +@kindex M-C The @kbd{M-C} command (@code{eww-toggle-colors}) toggles whether to use HTML-specified colors or not. This sets the @code{shr-use-colors} variable. +@findex eww-toggle-images +@vindex shr-inhibit-images +@kindex M-I +@cindex Image Display + The @kbd{M-I} command (@code{eww-toggle-images}, capital letter i) +toggles whether to display images or not. This also sets the +@code{shr-inhibit-images} variable. + @findex eww-download @vindex eww-download-directory @kindex d @@ -305,6 +313,11 @@ of the width and height. If Emacs supports image scaling (ImageMagick support required) then larger images are scaled down. You can block specific images completely by customizing @code{shr-blocked-images}. +@vindex shr-inhibit-images + You can control image display by customizing +@code{shr-inhibit-images}. If this variable is @code{nil}, display +the ``ALT'' text of images instead. + @vindex shr-color-visible-distance-min @vindex shr-color-visible-luminance-min @cindex Contrast diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 32fe857e65c..eec3ec7ba8b 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -987,6 +987,7 @@ the like." (define-key map "F" 'eww-toggle-fonts) (define-key map "D" 'eww-toggle-paragraph-direction) (define-key map [(meta C)] 'eww-toggle-colors) + (define-key map [(meta I)] 'eww-toggle-images) (define-key map "b" 'eww-add-bookmark) (define-key map "B" 'eww-list-bookmarks) @@ -1015,6 +1016,7 @@ the like." ["List cookies" url-cookie-list t] ["Toggle fonts" eww-toggle-fonts t] ["Toggle colors" eww-toggle-colors t] + ["Toggle images" eww-toggle-images t] ["Character Encoding" eww-set-character-encoding] ["Toggle Paragraph Direction" eww-toggle-paragraph-direction])) map)) @@ -1893,6 +1895,14 @@ If CHARSET is nil then use UTF-8." "off")) (eww-reload)) +(defun eww-toggle-images () + "Toggle whether or not to display images." + (interactive nil eww-mode) + (setq shr-inhibit-images (not shr-inhibit-images)) + (eww-reload) + (message "Images are now %s" + (if shr-inhibit-images "off" "on"))) + ;;; Bookmarks code (defvar eww-bookmarks nil) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 7c15eb1ca0b..cbdeb65ba8b 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -183,8 +183,10 @@ temporarily blinks with this face." "Face for elements." :version "27.1") -(defvar shr-inhibit-images nil - "If non-nil, inhibit loading images.") +(defcustom shr-inhibit-images nil + "If non-nil, inhibit loading images." + :version "28.1" + :type 'boolean) (defvar shr-external-rendering-functions nil "Alist of tag/function pairs used to alter how shr renders certain tags. From f2ab4cec7a762e8fe641cde00e6b299a92301cac Mon Sep 17 00:00:00 2001 From: Shitikanth Kashyap Date: Mon, 12 Apr 2021 10:43:42 +0200 Subject: [PATCH 110/128] Fix python-shell-switch-to-shell redisplay bug * lisp/progmodes/python.el (python-shell-switch-to-shell): Redisplay the switched-to window faster (bug#47679). Copyright-paperwork-exempt: yes --- lisp/progmodes/python.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e5c15d148f8..30721c7a577 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3385,7 +3385,8 @@ user-friendly message if there's no process running; defaults to t when called interactively." (interactive "p") (pop-to-buffer - (process-buffer (python-shell-get-process-or-error msg)) nil t)) + (process-buffer (python-shell-get-process-or-error msg)) + nil 'mark-for-redisplay)) (defun python-shell-send-setup-code () "Send all setup code for shell. From 72db25ef54f3d8e3b9827eeaa6df2eab2711cdff Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 12 Apr 2021 11:45:33 +0200 Subject: [PATCH 111/128] Adjust verilog-mode to changes in the completion framework * lisp/progmodes/verilog-mode.el (verilog-func-completion): Don't bug out on `C-M-i' (which expects no point movement) (bug#47652). (verilog-declaration-end): There may be no semicolons; don't bug out. --- lisp/progmodes/verilog-mode.el | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index a7f72950b10..5f8f723f80e 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3607,7 +3607,7 @@ inserted using a single call to `verilog-insert'." ;; More searching (defun verilog-declaration-end () - (search-forward ";")) + (search-forward ";" nil t)) (defun verilog-single-declaration-end (limit) "Returns pos where current (single) declaration statement ends. @@ -7555,25 +7555,25 @@ will be completed at runtime and should not be added to this list.") TYPE is `module', `tf' for task or function, or t if unknown." (if (string= verilog-str "") (setq verilog-str "[a-zA-Z_]")) - (let ((verilog-str (concat (cond - ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") - ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") - (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) - "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) + (let ((verilog-str + (concat (cond + ((eq type 'module) "\\<\\(module\\|connectmodule\\)\\s +") + ((eq type 'tf) "\\<\\(task\\|function\\)\\s +") + (t "\\<\\(task\\|function\\|module\\|connectmodule\\)\\s +")) + "\\<\\(" verilog-str "[a-zA-Z0-9_.]*\\)\\>")) match) - (if (not (looking-at verilog-defun-re)) - (verilog-re-search-backward verilog-defun-re nil t)) - (forward-char 1) + (save-excursion + (if (not (looking-at verilog-defun-re)) + (verilog-re-search-backward verilog-defun-re nil t)) + (forward-char 1) - ;; Search through all reachable functions - (goto-char (point-min)) - (while (verilog-re-search-forward verilog-str (point-max) t) - (progn (setq match (buffer-substring (match-beginning 2) - (match-end 2))) - (setq verilog-all (cons match verilog-all)))) - (if (match-beginning 0) - (goto-char (match-beginning 0))))) + ;; Search through all reachable functions + (goto-char (point-min)) + (while (verilog-re-search-forward verilog-str (point-max) t) + (setq match (buffer-substring (match-beginning 2) + (match-end 2))) + (setq verilog-all (cons match verilog-all)))))) (defun verilog-get-completion-decl (end) "Macro for searching through current declaration (var, type or const) From 07671edbf0686a71fe568626a71ef48fdb2e0215 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 10:46:07 -0400 Subject: [PATCH 112/128] * lisp/progmodes/vhdl-mode.el: Add note about XEmacs compatibility --- lisp/progmodes/vhdl-mode.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index be98066a620..5eeac8af3b8 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -12,6 +12,9 @@ ;; file on 18/3/2008, and the maintainer agreed that when a bug is ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. +;; +;; Reto also said in Apr 2021 that he preferred to keep the XEmacs +;; compatibility code. (defconst vhdl-version "3.38.1" "VHDL Mode version number.") From 6bec60ad3151825c2ee5f775848ea3d4c70c72a5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 11:08:19 -0400 Subject: [PATCH 113/128] (define-minor-mode): Warn about use of pre-Emacs-21 style args * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Use `advertised-calling-convention` to avoid promoting the old style arguments. Emit a wanring when old-style arguments are used. Massage the docstring accordingly. * doc/lispref/modes.texi (Defining Minor Modes): Document the keyword arguments rather than the old-style positional arguments. --- doc/lispref/modes.texi | 66 +++++------- etc/NEWS | 5 + lisp/emacs-lisp/easy-mmode.el | 197 +++++++++++++++++----------------- 3 files changed, 129 insertions(+), 139 deletions(-) diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 6cf4dd21c19..88f2f14c092 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1660,7 +1660,7 @@ reserved for users. @xref{Key Binding Conventions}. The macro @code{define-minor-mode} offers a convenient way of implementing a mode in one self-contained definition. -@defmac define-minor-mode mode doc [init-value [lighter [keymap]]] keyword-args@dots{} body@dots{} +@defmac define-minor-mode mode doc keyword-args@dots{} body@dots{} This macro defines a new minor mode whose name is @var{mode} (a symbol). It defines a command named @var{mode} to toggle the minor mode, with @var{doc} as its documentation string. @@ -1675,14 +1675,36 @@ If @var{doc} is @code{nil}, the macro supplies a default documentation string explaining the above. By default, it also defines a variable named @var{mode}, which is set to -@code{t} or @code{nil} by enabling or disabling the mode. The variable -is initialized to @var{init-value}. Except in unusual circumstances -(see below), this value must be @code{nil}. +@code{t} or @code{nil} by enabling or disabling the mode. +The @var{keyword-args} consist of keywords followed by +corresponding values. A few keywords have special meanings: + +@table @code +@item :global @var{global} +If non-@code{nil}, this specifies that the minor mode should be global +rather than buffer-local. It defaults to @code{nil}. + +One of the effects of making a minor mode global is that the +@var{mode} variable becomes a customization variable. Toggling it +through the Customize interface turns the mode on and off, and its +value can be saved for future Emacs sessions (@pxref{Saving +Customizations,,, emacs, The GNU Emacs Manual}. For the saved +variable to work, you should ensure that the minor mode function +is available each time Emacs starts; usually this is done by +marking the @code{define-minor-mode} form as autoloaded. + +@item :init-value @var{init-value} +This is the value to which the @var{mode} variable is initialized. +Except in unusual circumstances (see below), this value must be +@code{nil}. + +@item :lighter @var{lighter} The string @var{lighter} says what to display in the mode line when the mode is enabled; if it is @code{nil}, the mode is not displayed in the mode line. +@item :keymap @var{keymap} The optional argument @var{keymap} specifies the keymap for the minor mode. If non-@code{nil}, it should be a variable name (whose value is a keymap), a keymap, or an alist of the form @@ -1697,42 +1719,6 @@ suitable for passing to @code{define-key} (@pxref{Changing Key Bindings}). If @var{keymap} is a keymap or an alist, this also defines the variable @code{@var{mode}-map}. -The above three arguments @var{init-value}, @var{lighter}, and -@var{keymap} can be (partially) omitted when @var{keyword-args} are -used. The @var{keyword-args} consist of keywords followed by -corresponding values. A few keywords have special meanings: - -@table @code -@item :group @var{group} -Custom group name to use in all generated @code{defcustom} forms. -Defaults to @var{mode} without the possible trailing @samp{-mode}. -@strong{Warning:} don't use this default group name unless you have -written a @code{defgroup} to define that group properly. @xref{Group -Definitions}. - -@item :global @var{global} -If non-@code{nil}, this specifies that the minor mode should be global -rather than buffer-local. It defaults to @code{nil}. - -One of the effects of making a minor mode global is that the -@var{mode} variable becomes a customization variable. Toggling it -through the Customize interface turns the mode on and off, and its -value can be saved for future Emacs sessions (@pxref{Saving -Customizations,,, emacs, The GNU Emacs Manual}. For the saved -variable to work, you should ensure that the @code{define-minor-mode} -form is evaluated each time Emacs starts; for packages that are not -part of Emacs, the easiest way to do this is to specify a -@code{:require} keyword. - -@item :init-value @var{init-value} -This is equivalent to specifying @var{init-value} positionally. - -@item :lighter @var{lighter} -This is equivalent to specifying @var{lighter} positionally. - -@item :keymap @var{keymap} -This is equivalent to specifying @var{keymap} positionally. - @item :variable @var{place} This replaces the default variable @var{mode}, used to store the state of the mode. If you specify this, the @var{mode} variable is not diff --git a/etc/NEWS b/etc/NEWS index 7483a6e5b75..88583d952ff 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2363,6 +2363,11 @@ This is to keep the same behavior as Eshell. * Incompatible Lisp Changes in Emacs 28.1 ++++ +** The use of positional arguments in 'define-minor-mode' is obsolete. +These were actually rendered obsolete in Emacs-21 but were never +marked as such. + ** 'facemenu-color-alist' is now obsolete, and is not used. ** 'facemenu.el' is no longer preloaded. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index addb58cdbbe..e23ff5ae513 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -139,39 +139,31 @@ documenting what its argument does. If the word \"ARG\" does not appear in DOC, a paragraph is added to DOC explaining usage of the mode argument. -Optional INIT-VALUE is the initial value of the mode's variable. - Note that the minor mode function won't be called by setting - this option, so the value *reflects* the minor mode's natural - initial state, rather than *setting* it. - In the vast majority of cases it should be nil. -Optional LIGHTER is displayed in the mode line when the mode is on. -Optional KEYMAP is the default keymap bound to the mode keymap. - If non-nil, it should be a variable name (whose value is a keymap), - or an expression that returns either a keymap or a list of - (KEY . BINDING) pairs where KEY and BINDING are suitable for - `define-key'. If you supply a KEYMAP argument that is not a - symbol, this macro defines the variable MODE-map and gives it - the value that KEYMAP specifies. - BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. Before the actual body code, you can write keyword arguments, i.e. alternating keywords and values. If you provide BODY, then you must - provide (even if just nil) INIT-VALUE, LIGHTER, and KEYMAP, or provide - at least one keyword argument, or both; otherwise, BODY would be - misinterpreted as the first omitted argument. The following special + provide at least one keyword argument. The following special keywords are supported (other keywords are passed to `defcustom' if the minor mode is global): -:group GROUP Custom group name to use in all generated `defcustom' forms. :global GLOBAL If non-nil specifies that the minor mode is not meant to be buffer-local, so don't make the variable MODE buffer-local. By default, the mode is buffer-local. -:init-value VAL Same as the INIT-VALUE argument. +:init-value VAL the initial value of the mode's variable. + Note that the minor mode function won't be called by setting + this option, so the value *reflects* the minor mode's natural + initial state, rather than *setting* it. + In the vast majority of cases it should be nil. Not used if you also specify :variable. -:lighter SPEC Same as the LIGHTER argument. -:keymap MAP Same as the KEYMAP argument. -:require SYM Same as in `defcustom'. +:lighter SPEC Text displayed in the mode line when the mode is on. +:keymap MAP Keymap bound to the mode keymap. Defaults to `MODE-map'. + If non-nil, it should be a variable name (whose value is + a keymap), or an expression that returns either a keymap or + a list of (KEY . BINDING) pairs where KEY and BINDING are + suitable for `define-key'. If you supply a KEYMAP argument + that is not a symbol, this macro defines the variable MODE-map + and gives it the value that KEYMAP specifies. :interactive VAL Whether this mode should be a command or not. The default is to make it one; use nil to avoid that. If VAL is a list, it's interpreted as a list of major modes this minor mode @@ -185,15 +177,18 @@ BODY contains code to execute each time the mode is enabled or disabled. sets it. If you specify a :variable, this function does not define a MODE variable (nor any of the terms used in :variable). - :after-hook A single lisp form which is evaluated after the mode hooks have been run. It should not be quoted. For example, you could write (define-minor-mode foo-mode \"If enabled, foo on you!\" :lighter \" Foo\" :require \\='foo :global t :group \\='hassle :version \"27.5\" - ...BODY CODE...)" + ...BODY CODE...) + +For backward compatibility with the Emacs<21 calling convention, +BODY can also start with the triplet INIT-VALUE LIGHTER KEYMAP." (declare (doc-string 2) + (advertised-calling-convention (mode doc &rest body) "28.1") (debug (&define name string-or-null-p [&optional [¬ keywordp] sexp &optional [¬ keywordp] sexp @@ -201,23 +196,12 @@ For example, you could write [&rest [keywordp sexp]] def-body))) - ;; Allow skipping the first three args. - (cond - ((keywordp init-value) - (setq body (if keymap `(,init-value ,lighter ,keymap ,@body) - `(,init-value ,lighter)) - init-value nil lighter nil keymap nil)) - ((keywordp lighter) - (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil)) - ((keywordp keymap) (push keymap body) (setq keymap nil))) - (let* ((last-message (make-symbol "last-message")) (mode-name (symbol-name mode)) - (pretty-name (easy-mmode-pretty-mode-name mode lighter)) + (pretty-name nil) (globalp nil) (set nil) (initialize nil) - (group nil) (type nil) (extra-args nil) (extra-keywords nil) @@ -225,14 +209,28 @@ For example, you could write (setter `(setq ,mode)) ;The beginning of the exp to set the mode var. (getter mode) ;The exp to get the mode value. (modefun mode) ;The minor mode function name we're defining. - (require t) (after-hook nil) (hook (intern (concat mode-name "-hook"))) (hook-on (intern (concat mode-name "-on-hook"))) (hook-off (intern (concat mode-name "-off-hook"))) (interactive t) + (warnwrap (if (keywordp init-value) #'identity + (lambda (exp) + (macroexp-warn-and-return + "Use keywords rather than deprecated positional arguments to `define-minor-mode'" + exp)))) keyw keymap-sym tmp) + ;; Allow skipping the first three args. + (cond + ((keywordp init-value) + (setq body (if keymap `(,init-value ,lighter ,keymap ,@body) + `(,init-value ,lighter)) + init-value nil lighter nil keymap nil)) + ((keywordp lighter) + (setq body `(,lighter ,keymap ,@body) lighter nil keymap nil)) + ((keywordp keymap) (push keymap body) (setq keymap nil))) + ;; Check keys. (while (keywordp (setq keyw (car body))) (setq body (cdr body)) @@ -246,9 +244,7 @@ For example, you could write (:extra-args (setq extra-args (pop body))) (:set (setq set (list :set (pop body)))) (:initialize (setq initialize (list :initialize (pop body)))) - (:group (setq group (nconc group (list :group (pop body))))) (:type (setq type (list :type (pop body)))) - (:require (setq require (pop body))) (:keymap (setq keymap (pop body))) (:interactive (setq interactive (pop body))) (:variable (setq variable (pop body)) @@ -264,6 +260,7 @@ For example, you could write (:after-hook (setq after-hook (pop body))) (_ (push keyw extra-keywords) (push (pop body) extra-keywords)))) + (setq pretty-name (easy-mmode-pretty-mode-name mode lighter)) (setq keymap-sym (if (and keymap (symbolp keymap)) keymap (intern (concat mode-name "-map")))) @@ -301,70 +298,72 @@ or call the function `%s'.")))) ,(format base-doc-string pretty-name mode mode) ,@set ,@initialize - ,@group ,@type - ,@(unless (eq require t) `(:require ,require)) ,@(nreverse extra-keywords))))) ;; The actual function. - (defun ,modefun (&optional arg ,@extra-args) - ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) - ,(when interactive - ;; Use `toggle' rather than (if ,mode 0 1) so that using - ;; repeat-command still does the toggling correctly. - (if (consp interactive) - `(interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle)) - ,@interactive) - '(interactive (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 'toggle))))) - (let ((,last-message (current-message))) - (,@setter - (cond ((eq arg 'toggle) - (not ,getter)) - ((and (numberp arg) - (< arg 1)) - nil) - (t - t))) - ;; Keep minor modes list up to date. - ,@(if globalp - ;; When running this byte-compiled code in earlier - ;; Emacs versions, these variables may not be defined - ;; there. So check defensively, even if they're - ;; always defined in Emacs 28 and up. - `((when (boundp 'global-minor-modes) - (setq global-minor-modes - (delq ',modefun global-minor-modes)) - (when ,getter - (push ',modefun global-minor-modes)))) - ;; Ditto check. - `((when (boundp 'local-minor-modes) - (setq local-minor-modes (delq ',modefun local-minor-modes)) - (when ,getter - (push ',modefun local-minor-modes))))) - ,@body - ;; The on/off hooks are here for backward compatibility only. - (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) - (if (called-interactively-p 'any) - (progn - ,(if (and globalp (not variable)) - `(customize-mark-as-set ',mode)) - ;; Avoid overwriting a message shown by the body, - ;; but do overwrite previous messages. - (unless (and (current-message) - (not (equal ,last-message - (current-message)))) - (let ((local ,(if globalp "" " in current buffer"))) - (message ,(format "%s %%sabled%%s" pretty-name) - (if ,getter "en" "dis") local))))) - ,@(when after-hook `(,after-hook))) - (force-mode-line-update) - ;; Return the new setting. - ,getter) + ,(funcall + warnwrap + `(defun ,modefun (&optional arg ,@extra-args) + ,(easy-mmode--mode-docstring doc pretty-name keymap-sym) + ,(when interactive + ;; Use `toggle' rather than (if ,mode 0 1) so that using + ;; repeat-command still does the toggling correctly. + (if (consp interactive) + `(interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle)) + ,@interactive) + '(interactive + (list (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + 'toggle))))) + (let ((,last-message (current-message))) + (,@setter + (cond ((eq arg 'toggle) + (not ,getter)) + ((and (numberp arg) + (< arg 1)) + nil) + (t + t))) + ;; Keep minor modes list up to date. + ,@(if globalp + ;; When running this byte-compiled code in earlier + ;; Emacs versions, these variables may not be defined + ;; there. So check defensively, even if they're + ;; always defined in Emacs 28 and up. + `((when (boundp 'global-minor-modes) + (setq global-minor-modes + (delq ',modefun global-minor-modes)) + (when ,getter + (push ',modefun global-minor-modes)))) + ;; Ditto check. + `((when (boundp 'local-minor-modes) + (setq local-minor-modes + (delq ',modefun local-minor-modes)) + (when ,getter + (push ',modefun local-minor-modes))))) + ,@body + ;; The on/off hooks are here for backward compatibility only. + (run-hooks ',hook (if ,getter ',hook-on ',hook-off)) + (if (called-interactively-p 'any) + (progn + ,(if (and globalp (not variable)) + `(customize-mark-as-set ',mode)) + ;; Avoid overwriting a message shown by the body, + ;; but do overwrite previous messages. + (unless (and (current-message) + (not (equal ,last-message + (current-message)))) + (let ((local ,(if globalp "" " in current buffer"))) + (message ,(format "%s %%sabled%%s" pretty-name) + (if ,getter "en" "dis") local))))) + ,@(when after-hook `(,after-hook))) + (force-mode-line-update) + ;; Return the new setting. + ,getter)) ;; Autoloading a define-minor-mode autoloads everything ;; up-to-here. From 2ec25de5ea1966c2a3ac4ba7180ea57405dba132 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 12 Apr 2021 08:08:29 -0700 Subject: [PATCH 114/128] * lisp/strokes.el (strokes-mode): Fix typo in previous. --- lisp/strokes.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/strokes.el b/lisp/strokes.el index 4a018ff1993..575092a71d9 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -1393,7 +1393,7 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\[strokes-decode-buffer]. \\{strokes-mode-map}" - :ligher strokes-lighter :global t + :lighter strokes-lighter :global t (cond ((not (display-mouse-p)) (error "Can't use Strokes without a mouse")) (strokes-mode ; turn on strokes From 2ae53db722b64eb5e67ef53de46825b766fba17e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 11:53:25 -0400 Subject: [PATCH 115/128] * lisp/comint.el (comint-strip-ctrl-m): Avoid `called-interactively-p` --- lisp/comint.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index 9cbcfc03fa6..2745c5a26f6 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -2254,23 +2254,23 @@ This function could be on `comint-output-filter-functions' or bound to a key." (let ((inhibit-read-only t)) (delete-region (point-min) (point))))) -(defun comint-strip-ctrl-m (&optional _string) +(defun comint-strip-ctrl-m (&optional _string interactive) "Strip trailing `^M' characters from the current output group. This function could be on `comint-output-filter-functions' or bound to a key." - (interactive) + (interactive (list nil t)) (let ((process (get-buffer-process (current-buffer)))) (if (not process) ;; This function may be used in ;; `comint-output-filter-functions', and in that case, if ;; there's no process, then we should do nothing. If ;; interactive, report an error. - (when (called-interactively-p 'interactive) + (when interactive (error "No process in the current buffer")) (let ((pmark (process-mark process))) (save-excursion (condition-case nil (goto-char - (if (called-interactively-p 'interactive) + (if interactive comint-last-input-end comint-last-output-start)) (error nil)) (while (re-search-forward "\r+$" pmark t) From 632fd8079ddc3badd86d09a9770d617be78f5fac Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 11:54:10 -0400 Subject: [PATCH 116/128] * lisp/dynamic-setting.el: Add missing footer --- lisp/dynamic-setting.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 39d2a1d1e2a..6b037aa2a6c 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -24,8 +24,8 @@ ;;; Commentary: -;; This file provides the lisp part of the GConf and XSetting code in -;; xsetting.c. But it is nothing that prevents it from being used by +;; This file provides the Lisp part of the GConf and XSetting code in +;; xsetting.c. But there is nothing that prevents it from being used by ;; other configuration schemes. ;;; Code: @@ -92,3 +92,6 @@ Changes can be (define-key special-event-map [config-changed-event] #'dynamic-setting-handle-config-changed-event) + +(provide 'dynamic-setting) +;;; dynamic-setting.el ends here From ed4b51962ea5494b92e0d078916558cab27a836a Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 12 Apr 2021 19:14:45 +0300 Subject: [PATCH 117/128] * lisp/repeat.el (repeat-mode-echo): New defcustom. (repeat-post-hook): Use it. (repeat-mode-message): New function (bug#47566). (repeat-post-hook): Use real-this-command instead of this-command to handle e.g. rectangle-exchange-point-and-mark remapped to exchange-point-and-mark (bug#47688). --- lisp/repeat.el | 25 ++++++++++++++++++++----- 1 file changed, 20 insertions(+), 5 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index b3c58f2f818..f1b20d369bf 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -348,6 +348,17 @@ For example, you can set it to like `isearch-exit'." :group 'convenience :version "28.1") +(defcustom repeat-mode-echo #'repeat-mode-message + "Function to display a hint about available keys. +Function is called after every repeatable command with one argument: +a string with a list of keys." + :type '(choice (const :tag "Show hints in the echo area" + repeat-mode-message) + (const :tag "Don't show hints" ignore) + (function :tag "Function")) + :group 'convenience + :version "28.1") + ;;;###autoload (defvar repeat-map nil "The value of the repeating map for the next command. @@ -377,8 +388,8 @@ When Repeat mode is enabled, and the command symbol has the property named "Function run after commands to set transient keymap for repeatable keys." (when repeat-mode (let ((rep-map (or repeat-map - (and (symbolp this-command) - (get this-command 'repeat-map))))) + (and (symbolp real-this-command) + (get real-this-command 'repeat-map))))) (when rep-map (when (boundp rep-map) (setq rep-map (symbol-value rep-map))) @@ -403,9 +414,7 @@ When Repeat mode is enabled, and the command symbol has the property named (format ", or exit with %s" (key-description repeat-exit-key)) "")))) - (if (current-message) - (message "%s [%s]" (current-message) mess) - (message mess)))) + (funcall repeat-mode-echo mess))) ;; Adding an exit key (when repeat-exit-key @@ -417,6 +426,12 @@ When Repeat mode is enabled, and the command symbol has the property named (set-transient-map map)))))) (setq repeat-map nil)) +(defun repeat-mode-message (mess) + "Function that displays available repeating keys in the echo area." + (if (current-message) + (message "%s [%s]" (current-message) mess) + (message mess))) + (provide 'repeat) ;;; repeat.el ends here From 9a6523dfd68a17ebf7049d2aae3fd02386d7cb04 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:32:07 -0400 Subject: [PATCH 118/128] * lisp/frame.el (delete-other-frames): Add universal prefix `iconify` arg (frame--current-backround-mode): New function, extracted from `frame-set-background-mode`. Use `color-dark-p`. (frame-set-background-mode): Use it. --- doc/lispref/frames.texi | 5 +- etc/NEWS | 3 + lisp/frame.el | 125 +++++++++++++++++++++++----------------- 3 files changed, 80 insertions(+), 53 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index cd2ff8f3b31..a9d20c543da 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2628,7 +2628,7 @@ When Emacs gets one of these commands, it generates a @code{delete-frame} event, whose normal definition is a command that calls the function @code{delete-frame}. @xref{Misc Events}. -@deffn Command delete-other-frames &optional frame +@deffn Command delete-other-frames &optional frame iconify This command deletes all frames on @var{frame}'s terminal, except @var{frame}. If @var{frame} uses another frame's minibuffer, that minibuffer frame is left untouched. The argument @var{frame} must @@ -2639,6 +2639,9 @@ this command works by calling @code{delete-frame} with @var{force} This function does not delete any of @var{frame}'s child frames (@pxref{Child Frames}). If @var{frame} is a child frame, it deletes @var{frame}'s siblings only. + +With the prefix argument @var{iconify}, the frames are iconified rather +than deleted. @end deffn diff --git a/etc/NEWS b/etc/NEWS index 88583d952ff..320827d881e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -275,6 +275,9 @@ input using the minibuffer. * Editing Changes in Emacs 28.1 ++++ +** A prefix arg now causes 'delete-other-frames' to only iconify frames + +++ ** New command 'execute-extended-command-for-buffer'. This new command, bound to 'M-S-x', works like diff --git a/lisp/frame.el b/lisp/frame.el index 2b6e4a60b83..bca160175a5 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -301,7 +301,7 @@ This function runs the abnormal hook `move-frame-functions'." (declare-function tool-bar-mode "tool-bar" (&optional arg)) (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise)) -(defalias 'tool-bar-lines-needed 'tool-bar-height) +(defalias 'tool-bar-lines-needed #'tool-bar-height) ;; startup.el calls this function after loading the user's init ;; file. Now default-frame-alist and initial-frame-alist contain @@ -690,8 +690,8 @@ is not considered (see `next-frame')." 0)) (select-frame-set-input-focus (selected-frame))) -(defalias 'next-multiframe-window 'next-window-any-frame) -(defalias 'previous-multiframe-window 'previous-window-any-frame) +(defalias 'next-multiframe-window #'next-window-any-frame) +(defalias 'previous-multiframe-window #'previous-window-any-frame) (defun window-system-for-display (display) "Return the window system for DISPLAY. @@ -782,7 +782,7 @@ If DISPLAY is nil, that stands for the selected frame's display." (format "Delete %s frames? " (length frames)) (format "Delete %s ? " (car frames)))))) (error "Abort!") - (mapc 'delete-frame frames) + (mapc #'delete-frame frames) (x-close-connection display)))) (defun make-frame-command () @@ -1162,8 +1162,8 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." :group 'faces :set #'(lambda (var value) (set-default var value) - (mapc 'frame-set-background-mode (frame-list))) - :initialize 'custom-initialize-changed + (mapc #'frame-set-background-mode (frame-list))) + :initialize #'custom-initialize-changed :type '(choice (const dark) (const light) (const :tag "automatic" nil))) @@ -1176,6 +1176,27 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))." (defvar inhibit-frame-set-background-mode nil) +(defun frame--current-backround-mode (frame) + (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) + (bg-color (frame-parameter frame 'background-color)) + (tty-type (tty-type frame)) + (default-bg-mode + (if (or (window-system frame) + (and tty-type + (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" + tty-type))) + 'light + 'dark))) + (cond (frame-default-bg-mode) + ((equal bg-color "unspecified-fg") ; inverted colors + (if (eq default-bg-mode 'light) 'dark 'light)) + ((not (color-values bg-color frame)) + default-bg-mode) + ((color-dark-p (mapcar (lambda (c) (/ c 65535.0)) + (color-values bg-color frame))) + 'dark) + (t 'light)))) + (defun frame-set-background-mode (frame &optional keep-face-specs) "Set up display-dependent faces on FRAME. Display-dependent faces are those which have different definitions @@ -1184,30 +1205,8 @@ according to the `background-mode' and `display-type' frame parameters. If optional arg KEEP-FACE-SPECS is non-nil, don't recalculate face specs for the new background mode." (unless inhibit-frame-set-background-mode - (let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame)) - (bg-color (frame-parameter frame 'background-color)) - (tty-type (tty-type frame)) - (default-bg-mode - (if (or (window-system frame) - (and tty-type - (string-match "^\\(xterm\\|rxvt\\|dtterm\\|eterm\\)" - tty-type))) - 'light - 'dark)) - (non-default-bg-mode (if (eq default-bg-mode 'light) 'dark 'light)) - (bg-mode - (cond (frame-default-bg-mode) - ((equal bg-color "unspecified-fg") ; inverted colors - non-default-bg-mode) - ((not (color-values bg-color frame)) - default-bg-mode) - ((>= (apply '+ (color-values bg-color frame)) - ;; Just looking at the screen, colors whose - ;; values add up to .6 of the white total - ;; still look dark to me. - (* (apply '+ (color-values "white" frame)) .6)) - 'light) - (t 'dark))) + (let* ((bg-mode + (frame--current-backround-mode frame)) (display-type (cond ((null (window-system frame)) (if (tty-display-color-p frame) 'color 'mono)) @@ -1273,6 +1272,26 @@ the `background-mode' terminal parameter." (intern (downcase bg-resource)))) (terminal-parameter frame 'background-mode))) +;; FIXME: This needs to be significantly improved before we can use it: +;; - Fix the "scope" to be consistent: the code below is partly per-frame +;; and partly all-frames :-( +;; - Make it interact correctly with color themes (e.g. modus-themes). +;; Maybe automatically disabling color themes that disagree with the +;; selected value of `dark-mode'. +;; - Check interaction with "(in|re)verse-video". +;; +;; (define-minor-mode dark-mode +;; "Use light text on dark background." +;; :global t +;; :group 'faces +;; (when (eq dark-mode +;; (eq 'light (frame--current-backround-mode (selected-frame)))) +;; ;; FIXME: Change the face's SPEC instead? +;; (set-face-attribute 'default nil +;; :foreground (face-attribute 'default :background) +;; :background (face-attribute 'default :foreground)) +;; (frame-set-background-mode (selected-frame)))) + ;;;; Frame configurations @@ -1357,9 +1376,9 @@ differing font heights." If FRAME is omitted, describe the currently selected frame." (cdr (assq 'width (frame-parameters frame)))) -(defalias 'frame-border-width 'frame-internal-border-width) -(defalias 'frame-pixel-width 'frame-native-width) -(defalias 'frame-pixel-height 'frame-native-height) +(defalias 'frame-border-width #'frame-internal-border-width) +(defalias 'frame-pixel-width #'frame-native-width) +(defalias 'frame-pixel-height #'frame-native-height) (defun frame-inner-width (&optional frame) "Return inner width of FRAME in pixels. @@ -1991,9 +2010,9 @@ frame's display)." (fboundp 'image-mask-p) (fboundp 'image-size))) -(defalias 'display-blink-cursor-p 'display-graphic-p) -(defalias 'display-multi-frame-p 'display-graphic-p) -(defalias 'display-multi-font-p 'display-graphic-p) +(defalias 'display-blink-cursor-p #'display-graphic-p) +(defalias 'display-multi-frame-p #'display-graphic-p) +(defalias 'display-multi-font-p #'display-graphic-p) (defun display-selections-p (&optional display) "Return non-nil if DISPLAY supports selections. @@ -2340,13 +2359,15 @@ In the 3rd, 4th, and 6th examples, the returned value is relative to the opposite frame edge from the edge indicated in the input spec." (cons (car spec) (frame-geom-value-cons (car spec) (cdr spec) frame))) -(defun delete-other-frames (&optional frame) +(defun delete-other-frames (&optional frame iconify) "Delete all frames on FRAME's terminal, except FRAME. If FRAME uses another frame's minibuffer, the minibuffer frame is left untouched. Do not delete any of FRAME's child frames. If FRAME is a child frame, delete its siblings only. FRAME must be -a live frame and defaults to the selected one." - (interactive) +a live frame and defaults to the selected one. +If the prefix arg ICONIFY is non-nil, just iconify the frames rather than +deleting them." + (interactive "i\nP") (setq frame (window-normalize-frame frame)) (let ((minibuffer-frame (window-frame (minibuffer-window frame))) (this (next-frame frame t)) @@ -2361,7 +2382,7 @@ a live frame and defaults to the selected one." (and parent (not (eq (frame-parent this) parent))) ;; Do not delete a child frame of FRAME. (eq (frame-parent this) frame)) - (delete-frame this)) + (if iconify (iconify-frame this) (delete-frame this))) (setq this next)) ;; In a second round consider all remaining frames. (setq this (next-frame frame t)) @@ -2373,7 +2394,7 @@ a live frame and defaults to the selected one." (and parent (not (eq (frame-parent this) parent))) ;; Do not delete a child frame of FRAME. (eq (frame-parent this) frame)) - (delete-frame this)) + (if iconify (iconify-frame this) (delete-frame this))) (setq this next)))) @@ -2399,7 +2420,7 @@ parameters `bottom-divider-width' and `right-divider-width'." :type '(choice (const :tag "Bottom only" bottom-only) (const :tag "Right only" right-only) (const :tag "Bottom and right" t)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2420,7 +2441,7 @@ parameter `bottom-divider-width'." :type '(restricted-sexp :tag "Default width of bottom dividers" :match-alternatives (window-divider-width-valid-p)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2437,7 +2458,7 @@ parameter `right-divider-width'." :type '(restricted-sexp :tag "Default width of right dividers" :match-alternatives (window-divider-width-valid-p)) - :initialize 'custom-initialize-default + :initialize #'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) (when window-divider-mode @@ -2714,14 +2735,14 @@ See also `toggle-frame-maximized'." ;;;; Key bindings -(define-key ctl-x-5-map "2" 'make-frame-command) -(define-key ctl-x-5-map "1" 'delete-other-frames) -(define-key ctl-x-5-map "0" 'delete-frame) -(define-key ctl-x-5-map "o" 'other-frame) -(define-key ctl-x-5-map "5" 'other-frame-prefix) -(define-key global-map [f11] 'toggle-frame-fullscreen) -(define-key global-map [(meta f10)] 'toggle-frame-maximized) -(define-key esc-map [f10] 'toggle-frame-maximized) +(define-key ctl-x-5-map "2" #'make-frame-command) +(define-key ctl-x-5-map "1" #'delete-other-frames) +(define-key ctl-x-5-map "0" #'delete-frame) +(define-key ctl-x-5-map "o" #'other-frame) +(define-key ctl-x-5-map "5" #'other-frame-prefix) +(define-key global-map [f11] #'toggle-frame-fullscreen) +(define-key global-map [(meta f10)] #'toggle-frame-maximized) +(define-key esc-map [f10] #'toggle-frame-maximized) ;; Misc. From cf774fb8cc0404e00e284a75862d95b5cbc1e94d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:46:47 -0400 Subject: [PATCH 119/128] * lisp/files.el (file-modes-number-to-symbolic): Add `filetype` arg. * lisp/tar-mode.el (tar-header-block-summarize): Use it. (tar-grind-file-mode): Declare obsolete. --- lisp/files.el | 28 ++++++++++++++++++++++---- lisp/tar-mode.el | 38 ++++++++++++++++++----------------- test/manual/indent/scheme.scm | 23 +++++++++++++++++++++ 3 files changed, 67 insertions(+), 22 deletions(-) create mode 100644 test/manual/indent/scheme.scm diff --git a/lisp/files.el b/lisp/files.el index 60d60340114..9d9fbe1f068 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7633,6 +7633,9 @@ If CHAR is in [Xugo], the value is taken from FROM (or 0 if omitted)." ;; Rights relative to the previous file modes. ((= char ?X) (if (= (logand from #o111) 0) 0 #o0111)) ((= char ?u) (let ((uright (logand #o4700 from))) + ;; FIXME: These divisions/shifts seem to be right + ;; for the `7' part of the #o4700 mask, but not + ;; for the `4' part. Same below for `g' and `o'. (+ uright (/ uright #o10) (/ uright #o100)))) ((= char ?g) (let ((gright (logand #o2070 from))) (+ gright (/ gright #o10) (* gright #o10)))) @@ -7667,11 +7670,28 @@ as in \"og+rX-w\"." op char-right))) num-rights)) -(defun file-modes-number-to-symbolic (mode) +(defun file-modes-number-to-symbolic (mode &optional filetype) + "Return a string describing a a file's MODE. +For instance, if MODE is #o700, then it produces `-rwx------'. +FILETYPE if provided should be a character denoting the type of file, +such as `?d' for a directory, or `?l' for a symbolic link and will override +the leading `-' char." (string - (if (zerop (logand 8192 mode)) - (if (zerop (logand 16384 mode)) ?- ?d) - ?c) ; completeness + (or filetype + (pcase (lsh mode -12) + ;; POSIX specifies that the file type is included in st_mode + ;; and provides names for the file types but values only for + ;; the permissions (e.g., S_IWOTH=2). + + ;; (#o017 ??) ;; #define S_IFMT 00170000 + (#o014 ?s) ;; #define S_IFSOCK 0140000 + (#o012 ?l) ;; #define S_IFLNK 0120000 + ;; (8 ??) ;; #define S_IFREG 0100000 + (#o006 ?b) ;; #define S_IFBLK 0060000 + (#o004 ?d) ;; #define S_IFDIR 0040000 + (#o002 ?c) ;; #define S_IFCHR 0020000 + (#o001 ?p) ;; #define S_IFIFO 0010000 + (_ ?-))) (if (zerop (logand 256 mode)) ?- ?r) (if (zerop (logand 128 mode)) ?- ?w) (if (zerop (logand 64 mode)) diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index d9b2d421932..3f0cca0ab7a 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -474,6 +474,7 @@ checksum before doing the check." "Construct a `rw-r--r--' string indicating MODE. MODE should be an integer which is a file mode value. For instance, if mode is #o700, then it produces `rwx------'." + (declare (obsolete file-modes-number-to-symbolic "28.1")) (substring (file-modes-number-to-symbolic mode) 1)) (defun tar-header-block-summarize (tar-hblock &optional mod-p) @@ -489,25 +490,26 @@ For instance, if mode is #o700, then it produces `rwx------'." ;; (ck (tar-header-checksum tar-hblock)) (type (tar-header-link-type tar-hblock)) (link-name (tar-header-link-name tar-hblock))) - (format "%c%c%s %7s/%-7s %7s%s %s%s" + (format "%c%s %7s/%-7s %7s%s %s%s" (if mod-p ?* ? ) - (cond ((or (eq type nil) (eq type 0)) ?-) - ((eq type 1) ?h) ; link - ((eq type 2) ?l) ; symlink - ((eq type 3) ?c) ; char special - ((eq type 4) ?b) ; block special - ((eq type 5) ?d) ; directory - ((eq type 6) ?p) ; FIFO/pipe - ((eq type 20) ?*) ; directory listing - ((eq type 28) ?L) ; next has longname - ((eq type 29) ?M) ; multivolume continuation - ((eq type 35) ?S) ; sparse - ((eq type 38) ?V) ; volume header - ((eq type 55) ?H) ; pax global extended header - ((eq type 72) ?X) ; pax extended header - (t ?\s) - ) - (tar-grind-file-mode mode) + (file-modes-number-to-symbolic + mode + (cond ((or (eq type nil) (eq type 0)) ?-) + ((eq type 1) ?h) ; link + ((eq type 2) ?l) ; symlink + ((eq type 3) ?c) ; char special + ((eq type 4) ?b) ; block special + ((eq type 5) ?d) ; directory + ((eq type 6) ?p) ; FIFO/pipe + ((eq type 20) ?*) ; directory listing + ((eq type 28) ?L) ; next has longname + ((eq type 29) ?M) ; multivolume continuation + ((eq type 35) ?S) ; sparse + ((eq type 38) ?V) ; volume header + ((eq type 55) ?H) ; pax global extended header + ((eq type 72) ?X) ; pax extended header + (t ?\s) + )) (if (= 0 (length uname)) uid uname) (if (= 0 (length gname)) gid gname) size diff --git a/test/manual/indent/scheme.scm b/test/manual/indent/scheme.scm new file mode 100644 index 00000000000..9053a8743e4 --- /dev/null +++ b/test/manual/indent/scheme.scm @@ -0,0 +1,23 @@ +;; Testing sexp-comments + +(define a #;(hello) there) + +(define a #;1 there) + +(define a #;"asdf" there) + +(define a ;; #;(hello + there) + +(define a #;(hello + there) 2) + +(define a #;(hello + #;(world)) + and) + there) 2) + +(define a #;(hello + #;"asdf" (world + and) + there) 2) From 0df37f741679f99bb57da138e61c91a99ed918a5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:49:36 -0400 Subject: [PATCH 120/128] * lisp/vt-control.el: Avoid `called-interactively-p` (vt-keypad-on, vt-keypad-off): Use the `tell` arg instead. (vt-numlock): Add `tell` arg. --- lisp/vt-control.el | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/lisp/vt-control.el b/lisp/vt-control.el index 0bd5132f7c3..bac0069b852 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -83,26 +83,24 @@ (defun vt-keypad-on (&optional tell) "Turn on the VT applications keypad." - (interactive) + (interactive "p") (send-string-to-terminal "\e=") (setq vt-applications-keypad-p t) - (if (or tell (called-interactively-p 'interactive)) - (message "Applications keypad enabled."))) + (if tell (message "Applications keypad enabled."))) (defun vt-keypad-off (&optional tell) "Turn off the VT applications keypad." (interactive "p") (send-string-to-terminal "\e>") (setq vt-applications-keypad-p nil) - (if (or tell (called-interactively-p 'interactive)) - (message "Applications keypad disabled."))) + (if tell (message "Applications keypad disabled."))) -(defun vt-numlock nil +(defun vt-numlock (&optional tell) "Toggle VT application keypad on and off." - (interactive) + (interactive "p") (if vt-applications-keypad-p - (vt-keypad-off (called-interactively-p 'interactive)) - (vt-keypad-on (called-interactively-p 'interactive)))) + (vt-keypad-off tell) + (vt-keypad-on tell))) (provide 'vt-control) From 0e2cf3b9853bceb74632daa2bd22edb350840d91 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:51:28 -0400 Subject: [PATCH 121/128] * lisp/emacs-lisp/edebug.el (edebug--frame): Move docstring where it belongs --- lisp/emacs-lisp/edebug.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 365bc748741..cbc40193125 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -4116,12 +4116,12 @@ This should be a list of `edebug---frame' objects.") "Stack frames of the current Edebug Backtrace buffer with instrumentation. This should be a list of `edebug---frame' objects.") -;; Data structure for backtrace frames with information -;; from Edebug instrumentation found in the backtrace. (cl-defstruct (edebug--frame (:constructor edebug--make-frame) (:include backtrace-frame)) + "Data structure for backtrace frames with information +from Edebug instrumentation found in the backtrace." def-name before-index after-index) (defun edebug-pop-to-backtrace () From be75b08f8214545c9991e157e83e1c864503f25c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:53:53 -0400 Subject: [PATCH 122/128] * lisp/emacs-lisp/float-sup.el (pi): Actually mark it as obsolete --- lisp/emacs-lisp/float-sup.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index 4256bd59584..0e86b923c4a 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -31,6 +31,7 @@ (with-suppressed-warnings ((lexical pi)) (defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.")) +(make-obsolete-variable 'pi 'float-pi "23.3") (internal-make-var-non-special 'pi) (defconst float-e (exp 1) "The value of e (2.7182818...).") From c42dc493d1af7fd1ba73c64ba481f017858c24f6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 12:55:52 -0400 Subject: [PATCH 123/128] * lisp/emacs-lisp/memory-report.el (memory-report--object-size-1): Simplify --- lisp/emacs-lisp/memory-report.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el index ecbca280e59..f4f03133b0f 100644 --- a/lisp/emacs-lisp/memory-report.el +++ b/lisp/emacs-lisp/memory-report.el @@ -182,7 +182,7 @@ by counted more than once." (cl-defmethod memory-report--object-size-1 (_ (value symbol)) ;; Don't count global symbols -- makes sizes of lists of symbols too - ;; heavey. + ;; heavy. (if (intern-soft value obarray) 0 (memory-report--size 'symbol))) @@ -214,14 +214,14 @@ by counted more than once." (setf (gethash value counted) t) (when (car value) (cl-incf total (memory-report--object-size counted (car value)))) - (if (cdr value) - (if (consp (cdr value)) - (if (gethash (cdr value) counted) - (setq value nil) - (setq value (cdr value))) - (cl-incf total (memory-report--object-size counted (cdr value))) - (setq value nil)) - (setq value nil))) + (let ((next (cdr value))) + (setq value (when next + (if (consp next) + (unless (gethash next counted) + (cdr value)) + (cl-incf total (memory-report--object-size + counted next)) + nil))))) total)) (cl-defmethod memory-report--object-size-1 (counted (value vector)) From f63da590fdf115ad6173e123fd41dc62accc7704 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 13:01:06 -0400 Subject: [PATCH 124/128] * lisp/emacs-lisp/smie.el: Fix URL. Remove redundant `:group` args (smie-indent-forward-token): Improve error message. (smie--funcall): New function. (smie-indent-calculate): Use it. --- lisp/emacs-lisp/smie.el | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 994433063ce..ab3cb3c5ace 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -57,7 +57,7 @@ ;; ;; SMIE: Weakness is Power! Auto-indentation with incomplete information ;; Stefan Monnier, Journal 2020, volumn 5, issue 1. -;; doi: 10.22152/programming-journal.org/2020/5/1 +;; doi: 10.22152/programming-journal.org/2021/5/1 ;; A good background to understand the development (especially the parts ;; building the 2D precedence tables and then computing the precedence levels @@ -68,7 +68,7 @@ ;; OTOH we had to kill many chickens, read many coffee grounds, and practice ;; untold numbers of black magic spells, to come up with the indentation code. ;; Since then, some of that code has been beaten into submission, but the -;; smie-indent-keyword is still pretty obscure. +;; `smie-indent-keyword' function is still pretty obscure. ;; Conflict resolution: @@ -247,7 +247,7 @@ be either: ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in ;; the repetition, maybe). - (let* ((nts (mapcar 'car bnf)) ;Non-terminals. + (let* ((nts (mapcar #'car bnf)) ;Non-terminals. (first-ops-table ()) (last-ops-table ()) (first-nts-table ()) @@ -266,7 +266,7 @@ be either: (push resolver precs)) (t (error "Unknown resolver %S" resolver)))) (apply #'smie-merge-prec2s over - (mapcar 'smie-precs->prec2 precs)))) + (mapcar #'smie-precs->prec2 precs)))) again) (dolist (rules bnf) (let ((nt (car rules)) @@ -497,7 +497,7 @@ CSTS is a list of pairs representing arcs in a graph." res)) cycle))) (mapconcat - (lambda (elems) (mapconcat 'identity elems "=")) + (lambda (elems) (mapconcat #'identity elems "=")) (append names (list (car names))) " < "))) @@ -567,7 +567,7 @@ PREC2 is a table as returned by `smie-precs->prec2' or ;; Then eliminate trivial constraints iteratively. (let ((i 0)) (while csts - (let ((rhvs (mapcar 'cdr csts)) + (let ((rhvs (mapcar #'cdr csts)) (progress nil)) (dolist (cst csts) (unless (memq (car cst) rhvs) @@ -657,8 +657,8 @@ use syntax-tables to handle them in efficient C code.") Same calling convention as `smie-forward-token-function' except it should move backward to the beginning of the previous token.") -(defalias 'smie-op-left 'car) -(defalias 'smie-op-right 'cadr) +(defalias 'smie-op-left #'car) +(defalias 'smie-op-right #'cadr) (defun smie-default-backward-token () (forward-comment (- (point))) @@ -974,8 +974,7 @@ I.e. a good choice can be: (defcustom smie-blink-matching-inners t "Whether SMIE should blink to matching opener for inner keywords. If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." - :type 'boolean - :group 'smie) + :type 'boolean) (defun smie-blink-matching-check (start end) (save-excursion @@ -1141,8 +1140,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." (defcustom smie-indent-basic 4 "Basic amount of indentation." - :type 'integer - :group 'smie) + :type 'integer) (defvar smie-rules-function #'ignore "Function providing the indentation rules. @@ -1189,7 +1187,7 @@ designed specifically for use in this function.") (and ;; (looking-at comment-start-skip) ;(bug#16041). (forward-comment (point-max)))))) -(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) +(defalias 'smie-rule-hanging-p #'smie-indent--hanging-p) (defun smie-indent--hanging-p () "Return non-nil if the current token is \"hanging\". A hanging keyword is one that's at the end of a line except it's not at @@ -1205,7 +1203,7 @@ the beginning of a line." (funcall smie--hanging-eolp-function) (point)))))) -(defalias 'smie-rule-bolp 'smie-indent--bolp) +(defalias 'smie-rule-bolp #'smie-indent--bolp) (defun smie-indent--bolp () "Return non-nil if the current token is the first on the line." (save-excursion (skip-chars-backward " \t") (bolp))) @@ -1421,7 +1419,7 @@ BASE-POS is the position relative to which offsets should be applied." (forward-sexp 1) nil) ((eobp) nil) - (t (error "Bumped into unknown token"))))) + (t (error "Bumped into unknown token: %S" tok))))) (defun smie-indent-backward-token () "Skip token backward and return it, along with its levels." @@ -1810,9 +1808,11 @@ Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column to which that point should be aligned, if we were to reindent it.") +(defalias 'smie--funcall #'funcall) ;Debugging/tracing convenience indirection. + (defun smie-indent-calculate () "Compute the indentation to use for point." - (run-hook-with-args-until-success 'smie-indent-functions)) + (run-hook-wrapped 'smie-indent-functions #'smie--funcall)) (defun smie-indent-line () "Indent current line using the SMIE indentation engine." @@ -2016,7 +2016,7 @@ value with which to replace it." ;; FIXME improve value-type. :type '(choice (const nil) (alist :key-type symbol)) - :initialize 'custom-initialize-set + :initialize #'custom-initialize-set :set #'smie-config--setter) (defun smie-config-local (rules) From 3cb0229d75b1380d7a144e24ad24172497fb931c Mon Sep 17 00:00:00 2001 From: Wilson Snyder Date: Mon, 12 Apr 2021 13:36:05 -0400 Subject: [PATCH 125/128] * lisp/progmodes/verilog-mode.el (vl-memory): Add missing defvar. --- lisp/progmodes/verilog-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 5f8f723f80e..2b88120eb9c 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2021.03.30.243771231 +;; Version: 2021.04.12.188864585 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2021-03-30-e87a75f-vpo-GNU" +(defconst verilog-mode-version "2021-04-12-b41d849-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -11561,6 +11561,7 @@ See the example in `verilog-auto-inout-modport'." (defvar vl-cell-type nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-cell-name nil "See `verilog-auto-inst'.") ; Prevent compile warning +(defvar vl-memory nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-modport nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-name nil "See `verilog-auto-inst'.") ; Prevent compile warning (defvar vl-width nil "See `verilog-auto-inst'.") ; Prevent compile warning @@ -12063,6 +12064,7 @@ Lisp Templates: vl-width Width of the input/output port (`3' for [2:0]). May be a (...) expression if bits isn't a constant. vl-dir Direction of the pin input/output/inout/interface. + vl-memory The unpacked array part of the I/O port (`[5:0]'). vl-modport The modport, if an interface with a modport. vl-cell-type Module name/type of the cell (`InstModule'). vl-cell-name Instance name of the cell (`instName'). From fc3caa45ef2dcbd5a1c8339f14696589b99888ce Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 19:23:45 -0400 Subject: [PATCH 126/128] * lisp/minibuffer.el (completion-table-with-quoting): Fix bug#47678 --- lisp/minibuffer.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 5f594679ca3..c900b0d7ce6 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -488,8 +488,17 @@ for use at QPOS." (qsuffix (cdr action)) (ufull (if (zerop (length qsuffix)) ustring (funcall unquote (concat string qsuffix)))) - (_ (cl-assert (string-prefix-p ustring ufull))) - (usuffix (substring ufull (length ustring))) + ;; If (not (string-prefix-p ustring ufull)) we have a problem: + ;; the unquoting the qfull gives something "unrelated" to ustring. + ;; E.g. "~/" and "/" where "~//" gets unquoted to just "/" (see + ;; bug#47678). + ;; In that case we can't even tell if we're right before the + ;; "/" or right after it (aka if this "/" is from qstring or + ;; from qsuffix), which which usuffix to use is very unclear. + (usuffix (if (string-prefix-p ustring ufull) + (substring ufull (length ustring)) + ;; FIXME: Maybe "" is preferable/safer? + qsuffix)) (boundaries (completion-boundaries ustring table pred usuffix)) (qlboundary (car (funcall requote (car boundaries) string))) (qrboundary (if (zerop (cdr boundaries)) 0 ;Common case. From 214dfbfea0cc7d64704aa4a258da542435c44cbb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 21:55:50 -0400 Subject: [PATCH 127/128] Don't version-control generated file `grammat-wy.el` This file is needed for CEDET's bootstrap, tho, so we now keep a copy of it under version control in `gram-wy-boot.el`, very much like we do with the `ldefs-boot.el` copy of `loaddefs.el`. * lisp/cedet/semantic/grm-wy-boot.el: Rename from `lisp/cedet/semantic/grammar-wy.el`. * lisp/cedet/semantic/grammar.el: Load `grm-wy-boot.el` if `grammar-wy.el` hasn't been generated yet. * admin/update_autogen: Also refresh `grm-wy-boot.el`. * admin/grammars/Makefile.in (WISENT): Add `grammar-wy.el` to the generated files. * .gitignore: Add `grammar-wy.el`. --- .gitignore | 1 + admin/grammars/Makefile.in | 13 +++++-------- admin/update_autogen | 12 +++++++++--- lisp/cedet/semantic/grammar.el | 7 ++++++- .../semantic/{grammar-wy.el => grm-wy-boot.el} | 0 lisp/emacs-lisp/eieio-base.el | 3 +-- 6 files changed, 22 insertions(+), 14 deletions(-) rename lisp/cedet/semantic/{grammar-wy.el => grm-wy-boot.el} (100%) diff --git a/.gitignore b/.gitignore index a1e3cb92f87..c262f39126d 100644 --- a/.gitignore +++ b/.gitignore @@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el lisp/cedet/semantic/wisent/js-wy.el lisp/cedet/semantic/wisent/python-wy.el lisp/cedet/srecode/srt-wy.el +lisp/cedet/semantic/grammar-wy.el lisp/eshell/esh-groups.el lisp/finder-inf.el lisp/leim/ja-dic/ diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 35ce55461f3..4172411e034 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -51,14 +51,11 @@ BOVINE = \ ${bovinedir}/make-by.el \ ${bovinedir}/scm-by.el -## FIXME Should include this one too: -## ${cedetdir}/semantic/grammar-wy.el -## but semantic/grammar.el (which is what we use to generate grammar-wy.el) -## requires it! https://debbugs.gnu.org/16008 -WISENT = \ - ${wisentdir}/javat-wy.el \ - ${wisentdir}/js-wy.el \ - ${wisentdir}/python-wy.el \ +WISENT = \ + ${cedetdir}/semantic/grammar-wy.el \ + ${wisentdir}/javat-wy.el \ + ${wisentdir}/js-wy.el \ + ${wisentdir}/python-wy.el \ ${cedetdir}/srecode/srt-wy.el ALL = ${BOVINE} ${WISENT} diff --git a/admin/update_autogen b/admin/update_autogen index 35c391da19e..11c4313ae37 100755 --- a/admin/update_autogen +++ b/admin/update_autogen @@ -317,7 +317,7 @@ EOF echo "Finding loaddef targets..." find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \ - sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ + sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ >| $tempfile || die "Error finding targets" genfiles= @@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error" ## Ignore comment differences. -[ ! "$lboot_flag" ] || \ +[ ! "$lboot_flag" ] || \ diff -q -I '^;' $ldefs_in $ldefs_out || \ cp $ldefs_in $ldefs_out || die "cp ldefs_boot error" +# Refresh the prebuilt grammar-wy.el +grammar_in=lisp/cedet/semantic/grammar-wy.el +grammar_out=lisp/cedet/semantic/grm-wy-boot.el +make -C admin/grammars/ ../../$grammar_in +cp $grammar_in $grammar_out || die "cp grm_wy_boot error" + echo "Checking status of loaddef files..." ## It probably would be fine to just check+commit lisp/, since ## making autoloads should not effect any other files. But better ## safe than sorry. -modified=$(status $genfiles $ldefs_out) || die +modified=$(status $genfiles $ldefs_out $grammar_out) || die commit "loaddefs" $modified || die "commit error" diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index dba289fdd75..4c3bb6c238b 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -31,7 +31,12 @@ (require 'semantic/format) ;; FIXME this is a generated file, but we need to load this file to ;; generate it! -(require 'semantic/grammar-wy) +;; We need `semantic/grammar-wy.el' but we're also needed to generate +;; that file from `grammar.wy', so to break the dependency, we keep +;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008. +(eval-and-compile + (unless (require 'semantic/grammar-wy nil t) + (load "semantic/grm-wy-boot"))) (require 'semantic/idle) (require 'help-fns) (require 'semantic/analyze) diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grm-wy-boot.el similarity index 100% rename from lisp/cedet/semantic/grammar-wy.el rename to lisp/cedet/semantic/grm-wy-boot.el diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index ec1077d447e..641882c9026 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,7 +1,6 @@ ;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- -;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software -;;; Foundation, Inc. +;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: OO, lisp From 6de79542e43ece9a12ebc032c275a6c3fee0b73b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 22:49:48 -0400 Subject: [PATCH 128/128] * lisp/comint.el: Add `font-lock-face` to `rear-nonsticky` (comint--prompt-rear-nonsticky): New const. (comint-send-input, comint-output-filter): Use it. --- lisp/comint.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/lisp/comint.el b/lisp/comint.el index 2745c5a26f6..ef34174305f 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1797,6 +1797,10 @@ Ignore duplicates if `comint-input-ignoredups' is non-nil." (min size (- comint-input-ring-size size))))) (ring-insert comint-input-ring cmd))) +(defconst comint--prompt-rear-nonsticky + '(field inhibit-line-move-field-capture read-only font-lock-face) + "Text properties we set on the prompt and don't want to leak past it.") + (defun comint-send-input (&optional no-newline artificial) "Send input to process. After the process output mark, sends all text from the process mark to @@ -1916,8 +1920,8 @@ Similarly for Soar, Scheme, etc." (unless (or no-newline comint-use-prompt-regexp) ;; Cover the terminating newline (add-text-properties end (1+ end) - '(rear-nonsticky - (field inhibit-line-move-field-capture read-only) + `(rear-nonsticky + ,comint--prompt-rear-nonsticky field boundary inhibit-line-move-field-capture t))))) @@ -2124,10 +2128,10 @@ Make backspaces delete the previous character." (unless comint-use-prompt-regexp (with-silent-modifications (add-text-properties comint-last-output-start (point) - '(front-sticky + `(rear-nonsticky + ,comint--prompt-rear-nonsticky + front-sticky (field inhibit-line-move-field-capture) - rear-nonsticky - (field inhibit-line-move-field-capture read-only) field output inhibit-line-move-field-capture t)))) @@ -2157,8 +2161,8 @@ Make backspaces delete the previous character." 'font-lock-face 'comint-highlight-prompt) (add-text-properties prompt-start (point) - '(rear-nonsticky - (field inhibit-line-move-field-capture read-only)))) + `(rear-nonsticky + ,comint--prompt-rear-nonsticky))) (goto-char saved-point))))))) (defun comint-preinput-scroll-to-bottom ()