commit 3e07af4e416538d29ffa523f8f2eb7bccc1823a5 (HEAD, refs/remotes/origin/master) Author: Stefan Kangas Date: Wed Aug 2 21:54:16 2023 +0200 Support css-ts-mode in align.el * lisp/align.el (align-rules-list): Add css-ts-mode. diff --git a/lisp/align.el b/lisp/align.el index 5dfebc0e5f9..bc8ccbd599c 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -570,7 +570,7 @@ align-rules-list (css-declaration (regexp . "^\\s-*\\(?:\\w-?\\)+:\\(\\s-*\\).*;") (group . (1)) - (modes . '(css-mode html-mode))) + (modes . '(css-base-mode html-mode))) (toml-assignment (regexp . ,(rx (group (zero-or-more (syntax whitespace))) commit 8c0e59136a869e5cc0a35ed4ac0af81f8bef59f3 Author: Stefan Kangas Date: Wed Aug 2 09:25:26 2023 +0200 Support python-ts-mode in align.el * lisp/align.el (align-dq-string-modes, align-sq-string-modes) (align-open-comment-modes, align-rules-list): Use python-base-mode instead of python-mode. diff --git a/lisp/align.el b/lisp/align.el index b13008b1fdf..5dfebc0e5f9 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -211,20 +211,20 @@ align-text-modes (defcustom align-dq-string-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode vhdl-mode)) + '(python-base-mode vhdl-mode)) "A list of modes where double quoted strings should be excluded." :type '(repeat symbol) :group 'align) (defcustom align-sq-string-modes - (append align-perl-modes '(python-mode)) + (append align-perl-modes '(python-base-mode)) "A list of modes where single quoted strings should be excluded." :type '(repeat symbol) :group 'align) (defcustom align-open-comment-modes (append align-lisp-modes align-c++-modes align-perl-modes - '(python-mode makefile-mode vhdl-mode)) + '(python-base-mode makefile-mode vhdl-mode)) "A list of modes with a single-line comment syntax. These are comments as in Lisp, which have a beginning, but end with the line (i.e., `comment-end' is an empty string)." @@ -450,7 +450,7 @@ align-rules-list (regexp . ,(concat "[^=!<> \t\n]\\(\\s-*\\)=" "\\(\\s-*\\)\\([^>= \t\n]\\|$\\)")) (group . (1 2)) - (modes . '(python-mode)) + (modes . '(python-base-mode)) (tab-stop . nil)) (make-assignment @@ -478,7 +478,7 @@ align-rules-list (basic-comma-delimiter (regexp . ",\\(\\s-*\\)[^# \t\n]") (repeat . t) - (modes . (append align-perl-modes '(python-mode))) + (modes . (append align-perl-modes '(python-base-mode))) (run-if . ,(lambda () current-prefix-arg))) (c++-comment @@ -508,7 +508,7 @@ align-rules-list (python-chain-logic (regexp . "\\(\\s-*\\)\\(\\\\|\\\\)") - (modes . '(python-mode)) + (modes . '(python-base-mode)) (valid . ,(lambda () (save-excursion (goto-char (match-end 2)) @@ -525,7 +525,7 @@ align-rules-list (basic-line-continuation (regexp . "\\(\\s-*\\)\\\\$") - (modes . '(python-mode makefile-mode))) + (modes . '(python-base-mode makefile-mode))) (tex-record-separator (regexp . ,(lambda (end reverse) commit 0de20a595c964c03ed363ff01d4707a17cee3759 Author: Stefan Kangas Date: Thu Aug 3 05:45:13 2023 +0200 Add latex-mode tests for align.el diff --git a/test/lisp/align-resources/latex-mode.erts b/test/lisp/align-resources/latex-mode.erts new file mode 100644 index 00000000000..cdc93e4a925 --- /dev/null +++ b/test/lisp/align-resources/latex-mode.erts @@ -0,0 +1,29 @@ +Name: tex-record-separator and basic-line-continuation + +=-= +\documentclass{} + +\begin{document} + +\begin{tabular}{l|l} + \textit{Player name} &\textit{Career home runs} \\ + \hline + Hank Aaron &755 \\ + Babe Ruth &714 +\end{tabular} + +\end{document} +=-= +\documentclass{} + +\begin{document} + +\begin{tabular}{l|l} + \textit{Player name} & \textit{Career home runs} \\ + \hline + Hank Aaron & 755 \\ + Babe Ruth & 714 +\end{tabular} + +\end{document} +=-=-= diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el index 90b6b9df9bf..dac23ef96d9 100644 --- a/test/lisp/align-tests.el +++ b/test/lisp/align-tests.el @@ -43,6 +43,10 @@ align-java (ert-test-erts-file (ert-resource-file "java-mode.erts") (test-align-transform-fun #'java-mode))) +(ert-deftest align-latex () + (ert-test-erts-file (ert-resource-file "latex-mode.erts") + (test-align-transform-fun #'latex-mode))) + (ert-deftest align-python () (ert-test-erts-file (ert-resource-file "python-mode.erts") (test-align-transform-fun #'python-mode))) commit daa174e56be6dedbf6f1f5dc197c4a442e901809 Author: Stefan Kangas Date: Thu Aug 3 00:48:23 2023 +0200 Add python-mode tests for align.el * test/lisp/align-tests.el (align-python): New test. * test/lisp/align-resources/python-mode.erts: New file. diff --git a/test/lisp/align-resources/python-mode.erts b/test/lisp/align-resources/python-mode.erts new file mode 100644 index 00000000000..1ce50b32dba --- /dev/null +++ b/test/lisp/align-resources/python-mode.erts @@ -0,0 +1,29 @@ +Name: align assignments + +=-= +foo = "bar" +x = 1 +zzzzz = True +y = None +=-= +foo = "bar" +x = 1 +zzzzz = True +y = None +=-=-= + +Name: python-chain-logic and basic-line-continuation + +=-= +if foo or\ + b and \ + bcxxx and \ + c: + pass +=-= +if foo or \ + b and \ + bcxxx and \ + c: + pass +=-=-= diff --git a/test/lisp/align-tests.el b/test/lisp/align-tests.el index 52e136abfc8..90b6b9df9bf 100644 --- a/test/lisp/align-tests.el +++ b/test/lisp/align-tests.el @@ -43,6 +43,10 @@ align-java (ert-test-erts-file (ert-resource-file "java-mode.erts") (test-align-transform-fun #'java-mode))) +(ert-deftest align-python () + (ert-test-erts-file (ert-resource-file "python-mode.erts") + (test-align-transform-fun #'python-mode))) + (ert-deftest align-toml () (let ((indent-tabs-mode nil)) (ert-test-erts-file (ert-resource-file "conf-toml-mode.erts") commit 3c44d7a1b70a2f7c813c9034bb3e28932a1a66c9 Author: Harald Jörg Date: Wed Aug 2 23:53:42 2023 +0200 cperl-mode.el: Subroutine names are fontified correctly in all places Subroutine names are fontified as subroutine names even if the name is also the name of a builtin (fixing an ancient unreported bug). Subroutine name are just comments in comment and pod (fixing a bug introduced recently) * lisp/progmodes/cperl-mode.el (cperl-init-faces): Move fontification of sub declarations before that of builtins. Don't override existing faces when fontifying subroutine declarations. Don't fontify method calls even if the sub names match those of builtins. * test/lisp/progmodes/cperl-mode-tests.el (cperl-test-fontify-sub-names): New tests with a subroutine name in several surroundings. * test/lisp/progmodes/cperl-mode-resources/sub-names.pl: New resource for the new test. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 5dc49e4ebb4..51bed91c8c2 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -5875,6 +5875,13 @@ cperl-font-lock-syntactic-face-function cperl-here-face) (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) +(defface cperl-method-call + '((t (:inherit 'default ))) + "The face for method calls. Usually, they are not fontified. +We use this face to prevent calls to methods which look like +builtin functions to be fontified like, well, builtin +functions (which they are not). Inherits from `default'.") + (defun cperl-init-faces () (condition-case errs (progn @@ -5885,8 +5892,59 @@ cperl-init-faces ;; -------- trailing spaces -> use invalid-face as a warning ;; (matcher subexp facespec) `("[ \t]+$" 0 ',cperl-invalid-face t) + ;; -------- function definition _and_ declaration + ;; (matcher (subexp facespec)) + ;; facespec is evaluated depending on whether the + ;; statement ends in a "{" (definition) or ";" + ;; (declaration without body) + (list (concat "\\<" cperl-sub-regexp + ;; group 1: optional subroutine name + (rx + (sequence (eval cperl--ws+-rx) + (group (optional + (eval cperl--normal-identifier-rx))))) + ;; "fontified" elsewhere: Prototype + (rx (optional + (sequence (eval cperl--ws*-rx) + (eval cperl--prototype-rx)))) + ;; fontified elsewhere: Attributes + (rx (optional (sequence (eval cperl--ws*-rx) + (eval cperl--attribute-list-rx)))) + (rx (eval cperl--ws*-rx)) + ;; group 2: Identifies the start of the anchor + (rx (group + (or (group-n 3 ";") ; Either a declaration... + "{" ; ... or a code block + ;; ... or a complete signature + (sequence (eval cperl--signature-rx) + (eval cperl--ws*-rx)) + ;; ... or the start of a "sloppy" signature + (sequence (eval cperl--sloppy-signature-rx) + ;; arbtrarily continue "a few lines" + (repeat 0 200 (not (in "{")))) + ;; make sure we have a reasonably + ;; short match for an incomplete sub + (not (in ";{(")) + buffer-end)))) + '(1 (if (match-beginning 3) + 'font-lock-variable-name-face + 'font-lock-function-name-face) + nil ; override + t) ; laxmatch in case of anonymous subroutines + ;; -------- anchored: Signature + `(,(rx (sequence (in "(,") + (eval cperl--ws*-rx) + (group (eval cperl--basic-variable-rx)))) + (progn + (goto-char (match-beginning 2)) ; pre-match: Back to sig + (match-end 2)) + nil + (1 font-lock-variable-name-face))) ;; -------- flow control ;; (matcher . subexp) font-lock-keyword-face by default + ;; This highlights declarations and definitions differently. + ;; We do not try to highlight in the case of attributes: + ;; it is already done by `cperl-find-pods-heres' (cons (concat "\\(^\\|[^$@%&\\]\\)\\<\\(" @@ -5910,6 +5968,11 @@ cperl-init-faces "\\)\\>") 2) ; was "\\)[ \n\t;():,|&]" ; In what follows we use `type' style ; for overwritable builtins + ;; -------- avoid method calls being fontified as keywords + ;; (matcher (subexp facespec)) + (list + (rx "->" (* space) (group-n 1(eval cperl--basic-identifier-rx))) + 1 ''cperl-method-call) ;; -------- builtin functions ;; (matcher subexp facespec) (list @@ -5982,57 +6045,6 @@ cperl-init-faces ;; (matcher subexp facespec) '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0 font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]" - ;; This highlights declarations and definitions differently. - ;; We do not try to highlight in the case of attributes: - ;; it is already done by `cperl-find-pods-heres' - ;; -------- function definition _and_ declaration - ;; (matcher (subexp facespec)) - ;; facespec is evaluated depending on whether the - ;; statement ends in a "{" (definition) or ";" - ;; (declaration without body) - (list (concat "\\<" cperl-sub-regexp - ;; group 1: optional subroutine name - (rx - (sequence (eval cperl--ws+-rx) - (group (optional - (eval cperl--normal-identifier-rx))))) - ;; "fontified" elsewhere: Prototype - (rx (optional - (sequence (eval cperl--ws*-rx) - (eval cperl--prototype-rx)))) - ;; fontified elsewhere: Attributes - (rx (optional (sequence (eval cperl--ws*-rx) - (eval cperl--attribute-list-rx)))) - (rx (eval cperl--ws*-rx)) - ;; group 2: Identifies the start of the anchor - (rx (group - (or (group-n 3 ";") ; Either a declaration... - "{" ; ... or a code block - ;; ... or a complete signature - (sequence (eval cperl--signature-rx) - (eval cperl--ws*-rx)) - ;; ... or the start of a "sloppy" signature - (sequence (eval cperl--sloppy-signature-rx) - ;; arbtrarily continue "a few lines" - (repeat 0 200 (not (in "{")))) - ;; make sure we have a reasonably - ;; short match for an incomplete sub - (not (in ";{(")) - buffer-end)))) - '(1 (if (match-beginning 3) - 'font-lock-variable-name-face - 'font-lock-function-name-face) - t ;; override - t) ;; laxmatch in case of anonymous subroutines - ;; -------- anchored: Signature - `(,(rx (sequence (in "(,") - (eval cperl--ws*-rx) - (group (eval cperl--basic-variable-rx)))) - (progn - (goto-char (match-beginning 2)) ; pre-match: Back to sig - (match-end 2)) - nil - (1 font-lock-variable-name-face))) ;; -------- various stuff calling for a package name ;; (matcher (subexp facespec) (subexp facespec)) `(,(rx (sequence diff --git a/test/lisp/progmodes/cperl-mode-resources/sub-names.pl b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl new file mode 100644 index 00000000000..46d05b4dbd2 --- /dev/null +++ b/test/lisp/progmodes/cperl-mode-resources/sub-names.pl @@ -0,0 +1,25 @@ +use 5.038; +use feature 'class'; +use warnings; +no warnings 'experimental'; + +class C { + # "method" is not yet understood by perl-mode, but it isn't + # relevant here: We can use "sub" because what matters is the + # name, which collides with a builtin. + sub m { + "m called" + } +} + +say C->new->m; + +# This comment has a method name in it, and we don't want "method" +# to be fontified as a keyword, nor "name" fontified as a name. + +__END__ + +=head1 Test using the keywords POD + +This piece of POD has a method name in it, and we don't want "method" +to be fontified as a keyword, nor "name" fontified as a name. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index eaf228cb2e2..8f334245c64 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -256,6 +256,39 @@ cperl-test-fontify-special-variables (should (equal (get-text-property (point) 'face) 'font-lock-variable-name-face)))) +(ert-deftest cperl-test-fontify-sub-names () + "Test fontification of subroutines named like builtins. +On declaration, they should look like other used defined +functions. When called, they should not be fontified. In +comments and POD they should be fontified as POD." + (let ((file (ert-resource-file "sub-names.pl"))) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (funcall cperl-test-mode) + (font-lock-ensure) + ;; The declaration + (search-forward-regexp "sub \\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-function-name-face)) + ;; calling as a method + (search-forward-regexp "C->new->\\(m\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + (if (equal cperl-test-mode 'perl-mode) nil + 'cperl-method-call))) + ;; POD + (search-forward-regexp "\\(method\\) \\(name\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-comment-face)) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-comment-face)) + ;; comment + (search-forward-regexp "\\(method\\) \\(name\\)") + (should (equal (get-text-property (match-beginning 1) 'face) + 'font-lock-comment-face)) + (should (equal (get-text-property (match-beginning 2) 'face) + 'font-lock-comment-face))))) + (ert-deftest cperl-test-identify-heredoc () "Test whether a construct containing \"<<\" followed by a bareword is properly identified for a here-document if commit 0910230be6ee858d8d8849a1fc9559bfd163dc38 Author: Stefan Kangas Date: Wed Aug 2 23:26:52 2023 +0200 ; Prefer HTTPS to HTTP in more links diff --git a/ChangeLog.4 b/ChangeLog.4 index 9d64446d68e..372b03b32b2 100644 --- a/ChangeLog.4 +++ b/ChangeLog.4 @@ -116226,7 +116226,7 @@ Do not quote lambda expressions - http://emacs.stackexchange.com/a/3596 + https://emacs.stackexchange.com/a/3596 Quoting lambda expressions is at best redundant and at worst detrimental; this commit removes all use of the sharp-quote to reduce @@ -116960,7 +116960,7 @@ This change follows the regexp for require on emacs truck. See line 2327 on font-lock.el in the following patch. - http://bzr.savannah.gnu.org/lh/emacs/trunk/revision/111821 + https://bzr.savannah.gnu.org/lh/emacs/trunk/revision/111821 2013-09-04 John Wiegley diff --git a/doc/misc/org.org b/doc/misc/org.org index d8bbcb4d0c5..5562a13a005 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -3284,7 +3284,7 @@ options: | Link Type | Example | |------------+----------------------------------------------------------| -| http | =http://staff.science.uva.nl/c.dominik/= | +| http | =https://staff.science.uva.nl/c.dominik/= | | https | =https://orgmode.org/= | | doi | =doi:10.1000/182= | | file | =file:/home/dominik/images/jupiter.jpg= | @@ -3619,7 +3619,7 @@ replacement text. Here is an example: #+begin_src emacs-lisp (setq org-link-abbrev-alist - '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + '(("bugzilla" . "https://10.1.2.9/bugzilla/show_bug.cgi?id=") ("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h") ("duckduckgo" . "https://duckduckgo.com/?q=%s") ("omap" . "https://nominatim.openstreetmap.org/search?q=%s&polygon=1") @@ -20693,8 +20693,8 @@ adding ~:rewrites~ rules like this: #+texinfo: @noindent Since =example.com/$= is used as a regular expression, it maps -=http://example.com/=, =https://example.com=, -=http://www.example.com/= and similar to +=https://example.com/=, =https://example.com=, +=https://www.example.com/= and similar to =/home/user/example/index.php=. The ~:rewrites~ rules are searched as a last resort if and only if no diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e518330c9b0..291d6600af5 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -375,7 +375,7 @@ Obtaining @value{tramp} @example @group -$ git config --global http.proxy http://user:pwd@@proxy.server.com:8080 +$ git config --global http.proxy https://user:pwd@@proxy.server.com:8080 $ git clone https://git.savannah.gnu.org/r/tramp.git @end group @end example diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 2f5f994b474..b5a6cb0e6a1 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -896,8 +896,8 @@ Disk Caching This is creates entries with very few cache collisions and is fast. @cindex MD5 @smallexample -(url-cache-create-filename-using-md5 "http://www.example.com/foo/bar") - @result{} "/home/fx/.url/cache/fx/http/com/example/www/b8a35774ad20db71c7c3409a5410e74f" +(url-cache-create-filename-using-md5 "https://www.example.com/foo/bar") + @result{} "/home/fx/.url/cache/fx/https/com/example/www/b8a35774ad20db71c7c3409a5410e74f" @end smallexample @end defun @@ -906,8 +906,8 @@ Disk Caching @var{url} than for @code{url-cache-create-filename-using-md5}, but more likely to conflict with other files. @smallexample -(url-cache-create-filename-human-readable "http://www.example.com/foo/bar") - @result{} "/home/fx/.url/cache/fx/http/com/example/www/foo/bar" +(url-cache-create-filename-human-readable "https://www.example.com/foo/bar") + @result{} "/home/fx/.url/cache/fx/https/com/example/www/foo/bar" @end smallexample @end defun @@ -1159,7 +1159,7 @@ Suppressing network connections @c linked with the resolver libraries, it will not be able to get to any @c machines off the local network. This is characterized by being able @c to reach someplace with a raw ip number, but not its hostname -@c (@url{http://129.79.254.191/} works, but +@c (@url{https://129.79.254.191/} works, but @c @url{https://www.cs.indiana.edu/} doesn't). This used to happen on @c SunOS4 and Ultrix, but is now probably now rare. If Emacs can't be @c rebuilt linked against the resolver library, it can use the external diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index 6dda3703e6d..f7dcda87466 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -10665,8 +10665,7 @@ * textmodes/rst.el: Add comments. (rst-transition, rst-adornment): New faces. (rst-adornment-faces-alist): Make default safe to reevaluate. - Fixes - http://sourceforge.net/tracker/?func=detail&atid=422030&aid=3479603&group_id=38414. + Fixes https://sourceforge.net/p/docutils/bugs/180/. Improve customization tags. (rst-define-level-faces): Clarify meaning. diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 40f1f54eed0..466822e0e06 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -50,7 +50,7 @@ ;; - coercion wrappers, as in "Threesomes, with and without blame" ;; https://dl.acm.org/doi/10.1145/1706299.1706342, or ;; "On the Runtime Complexity of Type-Directed Unboxing" -;; http://sv.c.titech.ac.jp/minamide/papers.html +;; https://sv.c.titech.ac.jp/minamide/papers.html ;; - An efficient `negate' operation such that ;; (negate (negate f)) returns just `f' and (negate #'<) returns #'>=. ;; - Autoloads (tho currently our bytecode functions (and hence OClosures) diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el index 67f513f8d3e..a7d0b0769f2 100644 --- a/lisp/erc/erc-nicks.el +++ b/lisp/erc/erc-nicks.el @@ -61,7 +61,7 @@ ;; 2007/09 - erc-highlight-nicknames.el ;; Initial release by by André Riemann -;; [1] +;; [1] ;; [2] ;;; Code: diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index a68a6bf1a24..31dc8d8e177 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -81,15 +81,15 @@ newsticker--raw-url-list-defaults ("The Register" "https://www.theregister.co.uk/headlines.rss") ("slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" + "https://rss.slashdot.org/Slashdot/slashdot" nil 3600) ;/. will ban you if under 3600 seconds! ("Wired News" "https://www.wired.com/feed/rss") ("Heise News (german)" - "http://www.heise.de/newsticker/heise.rdf") + "https://www.heise.de/newsticker/heise.rdf") ("Tagesschau (german)" - "http://www.tagesschau.de/newsticker.rdf" + "https://www.tagesschau.de/newsticker.rdf" nil 1800)) "Default URL list in raw form. @@ -1168,7 +1168,7 @@ newsticker--parse-atom-1.0 ;; allows for integrating (x)html into the atom ;; structure but we need the raw html string. ;; e.g. https://www.heise.de/open/news/news-atom.xml - ;; http://feeds.feedburner.com/ru_nix_blogs + ;; https://feeds.feedburner.com/ru_nix_blogs (or (newsticker--unxml (car (xml-node-children (car (xml-get-children node 'content))))) @@ -1302,7 +1302,7 @@ newsticker--parse-rss-1.0 Return value as well as arguments NAME, TIME, and TOPNODE are the same as in `newsticker--parse-atom-1.0'. -For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'." +For the RSS 1.0 specification see URL `https://web.resource.org/rss/1.0/spec'." (newsticker--debug-msg "Parsing RSS 1.0 feed %s" name) (let* ((channelnode (car (xml-get-children topnode 'channel))) is-new-feed has-new-items) @@ -1361,7 +1361,7 @@ newsticker--parse-rss-2.0 Return value as well as arguments NAME, TIME, and TOPNODE are the same as in `newsticker--parse-atom-1.0'. -For the RSS 2.0 specification see URL `http://blogs.law.harvard.edu/tech/rss'." +For the RSS 2.0 specification see URL `https://cyber.harvard.edu/rss/'." (newsticker--debug-msg "Parsing RSS 2.0 feed %s" name) (let* ((channelnode (car (xml-get-children topnode 'channel))) is-new-feed has-new-items) diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 938683a12a1..c86174b6d8e 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -47,9 +47,9 @@ newsticker-version ;; * RSS 0.92 ;; (see http://backend.userland.com/rss092) ;; * RSS 1.0 -;; (see http://purl.org/rss/1.0/spec) +;; (see https://web.resource.org/rss/1.0/spec) ;; * RSS 2.0 -;; (see http://blogs.law.harvard.edu/tech/rss) +;; (see https://cyber.harvard.edu/rss/) ;; as well as the following Atom formats: ;; * Atom 0.3 ;; * Atom 1.0 diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el index 24b38ed0635..24eb711eb99 100644 --- a/lisp/nxml/nxml-maint.el +++ b/lisp/nxml/nxml-maint.el @@ -26,7 +26,7 @@ ;;; Parsing target repertoire files from ucs-fonts. ;; This is for converting the TARGET? files in -;; http://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz +;; https://www.cl.cam.ac.uk/~mgk25/download/ucs-fonts.tar.gz ;; into a glyph set. (defun nxml-insert-target-repertoire-glyph-set (file var) diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 6d316fdf1cc..59e6c0403a2 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -251,7 +251,7 @@ iswitchb :group 'convenience :group 'completion :link '(emacs-commentary-link :tag "Commentary" "iswitchb.el") - :link '(url-link "http://www.anc.ed.ac.uk/~stephen/emacs/") + :link '(url-link "https://www.anc.ed.ac.uk/~stephen/emacs/") :link '(emacs-library-link :tag "Lisp File" "iswitchb.el")) (defcustom iswitchb-case case-fold-search diff --git a/lisp/term.el b/lisp/term.el index 73f583ff718..3e7745b94c9 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -2961,7 +2961,7 @@ term-handle-ansi-terminal-messages ;; It emulates (most of the features of) a VT100/ANSI-style terminal. ;; References: -;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html +;; [ctlseqs]: https://invisible-island.net/xterm/ctlseqs/ctlseqs.html ;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm ;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el index c3905afb4e7..2e4d71fb631 100644 --- a/lisp/textmodes/less-css-mode.el +++ b/lisp/textmodes/less-css-mode.el @@ -215,7 +215,7 @@ less-css-mode-map ;;;###autoload (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode)) ;;;###autoload (define-derived-mode less-css-mode css-mode "Less" - "Major mode for editing Less files (http://lesscss.org/). + "Major mode for editing Less files (https://lesscss.org/). Special commands: \\{less-css-mode-map}" (font-lock-add-keywords nil less-css-font-lock-keywords) diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 95e18b7d1d5..84a0185f7b5 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -7,7 +7,7 @@ ;; Created: 29 Mar 1999 ;; Old-Version: 2.0 ;; Keywords: data memory todo pim -;; URL: http://gna.org/projects/remember-el/ +;; URL: http://gna.org/projects/remember-el/ [dead link] ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 9d68feed0e0..6108e80363c 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1473,7 +1473,7 @@ rst-adjust :version "21.1") ;; FIXME: Default must match suggestion in -;; http://sphinx-doc.org/rest.html#sections for Python documentation. +;; https://sphinx-doc.org/rest.html#sections for Python documentation. (defcustom rst-preferred-adornments '((?= over-and-under 1) (?= simple 0) (?- simple 0) diff --git a/src/ChangeLog.12 b/src/ChangeLog.12 index 74df9809261..fdb7a2e659b 100644 --- a/src/ChangeLog.12 +++ b/src/ChangeLog.12 @@ -7077,7 +7077,7 @@ * .gdbinit: Use "set $dummy = ..." to avoid warnings from GDB 7.5 and later about non-assignments with no effect. See discussion at - http://sourceware.org/ml/gdb-patches/2012-08/msg00518.html for + https://sourceware.org/ml/gdb-patches/2012-08/msg00518.html for details. 2012-08-20 Dmitry Antipov diff --git a/src/w32fns.c b/src/w32fns.c index dcf9a212bdd..07b389df84a 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3852,7 +3852,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, /* What follows is just heuristics; the correct treatment requires non-destructive ToUnicode(): - http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Can_an_application_on_Windows_accept_keyboard_events?_Part_IV:_application-specific_modifiers + https://metacpan.org/dist/UI-KeyboardLayout/view/lib/UI/KeyboardLayout.pm#Can-an-application-on-Windows-accept-keyboard-events?-Part-IV:-application-specific-modifiers What one needs to find is: * which of the present modifiers AFFECT the resulting char(s) @@ -3914,7 +3914,7 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg, UINT wParam, character is the same for AltGr-* (=rAlt-*) and Ctrl-Alt-* (in any combination of handedness). For description of masks, see - http://search.cpan.org/~ilyaz/UI-KeyboardLayout/lib/UI/KeyboardLayout.pm#Keyboard_input_on_Windows,_Part_I:_what_is_the_kernel_doing? + https://metacpan.org/dist/UI-KeyboardLayout/view/lib/UI/KeyboardLayout.pm#Keyboard-input-on-Windows,-Part-I:-what-is-the-kernel-doing? By default, Emacs was using these coincidences via the following heuristics: it was treating: diff --git a/src/w32term.h b/src/w32term.h index 69ef297cbcc..68237bfff1d 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -29,7 +29,7 @@ calls us. The ALIGN_STACK attribute forces GCC to emit a preamble code to re-align the stack at function entry. Further details about this can be found in - http://www.peterstock.co.uk/games/mingw_sse/. */ + https://www.peterstock.co.uk/games/mingw_sse/. */ #ifdef __GNUC__ # if USE_STACK_LISP_OBJECTS && !defined _WIN64 && !defined __x86_64__ \ && __GNUC__ + (__GNUC_MINOR__ > 1) >= 5 commit dbd3c030bb90a38d4d5aed5e13f8d698f7960321 Author: Stefan Kangas Date: Wed Aug 2 21:57:15 2023 +0200 Add nvim and ncmpcpp to eshell-visual-commands * lisp/eshell/em-term.el (eshell-visual-commands): Add nvim and ncmpcpp. diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ab26da857b7..3f76c349a7e 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -55,10 +55,11 @@ eshell-term-load-hook :type 'hook) (defcustom eshell-visual-commands - '("vi" "vim" ; what is going on?? + '("vi" "vim" "nvim" ; what is going on?? "screen" "tmux" "top" "htop" ; ok, a valid program... "less" "more" ; M-x view-file "lynx" "links" "ncftp" ; eww, ange-ftp + "ncmpcpp" ; M-x mpc "mutt" "pine" "tin" "trn" "elm") ; GNUS!! "A list of commands that present their output in a visual fashion. @@ -66,7 +67,7 @@ eshell-visual-commands See also `eshell-visual-subcommands' and `eshell-visual-options'." :type '(repeat string) - :version "29.1") + :version "30.1") (defcustom eshell-visual-subcommands nil commit 0bcea805e6fd3c6d00366c56acd822898bb8389f Author: Stefan Kangas Date: Wed Aug 2 21:50:47 2023 +0200 Make use-package-statistics-mode non-interactive * lisp/use-package/use-package-core.el (use-package-statistics-mode): Make non-interactive; it only works in buffers prepared by use-package-report. diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el index 8efdf061060..21a831ce26d 100644 --- a/lisp/use-package/use-package-core.el +++ b/lisp/use-package/use-package-core.el @@ -1058,6 +1058,7 @@ use-package-statistics-status-order (define-derived-mode use-package-statistics-mode tabulated-list-mode "use-package statistics" "Show current statistics gathered about `use-package' declarations." + :interactive nil (setq tabulated-list-format ;; The sum of column width is 80 characters: [("Package" 25 t) commit 9fe1bebd1312b37504ead86c1fc09bd5548f64e9 Author: Stefan Kangas Date: Wed Aug 2 21:49:19 2023 +0200 Add let-alist to alist shortdoc group * lisp/emacs-lisp/shortdoc.el (alist): Add let-alist. diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index d1cf63317bf..dbc061d8a70 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -153,14 +153,14 @@ alist :eval (let* ((old '((foo . bar))) (new (copy-alist old))) (eq old new))) - ;; FIXME: Outputs "\.rose" for the symbol `.rose'. - ;; (let-alist - ;; :eval (let ((colors '((rose . red) - ;; (lily . white)))) - ;; (let-alist colors - ;; (if (eq .rose 'red) - ;; .lily)))) - ) + ;; FIXME: Outputs "\.rose" for the symbol `.rose'. It would be + ;; better if that could be cleaned up. + (let-alist + :eval (let ((colors '((rose . red) + (lily . white)))) + (let-alist colors + (if (eq .rose 'red) + .lily))))) (define-short-documentation-group string "Making Strings" commit af2de7b1f2adde62b4030f95fe5697a68d0c0d90 Author: Stefan Kangas Date: Wed Aug 2 08:50:14 2023 +0200 Refer to align-highlight-rule in face docstrings * lisp/align.el (align-highlight-change-face) (align-highlight-nochange-face): Refer to align-highlight-rule. diff --git a/lisp/align.el b/lisp/align.el index 6b6cba12447..b13008b1fdf 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -164,12 +164,14 @@ align-region-heuristic :group 'align) (defcustom align-highlight-change-face 'highlight - "The face to highlight with if changes are necessary." + "The face to highlight with if changes are necessary. +Used by the `align-highlight-rule' command." :type 'face :group 'align) (defcustom align-highlight-nochange-face 'secondary-selection - "The face to highlight with if no changes are necessary." + "The face to highlight with if no changes are necessary. +Used by the `align-highlight-rule' command." :type 'face :group 'align) commit 4b73edb8d1da74fd1bda8894e982d9768fd1f18c Author: Stefan Kangas Date: Tue Aug 1 19:28:53 2023 +0200 Fix link to info node in prin1 docstring * src/print.c (Fprin1): Fix linking to info node in docstring. diff --git a/src/print.c b/src/print.c index 5c95aeb9a20..2d81c450a14 100644 --- a/src/print.c +++ b/src/print.c @@ -759,8 +759,7 @@ DEFUN ("prin1", Fprin1, Sprin1, 1, 3, 0, (prin1 object nil \\='((length . 100) (circle . t))). -See the manual entry `(elisp)Output Overrides' for a list of possible -values. +See Info node `(elisp)Output Overrides' for a list of possible values. As a special case, OVERRIDES can also simply be the symbol t, which means "use default values for all the print-related settings". */) commit 1f30404ebcf7c23f4a79e9ac61a17dc9c6a5c9c3 Author: Stefan Kangas Date: Wed Aug 2 21:46:55 2023 +0200 Don't hardcode ruby version in interpreter-mode-alist * lisp/progmodes/ruby-mode.el (interpreter-mode-alist): Don't hardcode ruby version. This adds support for modern versions of Ruby like "ruby2.7", instead of the previously hardcoded "ruby1.9". diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index e441ffbbfe3..9d8f45604f9 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2708,7 +2708,7 @@ ruby-mode 'ruby-mode)) ;;;###autoload -(dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) +(dolist (name (list "ruby" "rbx" "jruby" "j?ruby\\(?:[0-9.]+\\)")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) (provide 'ruby-mode) commit 0724569c2ec22899f73c3bcf76ac57eb8bef64e4 Author: Stefan Kangas Date: Wed Aug 2 21:42:54 2023 +0200 use-package: Mark Emacs 25 support code obsolete * lisp/use-package/use-package-core.el (use-package-font-lock-keywords): Make obsolete. (font-lock-add-keywords): Only call for Emacs 25 or older. diff --git a/lisp/use-package/use-package-core.el b/lisp/use-package/use-package-core.el index e0e16134ed3..8efdf061060 100644 --- a/lisp/use-package/use-package-core.el +++ b/lisp/use-package/use-package-core.el @@ -327,12 +327,15 @@ use-package-enable-imenu-support (set-default sym value)) :group 'use-package) +;; Redundant in Emacs 26 or later, which already highlights macro names. (defconst use-package-font-lock-keywords '(("(\\(use-package\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)))) - -(font-lock-add-keywords 'emacs-lisp-mode use-package-font-lock-keywords) +(make-obsolete-variable 'use-package-font-lock-keywords + 'lisp-el-font-lock-keywords "30.1") +(when (< emacs-major-version 26) + (font-lock-add-keywords 'emacs-lisp-mode use-package-font-lock-keywords)) (defcustom use-package-compute-statistics nil "If non-nil, compute statistics concerned `use-package' declarations. commit ece5ace4a52eda26d9fe9563206781944aed16d0 Author: Mattias Engdegård Date: Mon Jul 24 09:44:01 2023 +0200 rx: better not-wordchar and (syntax word) translation * lisp/emacs-lisp/rx.el: Add tables of legacy syntax. (rx--translate-symbol): Translate the legacy construct `not-wordchar` as (not wordchar), which is more intuitively obvious. * lisp/emacs-lisp/rx.el (rx--translate-syntax): Generate the shorter \w and \W instead of \sw and \Sw. * test/lisp/emacs-lisp/rx-tests.el (rx-atoms, rx-syntax, rx-not): Adapt tests. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 5fad84964cc..d46d0ca5a98 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -35,8 +35,43 @@ ;; Olin Shivers's SRE, with concessions to Emacs regexp peculiarities, ;; and the older Emacs package Sregex. +;;; Legacy syntax still accepted by rx: +;; +;; These are constructs from earlier rx and sregex implementations +;; that were mistakes, accidents or just not very good ideas in hindsight. + +;; Obsolete: accepted but not documented +;; +;; Obsolete Preferred +;; -------------------------------------------------------- +;; (not word-boundary) not-word-boundary +;; (not-syntax X) (not (syntax X)) +;; not-wordchar (not wordchar) +;; (not-char ...) (not (any ...)) +;; any nonl, not-newline +;; (repeat N FORM) (= N FORM) +;; (syntax CHARACTER) (syntax NAME) +;; (syntax CHAR-SYM) [1] (syntax NAME) +;; (category chinse-two-byte) (category chinese-two-byte) +;; unibyte ascii +;; multibyte nonascii +;; -------------------------------------------------------- +;; [1] where CHAR-SYM is a symbol with single-character name + +;; Obsolescent: accepted and documented but discouraged +;; +;; Obsolescent Preferred +;; -------------------------------------------------------- +;; (and ...) (seq ...), (: ...), (sequence ...) +;; anything anychar +;; minimal-match, maximal-match lazy ops: ??, *?, +? + +;; FIXME: Prepare a phase-out by emitting compile-time warnings about +;; at least some of the legacy constructs above. + ;;; Code: + ;; The `rx--translate...' functions below return (REGEXP . PRECEDENCE), ;; where REGEXP is a list of string expressions that will be ;; concatenated into a regexp, and PRECEDENCE is one of @@ -167,7 +202,7 @@ rx--translate-symbol ('not-word-boundary (cons (list "\\B") t)) ('symbol-start (cons (list "\\_<") t)) ('symbol-end (cons (list "\\_>") t)) - ('not-wordchar (cons (list "\\W") t)) + ('not-wordchar (rx--translate '(not wordchar))) (_ (cond ((let ((class (cdr (assq sym rx--char-classes)))) @@ -817,7 +852,10 @@ rx--translate-syntax (setq syntax char))))))) (unless syntax (error "Unknown rx syntax name `%s'" sym))) - (cons (list (string ?\\ (if negated ?S ?s) syntax)) + ;; Produce \w and \W instead of \sw and \Sw, for smaller size. + (cons (list (if (eq syntax ?w) + (string ?\\ (if negated ?W ?w)) + (string ?\\ (if negated ?S ?s) syntax))) t))) (defconst rx--categories diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 7d7e0068eed..ae83f28d9c4 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -284,7 +284,7 @@ rx-atoms "^\\`\\'\\`\\'\\`\\'\\`\\'$")) (should (equal (rx point word-start word-end bow eow symbol-start symbol-end word-boundary not-word-boundary not-wordchar) - "\\=\\<\\>\\<\\>\\_<\\_>\\b\\B\\W")) + "\\=\\<\\>\\<\\>\\_<\\_>\\b\\B[^[:word:]]")) (should (equal (rx digit numeric num control cntrl) "[[:digit:]][[:digit:]][[:digit:]][[:cntrl:]][[:cntrl:]]")) (should (equal (rx hex-digit hex xdigit blank) @@ -306,7 +306,7 @@ rx-syntax (should (equal (rx (syntax whitespace) (syntax punctuation) (syntax word) (syntax symbol) (syntax open-parenthesis) (syntax close-parenthesis)) - "\\s-\\s.\\sw\\s_\\s(\\s)")) + "\\s-\\s.\\w\\s_\\s(\\s)")) (should (equal (rx (syntax string-quote) (syntax paired-delimiter) (syntax escape) (syntax character-quote) (syntax comment-start) (syntax comment-end) @@ -354,8 +354,9 @@ rx-not "\\B")) (should (equal (rx (not ascii) (not lower-case) (not wordchar)) "[^[:ascii:]][^[:lower:]][^[:word:]]")) - (should (equal (rx (not (syntax punctuation)) (not (syntax escape))) - "\\S.\\S\\")) + (should (equal (rx (not (syntax punctuation)) (not (syntax escape)) + (not (syntax word))) + "\\S.\\S\\\\W")) (should (equal (rx (not (category tone-mark)) (not (category lao))) "\\C4\\Co")) (should (equal (rx (not (not ascii)) (not (not (not (any "a-z"))))) commit d167888c5b7740af3300ee363c5121519dada0a2 Author: Mattias Engdegård Date: Sun Jul 30 21:53:06 2023 +0200 rx performance improvements * lisp/emacs-lisp/rx.el (rx--generate-alt): Treat the intervals and classes lists separately without joining, to reduce allocation. Handle special cases first. (rx--union-intervals): Implement directly instead of using intersection and complement. * test/lisp/emacs-lisp/rx-tests.el (rx-any): Adapt test, as some character alternatives are now slightly different. (rx--complement-intervals, rx--union-intervals) (rx--intersect-intervals): New unit tests. diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 19c82d9b23d..5fad84964cc 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -419,86 +419,96 @@ rx--generate-alt If NEGATED is non-nil, negate the result; INTERVALS is a sorted list of disjoint intervals and CLASSES a list of named character classes." - (let ((items (append intervals classes))) - ;; Move lone ] and range ]-x to the start. - (let ((rbrac-l (assq ?\] items))) - (when rbrac-l - (setq items (cons rbrac-l (delq rbrac-l items))))) - - ;; Split x-] and move the lone ] to the start. - (let ((rbrac-r (rassq ?\] items))) - (when (and rbrac-r (not (eq (car rbrac-r) ?\]))) - (setcdr rbrac-r ?\\) - (setq items (cons '(?\] . ?\]) items)))) - - ;; Split ,-- (which would end up as ,- otherwise). - (let ((dash-r (rassq ?- items))) - (when (eq (car dash-r) ?,) - (setcdr dash-r ?,) - (setq items (nconc items '((?- . ?-)))))) - - ;; Remove - (lone or at start of interval) - (let ((dash-l (assq ?- items))) - (when dash-l - (if (eq (cdr dash-l) ?-) - (setq items (delq dash-l items)) ; Remove lone - - (setcar dash-l ?.)) ; Reduce --x to .-x - (setq items (nconc items '((?- . ?-)))))) - - ;; Deal with leading ^ and range ^-x in non-negated set. - (when (and (eq (car-safe (car items)) ?^) - (not negated)) - (if (eq (cdar items) ?^) - ;; single leading ^ - (when (cdr items) - ;; Move the ^ to second place. - (setq items (cons (cadr items) - (cons (car items) (cddr items))))) - ;; Split ^-x to _-x^ - (setq items (cons (cons ?_ (cdar items)) - (cons '(?^ . ?^) - (cdr items)))))) - - (cond - ;; Empty set: if negated, any char, otherwise match-nothing. - ((null items) + ;; No, this is not pretty code. You try doing it in a way that is both + ;; elegant and efficient. Or just one of the two. I dare you. + (cond + ;; Single character. + ((and intervals (eq (caar intervals) (cdar intervals)) + (null (cdr intervals)) + (null classes)) + (let ((ch (caar intervals))) (if negated - (rx--translate-symbol 'anything) - (rx--empty))) - ;; Single non-negated character. - ((and (null (cdr items)) - (consp (car items)) - (eq (caar items) (cdar items)) - (not negated)) - (cons (list (regexp-quote (char-to-string (caar items)))) - t)) - ;; Negated newline. - ((and (equal items '((?\n . ?\n))) - negated) - (rx--translate-symbol 'nonl)) - ;; At least one character or class, possibly negated. - (t + (if (eq ch ?\n) + ;; Single negated newline. + (rx--translate-symbol 'nonl) + ;; Single negated character (other than newline). + (cons (list (string ?\[ ?^ ch ?\])) t)) + ;; Single literal character. + (cons (list (regexp-quote (char-to-string ch))) t)))) + + ;; Empty set (or any char). + ((and (null intervals) (null classes)) + (if negated + (rx--translate-symbol 'anything) + (rx--empty))) + + ;; More than one character, or at least one class. + (t + (let ((dash nil) (caret nil)) + ;; Move ] and range ]-x to the start. + (let ((rbrac-l (assq ?\] intervals))) + (when rbrac-l + (setq intervals (cons rbrac-l (remq rbrac-l intervals))))) + + ;; Split x-] and move the lone ] to the start. + (let ((rbrac-r (rassq ?\] intervals))) + (when (and rbrac-r (not (eq (car rbrac-r) ?\]))) + (setcdr rbrac-r ?\\) + (setq intervals (cons '(?\] . ?\]) intervals)))) + + ;; Split ,-- (which would end up as ,- otherwise). + (let ((dash-r (rassq ?- intervals))) + (when (eq (car dash-r) ?,) + (setcdr dash-r ?,) + (setq dash "-"))) + + ;; Remove - (lone or at start of interval) + (let ((dash-l (assq ?- intervals))) + (when dash-l + (if (eq (cdr dash-l) ?-) + (setq intervals (remq dash-l intervals)) ; Remove lone - + (setcar dash-l ?.)) ; Reduce --x to .-x + (setq dash "-"))) + + ;; Deal with leading ^ and range ^-x in non-negated set. + (when (and (eq (caar intervals) ?^) + (not negated)) + (if (eq (cdar intervals) ?^) + ;; single leading ^ + (if (or (cdr intervals) classes) + ;; something else to put before the ^ + (progn + (setq intervals (cdr intervals)) ; remove lone ^ + (setq caret "^")) ; put ^ (almost) last + ;; nothing else but a lone - + (setq intervals (cons '(?- . ?-) intervals)) ; move - first + (setq dash nil)) + ;; split ^-x to _-x^ + (setq intervals `((?_ . ,(cdar intervals)) (?^ . ?^) + . ,(cdr intervals))))) + (cons (list (concat "[" (and negated "^") - (mapconcat (lambda (item) - (cond ((symbolp item) - (format "[:%s:]" item)) - ((eq (car item) (cdr item)) - (char-to-string (car item))) - ((eq (1+ (car item)) (cdr item)) - (string (car item) (cdr item))) + (mapconcat (lambda (iv) + (cond ((eq (car iv) (cdr iv)) + (char-to-string (car iv))) + ((eq (1+ (car iv)) (cdr iv)) + (string (car iv) (cdr iv))) ;; Ranges that go between normal chars and raw bytes ;; must be split to avoid being mutilated ;; by Emacs's regexp parser. - ((<= (car item) #x3fff7f (cdr item)) - (string (car item) ?- #x3fff7f - #x3fff80 ?- (cdr item))) + ((<= (car iv) #x3fff7f (cdr iv)) + (string (car iv) ?- #x3fff7f + #x3fff80 ?- (cdr iv))) (t - (string (car item) ?- (cdr item))))) - items nil) + (string (car iv) ?- (cdr iv))))) + intervals) + (mapconcat (lambda (cls) (format "[:%s:]" cls)) classes) + caret ; ^ or nothing + dash ; - or nothing "]")) t))))) @@ -602,10 +612,28 @@ rx--intersect-intervals (defun rx--union-intervals (ivs-a ivs-b) "Union of the interval lists IVS-A and IVS-B." - (rx--complement-intervals - (rx--intersect-intervals - (rx--complement-intervals ivs-a) - (rx--complement-intervals ivs-b)))) + (let ((union nil)) + (while (and ivs-a ivs-b) + (let ((a (car ivs-a)) + (b (car ivs-b))) + (cond + ((< (1+ (cdr a)) (car b)) ; a before b, not adacent + (push a union) + (setq ivs-a (cdr ivs-a))) + ((< (1+ (cdr b)) (car a)) ; b before a, not adacent + (push b union) + (setq ivs-b (cdr ivs-b))) + (t ; a and b adjacent or overlap + (setq ivs-a (cdr ivs-a)) + (setq ivs-b (cdr ivs-b)) + (if (< (cdr a) (cdr b)) + (push (cons (min (car a) (car b)) + (cdr b)) + ivs-b) + (push (cons (min (car a) (car b)) + (cdr a)) + ivs-a)))))) + (nconc (nreverse union) (or ivs-a ivs-b)))) (defun rx--charset-intervals (charset) "Return a sorted list of non-adjacent disjoint intervals from CHARSET. diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 4928d5adf9d..7d7e0068eed 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -148,7 +148,7 @@ rx-any (should (equal (rx (any "-]^" ascii) (not (any "-]^" ascii))) "[]^[:ascii:]-][^]^[:ascii:]-]")) (should (equal (rx (any "^" lower upper) (not (any "^" lower upper))) - "[[:lower:]^[:upper:]][^^[:lower:][:upper:]]")) + "[[:lower:][:upper:]^][^^[:lower:][:upper:]]")) (should (equal (rx (any "-" lower upper) (not (any "-" lower upper))) "[[:lower:][:upper:]-][^[:lower:][:upper:]-]")) (should (equal (rx (any "]" lower upper) (not (any "]" lower upper))) @@ -610,6 +610,57 @@ rx-compat (rx-submatch-n '(group-n 3 (+ nonl) eol))) "\\(?3:.+$\\)"))) +;;; unit tests for internal functions + +(ert-deftest rx--complement-intervals () + (should (equal (rx--complement-intervals '()) + '((0 . #x3fffff)))) + (should (equal (rx--complement-intervals '((10 . 20) (30 . 40))) + '((0 . 9) (21 . 29) (41 . #x3fffff)))) + (should (equal (rx--complement-intervals '((0 . #x3fffff))) + '())) + (should (equal (rx--complement-intervals + '((0 . 10) (20 . 20) (30 . #x3fffff))) + '((11 . 19) (21 . 29))))) + +(ert-deftest rx--union-intervals () + (should (equal (rx--union-intervals '() '()) '())) + (should (equal (rx--union-intervals '() '((10 . 20) (30 . 40))) + '((10 . 20) (30 . 40)))) + (should (equal (rx--union-intervals '((10 . 20) (30 . 40)) '()) + '((10 . 20) (30 . 40)))) + (should (equal (rx--union-intervals '((5 . 15) (18 . 24) (32 . 40)) + '((10 . 20) (30 . 40) (50 . 60))) + '((5 . 24) (30 . 40) (50 . 60)))) + (should (equal (rx--union-intervals '((10 . 20) (30 . 40) (50 . 60)) + '((0 . 9) (21 . 29) (41 . 50))) + '((0 . 60)))) + (should (equal (rx--union-intervals '((10 . 20) (30 . 40)) + '((12 . 18) (28 . 42))) + '((10 . 20) (28 . 42)))) + (should (equal (rx--union-intervals '((10 . 20) (30 . 40)) + '((0 . #x3fffff))) + '((0 . #x3fffff))))) + +(ert-deftest rx--intersect-intervals () + (should (equal (rx--intersect-intervals '() '()) '())) + (should (equal (rx--intersect-intervals '() '((10 . 20) (30 . 40))) + '())) + (should (equal (rx--intersect-intervals '((10 . 20) (30 . 40)) '()) + '())) + (should (equal (rx--intersect-intervals '((5 . 15) (18 . 24) (32 . 40)) + '((10 . 20) (30 . 40) (50 . 60))) + '((10 . 15) (18 . 20) (32 . 40)))) + (should (equal (rx--intersect-intervals '((10 . 20) (30 . 40) (50 . 60)) + '((0 . 9) (21 . 29) (41 . 50))) + '((50 . 50)))) + (should (equal (rx--intersect-intervals '((10 . 20) (30 . 40)) + '((12 . 18) (28 . 42))) + '((12 . 18) (30 . 40)))) + (should (equal (rx--intersect-intervals '((10 . 20) (30 . 40)) + '((0 . #x3fffff))) + '((10 . 20) (30 . 40))))) + (provide 'rx-tests) ;;; rx-tests.el ends here commit cda4396ade14aae126b06d7ea559fc0fcb4324fe Author: Mattias Engdegård Date: Wed Aug 2 11:21:37 2023 +0200 ; * lisp/emacs-lisp/shortdoc.el (list): Move misplaced `remq` entry diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index e23db8e999c..d1cf63317bf 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -642,6 +642,8 @@ list (delete :eval (delete 2 (list 1 2 3 4)) :eval (delete "a" (list "a" "b" "c" "d"))) + (remq + :eval (remq 'b '(a b c))) (remove :eval (remove 2 '(1 2 3 4)) :eval (remove "a" '("a" "b" "c" "d"))) @@ -686,8 +688,6 @@ list (member :eval (member 2 '(1 2 3)) :eval (member "b" '("a" "b" "c"))) - (remq - :eval (remq 'b '(a b c))) (member-ignore-case :eval (member-ignore-case "foo" '("bar" "Foo" "zot"))) "Association Lists"