From b7682d2a2617a595b64a7e2839344086a5b0318c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Sun, 10 May 2020 10:00:56 +0200 Subject: [PATCH 01/34] Add writing modes module to CSS property list * lisp/textmodes/css-mode.el (css-property-alist): Add new properties from the CSS Writing Modes Level 3 module. --- lisp/textmodes/css-mode.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 0d4a910a1db..3f581c539c6 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -119,7 +119,6 @@ ("cue" cue-before cue-after) ("cue-after" uri "none") ("cue-before" uri "none") - ("direction" "ltr" "rtl") ("display" "inline" "block" "list-item" "inline-block" "table" "inline-table" "table-row-group" "table-header-group" "table-footer-group" "table-row" "table-column-group" @@ -180,7 +179,6 @@ ("stress" number) ("table-layout" "auto" "fixed") ("top" length percentage "auto") - ("unicode-bidi" "normal" "embed" "bidi-override") ("vertical-align" "baseline" "sub" "super" "top" "text-top" "middle" "bottom" "text-bottom" percentage length) ("visibility" "visible" "hidden" "collapse") @@ -490,6 +488,16 @@ ;; (https://www.w3.org/TR/css-will-change-1/#property-index) ("will-change" "auto" animateable-feature) + ;; CSS Writing Modes Level 3 + ;; (https://www.w3.org/TR/css-writing-modes-3/#property-index) + ;; "glyph-orientation-vertical" is obsolete and left out. + ("direction" "ltr" "rtl") + ("text-combine-upright" "none" "all") + ("text-orientation" "mixed" "upright" "sideways") + ("unicode-bidi" "normal" "embed" "isolate" "bidi-override" + "isolate-override" "plaintext") + ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr") + ;; Filter Effects Module Level 1 ;; (http://www.w3.org/TR/filter-effects/#property-index) ("color-interpolation-filters" "auto" "sRGB" "linearRGB") From 2df2f787116a9b0f3907ffbf1027c2eab0804e7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Sun, 10 May 2020 12:14:21 +0200 Subject: [PATCH 02/34] Add containment module to CSS property list * lisp/textmodes/css-mode.el (css-property-alist): Add new properties from CSS Containment Module Level 1. --- lisp/textmodes/css-mode.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 3f581c539c6..ab9e2dc35ec 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -276,6 +276,10 @@ ("color" color) ("opacity" alphavalue) + ;; CSS Containment Module Level 1 + ;; (https://www.w3.org/TR/css-contain-1/#property-index) + ("contain" "none" "strict" "content" "size" "layout" "paint") + ;; CSS Grid Layout Module Level 1 ;; (https://www.w3.org/TR/css-grid-1/#property-index) ("grid" grid-template grid-template-rows "auto-flow" "dense" From 1efaa1d66b9bc51284c7cac4477f45c9bde4fcfb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Sun, 10 May 2020 14:44:26 +0200 Subject: [PATCH 03/34] Allow underscores in CSS variable names * lisp/textmodes/css-mode.el (css-nmchar-re): Allow underscores in variable names (and in identifiers in general). * test/manual/indent/css-mode.css: Add some examples of variable names with underscores in them. * test/manual/indent/less-css-mode.less: Add some examples of variable names with underscores in them. * test/manual/indent/scss-mode.scss: Add some examples of variable names with underscores in them. --- lisp/textmodes/css-mode.el | 2 +- test/manual/indent/css-mode.css | 4 ++++ test/manual/indent/less-css-mode.less | 10 ++++++++++ test/manual/indent/scss-mode.scss | 4 ++++ 4 files changed, 19 insertions(+), 1 deletion(-) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index ab9e2dc35ec..0035c5e7b05 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -886,7 +886,7 @@ cannot be completed sensibly: `custom-ident', (defconst css-escapes-re "\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)") -(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)")) +(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)")) (defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)")) (defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*") ;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes. diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css index ecf6c3c0ca5..041aeec1b15 100644 --- a/test/manual/indent/css-mode.css +++ b/test/manual/indent/css-mode.css @@ -92,5 +92,9 @@ div::before { .foo-bar--baz { --foo-variable: 5px; + --_variable_with_underscores: #fff; + --_variable-starting-with-underscore: none; margin: var(--foo-variable); + color: var(--_variable_with_underscores); + display: var(--_variable-starting-with-underscore); } diff --git a/test/manual/indent/less-css-mode.less b/test/manual/indent/less-css-mode.less index 36c037450cc..b40a2362e28 100644 --- a/test/manual/indent/less-css-mode.less +++ b/test/manual/indent/less-css-mode.less @@ -1,3 +1,13 @@ +@var-with-dashes: #428bca; +@var_with_underscores: 10px; +@_var-starting-with-underscore: none; + +body { + background: @var-with-dashes; + padding: @var_with_underscores; + display: @_var-starting-with-underscore; +} + .desktop-and-old-ie(@rules) { @media screen and (min-width: 1200) { @rules(); } html.lt-ie9 & { @rules(); } diff --git a/test/manual/indent/scss-mode.scss b/test/manual/indent/scss-mode.scss index a3dd41eeb47..189ec4e22ac 100644 --- a/test/manual/indent/scss-mode.scss +++ b/test/manual/indent/scss-mode.scss @@ -41,9 +41,13 @@ p.#{$name} var article[role="main"] { $toto: 500 !global; $var-with-default: 300 !default; + $var_with_underscores: #fff; + $_var-starting-with-underscore: none; float: left !important; width: 600px / 888px * 100%; height: 100px / 888px * 100%; + color: $var_with_underscores; + display: $_var-starting-with-underscore; } %placeholder { From 8f808be68bfab51fe282e7ee2f6bc8c28bf7a442 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Simen=20Heggest=C3=B8yl?= Date: Sun, 10 May 2020 16:17:27 +0200 Subject: [PATCH 04/34] Use lexical-binding in glasses.el and add tests * lisp/progmodes/glasses.el: Use lexical-binding. (glasses-separator, glasses-original-separator, glasses-face) (glasses-separate-parentheses-p) (glasses-separate-parentheses-exceptions) (glasses-separate-capital-groups, glasses-uncapitalize-p) (glasses-uncapitalize-regexp, glasses-convert-on-write-p): Remove redundant :group args. * test/lisp/progmodes/glasses-tests.el: New file with tests for glasses.el. --- lisp/progmodes/glasses.el | 11 +-- test/lisp/progmodes/glasses-tests.el | 101 +++++++++++++++++++++++++++ 2 files changed, 102 insertions(+), 10 deletions(-) create mode 100644 test/lisp/progmodes/glasses-tests.el diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index cad74f9f63a..ab65a1590c0 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -1,4 +1,4 @@ -;;; glasses.el --- make cantReadThis readable +;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*- ;; Copyright (C) 1999-2020 Free Software Foundation, Inc. @@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want to add missing separators, set `glasses-separator' to an empty string. If you don't want to replace existent separators, set `glasses-original-separator' to an empty string." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set `glasses-separator' to \"-\", underscore separators are displayed as hyphens. If `glasses-original-separator' is an empty string, no such display change is performed." - :group 'glasses :type 'string :set 'glasses-custom-set :initialize 'custom-initialize-default @@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter. For example, you can set `glasses-separator' to an empty string and `glasses-face' to `bold'. Then unreadable identifiers will have no separators, but will have their capitals in bold." - :group 'glasses :type '(choice (const :tag "None" nil) face) :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -100,7 +97,6 @@ but will have their capitals in bold." (defcustom glasses-separate-parentheses-p t "If non-nil, ensure space between an identifier and an opening parenthesis." - :group 'glasses :type 'boolean) (defcustom glasses-separate-parentheses-exceptions @@ -108,7 +104,6 @@ but will have their capitals in bold." "List of regexp that are exceptions for `glasses-separate-parentheses-p'. They are matched to the current line truncated to the point where the parenthesis expression starts." - :group 'glasses :type '(repeat regexp)) (defcustom glasses-separate-capital-groups t @@ -116,7 +111,6 @@ parenthesis expression starts." When the value is non-nil, HTMLSomething and IPv6 are displayed as HTML_Something and I_Pv6 respectively. Set the value to nil if you prefer to display them unchanged." - :group 'glasses :type 'boolean :version "24.1") @@ -124,7 +118,6 @@ if you prefer to display them unchanged." "If non-nil, downcase embedded capital letters in identifiers. Only identifiers starting with lower case letters are affected, letters inside other identifiers are unchanged." - :group 'glasses :type 'boolean :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -135,7 +128,6 @@ other identifiers are unchanged." Only words starting with this regexp are uncapitalized. The regexp is case sensitive. It has any effect only when `glasses-uncapitalize-p' is non-nil." - :group 'glasses :type 'regexp :set 'glasses-custom-set :initialize 'custom-initialize-default) @@ -149,7 +141,6 @@ file write then. Note the removal action does not try to be much clever, so it can remove real separators too." - :group 'glasses :type 'boolean) diff --git a/test/lisp/progmodes/glasses-tests.el b/test/lisp/progmodes/glasses-tests.el new file mode 100644 index 00000000000..277a9cc1927 --- /dev/null +++ b/test/lisp/progmodes/glasses-tests.el @@ -0,0 +1,101 @@ +;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2020 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl +;; Keywords: + +;; 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 'glasses) +(require 'seq) + +(ert-deftest glasses-tests-parenthesis-exception-p () + (with-temp-buffer + (insert "public OnClickListener menuListener() {}") + (let ((glasses-separate-parentheses-exceptions '("^Listen"))) + (should-not (glasses-parenthesis-exception-p 1 (point-max))) + (should (glasses-parenthesis-exception-p 15 (point-max))) + (should-not (glasses-parenthesis-exception-p 24 (point-max))) + (should (glasses-parenthesis-exception-p 28 (point-max)))))) + +(ert-deftest glasses-tests-overlay-p () + (should + (glasses-overlay-p (glasses-make-overlay (point-min) (point-max)))) + (should-not + (glasses-overlay-p (make-overlay (point-min) (point-max))))) + +(ert-deftest glasses-tests-make-overlay-p () + (let ((o (glasses-make-overlay (point-min) (point-max)))) + (should (eq (overlay-get o 'category) 'glasses))) + (let ((o (glasses-make-overlay (point-min) (point-max) 'foo))) + (should (eq (overlay-get o 'category) 'foo)))) + +(ert-deftest glasses-tests-make-readable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (pcase-let ((`(,o1 ,o2 ,o3) + (sort (overlays-in (point-min) (point-max)) + (lambda (o1 o2) + (< (overlay-start o1) (overlay-start o2)))))) + (should (= (overlay-start o1) 7)) + (should (equal (overlay-get o1 'before-string) + glasses-separator)) + (should (= (overlay-start o2) 17)) + (should (equal (overlay-get o2 'before-string) + glasses-separator)) + (should (= (overlay-start o3) 25)) + (should (equal (overlay-get o3 'before-string) " "))))) + +(ert-deftest glasses-tests-make-readable-dont-separate-parentheses () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (let ((glasses-separate-parentheses-p nil)) + (glasses-make-readable (point-min) (point-max)) + (should-not (overlays-at 25))))) + +(ert-deftest glasses-tests-make-unreadable () + (with-temp-buffer + (insert "pp.setBackgroundResource(R.drawable.button_right);") + (glasses-make-readable (point-min) (point-max)) + (should (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))) + (glasses-make-unreadable (point-min) (point-max)) + (should-not (seq-some #'glasses-overlay-p + (overlays-in (point-min) (point-max)))))) + +(ert-deftest glasses-tests-convert-to-unreadable () + (with-temp-buffer + (insert "set_Background_Resource(R.button_right);") + (let ((glasses-convert-on-write-p nil)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "set_Background_Resource(R.button_right);"))) + (let ((glasses-convert-on-write-p t)) + (should-not (glasses-convert-to-unreadable)) + (should (equal (buffer-string) + "setBackgroundResource(R.button_right);"))))) + +(provide 'glasses-tests) +;;; glasses-tests.el ends here From 0bb9aeddd6ac713c751b3b6586d62d2dcc8465c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 10 May 2020 13:51:51 -0400 Subject: [PATCH 05/34] * lisp/emacs-lisp/eieio.el (eieio pcase macro): Remove unused var `is` --- lisp/emacs-lisp/eieio.el | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 999d75f79e9..6482c4d052a 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -351,21 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which case the contents of field NAME is matched against PAT, or they can be of the form NAME which is a shorthand for (NAME NAME)." (declare (debug (&rest [&or (sexp pcase-PAT) sexp]))) - (let ((is (make-symbol "table"))) - ;; FIXME: This generates a horrendous mess of redundant let bindings. - ;; `pcase' needs to be improved somehow to introduce let-bindings more - ;; sparingly, or the byte-compiler needs to be taught to optimize - ;; them away. - ;; FIXME: `pcase' does not do a good job here of sharing tests&code among - ;; various branches. - `(and (pred eieio-object-p) + ;; FIXME: This generates a horrendous mess of redundant let bindings. + ;; `pcase' needs to be improved somehow to introduce let-bindings more + ;; sparingly, or the byte-compiler needs to be taught to optimize + ;; them away. + ;; FIXME: `pcase' does not do a good job here of sharing tests&code among + ;; various branches. + `(and (pred eieio-object-p) ,@(mapcar (lambda (field) (pcase-exhaustive field (`(,name ,pat) - `(app (pcase--flip eieio-oref ',name) ,pat)) + `(app (pcase--flip eieio-oref ',name) ,pat)) ((pred symbolp) `(app (pcase--flip eieio-oref ',field) ,field)))) - fields)))) + field-s))) ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. From 5a31b1afca41e71f15a56ad834449bf49ca6aad2 Mon Sep 17 00:00:00 2001 From: Tassilo Horn Date: Sun, 10 May 2020 20:41:42 +0200 Subject: [PATCH 06/34] Prefer function-put over put for setting browse-url-browser-kind. * lisp/net/browse-url.el: Prefer `function-put' over `put' for setting `browse-url-browser-kind' symbol property. --- lisp/net/browse-url.el | 79 ++++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 38 deletions(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index f88de98fca7..8132f8d9933 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -127,8 +127,10 @@ ;; is not sensible to invoke an external browser with it, so here only ;; internal browsers are considered. Therefore, it is advised to put ;; that property also on custom browser functions. -;; (put 'my-browse-url-in-emacs 'browse-url-browser-kind 'internal) -;; (put 'my-browse-url-externally 'browse-url-browser-kind 'external) +;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind +;; 'internal) +;; (function-put 'my-browse-url-externally 'browse-url-browser-kind +;; 'external) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Code: @@ -621,8 +623,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-mailto (url) (browse-url--browser-kind browse-url-mailto-function url)) -(put 'browse-url--mailto 'browse-url-browser-kind - #'browse-url--browser-kind-mailto) +(function-put 'browse-url--mailto 'browse-url-browser-kind + #'browse-url--browser-kind-mailto) (defun browse-url--man (url &rest args) "Calls `browse-url-man-function' with URL and ARGS." @@ -630,8 +632,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-man (url) (browse-url--browser-kind browse-url-man-function url)) -(put 'browse-url--man 'browse-url-browser-kind - #'browse-url--browser-kind-man) +(function-put 'browse-url--man 'browse-url-browser-kind + #'browse-url--browser-kind-man) (defun browse-url--browser (url &rest args) "Calls `browse-url-browser-function' with URL and ARGS." @@ -639,8 +641,8 @@ process), or nil (we don't know)." (defun browse-url--browser-kind-browser (url) (browse-url--browser-kind browse-url-browser-function url)) -(put 'browse-url--browser 'browse-url-browser-kind - #'browse-url--browser-kind-browser) +(function-put 'browse-url--browser 'browse-url-browser-kind + #'browse-url--browser-kind-browser) (defun browse-url--non-html-file-url-p (url) "Return non-nil if URL is a file:// URL of a non-HTML file." @@ -1010,8 +1012,8 @@ The optional NEW-WINDOW argument is not used." (url-unhex-string url) url))))) -(put 'browse-url-default-windows-browser 'browse-url-browser-kind - 'external) +(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind + 'external) (defun browse-url-default-macosx-browser (url &optional _new-window) "Invoke the macOS system's default Web browser. @@ -1019,8 +1021,8 @@ The optional NEW-WINDOW argument is not used." (interactive (browse-url-interactive-arg "URL: ")) (start-process (concat "open " url) nil "open" url)) -(put 'browse-url-default-macosx-browser 'browse-url-browser-kind - 'external) +(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind + 'external) ;; --- Netscape --- @@ -1078,9 +1080,9 @@ instead of `browse-url-new-window-flag'." (lambda (&rest _ignore) (error "No usable browser found")))) url args)) -(put 'browse-url-default-browser 'browse-url-browser-kind - ;; Well, most probably external if we ignore w3. - 'external) +(function-put 'browse-url-default-browser 'browse-url-browser-kind + ;; Well, most probably external if we ignore w3. + 'external) (defun browse-url-can-use-xdg-open () "Return non-nil if the \"xdg-open\" program can be used. @@ -1101,7 +1103,7 @@ The optional argument IGNORED is not used." (interactive (browse-url-interactive-arg "URL: ")) (call-process "xdg-open" nil 0 nil url)) -(put 'browse-url-xdg-open 'browse-url-browser-kind 'external) +(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-netscape (url &optional new-window) @@ -1146,7 +1148,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-netscape-sentinel process ,url))))) -(put 'browse-url-netscape 'browse-url-browser-kind 'external) +(function-put 'browse-url-netscape 'browse-url-browser-kind 'external) (defun browse-url-netscape-sentinel (process url) "Handle a change to the process communicating with Netscape." @@ -1218,7 +1220,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-mozilla-sentinel process ,url))))) -(put 'browse-url-mozilla 'browse-url-browser-kind 'external) +(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external) (defun browse-url-mozilla-sentinel (process url) "Handle a change to the process communicating with Mozilla." @@ -1260,7 +1262,7 @@ instead of `browse-url-new-window-flag'." '("-new-window"))) (list url))))) -(put 'browse-url-firefox 'browse-url-browser-kind 'external) +(function-put 'browse-url-firefox 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-chromium (url &optional _new-window) @@ -1279,7 +1281,7 @@ The optional argument NEW-WINDOW is not used." browse-url-chromium-arguments (list url))))) -(put 'browse-url-chromium 'browse-url-browser-kind 'external) +(function-put 'browse-url-chromium 'browse-url-browser-kind 'external) (defun browse-url-chrome (url &optional _new-window) "Ask the Google Chrome WWW browser to load URL. @@ -1297,7 +1299,7 @@ The optional argument NEW-WINDOW is not used." browse-url-chrome-arguments (list url))))) -(put 'browse-url-chrome 'browse-url-browser-kind 'external) +(function-put 'browse-url-chrome 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-galeon (url &optional new-window) @@ -1336,7 +1338,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-galeon-sentinel process ,url))))) -(put 'browse-url-galeon 'browse-url-browser-kind 'external) +(function-put 'browse-url-galeon 'browse-url-browser-kind 'external) (defun browse-url-galeon-sentinel (process url) "Handle a change to the process communicating with Galeon." @@ -1384,7 +1386,7 @@ used instead of `browse-url-new-window-flag'." `(lambda (process change) (browse-url-epiphany-sentinel process ,url))))) -(put 'browse-url-epiphany 'browse-url-browser-kind 'external) +(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external) (defun browse-url-epiphany-sentinel (process url) "Handle a change to the process communicating with Epiphany." @@ -1410,7 +1412,7 @@ currently selected window instead." file-name-handler-alist))) (if same-window (find-file url) (find-file-other-window url)))) -(put 'browse-url-emacs 'browse-url-browser-kind 'internal) +(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal) ;;;###autoload (defun browse-url-gnome-moz (url &optional new-window) @@ -1436,7 +1438,7 @@ used instead of `browse-url-new-window-flag'." '("--newwin")) (list "--raise" url)))) -(put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) +(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) ;; --- Mosaic --- @@ -1489,7 +1491,7 @@ used instead of `browse-url-new-window-flag'." (append browse-url-mosaic-arguments (list url))) (message "Starting %s...done" browse-url-mosaic-program)))) -(put 'browse-url-mosaic 'browse-url-browser-kind 'external) +(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external) ;; --- Mosaic using CCI --- @@ -1523,7 +1525,7 @@ used instead of `browse-url-new-window-flag'." (process-send-string "browse-url" "disconnect\r\n") (delete-process "browse-url")) -(put 'browse-url-cci 'browse-url-browser-kind 'external) +(function-put 'browse-url-cci 'browse-url-browser-kind 'external) ;; --- Conkeror --- ;;;###autoload @@ -1562,7 +1564,7 @@ NEW-WINDOW instead of `browse-url-new-window-flag'." "buffer") url)))))) -(put 'browse-url-conkeror 'browse-url-browser-kind 'external) +(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external) ;; --- W3 --- @@ -1587,7 +1589,7 @@ used instead of `browse-url-new-window-flag'." (w3-fetch-other-window url) (w3-fetch url))) -(put 'browse-url-w3 'browse-url-browser-kind 'internal) +(function-put 'browse-url-w3 'browse-url-browser-kind 'internal) ;;;###autoload (defun browse-url-w3-gnudoit (url &optional _new-window) @@ -1603,7 +1605,7 @@ The `browse-url-gnudoit-program' program is used with options given by (list (concat "(w3-fetch \"" url "\")") "(raise-frame)")))) -(put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal) +(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal) ;; --- Lynx in an xterm --- @@ -1622,7 +1624,7 @@ The optional argument NEW-WINDOW is not used." ,@browse-url-xterm-args "-e" ,browse-url-text-browser ,url))) -(put 'browse-url-text-xterm 'browse-url-browser-kind 'external) +(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external) ;; --- Lynx in an Emacs "term" window --- @@ -1698,7 +1700,7 @@ used instead of `browse-url-new-window-flag'." url "\r"))))) -(put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) ;; --- mailto --- @@ -1747,7 +1749,7 @@ used instead of `browse-url-new-window-flag'." (unless (bolp) (insert "\n")))))))) -(put 'browse-url-mail 'browse-url-browser-kind 'internal) +(function-put 'browse-url-mail 'browse-url-browser-kind 'internal) ;; --- man --- @@ -1762,7 +1764,7 @@ used instead of `browse-url-new-window-flag'." ((executable-find manual-program) (man url)) (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url))))) -(put 'browse-url-man 'browse-url-browser-kind 'internal) +(function-put 'browse-url-man 'browse-url-browser-kind 'internal) ;; --- Random browser --- @@ -1781,7 +1783,7 @@ don't offer a form of remote control." 0 nil (append browse-url-generic-args (list url)))) -(put 'browse-url-generic 'browse-url-browser-kind 'external) +(function-put 'browse-url-generic 'browse-url-browser-kind 'external) ;;;###autoload (defun browse-url-kde (url &optional _new-window) @@ -1793,7 +1795,7 @@ The optional argument NEW-WINDOW is not used." (apply #'start-process (concat "KDE " url) nil browse-url-kde-program (append browse-url-kde-args (list url)))) -(put 'browse-url-kde 'browse-url-browser-kind 'external) +(function-put 'browse-url-kde 'browse-url-browser-kind 'external) (defun browse-url-elinks-new-window (url) "Ask the Elinks WWW browser to load URL in a new window." @@ -1804,7 +1806,8 @@ The optional argument NEW-WINDOW is not used." browse-url-elinks-wrapper (list "elinks" url))))) -(put 'browse-url-elinks-new-window 'browse-url-browser-kind 'external) +(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind + 'external) ;;;###autoload (defun browse-url-elinks (url &optional new-window) @@ -1827,7 +1830,7 @@ from `browse-url-elinks-wrapper'." `(lambda (process change) (browse-url-elinks-sentinel process ,url)))))) -(put 'browse-url-elinks 'browse-url-browser-kind 'external) +(function-put 'browse-url-elinks 'browse-url-browser-kind 'external) (defun browse-url-elinks-sentinel (process url) "Determines if Elinks is running or a new one has to be started." From 7f7a8fbfd707ee51858a9bee53cff560a0e5b3c0 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 10 May 2020 16:17:01 -0400 Subject: [PATCH 07/34] * lisp/emacs-lisp/eieio.el (eieio pcase macro): Fix last-minute typo --- lisp/emacs-lisp/eieio.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 6482c4d052a..ee5dd2cccdb 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -364,7 +364,7 @@ contents of field NAME is matched against PAT, or they can be of `(app (pcase--flip eieio-oref ',name) ,pat)) ((pred symbolp) `(app (pcase--flip eieio-oref ',field) ,field)))) - field-s))) + fields))) ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. From a218c9861573b5ec4979ff2662f5c0343397e3ff Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 10 May 2020 19:07:45 -0400 Subject: [PATCH 08/34] * lisp/emacs-lisp/pcase.el: Don't bind unused vars in branches (pcase--fgrep): Change calling convention to take bindings rather than just variables. (pcase--funcall, pcase--eval): Adjust to this new calling convention. (pcase--expand): Use `pcase--fgrep` to bind only the vars that are used. --- lisp/emacs-lisp/pcase.el | 47 +++++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 20 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 36b93fa7ac5..4b7689ad42c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'. (seen '()) (codegen (lambda (code vars) - (let ((prev (assq code seen))) + (let ((vars (pcase--fgrep vars code)) + (prev (assq code seen))) (if (not prev) (let ((res (pcase-codegen code vars))) (push (list code vars res) seen) @@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'. (if (pcase--small-branch-p (cdr case)) ;; Don't bother sharing multiple ;; occurrences of this leaf since it's small. - #'pcase-codegen codegen) + (lambda (code vars) + (pcase-codegen code + (pcase--fgrep vars code))) + codegen) (cdr case) vars)))) cases)))) @@ -687,14 +691,17 @@ MATCH is the pattern that needs to be matched, of the form: '(nil . :pcase--fail) '(:pcase--fail . nil)))))) -(defun pcase--fgrep (vars sexp) - "Check which of the symbols VARS appear in SEXP." +(defun pcase--fgrep (bindings sexp) + "Return those of the BINDINGS which might be used in SEXP." (let ((res '())) - (while (consp sexp) - (dolist (var (pcase--fgrep vars (pop sexp))) - (unless (memq var res) (push var res)))) - (and (memq sexp vars) (not (memq sexp res)) (push sexp res)) - res)) + (while (and (consp sexp) bindings) + (dolist (binding (pcase--fgrep bindings (pop sexp))) + (push binding res) + (setq bindings (remove binding bindings)))) + (let ((tmp (assq sexp bindings))) + (if tmp + (cons tmp res) + res)))) (defun pcase--self-quoting-p (upat) (or (keywordp upat) (integerp upat) (stringp upat))) @@ -734,13 +741,11 @@ MATCH is the pattern that needs to be matched, of the form: "Build a function call to FUN with arg ARG." (if (symbolp fun) `(,fun ,arg) - (let* (;; `vs' is an upper bound on the vars we need. - (vs (pcase--fgrep (mapcar #'car vars) fun)) - (env (mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs)) + (let* (;; `env' is an upper bound on the bindings we need. + (env (mapcar (lambda (x) (list (car x) (cdr x))) + (pcase--fgrep vars fun))) (call (progn - (when (memq arg vs) + (when (assq arg env) ;; `arg' is shadowed by `env'. (let ((newsym (gensym "x"))) (push (list newsym arg) env) @@ -748,7 +753,7 @@ MATCH is the pattern that needs to be matched, of the form: (if (functionp fun) `(funcall #',fun ,arg) `(,@fun ,arg))))) - (if (null vs) + (if (null env) call ;; Let's not replace `vars' in `fun' since it's ;; too difficult to do it right, instead just @@ -759,10 +764,12 @@ MATCH is the pattern that needs to be matched, of the form: "Build an expression that will evaluate EXP." (let* ((found (assq exp vars))) (if found (cdr found) - (let* ((vs (pcase--fgrep (mapcar #'car vars) exp)) - (env (mapcar (lambda (v) (list v (cdr (assq v vars)))) - vs))) - (if env (macroexp-let* env exp) exp))))) + (let* ((env (pcase--fgrep vars exp))) + (if env + (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x))) + env) + exp) + exp))))) ;; It's very tempting to use `pcase' below, tho obviously, it'd create ;; bootstrapping problems. From b97877470dcf98d02e4bd31ece7bfb862969663f Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 11 May 2020 04:25:53 +0300 Subject: [PATCH 09/34] Use better icons on GTK in message-mode and isearch * lisp/gnus/message.el (message-tool-bar-retro): Use non-Gnus-specific icon. * lisp/term/x-win.el (x-gtk-stock-map): Use more themed icons (bug#40990). --- lisp/gnus/message.el | 2 +- lisp/term/x-win.el | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 8f402bfc621..5a6827af762 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -7984,7 +7984,7 @@ See `gmm-tool-bar-from-list' for details on the format of the list." (defcustom message-tool-bar-retro '(;; Old Emacs 21 icon for consistency. - (message-send-and-exit "gnus/mail-send") + (message-send-and-exit "mail/send") (message-kill-buffer "close") (message-dont-send "cancel") (mml-attach-file "attach" mml-mode-map) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 5b8feb14a5e..d7bc64fa52a 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames." ("etc/images/right-arrow" . ("go-next" "gtk-go-forward")) ("etc/images/home" . ("go-home" "gtk-home")) ("etc/images/jump-to" . ("go-jump" "gtk-jump-to")) - ("etc/images/index" . "gtk-index") + ("etc/images/index" . ("gtk-search" "gtk-index")) ("etc/images/exit" . ("application-exit" "gtk-quit")) ("etc/images/cancel" . "gtk-cancel") ("etc/images/info" . ("dialog-information" "gtk-info")) ("etc/images/bookmark_add" . "n:bookmark_add") ;; Used in Gnus and/or MH-E: - ("etc/images/attach" . "gtk-attach") + ("etc/images/attach" . ("mail-attachment" "gtk-attach")) ("etc/images/connect" . "gtk-connect") ("etc/images/contact" . "gtk-contact") ("etc/images/delete" . ("edit-delete" "gtk-delete")) @@ -1425,12 +1425,14 @@ This returns an error if any Emacs frames are X frames." ("etc/images/lock" . "gtk-lock") ("etc/images/next-page" . "gtk-next-page") ("etc/images/refresh" . ("view-refresh" "gtk-refresh")) + ("etc/images/search-replace" . "edit-find-replace") ("etc/images/sort-ascending" . ("view-sort-ascending" "gtk-sort-ascending")) ("etc/images/sort-column-ascending" . "gtk-sort-column-ascending") ("etc/images/sort-criteria" . "gtk-sort-criteria") ("etc/images/sort-descending" . ("view-sort-descending" "gtk-sort-descending")) ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending") + ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check")) ("images/gnus/toggle-subscription" . "gtk-task-recurring") ("images/mail/compose" . "gtk-mail-compose") ("images/mail/copy" . "gtk-mail-copy") @@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames." ("images/mail/reply-all" . "gtk-mail-reply-to-all") ("images/mail/reply" . "gtk-mail-reply") ("images/mail/save-draft" . "gtk-mail-handling") - ("images/mail/send" . "gtk-mail-send") + ("images/mail/send" . ("mail-send" "gtk-mail-send")) ("images/mail/spam" . "gtk-spam") ;; Used for GDB Graphical Interface ("images/gud/break" . "gtk-no") From f8da04d6fa5a55367c8ed58a79a8ad3a501bc697 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 11 May 2020 04:34:55 +0300 Subject: [PATCH 10/34] Use the "modern" toolbars in Gnus again * lisp/gnus/gmm-utils.el (gmm-tool-bar-style): Undo the breakage from commit d88118db37dd (https://lists.gnu.org/archive/html/emacs-devel/2020-04/msg02094.html). --- lisp/gnus/gmm-utils.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 2df098bc0bf..6d24b409ed0 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -168,9 +168,9 @@ ARGS are passed to `message'." (defcustom gmm-tool-bar-style (if (and (boundp 'tool-bar-mode) tool-bar-mode - (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color))) + (not (memq (display-visual-class) + (list 'static-gray 'gray-scale + 'static-color 'pseudo-color)))) 'gnome 'retro) "Preferred tool bar style." From c9d7253dd1bd33c1b857203bc9a050013fcb4b34 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 11 May 2020 05:13:25 +0300 Subject: [PATCH 11/34] Map "mail/compose" icon to "mail-message-new" in GTK * lisp/term/x-win.el (x-gtk-stock-map): One more icon mapping. --- lisp/term/x-win.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index d7bc64fa52a..42a6f4030e5 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1434,7 +1434,7 @@ This returns an error if any Emacs frames are X frames." ("etc/images/sort-row-ascending" . "gtk-sort-row-ascending") ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check")) ("images/gnus/toggle-subscription" . "gtk-task-recurring") - ("images/mail/compose" . "gtk-mail-compose") + ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose")) ("images/mail/copy" . "gtk-mail-copy") ("images/mail/forward" . "gtk-mail-forward") ("images/mail/inbox" . "gtk-inbox") From 67bcde188f777e1f884eb46ab3123afa74d8d303 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 May 2020 00:12:29 -0400 Subject: [PATCH 12/34] * lisp/ielm.el: Handle corner case where */**/*** are not yet bound Remote redundant :group args. (ielm-eval-input): Use bound-and-true-p for */**/*** --- lisp/ielm.el | 31 +++++++++++++------------------ 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/lisp/ielm.el b/lisp/ielm.el index fc06ebfa2db..47c5158ce41 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -44,8 +44,7 @@ (defcustom ielm-noisy t "If non-nil, IELM will beep on error." - :type 'boolean - :group 'ielm) + :type 'boolean) (defcustom ielm-prompt-read-only t "If non-nil, the IELM prompt is read only. @@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on text-only terminals or with `emacs -nw', you might wish to use another binding for `comint-kill-whole-line'." :type 'boolean - :group 'ielm :version "22.1") (defcustom ielm-prompt "ELISP> " @@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running process. For IELM buffers that are not called `*ielm*', you can execute \\[inferior-emacs-lisp-mode] in that IELM buffer to update the value, for new prompts. This works even if the buffer has a running process." - :type 'string - :group 'ielm) + :type 'string) (defvar ielm-prompt-internal "ELISP> " "Stored value of `ielm-prompt' in the current IELM buffer. @@ -103,8 +100,7 @@ customizes `ielm-prompt'.") "Controls whether \\\\[ielm-return] has intelligent behavior in IELM. If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline and indents for incomplete sexps. If nil, always inserts newlines." - :type 'boolean - :group 'ielm) + :type 'boolean) (defcustom ielm-dynamic-multiline-inputs t "Force multiline inputs to start from column zero? @@ -112,15 +108,13 @@ If non-nil, after entering the first line of an incomplete sexp, a newline will be inserted after the prompt, moving the input to the next line. This gives more frame width for large indented sexps, and allows functions such as `edebug-defun' to work with such inputs." - :type 'boolean - :group 'ielm) + :type 'boolean) (defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook) (defcustom ielm-mode-hook nil "Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started." :options '(eldoc-mode) - :type 'hook - :group 'ielm) + :type 'hook) ;; We define these symbols (that are only used buffer-locally in ielm ;; buffers) this way to avoid having them be defined in the global @@ -366,9 +360,9 @@ nonempty, then flushes the buffer." ;; that same let. To avoid problems, neither of ;; these buffers should be alive during the ;; evaluation of form. - (let* ((*1 *) - (*2 **) - (*3 ***) + (let* ((*1 (bound-and-true-p *)) + (*2 (bound-and-true-p **)) + (*3 (bound-and-true-p ***)) (active-process (ielm-process)) (old-standard-output standard-output) new-standard-output @@ -453,11 +447,12 @@ nonempty, then flushes the buffer." (if error-type (progn (when ielm-noisy (ding)) - (setq output (concat output "*** " error-type " *** ")) - (setq output (concat output result))) + (setq output (concat output + "*** " error-type " *** " + result))) ;; There was no error, so shift the *** values - (setq *** **) - (setq ** *) + (setq *** (bound-and-true-p **)) + (setq ** (bound-and-true-p *)) (setq * result)) (when (or (not for-effect) (not (equal output ""))) (setq output (concat output "\n")))) From 5601eb231fe1467b2949d7cdc57d8fefb81540e2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 May 2020 00:15:15 -0400 Subject: [PATCH 13/34] * lisp/emacs-lisp/syntax.el (syntax-propertize): Use run-hook-wrapped This way we avoid making assumptions about the content of syntax-propertize-extend-region-functions --- lisp/emacs-lisp/syntax.el | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 11cc1988b1f..3294378754a 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -345,23 +345,27 @@ END) suitable for `syntax-propertize-function'." (end (max pos (min (point-max) (+ start syntax-propertize-chunk-size)))) - (funs syntax-propertize-extend-region-functions)) - (while funs - (let ((new (funcall (pop funs) start end)) - ;; Avoid recursion! - (syntax-propertize--done most-positive-fixnum)) - (if (or (null new) - (and (>= (car new) start) (<= (cdr new) end))) - nil - (setq start (car new)) - (setq end (cdr new)) - ;; If there's been a change, we should go through the - ;; list again since this new position may - ;; warrant a different answer from one of the funs we've - ;; already seen. - (unless (eq funs - (cdr syntax-propertize-extend-region-functions)) - (setq funs syntax-propertize-extend-region-functions))))) + (first t) + (repeat t)) + (while repeat + (setq repeat nil) + (run-hook-wrapped + 'syntax-propertize-extend-region-functions + (lambda (f) + (let ((new (funcall f start end)) + ;; Avoid recursion! + (syntax-propertize--done most-positive-fixnum)) + (if (or (null new) + (and (>= (car new) start) (<= (cdr new) end))) + nil + (setq start (car new)) + (setq end (cdr new)) + ;; If there's been a change, we should go through the + ;; list again since this new position may + ;; warrant a different answer from one of the funs we've + ;; already seen. + (unless first (setq repeat t)))) + (setq first nil)))) ;; Flush ppss cache between the original value of `start' and that ;; set above by syntax-propertize-extend-region-functions. (syntax-ppss-flush-cache start) From 68b34c66319bbc314d505f1352ee8b28b00d69f2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 May 2020 00:18:14 -0400 Subject: [PATCH 14/34] * lisp/subr.el (dolist, dotimes, combine-change-calls): Cosmetic tweaks (dolist, dotimes): Adjust comment since testing `lexical-binding` is supposed to be reliable. (combine-change-calls): Add debug and indent specs. --- lisp/subr.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index c8913145a18..324c59f13f7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil. ;; use dolist. ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dolist-tail--)) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other is slightly faster (and has cleaner semantics) - ;; with lexical scoping. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other is + ;; slightly faster (and has cleaner semantics) with lexical scoping. (if lexical-binding `(let ((,temp ,(nth 1 spec))) (while ,temp @@ -292,9 +291,9 @@ the return value (nil if RESULT is omitted). Its use is deprecated. (let ((temp '--dotimes-limit--) (start 0) (end (nth 1 spec))) - ;; This is not a reliable test, but it does not matter because both - ;; semantics are acceptable, tho one is slightly faster with dynamic - ;; scoping and the other has cleaner semantics. + ;; This test does not matter much because both semantics are acceptable, + ;; but one is slightly faster with dynamic scoping and the other has + ;; cleaner semantics. (if lexical-binding (let ((counter '--dotimes-counter--)) `(let ((,temp ,end) @@ -4033,7 +4032,7 @@ the function `undo--wrap-and-run-primitive-undo'." (defmacro combine-change-calls (beg end &rest body) "Evaluate BODY, running the change hooks just once. -BODY is a sequence of lisp forms to evaluate. BEG and END bound +BODY is a sequence of Lisp forms to evaluate. BEG and END bound the region the change hooks will be run for. Firstly, `before-change-functions' is invoked for the region @@ -4051,7 +4050,8 @@ change `before-change-functions' or `after-change-functions'. Additionally, the buffer modifications of BODY are recorded on the buffer's undo list as a single \(apply ...) entry containing -the function `undo--wrap-and-run-primitive-undo'. " +the function `undo--wrap-and-run-primitive-undo'." + (declare (debug t) (indent 2)) `(combine-change-calls-1 ,beg ,end (lambda () ,@body))) (defun undo--wrap-and-run-primitive-undo (beg end list) From 6bcf7912aad6312d4bd521a3b8b5d9638d83dfa1 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 May 2020 00:30:10 -0400 Subject: [PATCH 15/34] * lisp/textmodes/bibtex.el: Avoid `eval` In the top-level construction of the entry-type commands, use `defalias` instead of (eval `(defun ...)). (bibtex-insert-kill): Strength reduce `eval` => `symbol-value`. (bibtex-autokey-before-presentation-function): Avoid nil value. --- lisp/textmodes/bibtex.el | 109 +++++++++++++++++++++------------------ 1 file changed, 59 insertions(+), 50 deletions(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 670e763814c..229c06f7c4f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -440,7 +440,7 @@ If parsing fails, try to set this variable to nil." "Alist of BibTeX entry types and their associated fields. Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL). ENTRY-TYPE is the type of a BibTeX entry. -DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used. +DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used. REQUIRED is a list of required fields. CROSSREF is a list of fields that are optional if a crossref field is present; but these fields are required otherwise. @@ -1051,7 +1051,7 @@ See `bibtex-generate-autokey' for details." (defvaralias 'bibtex-autokey-name-case-convert 'bibtex-autokey-name-case-convert-function) -(defcustom bibtex-autokey-name-case-convert-function 'downcase +(defcustom bibtex-autokey-name-case-convert-function #'downcase "Function called for each name to perform case conversion. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey @@ -1127,7 +1127,7 @@ Case is significant. See `bibtex-generate-autokey' for details." (defvaralias 'bibtex-autokey-titleword-case-convert 'bibtex-autokey-titleword-case-convert-function) -(defcustom bibtex-autokey-titleword-case-convert-function 'downcase +(defcustom bibtex-autokey-titleword-case-convert-function #'downcase "Function called for each titleword to perform case conversion. See `bibtex-generate-autokey' for details." :group 'bibtex-autokey @@ -1188,12 +1188,12 @@ See `bibtex-generate-autokey' for details." :group 'bibtex-autokey :type 'boolean) -(defcustom bibtex-autokey-before-presentation-function nil - "If non-nil, function to call before generated key is presented. +(defcustom bibtex-autokey-before-presentation-function #'identity + "Function to call before generated key is presented. The function must take one argument (the automatically generated key), and must return a string (the key to use)." :group 'bibtex-autokey - :type '(choice (const nil) function)) + :type 'function) (defcustom bibtex-entry-offset 0 "Offset for BibTeX entries. @@ -1242,7 +1242,7 @@ If non-nil, the column for the equal sign is the value of :group 'bibtex :type '(repeat string)) -(defcustom bibtex-summary-function 'bibtex-summary +(defcustom bibtex-summary-function #'bibtex-summary "Function to call for generating a summary of current BibTeX entry. It takes no arguments. Point must be at beginning of entry. Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'." @@ -1660,7 +1660,7 @@ Initialized by `bibtex-set-dialect'.") (defvar bibtex-font-lock-url-regexp ;; Assume that field names begin at the beginning of a line. (concat "^[ \t]*" - (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t) + (regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t) "[ \t]*=[ \t]*") "Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.") @@ -1892,14 +1892,16 @@ If `bibtex-expand-strings' is non-nil, also expand BibTeX strings." (let ((mtch (match-string-no-properties 0))) (push (or (if bibtex-expand-strings (cdr (assoc-string mtch (bibtex-strings) t))) - mtch) content) + mtch) + content) (goto-char (match-end 0))) (let ((bounds (bibtex-parse-field-string))) (push (buffer-substring-no-properties - (1+ (car bounds)) (1- (cdr bounds))) content) + (1+ (car bounds)) (1- (cdr bounds))) + content) (goto-char (cdr bounds)))) (re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t)) - (apply 'concat (nreverse content)))) + (apply #'concat (nreverse content)))) (buffer-substring-no-properties (bibtex-start-of-text-in-field bounds) (bibtex-end-of-text-in-field bounds)))) @@ -2239,8 +2241,9 @@ Optional arg BEG is beginning of entry." Optional arg COMMA is as in `bibtex-enclosing-field'." (unless bibtex-last-kill-command (error "BibTeX kill ring is empty")) (let ((fun (lambda (kryp kr) ; adapted from `current-kill' - (car (set kryp (nthcdr (mod (- n (length (eval kryp))) - (length kr)) kr)))))) + (car (set kryp (nthcdr (mod (- n (length (symbol-value kryp))) + (length kr)) + kr)))))) ;; We put the mark at the beginning of the inserted field or entry ;; and point at its end - a behavior similar to what `yank' does. ;; The mark is then used by `bibtex-yank-pop', which needs to know @@ -2251,7 +2254,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'." (goto-char (bibtex-end-of-field (bibtex-enclosing-field comma))) (push-mark) (bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer - bibtex-field-kill-ring) t nil t)) + bibtex-field-kill-ring) + t nil t)) ;; insert past the current entry (bibtex-skip-to-valid-entry) (push-mark) @@ -2615,7 +2619,7 @@ Return optimized value to be used by `bibtex-format-entry'." regexp-alist)) (let (opt-list) ;; Loop over field names - (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist)))) + (dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist)))) (let (rules) ;; Collect all matches we have for this field name (dolist (e regexp-alist) @@ -2623,7 +2627,7 @@ Return optimized value to be used by `bibtex-format-entry'." (push (cons (nth 1 e) (nth 2 e)) rules))) (if (eq type 'braces) ;; concatenate all regexps to a single regexp - (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)"))) + (setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)"))) ;; create list of replacement rules. (push (cons field rules) opt-list))) opt-list)) @@ -2674,7 +2678,7 @@ and `bibtex-autokey-names-stretch'." (if (string= "" names) names (let* ((case-fold-search t) - (name-list (mapcar 'bibtex-autokey-demangle-name + (name-list (mapcar #'bibtex-autokey-demangle-name (split-string names "[ \t\n]+and[ \t\n]+"))) additional-names) (unless (or (not (numberp bibtex-autokey-names)) @@ -2686,7 +2690,7 @@ and `bibtex-autokey-names-stretch'." bibtex-autokey-names) (nreverse name-list))) additional-names bibtex-autokey-additional-names)) - (concat (mapconcat 'identity name-list + (concat (mapconcat #'identity name-list bibtex-autokey-name-separator) additional-names))))) @@ -2736,7 +2740,7 @@ Return the result as a string." ;; specific words and use only a specific amount of words. (let ((counter 0) (ignore-re (concat "\\`\\(?:" - (mapconcat 'identity + (mapconcat #'identity bibtex-autokey-titleword-ignore "\\|") "\\)\\'")) titlewords titlewords-extra word) @@ -2760,7 +2764,7 @@ Return the result as a string." ;; titlewords-extra in titlewords. Otherwise, we ignore titlewords-extra. (unless (string-match "\\b\\w+" titlestring) (setq titlewords (append titlewords-extra titlewords))) - (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords) + (mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords) bibtex-autokey-titleword-separator)))) (defun bibtex-autokey-demangle-title (titleword) @@ -2837,7 +2841,7 @@ Concatenate the key: non-empty insert `bibtex-autokey-name-year-separator' between the two. If the title part and the year (or name) part are non-empty, insert `bibtex-autokey-year-title-separator' between the two. - 2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be + 2. `bibtex-autokey-before-presentation-function' must be a function taking one argument. Call this function with the generated key as the argument. Use the return value of this function (a string) as the key. @@ -2865,7 +2869,7 @@ Concatenate the key: (defun bibtex-global-key-alist () "Return global key alist based on `bibtex-files'." (if bibtex-files - (apply 'append + (apply #'append (mapcar (lambda (buf) (with-current-buffer buf bibtex-reference-keys)) ;; include current buffer only if it uses `bibtex-mode' @@ -3129,7 +3133,7 @@ does not use `bibtex-mode'." (if buffer-list (switch-to-buffer (completing-read "Switch to BibTeX buffer: " - (mapcar 'buffer-name buffer-list) + (mapcar #'buffer-name buffer-list) nil t (if current (buffer-name (current-buffer))))) (message "No BibTeX buffers defined"))) @@ -3178,7 +3182,7 @@ that is generated by calling `bibtex-url'." Used as default value of `bibtex-summary-function'." ;; It would be neat to make this function customizable. How? (if (looking-at bibtex-entry-maybe-empty-head) - (let* ((bibtex-autokey-name-case-convert-function 'identity) + (let* ((bibtex-autokey-name-case-convert-function #'identity) (bibtex-autokey-name-length 'infty) (bibtex-autokey-names 1) (bibtex-autokey-names-stretch 0) @@ -3189,7 +3193,7 @@ Used as default value of `bibtex-summary-function'." (year (bibtex-autokey-get-year)) (bibtex-autokey-titlewords 5) (bibtex-autokey-titlewords-stretch 2) - (bibtex-autokey-titleword-case-convert-function 'identity) + (bibtex-autokey-titleword-case-convert-function #'identity) (bibtex-autokey-titleword-length 5) (bibtex-autokey-titleword-separator " ") (title (bibtex-autokey-get-title)) @@ -3336,12 +3340,12 @@ BOUND limits the search." (define-button-type 'bibtex-url 'action 'bibtex-button-action - 'bibtex-function 'bibtex-url + 'bibtex-function #'bibtex-url 'help-echo (purecopy "mouse-2, RET: follow URL")) (define-button-type 'bibtex-search-crossref 'action 'bibtex-button-action - 'bibtex-function 'bibtex-search-crossref + 'bibtex-function #'bibtex-search-crossref 'help-echo (purecopy "mouse-2, RET: follow crossref")) (defun bibtex-button (beg end type &rest args) @@ -3405,7 +3409,7 @@ if that value is non-nil. \\{bibtex-mode-map}" (add-hook 'completion-at-point-functions - 'bibtex-completion-at-point-function nil 'local) + #'bibtex-completion-at-point-function nil 'local) (make-local-variable 'bibtex-buffer-last-parsed-tick) ;; Install stealthy parse function if not already installed (unless bibtex-parse-idle-timer @@ -3419,7 +3423,7 @@ if that value is non-nil. (set (make-local-variable 'comment-column) 0) (set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*") (set (make-local-variable 'outline-regexp) "[ \t]*@") - (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field) + (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field) (set (make-local-variable 'fill-prefix) (make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s)) (set (make-local-variable 'font-lock-defaults) @@ -3441,7 +3445,7 @@ if that value is non-nil. (syntax-propertize-via-font-lock bibtex-font-lock-syntactic-keywords)) ;; Allow `bibtex-dialect' as a file-local variable. - (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t)) + (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t)) (defun bibtex-entry-alist (dialect) "Return entry-alist for DIALECT." @@ -3488,8 +3492,9 @@ are also bound buffer-locally if `bibtex-dialect' is already buffer-local in the current buffer (for example, as a file-local variable). LOCAL is t for interactive calls." (interactive (list (intern (completing-read "Dialect: " - (mapcar 'list bibtex-dialect-list) - nil t)) t)) + (mapcar #'list bibtex-dialect-list) + nil t)) + t)) (let ((setfun (if (or local (local-variable-p 'bibtex-dialect)) (lambda (var val) (set (make-local-variable var) val)) 'set))) @@ -3506,7 +3511,7 @@ LOCAL is t for interactive calls." bibtex-dialect)))) (funcall setfun 'bibtex-entry-type (concat "@[ \t]*\\(?:" - (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)")) + (regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)")) (funcall setfun 'bibtex-entry-head (concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\(" bibtex-reference-key "\\)")) @@ -3516,7 +3521,7 @@ LOCAL is t for interactive calls." (concat "^[ \t]*@[ \t]*\\(?:" (regexp-opt (append '("String" "Preamble") - (mapcar 'car bibtex-entry-alist))) "\\)")) + (mapcar #'car bibtex-entry-alist))) "\\)")) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t))) @@ -3549,11 +3554,13 @@ LOCAL is t for interactive calls." (let* ((entry (car elt)) (fname (intern (format "bibtex-%s" entry)))) (unless (fboundp fname) - (eval (list 'defun fname nil - (format "Insert a template for a @%s entry; see also `bibtex-entry'." - entry) - '(interactive "*") - `(bibtex-entry ,entry)))) + (defalias fname + (lambda () + (:documentation + (format "Insert a template for a @%s entry; see also `bibtex-entry'." + entry) + (interactive "*") + (bibtex-entry entry))))) ;; Menu entries (define-key menu-map (vector fname) `(menu-item ,(or (nth 1 elt) (car elt)) ,fname)))) @@ -3608,8 +3615,8 @@ is non-nil." (insert "@" entry-type (bibtex-entry-left-delimiter)) (if key (insert key)) (save-excursion - (mapc 'bibtex-make-field (car field-list)) - (mapc 'bibtex-make-optional-field (cdr field-list)) + (mapc #'bibtex-make-field (car field-list)) + (mapc #'bibtex-make-optional-field (cdr field-list)) (if bibtex-comma-after-last-field (insert ",")) (insert "\n") @@ -3657,8 +3664,8 @@ When called interactively with a prefix arg, query for a value of ENTRY-TYPE." (insert (bibtex-field-left-delimiter))) (goto-char end))) (skip-chars-backward " \t\n") - (mapc 'bibtex-make-field required) - (mapc 'bibtex-make-optional-field optional))))) + (mapc #'bibtex-make-field required) + (mapc #'bibtex-make-optional-field optional))))) (defun bibtex-parse-entry (&optional content keep-opt-alt) "Parse entry at point, return an alist. @@ -4980,7 +4987,8 @@ If mark is active reformat entries in region, if not in whole buffer." ("Remove empty optional and alternative fields? " . opts-or-alts) ("Remove delimiters around pure numerical fields? " . numerical-fields) (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ") . last-comma) + " comma at end of entry? ") + . last-comma) ("Replace double page dashes by single ones? " . page-dashes) ("Delete whitespace at the beginning and end of fields? " . whitespace) ("Inherit booktitle? " . inherit-booktitle) @@ -5047,7 +5055,7 @@ entries from minibuffer." (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) -(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1") +(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1") (defun bibtex-completion-at-point-function () (let ((pnt (point)) (case-fold-search t) @@ -5258,8 +5266,8 @@ Return the URL or nil if none can be generated." ;; If SCHEME is set up correctly, ;; we should never reach this point (error "Match failed: %s" text))) - (if fmt (apply 'format fmt (nreverse obj)) - (apply 'concat (nreverse obj))))) + (if fmt (apply #'format fmt (nreverse obj)) + (apply #'concat (nreverse obj))))) (if (called-interactively-p 'interactive) (message "%s" url)) (unless no-browse (browse-url url))) (if (and (not url) (called-interactively-p 'interactive)) @@ -5289,10 +5297,11 @@ where FILE is the BibTeX file of ENTRY." (list (completing-read "Field: " (delete-dups - (apply 'append + (apply #'append bibtex-user-optional-fields - (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2 x)))) - bibtex-entry-alist))) nil t) + (mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2 x)))) + bibtex-entry-alist))) + nil t) (read-string "Regexp: ") (if bibtex-search-entry-globally (not current-prefix-arg) From 703115829b35de6a90d7bafb7931f905e79d0d35 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Mon, 11 May 2020 11:43:29 +0100 Subject: [PATCH 16/34] ; Fix last change to bibtex.el * lisp/textmodes/bibtex.el (bibtex-autokey-before-presentation-function): Bump :version tag now that nil is no longer a valid value. --- lisp/textmodes/bibtex.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 229c06f7c4f..fa82227f36c 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -1193,6 +1193,7 @@ See `bibtex-generate-autokey' for details." The function must take one argument (the automatically generated key), and must return a string (the key to use)." :group 'bibtex-autokey + :version "28.1" :type 'function) (defcustom bibtex-entry-offset 0 From a69ef94e22716f9cbb7cf8d78b89e7be4a4c60eb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 11 May 2020 09:53:37 -0400 Subject: [PATCH 17/34] * lisp/emacs-lisp/pcase.el (pcase--fgrep): Look inside vectors --- lisp/emacs-lisp/pcase.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4b7689ad42c..a8ce23284c4 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -698,10 +698,15 @@ MATCH is the pattern that needs to be matched, of the form: (dolist (binding (pcase--fgrep bindings (pop sexp))) (push binding res) (setq bindings (remove binding bindings)))) - (let ((tmp (assq sexp bindings))) - (if tmp - (cons tmp res) - res)))) + (if (vectorp sexp) + ;; With backquote, code can appear within vectors as well. + ;; This wouldn't be needed if we `macroexpand-all' before + ;; calling pcase--fgrep, OTOH. + (pcase--fgrep bindings (mapcar #'identity sexp)) + (let ((tmp (assq sexp bindings))) + (if tmp + (cons tmp res) + res))))) (defun pcase--self-quoting-p (upat) (or (keywordp upat) (integerp upat) (stringp upat))) From dd0b910f1a9d08e65f59cc7ebc10fb6cd0fecfc9 Mon Sep 17 00:00:00 2001 From: Alan Mackenzie Date: Mon, 11 May 2020 20:05:54 +0000 Subject: [PATCH 18/34] Fix bug #40992 whilst still allowing breakpoint highlights in edebug Strategy: when an instrumented function gets re-evaluated, save the former value of its symbol's `edebug' property in the new propery `ghost-edebug'. If this function is still being edebugged, edebug will then access its info from this new property. Also fix the bug whereby compile-defun'ing an instrumented function prevents the function being re-instrumented by I (edebug-instrument-callee). * lisp/emacs-lisp/edebug.el (edebug-get-edebug-or-ghost): New function. (edebug-read-and-maybe-wrap-form1): save value of `edebug' property in 'ghost-edebug'. (edebug-make-form-wrapper): Set value of `ghost-edebug' to nil. (edebug-make-form-wrapper, edebug-find-stop-point, edebug-next-break-point) (edebug-modify-breakpoint, edebug--overlay-breakpoints, edebug-set-breakpoint) (edebug-unset-breakpoints, edebug-toggle-disable-breakpoint) (edebug--backtrace-goto-source, edebug-display-freq-count) (edebug-set-conditional-breakpoint): Use edebug-get-edebug-or-ghost to access edebug information. (edebug-instrument-function): Also check a function is a cons before declaring it "already instrumented". --- lisp/emacs-lisp/edebug.el | 53 ++++++++++++++++++++++++++++----------- 1 file changed, 38 insertions(+), 15 deletions(-) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a376067443a..78461185d3a 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug property?" ;;; Offsets for reader +(defun edebug-get-edebug-or-ghost (name) + "Get NAME's value of property `edebug' or property `ghost-edebug'. + +The idea is that should function NAME be recompiled whilst +debugging is in progress, property `edebug' will get set to a +marker. The needed data will then come from property +`ghost-edebug'." + (let ((e (get name 'edebug))) + (if (consp e) + e + (let ((g (get name 'ghost-edebug))) + (if (consp g) + g + e))))) + ;; Define a structure to represent offset positions of expressions. ;; Each offset structure looks like: (before . after) for constituents, ;; or for structures that have elements: (before . after) @@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting ;; Not edebugging this form, so reset the symbol's edebug ;; property to be just a marker at the definition's source code. ;; This only works for defs with simple names. + + ;; Preserve the `edebug' property in case there's + ;; debugging still under way. + (let ((ghost (get def-name 'edebug))) + (if (consp ghost) + (put def-name 'ghost-edebug ghost))) (put def-name 'edebug (point-marker)) ;; Also nil out dependent defs. '(mapcar (function @@ -1411,6 +1432,8 @@ contains a circular object." (cons window (window-start window))))) ;; Store the edebug data in symbol's property list. + ;; We actually want to remove this property entirely, but can't. + (put edebug-def-name 'ghost-edebug nil) (put edebug-def-name 'edebug ;; A struct or vector would be better here!! (list edebug-form-begin-marker @@ -1423,8 +1446,8 @@ contains a circular object." ))) (defun edebug--restore-breakpoints (name) - (let ((data (get name 'edebug))) - (when (listp data) + (let ((data (edebug-get-edebug-or-ghost name))) + (when (consp data) (let ((offsets (nth 2 data)) (breakpoints (nth 1 data)) (start (nth 0 data)) @@ -3128,7 +3151,7 @@ before returning. The default is one second." ;; Return (function . index) of the nearest edebug stop point. (let* ((edebug-def-name (edebug-form-data-symbol)) (edebug-data - (let ((data (get edebug-def-name 'edebug))) + (let ((data (edebug-get-edebug-or-ghost edebug-def-name))) (if (or (null data) (markerp data)) (error "%s is not instrumented for Edebug" edebug-def-name)) data)) ; we could do it automatically, if data is a marker. @@ -3165,7 +3188,7 @@ before returning. The default is one second." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) @@ -3206,7 +3229,7 @@ the breakpoint." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) ;; pull out parts of edebug-data (edebug-def-mark (car edebug-data)) @@ -3244,7 +3267,7 @@ the breakpoint." "\x3c\x7e\xff\xff\xff\xff\x7e\x3c") (defun edebug--overlay-breakpoints (function) - (let* ((data (get function 'edebug)) + (let* ((data (edebug-get-edebug-or-ghost function)) (start (nth 0 data)) (breakpoints (nth 1 data)) (offsets (nth 2 data))) @@ -3284,9 +3307,9 @@ With prefix argument, make it a temporary breakpoint." (interactive "P") ;; If the form hasn't been instrumented yet, do it now. (when (and (not edebug-active) - (let ((data (get (edebug--form-data-name - (edebug-get-form-data-entry (point))) - 'edebug))) + (let ((data (edebug-get-edebug-or-ghost + (edebug--form-data-name + (edebug-get-form-data-entry (point)))))) (or (null data) (markerp data)))) (edebug-defun)) (edebug-modify-breakpoint t nil arg)) @@ -3300,7 +3323,7 @@ With prefix argument, make it a temporary breakpoint." "Unset all the breakpoints in the current form." (interactive) (let* ((name (edebug-form-data-symbol)) - (breakpoints (nth 1 (get name 'edebug)))) + (breakpoints (nth 1 (edebug-get-edebug-or-ghost name)))) (unless breakpoints (user-error "There are no breakpoints in %s" name)) (save-excursion @@ -3316,7 +3339,7 @@ With prefix argument, make it a temporary breakpoint." (user-error "No stop point near point")) (let* ((name (car stop-point)) (index (cdr stop-point)) - (data (get name 'edebug)) + (data (edebug-get-edebug-or-ghost name)) (breakpoint (assq index (nth 1 data)))) (unless breakpoint (user-error "No breakpoint near point")) @@ -3497,7 +3520,7 @@ instrument cannot be found, signal an error." (goto-char func-marker) (edebug-eval-top-level-form) (list func))) - ((consp func-marker) + ((and (consp func-marker) (consp (symbol-function func))) (message "%s is already instrumented." func) (list func)) (t @@ -4270,7 +4293,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME." (let* ((index (backtrace-get-index)) (frame (nth index backtrace-frames))) (when (edebug--frame-def-name frame) - (let* ((data (get (edebug--frame-def-name frame) 'edebug)) + (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame))) (marker (nth 0 data)) (offsets (nth 2 data))) (pop-to-buffer (marker-buffer marker)) @@ -4354,7 +4377,7 @@ reinstrument it." (let* ((function (edebug-form-data-symbol)) (counts (get function 'edebug-freq-count)) (coverages (get function 'edebug-coverage)) - (data (get function 'edebug)) + (data (edebug-get-edebug-or-ghost function)) (def-mark (car data)) ; mark at def start (edebug-points (nth 2 data)) (i (1- (length edebug-points))) @@ -4512,7 +4535,7 @@ With prefix argument, make it a temporary breakpoint." (if edebug-stop-point (let* ((edebug-def-name (car edebug-stop-point)) (index (cdr edebug-stop-point)) - (edebug-data (get edebug-def-name 'edebug)) + (edebug-data (edebug-get-edebug-or-ghost edebug-def-name)) (edebug-breakpoints (car (cdr edebug-data))) (edebug-break-data (assq index edebug-breakpoints)) (edebug-break-condition (car (cdr edebug-break-data))) From 00f0ad55cd7cbb71e42de0d52b7607ffb6a3c220 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 11 May 2020 17:28:23 -0700 Subject: [PATCH 19/34] Update from gnulib This incorporates: 2020-05-11 careadlinkat: fix GCC 10 workaround 2020-05-10 careadlinkat: limit GCC workaround 2020-05-10 attribute: clarify list of attributes 2020-05-10 string: fix compilation error in C++ mode 2020-05-09 manywarnings: port to GCC 10.1 2020-05-09 careadlinkat: pacify -Wreturn-local-addr 2020-05-09 attribute: remove ATTRIBUTE_DEPRECATED 2020-05-09 attribute: Add comments * lib/attribute.h, lib/careadlinkat.c, lib/string.in.h: * lib/warn-on-use.h, m4/manywarnings.m4: Copy from Gnulib. --- lib/attribute.h | 215 +++++++++++++++++++++++++++++++++++++++------ lib/careadlinkat.c | 38 +++++--- lib/string.in.h | 26 +++--- lib/warn-on-use.h | 21 +++-- m4/manywarnings.m4 | 24 ++++- 5 files changed, 263 insertions(+), 61 deletions(-) diff --git a/lib/attribute.h b/lib/attribute.h index c5919d97005..2836b99dad0 100644 --- a/lib/attribute.h +++ b/lib/attribute.h @@ -20,39 +20,196 @@ /* Provide public ATTRIBUTE_* names for the private _GL_ATTRIBUTE_* macros used within Gnulib. */ +/* These attributes can be placed in two ways: + - At the start of a declaration (i.e. even before storage-class + specifiers!); then they apply to all entities that are declared + by the declaration. + - Immediately after the name of an entity being declared by the + declaration; then they apply to that entity only. */ + #ifndef _GL_ATTRIBUTE_H #define _GL_ATTRIBUTE_H -/* C2X standard attributes have macro names that do not begin with - 'ATTRIBUTE_'. */ -#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED -#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH -#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED -#define NODISCARD _GL_ATTRIBUTE_NODISCARD -/* Selected GCC attributes; see: - https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html - These names begin with 'ATTRIBUTE_' to avoid name clashes. */ -#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args) -#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE -#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL -#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD -#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST -#define ATTRIBUTE_DEPRECATED _GL_ATTRIBUTE_DEPRECATED -#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg) -#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE -#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec) -#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF -#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS -#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC -#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE -#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args) -#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING -#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW -#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED -#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE -#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL -#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos) +/* This file defines two types of attributes: + * C2X standard attributes. These have macro names that do not begin with + 'ATTRIBUTE_'. + * Selected GCC attributes; see: + https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html + https://gcc.gnu.org/onlinedocs/gcc/Common-Variable-Attributes.html + https://gcc.gnu.org/onlinedocs/gcc/Common-Type-Attributes.html + These names begin with 'ATTRIBUTE_' to avoid name clashes. */ + + +/* =============== Attributes for specific kinds of functions =============== */ + +/* Attributes for functions that should not be used. */ + +/* Warn if the entity is used. */ +/* Applies to: + - function, variable, + - struct, union, struct/union member, + - enumeration, enumeration item, + - typedef, + in C++ also: namespace, class, template specialization. */ +#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED + +/* If a function call is not optimized way, warn with MSG. */ +/* Applies to: functions. */ #define ATTRIBUTE_WARNING(msg) _GL_ATTRIBUTE_WARNING (msg) +/* If a function call is not optimized way, report an error with MSG. */ +/* Applies to: functions. */ +#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg) + + +/* Attributes for memory-allocating functions. */ + +/* The function returns a pointer to freshly allocated memory. */ +/* Applies to: functions. */ +#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC + +/* ATTRIBUTE_ALLOC_SIZE ((N)) - The Nth argument of the function + is the size of the returned memory block. + ATTRIBUTE_ALLOC_SIZE ((M, N)) - Multiply the Mth and Nth arguments + to determine the size of the returned memory block. */ +/* Applies to: function, pointer to function, function types. */ +#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args) + + +/* Attributes for variadic functions. */ + +/* The variadic function expects a trailing NULL argument. + ATTRIBUTE_SENTINEL () - The last argument is NULL. + ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */ +/* Applies to: functions. */ +#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos) + + +/* ================== Attributes for compiler diagnostics ================== */ + +/* Attributes that help the compiler diagnose programmer mistakes. + Some of them may also help for some compiler optimizations. */ + +/* ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) - + The STRING-INDEXth function argument is a format string of style + ARCHETYPE, which is one of: + printf, gnu_printf + scanf, gnu_scanf, + strftime, gnu_strftime, + strfmon, + or the same thing prefixed and suffixed with '__'. + If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK + are suitable for the format string. */ +/* Applies to: functions. */ +#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec) + +/* ATTRIBUTE_NONNULL ((N1, N2,...)) - Arguments N1, N2,... must not be NULL. + ATTRIBUTE_NONNULL () - All pointer arguments must not be null. */ +/* Applies to: functions. */ +#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args) + +/* The function's return value is a non-NULL pointer. */ +/* Applies to: functions. */ +#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL + +/* Warn if the caller does not use the return value, + unless the caller uses something like ignore_value. */ +/* Applies to: function, enumeration, class. */ +#define NODISCARD _GL_ATTRIBUTE_NODISCARD + + +/* Attributes that disable false alarms when the compiler diagnoses + programmer "mistakes". */ + +/* Do not warn if the entity is not used. */ +/* Applies to: + - function, variable, + - struct, union, struct/union member, + - enumeration, enumeration item, + - typedef, + in C++ also: class. */ +#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED + +/* The contents of a character array is not meant to be NUL-terminated. */ +/* Applies to: struct/union members and variables that are arrays of element + type '[[un]signed] char'. */ +#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING + +/* Do not warn if control flow falls through to the immediately + following 'case' or 'default' label. */ +/* Applies to: Empty statement (;), inside a 'switch' statement. */ +#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH + + +/* ================== Attributes for debugging information ================== */ + +/* Attributes regarding debugging information emitted by the compiler. */ + +/* Omit the function from stack traces when debugging. */ +/* Applies to: function. */ +#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL + +/* Make the entity visible to debuggers etc., even with '-fwhole-program'. */ +/* Applies to: functions, variables. */ +#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE + + +/* ========== Attributes that mainly direct compiler optimizations ========== */ + +/* The function does not throw exceptions. */ +/* Applies to: functions. */ +#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW + +/* Do not inline the function. */ +/* Applies to: functions. */ +#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE + +/* Always inline the function, and report an error if the compiler + cannot inline. */ +/* Applies to: function. */ +#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE + +/* The function does not affect observable state, and always returns a value. + Compilers can omit duplicate calls with the same arguments if + observable state is not changed between calls. (This attribute is + looser than ATTRIBUTE_CONST.) */ +/* Applies to: functions. */ +#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE + +/* The function neither depends on nor affects observable state, + and always returns a value. Compilers can omit duplicate calls with + the same arguments. (This attribute is stricter than ATTRIBUTE_PURE.) */ +/* Applies to: functions. */ +#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST + +/* The function is rarely executed. */ +/* Applies to: functions. */ +#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD + +/* If called from some other compilation unit, the function executes + code from that unit only by return or by exception handling, + letting the compiler optimize that unit more aggressively. */ +/* Applies to: functions. */ +#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF + +/* For struct members: The member has the smallest possible alignment. + For struct, union, class: All members have the smallest possible alignment, + minimizing the memory required. */ +/* Applies to: struct members, struct, union, + in C++ also: class. */ +#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED + + +/* ================ Attributes that make invalid code valid ================ */ + +/* Attributes that prevent fatal compiler optimizations for code that is not + fully ISO C compliant. */ + +/* Pointers to the type may point to the same storage as pointers to + other types, thus disabling strict aliasing optimization. */ +/* Applies to: types. */ +#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS + + #endif /* _GL_ATTRIBUTE_H */ diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 1effdb78451..1aa04363dac 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -72,23 +72,38 @@ careadlinkat (int fd, char const *filename, SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX; char stack_buf[1024]; +#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1) + /* Pacify preadlinkat without creating a pointer to the stack + that a broken gcc -Wreturn-local-addr would cry wolf about. See: + https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95044 + This workaround differs from the mainline code, but + no other way to pacify GCC 10.1.0 is known; even an explicit + #pragma does not pacify GCC. When the GCC bug is fixed this + workaround should be limited to the broken GCC versions. */ +# define WORK_AROUND_GCC_BUG_95044 +#endif + if (! alloc) alloc = &stdlib_allocator; - if (! buffer_size) + if (!buffer) { +#ifdef WORK_AROUND_GCC_BUG_95044 + buffer = alloc->allocate (sizeof stack_buf); +#else /* Allocate the initial buffer on the stack. This way, in the common case of a symlink of small size, we get away with a single small malloc() instead of a big malloc() followed by a shrinking realloc(). */ buffer = stack_buf; +#endif buffer_size = sizeof stack_buf; } buf = buffer; buf_size = buffer_size; - do + while (buf) { /* Attempt to read the link into the current buffer. */ ssize_t link_length = preadlinkat (fd, filename, buf, buf_size); @@ -117,19 +132,19 @@ careadlinkat (int fd, char const *filename, if (buf == stack_buf) { - char *b = (char *) alloc->allocate (link_size); + char *b = alloc->allocate (link_size); buf_size = link_size; if (! b) break; - memcpy (b, buf, link_size); - buf = b; + return memcpy (b, buf, link_size); } - else if (link_size < buf_size && buf != buffer && alloc->reallocate) + + if (link_size < buf_size && buf != buffer && alloc->reallocate) { /* Shrink BUF before returning it. */ - char *b = (char *) alloc->reallocate (buf, link_size); + char *b = alloc->reallocate (buf, link_size); if (b) - buf = b; + return b; } return buf; @@ -138,8 +153,8 @@ careadlinkat (int fd, char const *filename, if (buf != buffer) alloc->free (buf); - if (buf_size <= buf_size_max / 2) - buf_size *= 2; + if (buf_size < buf_size_max / 2) + buf_size = 2 * buf_size + 1; else if (buf_size < buf_size_max) buf_size = buf_size_max; else if (buf_size_max < SIZE_MAX) @@ -149,9 +164,8 @@ careadlinkat (int fd, char const *filename, } else break; - buf = (char *) alloc->allocate (buf_size); + buf = alloc->allocate (buf_size); } - while (buf); if (alloc->die) alloc->die (buf_size); diff --git a/lib/string.in.h b/lib/string.in.h index 96e132f37d7..a08e7057fbd 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -334,9 +334,10 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - " GB18030 and the character to be searched is a digit. */ # undef strchr /* Assume strchr is always declared. */ -_GL_WARN_ON_USE (strchr, "strchr cannot work correctly on character strings " - "in some multibyte locales - " - "use mbschr if you care about internationalization"); +_GL_WARN_ON_USE_CXX (strchr, const char *, (const char *, int), + "strchr cannot work correctly on character strings " + "in some multibyte locales - " + "use mbschr if you care about internationalization"); #endif /* Find the first occurrence of C in S or the final NUL byte. */ @@ -528,15 +529,17 @@ _GL_CXXALIASWARN (strpbrk); locale encoding is GB18030 and one of the characters to be searched is a digit. */ # undef strpbrk -_GL_WARN_ON_USE (strpbrk, "strpbrk cannot work correctly on character strings " - "in multibyte locales - " - "use mbspbrk if you care about internationalization"); +_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *), + "strpbrk cannot work correctly on character strings " + "in multibyte locales - " + "use mbspbrk if you care about internationalization"); # endif #elif defined GNULIB_POSIXCHECK # undef strpbrk # if HAVE_RAW_DECL_STRPBRK -_GL_WARN_ON_USE (strpbrk, "strpbrk is unportable - " - "use gnulib module strpbrk for portability"); +_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *), + "strpbrk is unportable - " + "use gnulib module strpbrk for portability"); # endif #endif @@ -555,9 +558,10 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on character strings " GB18030 and the character to be searched is a digit. */ # undef strrchr /* Assume strrchr is always declared. */ -_GL_WARN_ON_USE (strrchr, "strrchr cannot work correctly on character strings " - "in some multibyte locales - " - "use mbsrchr if you care about internationalization"); +_GL_WARN_ON_USE_CXX (strrchr, const char *, (const char *, int), + "strrchr cannot work correctly on character strings " + "in some multibyte locales - " + "use mbsrchr if you care about internationalization"); #endif /* Search the next delimiter (char listed in DELIM) starting at *STRINGP. diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 1be2cbb9570..23c10fdd122 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -100,23 +100,28 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use #endif /* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string") - is like _GL_WARN_ON_USE (function, "string"), except that the function is - declared with the given prototype, consisting of return type, parameters, - and attributes. + is like _GL_WARN_ON_USE (function, "string"), except that in C++ mode the + function is declared with the given prototype, consisting of return type, + parameters, and attributes. This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does not work in this case. */ #ifndef _GL_WARN_ON_USE_CXX -# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) +# if !defined __cplusplus # define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ + _GL_WARN_ON_USE (function, msg) +# else +# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__) +# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ extern rettype function parameters_and_attributes \ __attribute__ ((__warning__ (msg))) -# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING +# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING /* Verify the existence of the function. */ -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ +# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ extern rettype function parameters_and_attributes -# else /* Unsupported. */ -# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ +# else /* Unsupported. */ +# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \ _GL_WARN_EXTERN_C int _gl_warn_on_use +# endif # endif #endif diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 783620da3ad..719bafb2909 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 18 +# manywarnings.m4 serial 19 dnl Copyright (C) 2008-2020 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -117,6 +117,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Waddress-of-packed-member \ -Waggressive-loop-optimizations \ -Wall \ + -Wanalyzer-double-fclose \ + -Wanalyzer-double-free \ + -Wanalyzer-exposure-through-output-file \ + -Wanalyzer-file-leak \ + -Wanalyzer-free-of-non-heap \ + -Wanalyzer-malloc-leak \ + -Wanalyzer-null-argument \ + -Wanalyzer-null-dereference \ + -Wanalyzer-possible-null-argument \ + -Wanalyzer-possible-null-dereference \ + -Wanalyzer-stale-setjmp-buffer \ + -Wanalyzer-tainted-array-index \ + -Wanalyzer-too-complex \ + -Wanalyzer-unsafe-call-within-signal-handler \ + -Wanalyzer-use-after-free \ + -Wanalyzer-use-of-pointer-in-stale-stack-frame \ + -Warith-conversion \ -Wattribute-warning \ -Wattributes \ -Wbad-function-cast \ @@ -150,9 +167,11 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wempty-body \ -Wendif-labels \ -Wenum-compare \ + -Wenum-conversion \ -Wexpansion-to-defined \ -Wextra \ -Wformat-contains-nul \ + -Wformat-diag \ -Wformat-extra-args \ -Wformat-nonliteral \ -Wformat-security \ @@ -231,6 +250,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wstrict-aliasing \ -Wstrict-overflow \ -Wstrict-prototypes \ + -Wstring-compare \ -Wstringop-truncation \ -Wsuggest-attribute=cold \ -Wsuggest-attribute=const \ @@ -242,6 +262,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wsuggest-final-types \ -Wswitch \ -Wswitch-bool \ + -Wswitch-outside-range \ -Wswitch-unreachable \ -Wsync-nand \ -Wsystem-headers \ @@ -269,6 +290,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], -Wvla \ -Wvolatile-register-var \ -Wwrite-strings \ + -Wzero-length-bounds \ \ ; do gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item" From 4645430b9287c3f5ae9863d465a5dd4158e313a9 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 11 May 2020 17:41:16 -0700 Subject: [PATCH 20/34] Pacify GCC 10.1.0 Pacify GCC 10.1.0 so that it does not issue false alarms when Emacs is configured with --enable-gcc-warnings. * src/dispnew.c (clear_glyph_row): * src/fns.c (hash_clear): * src/keyboard.c (append_tab_bar_item): * src/lisp.h (vcopy): * src/xfaces.c (get_lface_attributes_no_remap) (Finternal_copy_lisp_face, realize_default_face): * src/xmenu.c (set_frame_menubar): Work around -Warray-bounds false alarm in GCC 10.1.0. * src/intervals.c (copy_properties): Avoid -Wnull-dereference false alarm in GCC 10.1.0. * src/lisp.h (xvector_contents_addr, xvector_contents): New functions, useful for working around GCC bug 95072. --- src/dispnew.c | 2 +- src/fns.c | 2 +- src/intervals.c | 3 ++- src/keyboard.c | 4 ++-- src/lisp.h | 23 ++++++++++++++++++++++- src/xfaces.c | 6 +++--- src/xmenu.c | 2 +- 7 files changed, 32 insertions(+), 10 deletions(-) diff --git a/src/dispnew.c b/src/dispnew.c index 5b6fa51a563..1ae59e3ff2b 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -881,7 +881,7 @@ clear_glyph_row (struct glyph_row *row) enum { off = offsetof (struct glyph_row, used) }; /* Zero everything except pointers in `glyphs'. */ - memset (row->used, 0, sizeof *row - off); + memset ((char *) row + off, 0, sizeof *row - off); } diff --git a/src/fns.c b/src/fns.c index d6808aa1280..301bd59ab90 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4392,7 +4392,7 @@ hash_clear (struct Lisp_Hash_Table *h) { ptrdiff_t size = HASH_TABLE_SIZE (h); if (!hash_rehash_needed_p (h)) - memclear (XVECTOR (h->hash)->contents, size * word_size); + memclear (xvector_contents (h->hash), size * word_size); for (ptrdiff_t i = 0; i < size; i++) { set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1); diff --git a/src/intervals.c b/src/intervals.c index d4a734c923c..0257591a142 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -117,10 +117,11 @@ create_root_interval (Lisp_Object parent) /* Make the interval TARGET have exactly the properties of SOURCE. */ void -copy_properties (register INTERVAL source, register INTERVAL target) +copy_properties (INTERVAL source, INTERVAL target) { if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target)) return; + eassume (source && target); COPY_INTERVAL_CACHE (source, target); set_interval_plist (target, Fcopy_sequence (source->plist)); diff --git a/src/keyboard.c b/src/keyboard.c index c94d794b013..f9b9399d502 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -8302,7 +8302,7 @@ append_tab_bar_item (void) /* Append entries from tab_bar_item_properties to the end of tab_bar_items_vector. */ vcopy (tab_bar_items_vector, ntab_bar_items, - XVECTOR (tab_bar_item_properties)->contents, TAB_BAR_ITEM_NSLOTS); + xvector_contents (tab_bar_item_properties), TAB_BAR_ITEM_NSLOTS); ntab_bar_items += TAB_BAR_ITEM_NSLOTS; } @@ -8779,7 +8779,7 @@ append_tool_bar_item (void) /* Append entries from tool_bar_item_properties to the end of tool_bar_items_vector. */ vcopy (tool_bar_items_vector, ntool_bar_items, - XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS); + xvector_contents (tool_bar_item_properties), TOOL_BAR_ITEM_NSLOTS); ntool_bar_items += TOOL_BAR_ITEM_NSLOTS; } diff --git a/src/lisp.h b/src/lisp.h index b4ac017dcf5..a55fa32950d 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3350,6 +3350,27 @@ struct frame; #define HAVE_EXT_TOOL_BAR true #endif +/* Return the address of vector A's element at index I. */ + +INLINE Lisp_Object * +xvector_contents_addr (Lisp_Object a, ptrdiff_t i) +{ + /* This should return &XVECTOR (a)->contents[i], but that would run + afoul of GCC bug 95072. */ + void *v = XVECTOR (a); + char *p = v; + void *w = p + header_size + i * word_size; + return w; +} + +/* Return the address of vector A's elements. */ + +INLINE Lisp_Object * +xvector_contents (Lisp_Object a) +{ + return xvector_contents_addr (a, 0); +} + /* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */ INLINE void @@ -3357,7 +3378,7 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const *args, ptrdiff_t count) { eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v)); - memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args); + memcpy (xvector_contents_addr (v, offset), args, count * sizeof *args); } /* Functions to modify hash tables. */ diff --git a/src/xfaces.c b/src/xfaces.c index bab142ade0f..7d7aff95c11 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1888,7 +1888,7 @@ get_lface_attributes_no_remap (struct frame *f, Lisp_Object face_name, lface = lface_from_face_name_no_resolve (f, face_name, signal_p); if (! NILP (lface)) - memcpy (attrs, XVECTOR (lface)->contents, + memcpy (attrs, xvector_contents (lface), LFACE_VECTOR_SIZE * sizeof *attrs); return !NILP (lface); @@ -2860,7 +2860,7 @@ The value is TO. */) f = XFRAME (new_frame); } - vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE); + vcopy (copy, 0, xvector_contents (lface), LFACE_VECTOR_SIZE); /* Changing a named face means that all realized faces depending on that face are invalid. Since we cannot tell which realized faces @@ -5598,7 +5598,7 @@ realize_default_face (struct frame *f) /* Realize the face; it must be fully-specified now. */ eassert (lface_fully_specified_p (XVECTOR (lface)->contents)); check_lface (lface); - memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs); + memcpy (attrs, xvector_contents (lface), sizeof attrs); struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID); #ifndef HAVE_WINDOW_SYSTEM diff --git a/src/xmenu.c b/src/xmenu.c index 9201a283b47..dba7e88f486 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -763,7 +763,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool deep_p) /* Save the frame's previous menu bar contents data. */ if (previous_menu_items_used) - memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents, + memcpy (previous_items, xvector_contents (f->menu_bar_vector), previous_menu_items_used * word_size); /* Fill in menu_items with the current menu bar contents. From a2792ad54c310fdfabc8a9a8cf5bdf6c98a8ed20 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 12 May 2020 09:34:46 -0700 Subject: [PATCH 21/34] Suppress test failure on hydra.nixos.org * test/lisp/net/tramp-tests.el (tramp-test28-process-file): Attempt to suppress hydra oddity. --- test/lisp/net/tramp-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4cacfa2f712..8c3cb8e2e8f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4208,7 +4208,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (zerop (process-file "true"))) (should-not (zerop (process-file "false"))) (should-not (zerop (process-file "binary-does-not-exist"))) - (should (= 42 (process-file "sh" nil nil nil "-c" "exit 42"))) + (should (= (if (getenv "EMACS_HYDRA_CI") 127 42) + (process-file "sh" nil nil nil "-c" "exit 42"))) ;; Return string in case the process is interrupted. (should (stringp (process-file "sh" nil nil nil "-c" "kill -2 $$"))) (with-temp-buffer From ee5c5daad5f8560d0107301b67b49daf7f523588 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 24 Apr 2020 23:42:37 +0200 Subject: [PATCH 22/34] Base timer-list-mode on tabulated-list-mode (Bug#40854) * lisp/emacs-lisp/timer-list.el (list-timers) (timer-list-mode): Inherit from 'tabulated-list-mode' instead of 'special-mode' and make the necessary changes to support that. * doc/lispref/os.texi (Timers): Update documentation. --- doc/lispref/os.texi | 6 +- lisp/emacs-lisp/timer-list.el | 105 ++++++++++++++++------------------ 2 files changed, 52 insertions(+), 59 deletions(-) diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 5c0b1e2edf0..8bf48b1dbba 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -2182,9 +2182,9 @@ cause anything special to happen. @findex list-timers The @code{list-timers} command lists all the currently active timers. -There's only one command available in the buffer displayed: @kbd{c} -(@code{timer-list-cancel}) that will cancel the timer on the line -under point. +The command @kbd{c} (@code{timer-list-cancel}) will cancel the timer +on the line under point. You can sort the list by column using the +command @kbd{S} (@code{tabulated-list-sort}). @node Idle Timers @section Idle Timers diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 4cebd739c3b..17e5eb05928 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -32,41 +32,49 @@ "List all timers in a buffer." (interactive) (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) - (let ((inhibit-read-only t)) - (erase-buffer) - (timer-list-mode) - (dolist (timer (append timer-list timer-idle-list)) - (insert (format "%4s %10s %8s %s" - ;; Idle. - (if (aref timer 7) "*" " ") - ;; Next time. - (let ((time (list (aref timer 1) - (aref timer 2) - (aref timer 3)))) - (format "%.2f" - (float-time - (if (aref timer 7) - time - (time-subtract time nil))))) - ;; Repeat. - (let ((repeat (aref timer 4))) - (cond - ((numberp repeat) - (format "%.1f" repeat)) - ((null repeat) - "-") - (t - (format "%s" repeat)))) - ;; Function. - (let ((cl-print-compiled 'static) - (cl-print-compiled-button nil) - (print-escape-newlines t)) - (cl-prin1-to-string (aref timer 5))))) - (put-text-property (line-beginning-position) - (1+ (line-beginning-position)) - 'timer timer) - (insert "\n"))) - (goto-char (point-min))) + (timer-list-mode) + (tabulated-list-init-header) + (setq tabulated-list-entries + (mapcar + (lambda (timer) + (list + nil + `[ ;; Idle. + ,(propertize + (if (aref timer 7) " *" " ") + 'help-echo "* marks idle timers" + 'timer timer) + ;; Next time. + ,(propertize + (let ((time (list (aref timer 1) + (aref timer 2) + (aref timer 3)))) + (format "%10.2f" + (float-time + (if (aref timer 7) + time + (time-subtract time nil))))) + 'help-echo "Time in sec till next invocation") + ;; Repeat. + ,(propertize + (let ((repeat (aref timer 4))) + (cond + ((numberp repeat) + (format "%8.1f" repeat)) + ((null repeat) + " -") + (t + (format "%8s" repeat)))) + 'help-echo "Symbol: repeat; number: repeat interval in sec") + ;; Function. + ,(propertize + (let ((cl-print-compiled 'static) + (cl-print-compiled-button nil) + (print-escape-newlines t)) + (cl-prin1-to-string (aref timer 5))) + 'help-echo "Function called by timer")])) + (append timer-list timer-idle-list))) + (tabulated-list-print)) ;; This command can be destructive if they don't know what they are ;; doing. Kids, don't try this at home! ;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.") @@ -74,35 +82,20 @@ (defvar timer-list-mode-map (let ((map (make-sparse-keymap))) (define-key map "c" 'timer-list-cancel) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) (easy-menu-define nil map "" '("Timers" ["Cancel" timer-list-cancel t])) map)) -(define-derived-mode timer-list-mode special-mode "Timer-List" +(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List" "Mode for listing and controlling timers." - (setq bidi-paragraph-direction 'left-to-right) - (setq truncate-lines t) (buffer-disable-undo) (setq-local revert-buffer-function #'list-timers) - (setq buffer-read-only t) - (setq header-line-format - (concat (propertize " " 'display '(space :align-to 0)) - (format "%4s %10s %8s %s" - (propertize "Idle" - 'mouse-face 'highlight - 'help-echo "* marks idle timers") - (propertize "Next" - 'mouse-face 'highlight - 'help-echo "Time in sec till next invocation") - (propertize "Repeat" - 'mouse-face 'highlight - 'help-echo "Symbol: repeat; number: repeat interval in sec") - (propertize "Function" - 'mouse-face 'highlight - 'help-echo "Function called by timer"))))) + (setq tabulated-list-format + '[("Idle" 4) + (" Next" 10) + (" Repeat" 8) + ("Function" 0)])) (defun timer-list-cancel () "Cancel the timer on the line under point." From e6837016b02b89a8f393003f85017ade048d8ab1 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 24 Apr 2020 23:43:57 +0200 Subject: [PATCH 23/34] Support sorting timer-list-mode by column (Bug#40854) * lisp/emacs-lisp/timer-list.el (timer-list-mode) (timer-list--idle-predicate, timer-list--next-predicate) (timer-list--repeat-predicate) (timer-list--function-predicate): Add support for sorting by column. --- lisp/emacs-lisp/timer-list.el | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 17e5eb05928..00d09696d2a 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -92,10 +92,37 @@ (buffer-disable-undo) (setq-local revert-buffer-function #'list-timers) (setq tabulated-list-format - '[("Idle" 4) - (" Next" 10) - (" Repeat" 8) - ("Function" 0)])) + '[("Idle" 6 timer-list--idle-predicate) + (" Next" 12 timer-list--next-predicate) + (" Repeat" 11 timer-list--repeat-predicate) + ("Function" 10 timer-list--function-predicate)])) + +(defun timer-list--idle-predicate (A B) + "Predicate to sort Timer-List by the Idle column." + (let ((iA (aref (cadr A) 0)) + (iB (aref (cadr B) 0))) + (cond ((string= iA iB) + (timer-list--next-predicate A B)) + ((string= iA " *") nil) + (t t)))) + +(defun timer-list--next-predicate (A B) + "Predicate to sort Timer-List by the Next column." + (let ((nA (string-to-number (aref (cadr A) 1))) + (nB (string-to-number (aref (cadr B) 1)))) + (< nA nB))) + +(defun timer-list--repeat-predicate (A B) + "Predicate to sort Timer-List by the Repeat column." + (let ((rA (aref (cadr A) 2)) + (rB (aref (cadr B) 2))) + (string< rA rB))) + +(defun timer-list--function-predicate (A B) + "Predicate to sort Timer-List by the Next column." + (let ((fA (aref (cadr A) 3)) + (fB (aref (cadr B) 3))) + (string< fA fB))) (defun timer-list-cancel () "Cancel the timer on the line under point." From 3b170f04f494e58b0afe3f8a36d7f5ceeb9f07a9 Mon Sep 17 00:00:00 2001 From: Michael Heerdegen Date: Fri, 8 May 2020 03:49:24 +0200 Subject: [PATCH 24/34] Revert "Inhibit modification hooks when saving eieio-persistent's" This reverts commit c59e878439833d89998e03134ee9060f9c449fd9. --- lisp/emacs-lisp/eieio-base.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 010a2b673e1..2cb1f614ce3 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -473,8 +473,7 @@ instance." (let* ((cfn (or file (oref this file))) (default-directory (file-name-directory cfn))) (cl-letf ((standard-output (current-buffer)) - (inhibit-modification-hooks t) - ((oref this file) ;FIXME: Why change it? + ((oref this file) ;FIXME: Why change it? (if file ;; FIXME: Makes a name relative to (oref this file), ;; whereas I think it should be relative to cfn. From 45fa5e97248360369c19feaee9479d22be544c8c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 12 May 2020 16:51:55 -0400 Subject: [PATCH 25/34] * lisp/emacs-lisp/syntax.el: Fix bug#41195 Allow use of `syntax-ppss-flush-cache` in `syntax-propertize-function`. (syntax-propertize--inhibit-flush): New var. (syntax-propertize): Bind it. (syntax-ppss-flush-cache): Test it. --- lisp/emacs-lisp/syntax.el | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 3294378754a..46dc8d9ade8 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic constructs that cannot be handled just by the buffer's syntax-table. The specified function may call `syntax-ppss' on any position -before END, but it should not call `syntax-ppss-flush-cache', -which means that it should not call `syntax-ppss' on some -position and later modify the buffer on some earlier position.") +before END, but if it calls `syntax-ppss' on some +position and later modifies the buffer on some earlier position, +then it is its responsability to call `syntax-ppss-flush-cache' to flush +the now obsolete ppss info from the cache.") (defvar syntax-propertize-chunk-size 500) @@ -320,6 +321,11 @@ END) suitable for `syntax-propertize-function'." (defvar-local syntax-ppss-table nil "Syntax-table to use during `syntax-ppss', if any.") +(defvar-local syntax-propertize--inhibit-flush nil + "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache. +Otherwise it flushes both the ppss cache and the properties +set by `syntax-propertize'") + (defun syntax-propertize (pos) "Ensure that syntax-table properties are set until POS (a buffer point)." (when (< syntax-propertize--done pos) @@ -375,8 +381,13 @@ END) suitable for `syntax-propertize-function'." ;; (message "syntax-propertizing from %s to %s" start end) (remove-text-properties start end '(syntax-table nil syntax-multiline nil)) - ;; Avoid recursion! - (let ((syntax-propertize--done most-positive-fixnum)) + ;; Make sure we only let-bind it buffer-locally. + (make-local-variable 'syntax-propertize--inhibit-flush) + ;; Let-bind `syntax-propertize--done' to avoid infinite recursion! + (let ((syntax-propertize--done most-positive-fixnum) + ;; Let `syntax-propertize-function' call + ;; `syntax-ppss-flush-cache' without worries. + (syntax-propertize--inhibit-flush t)) (funcall syntax-propertize-function start end))))))))) ;;; Link syntax-propertize with syntax.c. @@ -455,7 +466,8 @@ These are valid when the buffer has no restriction.") (defun syntax-ppss-flush-cache (beg &rest ignored) "Flush the cache of `syntax-ppss' starting at position BEG." ;; Set syntax-propertize to refontify anything past beg. - (setq syntax-propertize--done (min beg syntax-propertize--done)) + (unless syntax-propertize--inhibit-flush + (setq syntax-propertize--done (min beg syntax-propertize--done))) ;; Flush invalid cache entries. (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow)) (pcase cell From a87cd10935b03e3db713a73ddcfa13e51d0a964c Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Tue, 12 May 2020 15:19:46 -0700 Subject: [PATCH 26/34] =?UTF-8?q?Use=20proper=20digraphs=20in=20Bah=C3=A1?= =?UTF-8?q?=E2=80=99=C3=AD=20month=20names?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/calendar/cal-bahai.el (calendar-bahai-month-name-array): There doesn’t seem to be any disagreement in the sources I consulted that “Mas͟híyyat” and “S͟haraf” both need an “s͟h” digraph instead of plain “sh”. --- lisp/calendar/cal-bahai.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index b6bb040dd54..4bfdf3a6cf6 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -57,8 +57,8 @@ (defconst calendar-bahai-month-name-array ["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál" - "Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il" - "Sharaf" "Sulṭán" "Mulk" "‘Alá’"] + "Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il" + "S͟haraf" "Sulṭán" "Mulk" "‘Alá’"] "Array of the month names in the Bahá’í calendar.") (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) From cf453495898a5f67d4d02e6d8980f148ee87c37f Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 13 May 2020 01:30:51 +0200 Subject: [PATCH 27/34] Use lexical-binding in cal-julian.el and add tests * lisp/calendar/cal-julian.el: Use lexical-binding. * test/lisp/calendar/cal-julian-tests.el: New file. --- lisp/calendar/cal-julian.el | 2 +- test/lisp/calendar/cal-julian-tests.el | 72 ++++++++++++++++++++++++++ 2 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 test/lisp/calendar/cal-julian-tests.el diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 1c741317803..0458c11920e 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -1,4 +1,4 @@ -;;; cal-julian.el --- calendar functions for the Julian calendar +;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*- ;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc. diff --git a/test/lisp/calendar/cal-julian-tests.el b/test/lisp/calendar/cal-julian-tests.el new file mode 100644 index 00000000000..76118b3d7f5 --- /dev/null +++ b/test/lisp/calendar/cal-julian-tests.el @@ -0,0 +1,72 @@ +;;; cal-julian-tests.el --- tests for calendar/cal-julian.el -*- lexical-binding:t -*- + +;; Copyright (C) 2020 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 . + +;;; Code: + +(require 'ert) +(require 'cal-julian) + +(ert-deftest cal-julian-test-to-absolute () + (should (equal (calendar-gregorian-from-absolute + (calendar-julian-to-absolute + '(10 25 1917))) + '(11 7 1917)))) + +(ert-deftest cal-julian-test-from-absolute () + (should (equal (calendar-julian-from-absolute + (calendar-absolute-from-gregorian + '(11 7 1917))) + '(10 25 1917)))) + +(ert-deftest cal-julian-test-date-string () + (should (equal (let ((calendar-date-display-form calendar-iso-date-display-form)) + (calendar-julian-date-string '(11 7 1917))) + "1917-10-25"))) + +(defmacro with-cal-julian-test (&rest body) + `(save-window-excursion + (unwind-protect + (progn + (calendar) + ,@body) + (kill-buffer "*Calendar*")))) + +(ert-deftest cal-julian-test-goto-date () + (with-cal-julian-test + (calendar-julian-goto-date '(10 25 1917)) + (should (looking-at "7")))) + +(ert-deftest cal-julian-test-astro-to-and-from-absolute () + (should (= (+ (calendar-astro-to-absolute 0.0) + (calendar-astro-from-absolute 0.0)) + 0.0))) + +(ert-deftest cal-julian-calendar-astro-date-string () + (should (equal (calendar-astro-date-string '(10 25 1917)) "2421527"))) + +(ert-deftest calendar-astro-goto-day-number () + (with-cal-julian-test + (calendar-astro-goto-day-number 2421527) + (backward-char) + (should (looking-at "25")))) + +(provide 'cal-julian-tests) +;;; cal-julian-tests.el ends here From 60c9a534291c21cc1f9ebe9dcbe325c91e1d7fc2 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 13 May 2020 01:48:55 +0200 Subject: [PATCH 28/34] Use lexical-binding in dissociate.el and add tests * lisp/play/dissociate.el: Use lexical-binding. * test/lisp/play/dissociate-tests.el: New file. --- lisp/play/dissociate.el | 2 +- test/lisp/play/dissociate-tests.el | 38 ++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 1 deletion(-) create mode 100644 test/lisp/play/dissociate-tests.el diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el index 3768a14ad82..9a6300c0fd2 100644 --- a/lisp/play/dissociate.el +++ b/lisp/play/dissociate.el @@ -1,4 +1,4 @@ -;;; dissociate.el --- scramble text amusingly for Emacs +;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc. diff --git a/test/lisp/play/dissociate-tests.el b/test/lisp/play/dissociate-tests.el new file mode 100644 index 00000000000..e8d903109fc --- /dev/null +++ b/test/lisp/play/dissociate-tests.el @@ -0,0 +1,38 @@ +;;; dissociate-tests.el --- Tests for dissociate.el -*- 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: + +;;; Code: + +(require 'ert) +(require 'dissociate) + +(ert-deftest dissociate-tests-dissociated-press () + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil)) + ((symbol-function 'random) (lambda (_) 10))) + (save-window-excursion + (with-temp-buffer + (insert "Lorem ipsum dolor sit amet") + (dissociated-press) + (should (string-match-p "dolor sit ametdolor sit amdolor sit amdolor sit am" + (buffer-string))))))) + +(provide 'dissociate-tests) +;;; dissociate-tests.el ends here From e420910eb62a635ce98e7e7abf583d0cec39f3c7 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 13 May 2020 02:06:03 +0200 Subject: [PATCH 29/34] Use lexical-binding in animate.el and add tests * lisp/play/animate.el: Use lexical-binding. * test/lisp/play/animate-tests.el: New file. --- lisp/play/animate.el | 2 +- test/lisp/play/animate-tests.el | 56 +++++++++++++++++++++++++++++++++ 2 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 test/lisp/play/animate-tests.el diff --git a/lisp/play/animate.el b/lisp/play/animate.el index ff464b68049..56c3e350e29 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -1,4 +1,4 @@ -;;; animate.el --- make text dance +;;; animate.el --- make text dance -*- lexical-binding:t -*- ;; Copyright (C) 2001-2020 Free Software Foundation, Inc. diff --git a/test/lisp/play/animate-tests.el b/test/lisp/play/animate-tests.el new file mode 100644 index 00000000000..8af1517ffa4 --- /dev/null +++ b/test/lisp/play/animate-tests.el @@ -0,0 +1,56 @@ +;;; animate-tests.el --- Tests for animate.el -*- 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: + +;;; Code: + +(require 'ert) +(require 'animate) + +(ert-deftest animate-test-birthday-present () + (unwind-protect + (save-window-excursion + (cl-letf (((symbol-function 'sit-for) (lambda (_) nil))) + (animate-birthday-present "foo") + (should (equal (buffer-string) + " + + + + + +Happy Birthday, + Foo + + + You are my sunshine, + My only sunshine. + I'm awful sad that + You've moved away. + + Let's talk together + And love more deeply. + Please bring back + my sunshine + to stay!")))) + (kill-buffer "*A-Present-for-Foo*"))) + +(provide 'animate-tests) +;;; animate-tests.el ends here From 41e6682eb6c2dc994202120b3d85c1b6122f30e4 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 13 May 2020 02:12:33 +0100 Subject: [PATCH 30/34] ; Fix warning in last change * lisp/play/animate.el (animate-place-char): Silence 'unused lexical variable' warning. --- lisp/play/animate.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/play/animate.el b/lisp/play/animate.el index 56c3e350e29..8dec55178b1 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -84,7 +84,7 @@ (defun animate-place-char (char vpos hpos) (goto-char (window-start)) (let (abbrev-mode) - (dotimes (i vpos) + (dotimes (_ vpos) (end-of-line) (if (= (forward-line 1) 1) (insert "\n")))) From ac298baa0edf1426f2d46811b113f338f695e04c Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Wed, 13 May 2020 12:13:52 +0200 Subject: [PATCH 31/34] Use lexical-binding in t-mouse.el * lisp/t-mouse.el: Use lexical-binding. --- lisp/t-mouse.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index fc174176cd6..a1af53d8c46 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -1,4 +1,4 @@ -;;; t-mouse.el --- mouse support within the text terminal +;;; t-mouse.el --- mouse support within the text terminal -*- lexical-binding:t -*- ;; Author: Nick Roberts ;; Maintainer: emacs-devel@gnu.org From 9ebf51999ce58cccc2a228fd07a18c7b472dd3fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 13 May 2020 11:31:21 +0100 Subject: [PATCH 32/34] Turn Eldoc, Xref and Project into GNU ELPA :core packages The new packages state they require Emacs 26.3 to function, but a small part of project.el breaks this "soft" rule: the two functions requiring fileloop.el are incompatible with Emacs 26.3. * lisp/jsonrpc.el: Tweak comment near Package-Requires. * lisp/emacs-lisp/eldoc.el: Add Version and Package-Requires. * lisp/progmodes/flymake.el: Add comment near Package-Requires. * lisp/progmodes/project.el: Add Version and Package-Requires. * lisp/progmodes/xref.el: Add Version and Package-Requires. --- lisp/emacs-lisp/eldoc.el | 5 +++++ lisp/jsonrpc.el | 6 +++--- lisp/progmodes/flymake.el | 5 ++++- lisp/progmodes/project.el | 5 +++++ lisp/progmodes/xref.el | 5 +++++ 5 files changed, 22 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 4a2e7488eb0..ef5dbf8103f 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -5,6 +5,11 @@ ;; Author: Noah Friedman ;; Keywords: extensions ;; Created: 1995-10-06 +;; Version: 1.0.0 +;; Package-Requires: ((emacs "26.3")) + +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 6cf41311a14..293dfaa7483 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -4,11 +4,11 @@ ;; Author: João Távora ;; Keywords: processes, languages, extensions -;; Package-Requires: ((emacs "25.2")) ;; Version: 1.0.11 +;; Package-Requires: ((emacs "25.2")) -;; This is an Elpa :core package. Don't use functionality that is not -;; compatible with Emacs 25.2. +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 7fca9dac1af..93a09d10967 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -5,8 +5,11 @@ ;; Author: Pavel Kobyakov ;; Maintainer: João Távora ;; Version: 1.0.8 -;; Package-Requires: ((emacs "26.1")) ;; Keywords: c languages tools +;; Package-Requires: ((emacs "26.1")) + +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index f5f4092babf..ca8b5fa84e0 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,6 +1,11 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. +;; Version: 0.1 +;; Package-Requires: ((emacs "26.3")) + +;; This is a GNU ELPA :core package. Avoid using functionality that +;; not compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index c36a9bd9940..b516ff0fe95 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1,6 +1,11 @@ ;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*- ;; Copyright (C) 2014-2020 Free Software Foundation, Inc. +;; Version: 1.0.0 +;; Package-Requires: ((emacs "26.3") (project "0.1")) + +;; This is a GNU ELPA :core package. Avoid functionality that is not +;; compatible with the version of Emacs recorded above. ;; This file is part of GNU Emacs. From f8a9edce7339273f9c56d27cc6999a22907638e7 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 13 May 2020 14:11:18 +0200 Subject: [PATCH 33/34] Fix some oddities, uncovered by Tramp tests * lisp/net/tramp-gvfs.el (tramp-gvfs-enabled): Prevent crash for older Emacsen. * lisp/net/tramp.el (tramp-process-running-p): Simplify. * test/lisp/net/tramp-tests.el (tramp-test28-process-file): Adapt test. (tramp-test33-environment-variables): Unset "INSIDE_EMACS" initially. --- lisp/net/tramp-gvfs.el | 5 ++++- lisp/net/tramp.el | 15 ++++++++------- test/lisp/net/tramp-tests.el | 16 +++++++++++++--- 3 files changed, 25 insertions(+), 11 deletions(-) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f19e510eb67..704d65cd55e 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -125,7 +125,10 @@ (autoload 'zeroconf-init "zeroconf") (tramp-compat-funcall 'dbus-get-unique-name :system) (tramp-compat-funcall 'dbus-get-unique-name :session) - (or (tramp-process-running-p "gvfs-fuse-daemon") + (or ;; Until Emacs 25, `process-attributes' could crash Emacs + ;; for some processes. Better we don't check. + (<= emacs-major-version 25) + (tramp-process-running-p "gvfs-fuse-daemon") (tramp-process-running-p "gvfsd-fuse")))) "Non-nil when GVFS is available.") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c8fdc5d7285..70fb46bb4cb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3783,7 +3783,8 @@ support symbolic links." (defun tramp-handle-start-file-process (name buffer program &rest args) "Like `start-file-process' for Tramp files. BUFFER might be a list, in this case STDERR is separated." - ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only. + ;; `make-process' knows the `:file-handler' argument since Emacs + ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'. (tramp-file-name-handler 'make-process :name name @@ -4857,13 +4858,13 @@ verbosity of 6." "Return t if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) (catch 'result - (dolist (pid (tramp-compat-funcall 'list-system-processes)) - (let ((attributes (process-attributes pid))) + (dolist (pid (list-system-processes)) + (when-let ((attributes (process-attributes pid)) + (comm (cdr (assoc 'comm attributes)))) (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) - (when-let ((comm (cdr (assoc 'comm attributes)))) - ;; The returned command name could be truncated to 15 - ;; characters. Therefore, we cannot check for `string-equal'. - (string-prefix-p comm process-name)) + ;; The returned command name could be truncated to 15 + ;; characters. Therefore, we cannot check for `string-equal'. + (string-prefix-p comm process-name) (throw 'result t))))))) (defun tramp-read-passwd (proc &optional prompt) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8c3cb8e2e8f..de85f83982c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4208,10 +4208,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (zerop (process-file "true"))) (should-not (zerop (process-file "false"))) (should-not (zerop (process-file "binary-does-not-exist"))) - (should (= (if (getenv "EMACS_HYDRA_CI") 127 42) - (process-file "sh" nil nil nil "-c" "exit 42"))) + (should + (= 42 + (process-file + (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") + nil nil nil "-c" "exit 42"))) ;; Return string in case the process is interrupted. - (should (stringp (process-file "sh" nil nil nil "-c" "kill -2 $$"))) + (should + (string-equal + "Signal 2" + (process-file + (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh") + nil nil nil "-c" "kill -2 $$"))) + (with-temp-buffer (write-region "foo" nil tmp-name) (should (file-exists-p tmp-name)) @@ -4874,6 +4883,7 @@ INPUT, if non-nil, is a string sent to the process." kill-buffer-query-functions) ;; Check INSIDE_EMACS. + (setenv "INSIDE_EMACS") (should (string-equal (format "%s,tramp:%s" emacs-version tramp-version) From a4671733b7b990e83ef6daed4d17ab240a3591b5 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 14 May 2020 01:28:03 +0200 Subject: [PATCH 34/34] ; Fix warning after last change in cal-julian.el * lisp/calendar/cal-julian.el (diary-julian-date) (diary-astro-day-number): Silence byte-compiler warning about variable 'declared after its first use'. --- lisp/calendar/cal-julian.el | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 0458c11920e..918995d0f9b 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil." (calendar-astro-to-absolute daynumber)))) (or noecho (calendar-astro-print-day-number))) - -;; The function below is designed to be used in sexp diary entries, -;; and may be present in users' diary files, so suppress the warning -;; about this prefix-less dynamic variable. It's called from -;; `diary-list-sexp-entries', which binds the variable. -(with-suppressed-warnings ((lexical date)) - (defvar date)) - ;;;###diary-autoload (defun diary-julian-date () "Julian calendar equivalent of date diary entry." + ;; This function is designed to be used in sexp diary entries, and + ;; may be present in users' diary files, so suppress the warning + ;; about this prefix-less dynamic variable. It's called from + ;; `diary-list-sexp-entries', which binds the variable. + (with-suppressed-warnings ((lexical date)) + (defvar date)) (format "Julian date: %s" (calendar-julian-date-string date))) ;; To be called from diary-list-sexp-entries, where DATE is bound. ;;;###diary-autoload (defun diary-astro-day-number () "Astronomical (Julian) day number diary entry." + ;; This function is designed to be used in sexp diary entries, and + ;; may be present in users' diary files, so suppress the warning + ;; about this prefix-less dynamic variable. It's called from + ;; `diary-list-sexp-entries', which binds the variable. + (with-suppressed-warnings ((lexical date)) + (defvar date)) (format "Astronomical (Julian) day number at noon UTC: %s.0" (calendar-astro-date-string date)))