commit 88cc910abee32df385e9596d2390ae010a5e6650 (HEAD, refs/remotes/origin/master) Author: Michael Albinus Date: Thu May 16 08:36:33 2019 +0200 * lisp/net/tramp.el (tramp-yesno-prompt-regexp): Extend. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2aa62eba80..38f07970a7 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -606,7 +606,10 @@ The regexp should match at end of buffer." (defcustom tramp-yesno-prompt-regexp (concat - (regexp-opt '("Are you sure you want to continue connecting (yes/no)?") t) + (regexp-opt + '("Are you sure you want to continue connecting (yes/no)?" + "Are you sure you want to continue connecting (yes/no/[fingerprint])?") + t) "\\s-*") "Regular expression matching all yes/no queries which need to be confirmed. The confirmation should be done with yes or no. commit 9a74e5666b022098c63d0047c0df90c66e1aa64a Author: Stefan Monnier Date: Wed May 15 22:21:36 2019 -0400 * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize-rules): Fix typo * test/lisp/textmodes/sgml-mode-tests.el (sgml-tests--quotes-syntax): New corresponding test. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 11b30537e6..1b064fb825 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -345,7 +345,7 @@ Any terminating `>' or `/' is not matched.") ;; the resulting number of calls to syntax-ppss made it too slow ;; (bug#33887), so we're now careful to leave alone any pair ;; of quotes that doesn't hold a < or > char, which is the vast majority. - ("\$?:\\(1:\"\$[^\"<>]*[<>\"]\\|\$1:'\$[^'<>]*[<>']\\)" + ("\$?:\\(?1:\"\$[^\"<>]*[<>\"]\\|\$?1:'\$[^'<>]*[<>']\\)" (1 (unless (memq (char-before) '(?\' ?\")) ;; Be careful to call `syntax-ppss' on a position before the one ;; we're going to change, so as not to need to flush the data we diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index 4355e1c865..a900e8dcf2 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el @@ -160,5 +160,12 @@ The point is set to the beginning of the buffer." (sgml-quote (point-min) (point-max) t) (should (string= "&&" (buffer-string)))))) +(ert-deftest sgml-tests--quotes-syntax () + (with-temp-buffer + (sgml-mode) + (insert "a\"b c'd") + (should (= 1 (car (syntax-ppss (1- (point-max)))))) + (should (= 0 (car (syntax-ppss (point-max))))))) + (provide 'sgml-mode-tests) ;;; sgml-mode-tests.el ends here commit e7e92dc5d24ac3bcde69732bab6a6c3c0d9de97b Author: Noam Postavsky Date: Wed May 15 18:51:30 2019 -0400 Fix merge of sgml-syntax-propertize-rules During the merge of emacs-26, the sgml-syntax-propertize-rules part of 2019-01-17 "* lisp/textmodes/sgml-mode.el: Try and fix bug#33887." got lost in the conflict against 2019-05-09 "Recognize single quote attribute values in nxml and sgml (Bug#35381)". * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize-rules): Reapply the 2019-01-17 change to speed up sgml-syntax-propertize-rules, taking into account the 2019-05-09 which means we have to handle single quotes as well. diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 6dc1b9e727..11b30537e6 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -339,12 +339,21 @@ Any terminating `>' or `/' is not matched.") ("--[ \t\n]*\$>\$" (1 "> b")) ("\$<\$[?!]" (1 (prog1 "|>" (sgml-syntax-propertize-inside end)))) - ;; Quotes outside of tags should not introduce strings. - ;; Be careful to call `syntax-ppss' on a position before the one we're - ;; going to change, so as not to need to flush the data we just computed. - ("[\"']" (0 (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) - (goto-char (match-end 0))) - (string-to-syntax "."))))))) + ;; Quotes outside of tags should not introduce strings which end up + ;; hiding tags. We used to test every quote and mark it as "." + ;; if it's outside of tags, but there are too many quotes and + ;; the resulting number of calls to syntax-ppss made it too slow + ;; (bug#33887), so we're now careful to leave alone any pair + ;; of quotes that doesn't hold a < or > char, which is the vast majority. + ("\$?:\\(1:\"\$[^\"<>]*[<>\"]\\|\$1:'\$[^'<>]*[<>']\\)" + (1 (unless (memq (char-before) '(?\' ?\")) + ;; Be careful to call `syntax-ppss' on a position before the one + ;; we're going to change, so as not to need to flush the data we + ;; just computed. + (if (prog1 (zerop (car (syntax-ppss (match-beginning 0)))) + (goto-char (1- (match-end 0)))) + (string-to-syntax "."))))) + ))) (defun sgml-syntax-propertize (start end) "Syntactic keywords for `sgml-mode'." commit 520aca2d890a051621b730b0a7e97dd07a546df4 Author: Anders Lindgren Date: Wed May 15 21:00:49 2019 +0200 Fix diff-mode face problem when used in terminals (Bug#35695) In a terminal supporting 256 colors, both diff-added and diff-removed was mapped to the same greyish color. * lisp/vc/diff-mode.el: Modify the colors of diff-removed, diff-added, diff-refine-removed, and diff-refine-added when used in a 256 color environment. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a26e9eef82..0d5dc0e1c0 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -283,6 +283,14 @@ well." ;;;; font-lock support ;;;; +;; Note: The colors used in a color-rich environments (a GUI or in a +;; terminal supporting 24 bit colors) doesn't render well in terminal +;; supporting only 256 colors. Concretely, both #ffeeee +;; (diff-removed) and #eeffee (diff-added) are mapped to the same +;; greyish color. "min-colors 257" ensures that those colors are not +;; used terminals supporting only 256 colors. However, any number +;; between 257 and 2^24 (16777216) would do. + (defface diff-header '((((class color) (min-colors 88) (background light)) :background "grey85") @@ -314,8 +322,10 @@ well." (defface diff-removed '((default :inherit diff-changed) - (((class color) (min-colors 88) (background light)) + (((class color) (min-colors 257) (background light)) :background "#ffeeee") + (((class color) (min-colors 88) (background light)) + :background "#ffdddd") (((class color) (min-colors 88) (background dark)) :background "#553333") (((class color)) @@ -325,8 +335,10 @@ well." (defface diff-added '((default :inherit diff-changed) - (((class color) (min-colors 88) (background light)) + (((class color) (min-colors 257) (background light)) :background "#eeffee") + (((class color) (min-colors 88) (background light)) + :background "#ddffdd") (((class color) (min-colors 88) (background dark)) :background "#335533") (((class color)) @@ -2040,8 +2052,10 @@ For use in `add-log-current-defun-function'." (defface diff-refine-removed '((default :inherit diff-refine-changed) - (((class color) (min-colors 88) (background light)) + (((class color) (min-colors 257) (background light)) :background "#ffcccc") + (((class color) (min-colors 88) (background light)) + :background "#ffbbbb") (((class color) (min-colors 88) (background dark)) :background "#aa2222")) "Face used for removed characters shown by `diff-refine-hunk'." @@ -2050,8 +2064,10 @@ For use in `add-log-current-defun-function'." (defface diff-refine-added '((default :inherit diff-refine-changed) - (((class color) (min-colors 88) (background light)) + (((class color) (min-colors 257) (background light)) :background "#bbffbb") + (((class color) (min-colors 88) (background light)) + :background "#aaffaa") (((class color) (min-colors 88) (background dark)) :background "#22aa22")) "Face used for added characters shown by `diff-refine-hunk'." commit c3e838166800d5af4be66e80c2be276905a73486 Author: Stefan Monnier Date: Wed May 15 13:53:13 2019 -0400 * lisp/gnus/gnus-sum.el: Use lexical-binding (gnus-summary-make-menu-bar, gnus-summary-display-make-predicate) (gnus-summary-refer-thread, gnus-summary-find-matching) (gnus-summary-edit-article, gnus-summary-sort): Replace backquoted lambda with closure. (gnus-summary-article-header): Use define-inline rather than defmacro, so it's also a function. (gnus-save-hidden-threads, gnus-summary-iterate, gnus-with-article): Use `declare`. (gnus-thread-sort-by-random): Simplify. (gnus-summary-display-article, gnus-summary-limit-to-address): Hoist common code outside of `if`. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index ac222acfd2..9431b06b4f 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1,4 +1,4 @@ -;;; gnus-sum.el --- summary mode commands for Gnus +;;; gnus-sum.el --- summary mode commands for Gnus -*- lexical-binding:t -*- ;; Copyright (C) 1996-2019 Free Software Foundation, Inc. @@ -243,7 +243,7 @@ fill in all gaps that Gnus manages to guess." (sexp :menu-tag "all" t))) (defcustom gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-subject + #'gnus-gather-threads-by-subject "Function used for gathering loose threads. There are two pre-defined functions: `gnus-gather-threads-by-subject', which only takes Subjects into consideration; and @@ -539,7 +539,7 @@ this variable specifies group names." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix +(defcustom gnus-move-group-prefix-function #'gnus-group-real-prefix "Function used to compute default prefix for article move/copy/etc prompts. The function should take one argument, a group name, and return a string with the suggested prefix." @@ -947,7 +947,7 @@ according to the value of `gnus-thread-sort-functions'." (function :tag "other")) (boolean :tag "Reverse order"))))) -(defcustom gnus-thread-score-function '+ +(defcustom gnus-thread-score-function #'+ "Function used for calculating the total score of a thread. The function is called with the scores of the article and each @@ -1171,11 +1171,11 @@ which it may alter in any way." function) :group 'gnus-summary) -(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string +(defvar gnus-decode-encoded-word-function #'mail-decode-encoded-word-string "Function used to decode a string with encoded words.") (defvar gnus-decode-encoded-address-function - 'mail-decode-encoded-address-string + #'mail-decode-encoded-address-string "Function used to decode addresses with encoded words.") (defcustom gnus-extra-headers '(To Cc Keywords Gcc Newsgroups X-GM-LABELS) @@ -1373,7 +1373,7 @@ the normal Gnus MIME machinery." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) -(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number +(defvar gnus-sort-gathered-threads-function #'gnus-thread-sort-by-number "Function called to sort the articles within a thread after it has been gathered together.") (defvar gnus-summary-save-parts-type-history nil) @@ -1706,6 +1706,7 @@ For example: ;; already been loaded (avoids infinite recursion) (with-no-warnings (defvar features)) ;Not just a local variable. (let ((features (cons 'gnus-sum features))) + ;; FIXME: Break this mutual dependency. (require 'gnus-art))) ;; MIME stuff. @@ -1812,7 +1813,7 @@ matter is removed. Additional things can be deleted by setting (setq modified-tick (buffer-modified-tick)) (cond ((listp regexp) - (mapc 'gnus-simplify-buffer-fuzzy-step regexp)) + (mapc #'gnus-simplify-buffer-fuzzy-step regexp)) (regexp (gnus-simplify-buffer-fuzzy-step regexp))) (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") @@ -2482,13 +2483,13 @@ increase the score of each group you read." (let ((command (intern (format "\ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (fset command - `(lambda () - (interactive) - (let ((gnus-summary-show-article-charset-alist - '((1 . ,cs)))) - (gnus-summary-show-article 1)))) + (lambda () + (interactive) + (let ((gnus-summary-show-article-charset-alist + `((1 . ,cs)))) + (gnus-summary-show-article 1)))) `[,(symbol-name cs) ,command t])) - (sort (coding-system-list) 'string<))))) + (sort (coding-system-list) #'string<))))) ("Washing" ("Remove Blanks" ["Leading" gnus-article-strip-leading-blank-lines t] @@ -2676,15 +2677,15 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (interactive) (setq message-cite-function (if (eq message-cite-function - 'message-cite-original-without-signature) - 'message-cite-original - 'message-cite-original-without-signature))) + #'message-cite-original-without-signature) + #'message-cite-original + #'message-cite-original-without-signature))) :visible (memq message-cite-function '(message-cite-original-without-signature message-cite-original)) :style toggle :selected (eq message-cite-function - 'message-cite-original-without-signature) + #'message-cite-original-without-signature) :help "Strip signature from cited article when replying."])) (cond @@ -3026,7 +3027,7 @@ When FORCE, rebuild the tool bar." header) (list (apply - 'nconc + #'nconc (list (if (eq type 'lower) "Lower score" @@ -3037,7 +3038,7 @@ When FORCE, rebuild the tool bar." (setq outh (cons (apply - 'nconc + #'nconc (list (car header)) (let ((ts (cdr (assoc (nth 2 header) types))) outt) @@ -3045,7 +3046,7 @@ When FORCE, rebuild the tool bar." (setq outt (cons (apply - 'nconc + #'nconc (list (caar ts)) (let ((ps perms) outp) @@ -3133,10 +3134,10 @@ The following commands are available: (make-local-variable 'gnus-article-buffer) (make-local-variable 'gnus-article-current) (make-local-variable 'gnus-original-article-buffer) - (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) + (add-hook 'pre-command-hook #'gnus-set-global-variables nil t) (mm-enable-multibyte) (set (make-local-variable 'bookmark-make-record-function) - 'gnus-summary-bookmark-make-record)) + #'gnus-summary-bookmark-make-record)) (defun gnus-summary-make-local-variables () "Make all the local summary buffer variables." @@ -3309,10 +3310,12 @@ article number." (or (get-text-property (point) 'gnus-number) (gnus-summary-last-subject)))) -(defmacro gnus-summary-article-header (&optional number) +(define-inline gnus-summary-article-header (&optional number) "Return the header of article NUMBER." - `(gnus-data-header (gnus-data-find - ,(or number '(gnus-summary-article-number))))) + (inline-quote + (gnus-data-header (gnus-data-find + ,(or number + (inline-quote (gnus-summary-article-number))))))) (defmacro gnus-summary-thread-level (&optional number) "Return the level of thread that starts with article NUMBER." @@ -3409,14 +3412,13 @@ marks of articles." (defmacro gnus-save-hidden-threads (&rest forms) "Save hidden threads, eval FORMS, and restore the hidden threads." + (declare (indent 0) (debug t)) (let ((config (make-symbol "config"))) `(let ((,config (gnus-hidden-threads-configuration))) (unwind-protect (save-excursion ,@forms) (gnus-restore-hidden-threads-configuration ,config))))) -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) (defun gnus-data-compute-positions () "Compute the positions of all articles." @@ -3843,8 +3845,8 @@ the thread are to be displayed." 1) ((and (consp thread) (cdr thread)) (apply - '+ 1 (mapcar - 'gnus-summary-number-of-articles-in-thread (cdr thread)))) + #'+ 1 (mapcar + #'gnus-summary-number-of-articles-in-thread (cdr thread)))) ((null thread) 1) ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) @@ -3852,9 +3854,9 @@ the thread are to be displayed." (t 0)))) (when (and level (zerop level) gnus-tmp-new-adopts) (cl-incf number - (apply '+ (mapcar - 'gnus-summary-number-of-articles-in-thread - gnus-tmp-new-adopts)))) + (apply #'+ (mapcar + #'gnus-summary-number-of-articles-in-thread + gnus-tmp-new-adopts)))) (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) @@ -4074,9 +4076,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless no-display (gnus-summary-prepare)) (when gnus-use-trees - (gnus-tree-open) + (gnus-tree-open) ;Autoloaded from gnus-salt. + (declare-function gnus-tree-highlight-article "gnus-salt" (article face)) (setq gnus-summary-highlight-line-function - 'gnus-tree-highlight-article)) + #'gnus-tree-highlight-article)) ;; If the summary buffer is empty, but there are some low-scored ;; articles or some excluded dormants, we include these in the ;; buffer. @@ -4338,7 +4341,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when (and (car refs) (not (zerop (apply - '+ + #'+ (mapcar (lambda (thread) (gnus-thread-loop-p @@ -4479,7 +4482,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. - (dolist (relation (sort relations 'car-less-than-car)) + (dolist (relation (sort relations #'car-less-than-car)) (when (gnus-dependencies-add-header (make-full-mail-header gnus-reffed-article-number @@ -4828,7 +4831,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (defun gnus-articles-in-thread (thread) "Return the list of articles in THREAD." (cons (mail-header-number (car thread)) - (mapcan 'gnus-articles-in-thread (cdr thread)))) + (mapcan #'gnus-articles-in-thread (cdr thread)))) (defun gnus-remove-thread (id &optional dont-remove) "Remove the thread that has ID in it." @@ -4916,7 +4919,8 @@ If LINE, insert the rebuilt thread starting on line LINE." (and (cdr thread) (gnus-sort-subthreads-recursive (cdr thread) subthread-sort-func)))) - threads) func))) + threads) + func))) (defun gnus-sort-subthreads-recursive (threads func) ;; Responsible for sorting subthreads. @@ -4924,7 +4928,8 @@ If LINE, insert the rebuilt thread starting on line LINE." (cons (car thread) (and (cdr thread) (gnus-sort-subthreads-recursive (cdr thread) func)))) - threads) func)) + threads) + func)) (defun gnus-sort-threads-loop (threads func) (let* ((superthread (cons nil threads)) @@ -4999,14 +5004,12 @@ using some other form will lead to serious barfage." (gnus-article-sort-by-number (gnus-thread-header h1) (gnus-thread-header h2))) -(defsubst gnus-article-sort-by-random (h1 h2) +(defsubst gnus-article-sort-by-random (_h1 _h2) "Sort articles randomly." (zerop (random 2))) -(defun gnus-thread-sort-by-random (h1 h2) - "Sort threads randomly." - (gnus-article-sort-by-random - (gnus-thread-header h1) (gnus-thread-header h2))) +(defalias 'gnus-thread-sort-by-random #'gnus-article-sort-by-random + "Sort threads randomly.") (defsubst gnus-article-sort-by-lines (h1 h2) "Sort articles by article Lines header." @@ -5122,7 +5125,7 @@ Unscored articles will be counted as having a score of zero." ((consp thread) (if (stringp (car thread)) (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) + (mapcar #'gnus-thread-total-score-1 (cdr thread))) (gnus-thread-total-score-1 thread))) (t (gnus-thread-total-score-1 (list thread))))) @@ -5137,7 +5140,7 @@ Unscored articles will be counted as having a score of zero." (defun gnus-thread-highest-number (thread) "Return the highest article number in THREAD." - (apply 'max (mapcar (lambda (header) + (apply #'max (mapcar (lambda (header) (mail-header-number header)) (flatten-tree thread)))) @@ -5155,7 +5158,7 @@ Unscored articles will be counted as having a score of zero." ; quite a bit to use gnus-date-get-time, which caches the time value. (defun gnus-thread-latest-date (thread) "Return the highest article date in THREAD." - (apply 'max + (apply #'max (mapcar (lambda (header) (float-time (gnus-date-get-time (mail-header-date header)))) @@ -5166,7 +5169,7 @@ Unscored articles will be counted as having a score of zero." (setq root (car root)) (apply gnus-thread-score-function (or (append - (mapcar 'gnus-thread-total-score + (mapcar #'gnus-thread-total-score (cdr (gnus-id-to-thread (mail-header-id root)))) (when (> (mail-header-number root) 0) (list (or (cdr (assq (mail-header-number root) @@ -5500,7 +5503,7 @@ or a straight list of headers." (t (or gnus-sum-thread-tree-single-indent subject)))) (t - (concat (apply 'concat + (concat (apply #'concat (mapcar (lambda (item) (if (= item 1) gnus-sum-thread-tree-vertical @@ -5594,7 +5597,7 @@ or a straight list of headers." "Get list identifier regexp for GROUP." (or (gnus-parameter-list-identifier group) (if (consp gnus-list-identifiers) - (mapconcat 'identity gnus-list-identifiers " *\\|") + (mapconcat #'identity gnus-list-identifiers " *\\|") gnus-list-identifiers))) (defun gnus-summary-remove-list-identifiers () @@ -5695,11 +5698,11 @@ If SELECT-ARTICLES, only select those articles from GROUP." ((not (zerop (or (car-safe read-all) 0))) ;; The user entered the group with C-u SPC/RET, let's show ;; all articles. - 'gnus-not-ignore) + #'gnus-not-ignore) ((eq display 'all) - 'gnus-not-ignore) + #'gnus-not-ignore) ((arrayp display) - (gnus-summary-display-make-predicate (mapcar 'identity display))) + (gnus-summary-display-make-predicate (mapcar #'identity display))) ((numberp display) ;; The following is probably the "correct" solution, but ;; it makes Gnus fetch all headers and then limit the @@ -5707,9 +5710,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; select-articles parameter instead. -- Simon Josefsson ;; ;; - ;; (gnus-byte-compile - ;; `(lambda () (> number ,(- (cdr (gnus-active group)) - ;; display))))) + ;; (let ((n (cdr (gnus-active group)))) + ;; (lambda () (> number (- n display)))) (setq select-articles (gnus-uncompress-range (cons (let ((tmp (- (cdr (gnus-active group)) display))) @@ -5833,8 +5835,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unseen . unseen)) gnus-article-mark-lists)) (push (cons (cdr elem) - (gnus-byte-compile ;Why bother? - `(lambda () (gnus-article-marked-p ',(cdr elem))))) + (let ((x (cdr elem))) + (lambda () (gnus-article-marked-p x)))) gnus-summary-display-cache))) (let ((gnus-category-predicate-alist gnus-summary-display-cache) (gnus-category-predicate-cache gnus-summary-display-cache)) @@ -5974,7 +5976,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." select (if (and (not (zerop scored)) (<= (abs select) scored)) (progn - (setq articles (sort scored-list '<)) + (setq articles (sort scored-list #'<)) (setq number (length articles))) (setq articles (copy-sequence articles))) @@ -5991,7 +5993,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (sort (funcall gnus-alter-articles-to-read-function gnus-newsgroup-name articles) - '<))) + #'<))) articles))) (defun gnus-killed-articles (killed articles) @@ -6137,7 +6139,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq list (gnus-range-add list gnus-newsgroup-unseen))) (when (eq (gnus-article-mark-to-type (cdr type)) 'list) - (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) + (setq list (gnus-compress-sequence (set symbol (sort list #'<)) t))) (when (and (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) @@ -6343,7 +6345,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ninfo (gnus-info-read info))) ;; Then we add the read articles to the range. (gnus-add-to-range - ninfo (setq articles (sort articles '<)))))) + ninfo (setq articles (sort articles #'<)))))) (defun gnus-group-make-articles-read (group articles) "Update the info of GROUP to say that ARTICLES are read." @@ -6567,7 +6569,7 @@ Return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) + (setq gnus-article-internal-prepare-hook (list #'gnus-article-get-xrefs)) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) @@ -6752,6 +6754,7 @@ current article will be taken into consideration." "Iterate over the process/prefixed articles and do FORMS. ARG is the interactive prefix given to the command. FORMS will be executed with point over the summary line of the articles." + (declare (indent 1) (debug t)) (let ((articles (make-symbol "gnus-summary-iterate-articles"))) `(let ((,articles (gnus-summary-work-articles ,arg))) (while ,articles @@ -6759,9 +6762,6 @@ executed with point over the summary line of the articles." ,@forms (pop ,articles))))) -(put 'gnus-summary-iterate 'lisp-indent-function 1) -(put 'gnus-summary-iterate 'edebug-form-spec '(form body)) - (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." (interactive) @@ -6784,7 +6784,7 @@ executed with point over the summary line of the articles." (defun gnus-summary-process-mark-set (set) "Make SET into the current process marked articles." (gnus-summary-unmark-all-processable) - (mapc 'gnus-summary-set-process-mark set)) + (mapc #'gnus-summary-set-process-mark set)) ;;; Searching and stuff @@ -7166,7 +7166,7 @@ buffer." (gnus-summary-position-point)) (define-obsolete-function-alias - 'gnus-summary-toggle-truncation 'toggle-truncate-lines "26.1") + 'gnus-summary-toggle-truncation #'toggle-truncate-lines "26.1") (defun gnus-summary-find-for-reselect () "Return the number of an article to stay on across a reselect. @@ -7772,9 +7772,9 @@ Given a prefix, will force an `article' buffer configuration." (if (null article) nil (prog1 - (if gnus-summary-display-article-function - (funcall gnus-summary-display-article-function article all-header) - (gnus-article-prepare article all-header)) + (funcall (or gnus-summary-display-article-function + #'gnus-article-prepare) + article all-header) (gnus-run-hooks 'gnus-select-article-hook) (when (and gnus-current-article (not (zerop gnus-current-article))) @@ -8229,7 +8229,7 @@ is a number, it is the line the article is to be displayed on." (list (gnus-completing-read "Article number or Message-ID" - (mapcar 'int-to-string gnus-newsgroup-limit)) + (mapcar #'int-to-string gnus-newsgroup-limit)) current-prefix-arg t)) (prog1 @@ -8410,9 +8410,9 @@ in `nnmail-extra-headers'." (if (eq to t) from (mapcar (lambda (a) (car (memq a from))) to)) - (if (eq to t) - (mapcar (lambda (a) (car (memq a from))) cc) - (mapcar (lambda (a) (car (memq a from))) + (mapcar (lambda (a) (car (memq a from))) + (if (eq to t) + cc (mapcar (lambda (a) (car (memq a to))) cc)))) (nconc (if (eq to t) nil to) @@ -8494,7 +8494,7 @@ articles that are younger than AGE days." (if current-prefix-arg "Exclude extra header" "Limit extra header") - (mapcar 'symbol-name gnus-extra-headers) + (mapcar #'symbol-name gnus-extra-headers) t nil nil (symbol-name (car gnus-extra-headers)))))) (list header @@ -8787,12 +8787,12 @@ fetched for this group." "Mark all unread excluded articles as read. If ALL, mark even excluded ticked and dormants as read." (interactive "P") - (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<)) + (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit #'<)) (let ((articles (gnus-sorted-ndifference (sort (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers) - '<) + #'<) gnus-newsgroup-limit)) article) (setq gnus-newsgroup-unreads @@ -8907,7 +8907,7 @@ fetch-old-headers verbiage, and so on." ;; Most groups have nothing to remove. (unless (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) - (eq gnus-newsgroup-display 'gnus-not-ignore) + (eq gnus-newsgroup-display #'gnus-not-ignore) (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) @@ -8948,7 +8948,7 @@ fetch-old-headers verbiage, and so on." (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth)) (children (if (cdr thread) - (apply '+ (mapcar 'gnus-summary-limit-children + (apply #'+ (mapcar #'gnus-summary-limit-children (cdr thread))) 0)) (number (mail-header-number (car thread))) @@ -9018,7 +9018,7 @@ fetch-old-headers verbiage, and so on." (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))) ;; Go recursively through all subthreads. - (mapcar 'gnus-expunge-thread (cdr thread))) + (mapcar #'gnus-expunge-thread (cdr thread))) ;; Summary article oriented commands @@ -9137,11 +9137,13 @@ non-numeric or nil fetch the number specified by the (refs (split-string (or (mail-header-references header) ""))) (gnus-parse-headers-hook - `(lambda () (goto-char (point-min)) - (keep-lines - (regexp-opt ',(append refs (list id subject))))))) + (let ((refs (append refs (list id subject)))) + (lambda () + (goto-char (point-min)) + (keep-lines (regexp-opt refs)))))) (gnus-fetch-headers (list last) (if (numberp limit) - (* 2 limit) limit) t)))) + (* 2 limit) limit) + t)))) article-ids new-unreads) (when (listp new-headers) (dolist (header new-headers) @@ -9578,7 +9580,7 @@ Optional argument BACKWARD means do search for backward. This search includes all articles in the current group that Gnus has fetched headers for, whether they are displayed or not." (let ((articles nil) - ;; Can't eta-reduce because it's a macro. + ;; FIXME: Can't η-reduce because it's a macro (make it define-inline) (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) (case-fold-search t)) (dolist (header gnus-newsgroup-headers) @@ -9603,12 +9605,14 @@ not match REGEXP on HEADER." (if (consp header) (if (eq (car header) 'extra) (setq func - `(lambda (h) - (or (cdr (assq ',(cdr header) (mail-header-extra h))) - ""))) + (let ((x (cdr header))) + (lambda (h) + (or (cdr (assq x (mail-header-extra h))) + "")))) (error "%s is an invalid header" header)) (unless (fboundp (intern (concat "mail-header-" header))) (error "%s is not a valid header" header)) + ;; FIXME: eta-reduce! (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) (dolist (d (if (eq backward 'all) gnus-newsgroup-data @@ -9635,7 +9639,7 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (list (let ((completion-ignore-case t)) (gnus-completing-read "Header name" - (mapcar 'symbol-name + (mapcar #'symbol-name (append '(Number Subject From Lines Date Message-ID Xref References Body) @@ -10149,7 +10153,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (setq xref (list (system-name)))) (setq new-xref (concat - (mapconcat 'identity + (mapconcat #'identity (delete "Xref:" (delete new-xref xref)) " ") " " new-xref)) @@ -10308,7 +10312,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (push article articles-to-update-marks)) (save-excursion - (apply 'gnus-summary-remove-process-mark articles-to-update-marks)) + (apply #'gnus-summary-remove-process-mark articles-to-update-marks)) ;; Re-activate all groups that have been moved to. (with-current-buffer gnus-group-buffer (let ((gnus-group-marked to-groups)) @@ -10500,7 +10504,7 @@ This will be the case if the article has both been mailed and posted." (gnus-summary-update-info) (gnus-list-of-read-articles gnus-newsgroup-name)) (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<))) + (sort gnus-newsgroup-expirable #'<))) gnus-newsgroup-unexist)) (expiry-wait (if now 'immediate (gnus-group-find-parameter @@ -10579,7 +10583,7 @@ confirmation before the articles are deleted." (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) (error "Couldn't open server")) ;; Compute the list of articles to delete. - (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) + (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) #'<)) (nnmail-expiry-target 'delete) not-deleted) (if (and gnus-novice-user @@ -10660,15 +10664,15 @@ groups." (setq raw t)) (gnus-article-edit-article (if raw 'ignore - `(lambda () - (let ((mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (let ((rfc2047-quote-decoded-words-containing-tspecials t)) - (mime-to-mml ',current-handles)) - (let ((mbl1 mml-buffer-list)) - (setq mml-buffer-list mbl) - (set (make-local-variable 'mml-buffer-list) mbl1)) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) + (lambda () + (let ((mbl mml-buffer-list)) + (setq mml-buffer-list nil) + (let ((rfc2047-quote-decoded-words-containing-tspecials t)) + (mime-to-mml current-handles)) + (let ((mbl1 mml-buffer-list)) + (setq mml-buffer-list mbl) + (set (make-local-variable 'mml-buffer-list) mbl1)) + (add-hook 'kill-buffer-hook #'mml-destroy-buffers t t)))) `(lambda (no-highlight) (let ((mail-parse-charset ',gnus-newsgroup-charset) (message-options message-options) @@ -10688,7 +10692,7 @@ groups." (mml-to-mime) (mml-destroy-buffers) (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) + #'mml-destroy-buffers t) (kill-local-variable 'mml-buffer-list))) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") @@ -10823,7 +10827,7 @@ groups." (unless silent (if groups (message "This message would go to %s" - (mapconcat 'car groups ", ")) + (mapconcat #'car groups ", ")) (message "This message would go to no groups")) groups))))) @@ -11631,6 +11635,7 @@ read." (defmacro gnus-with-article (article &rest forms) "Select ARTICLE and perform FORMS in the original article buffer. Then replace the article with the result." + (declare (indent 1) (debug t)) `(progn ;; We don't want the article to be marked as read. (let (gnus-mark-article-hook) @@ -11652,9 +11657,6 @@ Then replace the article with the result." (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))))) -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) - ;; Thread-based commands. (defun gnus-summary-articles-in-thread (&optional article) @@ -11821,9 +11823,8 @@ Returns nil if no thread was there to be shown." (defun gnus-map-articles (predicate articles) "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil." - (apply 'gnus-or (mapcar predicate - (mapcar (lambda (number) - (gnus-summary-article-header number)) + (apply #'gnus-or (mapcar predicate + (mapcar #'gnus-summary-article-header articles)))) (defun gnus-summary-hide-all-threads (&optional predicate) @@ -12101,15 +12102,15 @@ Argument REVERSE means reverse order." (gnus-thread-sort-functions (if (not reverse) thread - `(lambda (t1 t2) - (,thread t2 t1)))) + (lambda (t1 t2) + (funcall thread t2 t1)))) (gnus-sort-gathered-threads-function gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article - `(lambda (t1 t2) - (,article t2 t1)))) + (lambda (t1 t2) + (funcall article t2 t1)))) (inhibit-read-only t) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -12494,7 +12495,7 @@ If REVERSE, save parts that do not match TYPE." ;; If all commands are to be bunched up on one line, we collect ;; them here. (unless gnus-view-pseudos-separately - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) + (let ((ps (setq pslist (sort pslist #'gnus-pseudos<))) files action) (while ps (setq action (cdr (assq 'action (car ps)))) @@ -12511,7 +12512,7 @@ If REVERSE, save parts that do not match TYPE." (when (assq 'execute (car ps)) (setcdr (assq 'execute (car ps)) (funcall (if (string-match "%s" action) - 'format 'concat) + #'format #'concat) action (mapconcat (lambda (f) @@ -12938,7 +12939,7 @@ treated as multipart/mixed." (defun gnus-summary-make-all-marking-commands () (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map) (dolist (elem gnus-summary-marking-alist) - (apply 'gnus-summary-make-marking-command elem))) + (apply #'gnus-summary-make-marking-command elem))) (defun gnus-summary-make-marking-command (name mark keystroke) (let ((map (make-sparse-keymap))) @@ -13052,7 +13053,7 @@ If ALL is non-nil, already read articles become readable. If ALL is a number, fetch this number of articles." (interactive "P") (prog1 - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (let ((old (sort (mapcar #'car gnus-newsgroup-data) #'<)) older len) (setq older ;; Some nntp servers lie about their active range. When @@ -13122,7 +13123,7 @@ If ALL is a number, fetch this number of articles." (defun gnus-summary-insert-new-articles () "Insert all new articles in this group." (interactive) - (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<)) + (let ((old (sort (mapcar #'car gnus-newsgroup-data) #'<)) (old-high gnus-newsgroup-highest) (nnmail-fetched-sources (list t)) (new-active (gnus-activate-group gnus-newsgroup-name 'scan)) commit d4868b2bee88c89e704b4228a34e29dfc4a9f2a5 Author: Paul Eggert Date: Wed May 15 10:26:54 2019 -0700 Tune reading of radix integers This improves the performance of (read "%xFF") by about 25% on my platform. * src/lread.c: Include , so that we can better document buffer sizes of arguments. (invalid_radix_integer_format, stackbufsize): New constants. (free_contents): Remove. All uses removed. (invalid_radix_integer): New function. (read_integer): New arg STACKBUF. Assume radix is in range. All uses changed. Use STACKBUF to avoid calling malloc in the usual case. Use grow_read_buffer to simplify. (read1): Tune. Improve quality of diagnostic when MOST_POSITIVE_FIXNUM < radix <= EMACS_INT_MAX. diff --git a/src/lread.c b/src/lread.c index c37719e0d2..5fa90cad3f 100644 --- a/src/lread.c +++ b/src/lread.c @@ -44,6 +44,7 @@ along with GNU Emacs. If not, see . */ #include "blockinput.h" #include "pdumper.h" #include +#include #ifdef MSDOS #include "msdos.h" @@ -2640,89 +2641,83 @@ digit_to_number (int character, int base) return digit < base ? digit : -1; } +static char const invalid_radix_integer_format[] = "integer, radix %"pI"d"; + +/* Small, as read1 is recursive (Bug#31995). But big enough to hold + the invalid_radix_integer string. */ +enum { stackbufsize = max (64, + (sizeof invalid_radix_integer_format + - sizeof "%"pI"d" + + INT_STRLEN_BOUND (EMACS_INT) + 1)) }; + static void -free_contents (void *p) +invalid_radix_integer (EMACS_INT radix, char stackbuf[VLA_ELEMS (stackbufsize)]) { - void **ptr = (void **) p; - xfree (*ptr); + sprintf (stackbuf, invalid_radix_integer_format, radix); + invalid_syntax (stackbuf); } /* Read an integer in radix RADIX using READCHARFUN to read - characters. RADIX must be in the interval [2..36]; if it isn't, a - read error is signaled . Value is the integer read. Signals an - error if encountering invalid read syntax or if RADIX is out of - range. */ + characters. RADIX must be in the interval [2..36]. Use STACKBUF + for temporary storage as needed. Value is the integer read. + Signal an error if encountering invalid read syntax. */ static Lisp_Object -read_integer (Lisp_Object readcharfun, EMACS_INT radix) +read_integer (Lisp_Object readcharfun, int radix, + char stackbuf[VLA_ELEMS (stackbufsize)]) { - /* Room for sign, leading 0, other digits, trailing NUL byte. - Also, room for invalid syntax diagnostic. */ - size_t len = max (1 + 1 + UINTMAX_WIDTH + 1, - sizeof "integer, radix " + INT_STRLEN_BOUND (EMACS_INT)); - char *buf = xmalloc (len); - char *p = buf; + char *read_buffer = stackbuf; + ptrdiff_t read_buffer_size = stackbufsize; + char *p = read_buffer; + char *heapbuf = NULL; int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete. */ - ptrdiff_t count = SPECPDL_INDEX (); - record_unwind_protect_ptr (free_contents, &buf); - if (radix < 2 || radix > 36) - valid = 0; - else + int c = READCHAR; + if (c == '-' || c == '+') { - int c, digit; - - p = buf; - + *p++ = c; c = READCHAR; - if (c == '-' || c == '+') - { - *p++ = c; - c = READCHAR; - } + } - if (c == '0') - { - *p++ = c; - valid = 1; + if (c == '0') + { + *p++ = c; + valid = 1; - /* Ignore redundant leading zeros, so the buffer doesn't - fill up with them. */ - do - c = READCHAR; - while (c == '0'); - } + /* Ignore redundant leading zeros, so the buffer doesn't + fill up with them. */ + do + c = READCHAR; + while (c == '0'); + } - while ((digit = digit_to_number (c, radix)) >= -1) + for (int digit; (digit = digit_to_number (c, radix)) >= -1; ) + { + if (digit == -1) + valid = 0; + if (valid < 0) + valid = 1; + /* Allow 1 extra byte for the \0. */ + if (p + 1 == read_buffer + read_buffer_size) { - if (digit == -1) - valid = 0; - if (valid < 0) - valid = 1; - /* Allow 1 extra byte for the \0. */ - if (p + 1 == buf + len) - { - ptrdiff_t where = p - buf; - len *= 2; - buf = xrealloc (buf, len); - p = buf + where; - } - *p++ = c; - c = READCHAR; + ptrdiff_t offset = p - read_buffer; + read_buffer = grow_read_buffer (read_buffer, offset, + &heapbuf, &read_buffer_size, + count); + p = read_buffer + offset; } - - UNREAD (c); + *p++ = c; + c = READCHAR; } + UNREAD (c); + if (valid != 1) - { - sprintf (buf, "integer, radix %"pI"d", radix); - invalid_syntax (buf); - } + invalid_radix_integer (radix, stackbuf); *p = '\0'; - return unbind_to (count, string_to_number (buf, radix, 0)); + return unbind_to (count, string_to_number (read_buffer, radix, NULL)); } @@ -2738,7 +2733,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) int c; bool uninterned_symbol = false; bool multibyte; - char stackbuf[128]; /* Small, as read1 is recursive (Bug#31995). */ + char stackbuf[stackbufsize]; current_thread->stack_top = stackbuf; *pch = 0; @@ -3108,30 +3103,34 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* ## is the empty symbol. */ if (c == '#') return Fintern (empty_unibyte_string, Qnil); - /* Reader forms that can reuse previously read objects. */ + if (c >= '0' && c <= '9') { - EMACS_INT n = 0; - Lisp_Object tem; + EMACS_INT n = c - '0'; bool overflow = false; /* Read a non-negative integer. */ - while (c >= '0' && c <= '9') + while ('0' <= (c = READCHAR) && c <= '9') { overflow |= INT_MULTIPLY_WRAPV (n, 10, &n); overflow |= INT_ADD_WRAPV (n, c - '0', &n); - c = READCHAR; } - if (!overflow && n <= MOST_POSITIVE_FIXNUM) + if (!overflow) { if (c == 'r' || c == 'R') - return read_integer (readcharfun, n); + { + if (! (2 <= n && n <= 36)) + invalid_radix_integer (n, stackbuf); + return read_integer (readcharfun, n, stackbuf); + } - if (! NILP (Vread_circle)) + if (n <= MOST_POSITIVE_FIXNUM && ! NILP (Vread_circle)) { + /* Reader forms that can reuse previously read objects. */ + /* #n=object returns object, but associates it with - n for #n#. */ + n for #n#. */ if (c == '=') { /* Make a placeholder for #n# to use temporarily. */ @@ -3160,7 +3159,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) hash_put (h, number, placeholder, hash); /* Read the object itself. */ - tem = read0 (readcharfun); + Lisp_Object tem = read0 (readcharfun); /* If it can be recursive, remember it for future substitutions. */ @@ -3210,11 +3209,11 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Fall through to error message. */ } else if (c == 'x' || c == 'X') - return read_integer (readcharfun, 16); + return read_integer (readcharfun, 16, stackbuf); else if (c == 'o' || c == 'O') - return read_integer (readcharfun, 8); + return read_integer (readcharfun, 8, stackbuf); else if (c == 'b' || c == 'B') - return read_integer (readcharfun, 2); + return read_integer (readcharfun, 2, stackbuf); UNREAD (c); invalid_syntax ("#"); commit 32b01c02b48963a242fcc984c3599f59e59c1b2c Author: Stefan Monnier Date: Wed May 15 13:00:51 2019 -0400 * lisp/mail/footnote.el (footnote-prefix): Docstring typo. diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index a1bbf7369b..bbc42e11f7 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -101,7 +101,7 @@ displaying footnotes." :type 'integer) (defcustom footnote-prefix [(control ?c) ?!] - "Prefix key to use for Footnote command in Footnote minor mode. + "Prefix key to use for Footnote commands in Footnote minor mode. The value of this variable is checked as part of loading Footnote mode. After that, changing the prefix key requires manipulating keymaps." :type 'key-sequence) @@ -876,8 +876,7 @@ play around with the following keys: (add-function :around (local 'adaptive-fill-function) #'footnote--adaptive-fill-function) - ;; filladapt is an XEmacs package which AFAIK has never been ported - ;; to Emacs. + ;; Filladapt was an XEmacs package which is now in GNU ELPA. (when (boundp 'filladapt-token-table) ;; add tokens to filladapt to match footnotes ;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x commit 26f735ff198e52370aafe09ed5ed669e78f196ab Author: Mattias Engdegård Date: Tue May 14 11:43:49 2019 +0200 Add standard unmatchable regexp Add `regexp-unmatchable' as a standard unmatchable regexp, defined as "\\`a\\`". Use it where such a regexp is needed, replacing slower expressions in several places. From a suggestion by Philippe Schnoebelen. * lisp/subr.el (regexp-unmatchable): New defconst. * etc/NEWS (Lisp Changes): Mention `regexp-unmatchable'. * doc/lispref/searching.texi (Regexp Functions): Document it. * lisp/emacs-lisp/regexp-opt.el (regexp-opt) * lisp/progmodes/cc-defs.el (cc-conditional-require-after-load) (c-make-keywords-re) * lisp/progmodes/cc-engine.el (c-beginning-of-statement-1) (c-forward-<>-arglist-recur, c-forward-decl-or-cast-1) (c-looking-at-decl-block) * lisp/progmodes/cc-fonts.el (c-doc-line-join-re) (c-doc-bright-comment-start-re) * lisp/progmodes/cc-langs.el (c-populate-syntax-table) (c-assignment-op-regexp) (c-block-comment-ender-regexp, c-font-lock-comment-end-skip) (c-block-comment-start-regexp, c-line-comment-start-regexp) (c-doc-comment-start-regexp, c-decl-start-colon-kwd-re) (c-type-decl-prefix-key, c-type-decl-operator-prefix-key) (c-pre-id-bracelist-key, c-enum-clause-introduction-re) (c-nonlabel-token-2-key) * lisp/progmodes/cc-mode.el (c-doc-fl-decl-start, c-doc-fl-decl-end) * lisp/progmodes/cc-vars.el (c-noise-macro-with-parens-name-re) (c-noise-macro-name-re, c-make-noise-macro-regexps) * lisp/progmodes/octave.el (octave-help-mode) * lisp/vc/vc-bzr.el (vc-bzr-log-view-mode, vc-bzr-revision-completion-table) * lisp/vc/vc-git.el (vc-git-log-view-mode) * lisp/vc/vc-hg.el (vc-hg-log-view-mode) * lisp/vc/vc-mtn.el (vc-mtn-log-view-mode): Use `regexp-unmatchable'. * lisp/textmodes/ispell.el (ispell-non-empty-string): Use `regexp-unmatchable', fixing a broken never-match regexp. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 8775254dd0..24f30b4dac 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -1070,6 +1070,13 @@ list of characters @var{chars}. @c Internal functions: regexp-opt-group +@defvar regexp-unmatchable +This variable contains a regexp that is guaranteed not to match any +string at all. It is particularly useful as default value for +variables that may be set to a pattern that actually matches +something. +@end defvar + @node Regexp Search @section Regular Expression Searching @cindex regular expression searching diff --git a/etc/NEWS b/etc/NEWS index fc3ca1ea92..699a04b524 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1990,6 +1990,10 @@ returns a regexp that never matches anything, which is an identity for this operation. Previously, the empty string was returned in this case. +** New constant 'regexp-unmatchable' contains a never-matching regexp. +It is a convenient and readable way to specify a regexp that should +not match anything, and is as fast as any such regexp can be. + * Changes in Emacs 27.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index d883752d71..00f72e284a 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -144,9 +144,9 @@ usually more efficient than that of a simplified version: (sort (copy-sequence strings) 'string-lessp))) (re (cond - ;; No strings: return a\` which cannot match anything. + ;; No strings: return an unmatchable regexp. ((null strings) - (concat (or open "\$?:") "a\\`\$")) + (concat (or open "\$?:") regexp-unmatchable "\$")) ;; If we cannot reorder, give up all attempts at ;; optimisation. There is room for improvement (Bug#34641). ((and keep-order (regexp-opt--contains-prefix sorted-strings)) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 5af9ea75ed..b0a1e1799f 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1989,7 +1989,7 @@ on the gateway machine to do the FTP instead." (make-local-variable 'comint-password-prompt-regexp) ;; This is a regexp that can't match anything. ;; ange-ftp has its own ways of handling passwords. - (setq comint-password-prompt-regexp "\\`a\\`") + (setq comint-password-prompt-regexp regexp-unmatchable) (make-local-variable 'paragraph-start) (setq paragraph-start comint-prompt-regexp)) diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index cd4ed6b352..d20e3ef32d 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -81,7 +81,7 @@ (progn (require 'font-lock) (let (font-lock-keywords) - (font-lock-compile-keywords '("a\\`")) ; doesn't match anything. + (font-lock-compile-keywords (list regexp-unmatchable)) font-lock-keywords)))) @@ -1890,8 +1890,8 @@ when it's needed. The default is the current language taken from ;; Produce a regexp that doesn't match anything. (if adorn - "\$a\\`\$" - "a\\`"))) + (concat "\$" regexp-unmatchable "\$") + regexp-unmatchable))) (put 'c-make-keywords-re 'lisp-indent-function 1) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index ed8310d0e6..41bab270da 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -907,7 +907,7 @@ comment at the start of cc-engine.el for more info." stack ;; Regexp which matches "for", "if", etc. (cond-key (or c-opt-block-stmt-key - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) ;; Return value. (ret 'same) ;; Positions of the last three sexps or bounds we've stopped at. @@ -7646,7 +7646,9 @@ comment at the start of cc-engine.el for more info." (progn (c-forward-syntactic-ws) (when (or (and c-record-type-identifiers all-types) - (not (equal c-inside-<>-type-key "\$a\\`\$"))) + (not (equal c-inside-<>-type-key + (concat + "\$" regexp-unmatchable "\$")))) (c-forward-syntactic-ws) (cond ((eq (char-after) ??) @@ -9253,7 +9255,7 @@ This function might do hidden buffer changes." ;; Skip over type decl prefix operators. (Note similar code in ;; `c-forward-declarator'.) (if (and c-recognize-typeless-decls - (equal c-type-decl-prefix-key "a\\`")) ; Regexp which doesn't match + (equal c-type-decl-prefix-key regexp-unmatchable)) (when (eq (char-after) ?\() (progn (setq paren-depth (1+ paren-depth)) @@ -10886,7 +10888,7 @@ comment at the start of cc-engine.el for more info." ;; legal because it's part of a "compound keyword" like ;; "enum class". Of course, if c-after-brace-list-key ;; is nil, we can skip the test. - (or (equal c-after-brace-list-key "a\\`") ; Regexp which doesn't match + (or (equal c-after-brace-list-key regexp-unmatchable) (save-match-data (save-excursion (not diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 5f09be60a6..b3a9dd480b 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2580,14 +2580,14 @@ need for `pike-font-lock-extra-types'.") ;;; Doc comments. -(defvar c-doc-line-join-re "a\\`") +(defvar c-doc-line-join-re regexp-unmatchable) ;; Matches a join of two lines in a doc comment. ;; This should not be changed directly, but instead set by ;; `c-setup-doc-comment-style'. This variable is used in `c-find-decl-spots' ;; in (e.g.) autodoc style comments to bridge the gap between a "@\n" at an ;; EOL and the token following "//!" on the next line. -(defvar c-doc-bright-comment-start-re "a\\`") +(defvar c-doc-bright-comment-start-re regexp-unmatchable) ;; Matches the start of a "bright" comment, one whose contents may be ;; fontified by, e.g., `c-font-lock-declarations'. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 30da10a6c0..9d2f689e58 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -945,7 +945,7 @@ file name in angle brackets or quotes." (c-make-keywords-re 'appendable (c-lang-const c-cpp-include-directives)) "[ \t]*") - "a\\`")) ; Doesn't match anything + regexp-unmatchable)) (c-lang-defvar c-cpp-include-key (c-lang-const c-cpp-include-key)) (c-lang-defconst c-opt-cpp-macro-define @@ -1331,7 +1331,7 @@ operators." (c--set-difference (c-lang-const c-assignment-operators) '("=") :test 'string-equal))) - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-defvar c-assignment-op-regexp (c-lang-const c-assignment-op-regexp)) @@ -1554,7 +1554,7 @@ properly." ;; language) t (if (c-lang-const c-block-comment-ender) (regexp-quote (c-lang-const c-block-comment-ender)) - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-defvar c-block-comment-ender-regexp (c-lang-const c-block-comment-ender-regexp)) @@ -1565,7 +1565,7 @@ properly." ;; `font-lock-comment-delimiter-face'. t (if (c-lang-const c-block-comment-ender) (concat "[ \t]*" (c-lang-const c-block-comment-ender-regexp)) - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-setvar font-lock-comment-end-skip (c-lang-const c-font-lock-comment-end-skip)) @@ -1584,7 +1584,7 @@ properly." ;; language) t (if (c-lang-const c-block-comment-starter) (regexp-quote (c-lang-const c-block-comment-starter)) - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-defvar c-block-comment-start-regexp (c-lang-const c-block-comment-start-regexp)) @@ -1593,7 +1593,7 @@ properly." ;; language; it does in all 7 CC Mode languages). t (if (c-lang-const c-line-comment-starter) (regexp-quote (c-lang-const c-line-comment-starter)) - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-defvar c-line-comment-start-regexp (c-lang-const c-line-comment-start-regexp)) @@ -1628,7 +1628,7 @@ starter." (c-lang-defconst c-doc-comment-start-regexp "Regexp to match the start of documentation comments." - t "a\\`" ; Doesn't match anything. + t regexp-unmatchable ;; From font-lock.el: `doxygen' uses /*! while others use /**. (c c++ objc) "/\\*[*!]" java "/\\*\\*" @@ -3112,7 +3112,7 @@ Note that Java specific rules are currently applied to tell this from "Regexp matching a keyword that is followed by a colon, where the whole construct can precede a declaration. E.g. \"public:\" in C++." - t "a\\`" ; Doesn't match anything. + t regexp-unmatchable c++ (c-make-keywords-re t (c-lang-const c-protection-kwds))) (c-lang-defvar c-decl-start-colon-kwd-re (c-lang-const c-decl-start-colon-kwd-re)) @@ -3309,7 +3309,7 @@ Identifier syntax is in effect when this is matched $see t (if (c-lang-const c-type-modifier-kwds) (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>") ;; Default to a regexp that never matches. - "a\\`") + regexp-unmatchable) ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". (c objc) (concat "\\(" @@ -3347,7 +3347,7 @@ that might precede the identifier in a declaration, e.g. the as the end of the operator. Identifier syntax is in effect when this is matched \(see `c-identifier-syntax-table')." t ;; Default to a regexp that never matches. - "a\\`" + regexp-unmatchable ;; Check that there's no "=" afterwards to avoid matching tokens ;; like "*=". (c objc) (concat "\\(\\*\$" @@ -3506,7 +3506,7 @@ list." (c-lang-defconst c-pre-id-bracelist-key "A regexp matching tokens which, preceding an identifier, signify a bracelist. " - t "a\\`" ; Doesn't match anything. + t regexp-unmatchable c++ "new\$[^[:alnum:]_$]\\|$\$\\|&&?\$\\S.\\|$\$") (c-lang-defvar c-pre-id-bracelist-key (c-lang-const c-pre-id-bracelist-key)) @@ -3562,7 +3562,7 @@ the invalidity of the putative template construct." ;; before the '{' of the enum list, to avoid searching too far. "[^][{};/#=]*" "{") - "a\\`")) ; Doesn't match anything. + regexp-unmatchable)) (c-lang-defvar c-enum-clause-introduction-re (c-lang-const c-enum-clause-introduction-re)) @@ -3703,7 +3703,7 @@ Only used if `c-recognize-colon-labels' is set." "Regexp matching things that can't occur two symbols before a colon in a label construct. This catches C++'s inheritance construct \"class foo : bar\". Only used if `c-recognize-colon-labels' is set." - t "a\\`" ; Doesn't match anything. + t regexp-unmatchable c++ (c-make-keywords-re t '("class"))) (c-lang-defvar c-nonlabel-token-2-key (c-lang-const c-nonlabel-token-2-key)) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index bd62fc754a..e4ff9f019d 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1825,7 +1825,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; by `c-doc-line-join-re'), return the position of the first line of the ;; sequence. Otherwise, return nil. Point has no significance at entry to ;; and exit from this function. - (when (not (equal c-doc-line-join-re "a\\`")) + (when (not (equal c-doc-line-join-re regexp-unmatchable)) (goto-char pos) (back-to-indentation) (and (or (looking-at c-comment-start-regexp) @@ -1842,7 +1842,7 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; marker (as defined by `c-doc-line-join-re), return the position of ;; the BOL at the end of the sequence. Otherwise, return nil. Point has no ;; significance at entry to and exit from this function. - (when (not (equal c-doc-line-join-re "a\\`")) + (when (not (equal c-doc-line-join-re regexp-unmatchable)) (goto-char pos) (back-to-indentation) (let ((here (point))) diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 6e8acd4c0d..b818bced73 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -1648,9 +1648,9 @@ white space either before or after the operator, but not both." :group 'c) ;; Initialize the next two to a regexp which never matches. -(defvar c-noise-macro-with-parens-name-re "a\\`") +(defvar c-noise-macro-with-parens-name-re regexp-unmatchable) (make-variable-buffer-local 'c-noise-macro-with-parens-name-re) -(defvar c-noise-macro-name-re "a\\`") +(defvar c-noise-macro-name-re regexp-unmatchable) (make-variable-buffer-local 'c-noise-macro-name-re) (defcustom c-noise-macro-names nil @@ -1682,7 +1682,7 @@ These are recognized by CC Mode only in declarations." ;; Convert `c-noise-macro-names' and `c-noise-macro-with-parens-names' into ;; `c-noise-macro-name-re' and `c-noise-macro-with-parens-name-re'. (setq c-noise-macro-with-parens-name-re - (cond ((null c-noise-macro-with-parens-names) "a\\`") ; Never matches. + (cond ((null c-noise-macro-with-parens-names) regexp-unmatchable) ((consp c-noise-macro-with-parens-names) (concat (regexp-opt c-noise-macro-with-parens-names t) "\$[^[:alnum:]_$]\\|$\$")) @@ -1691,7 +1691,7 @@ These are recognized by CC Mode only in declarations." (t (error "c-make-noise-macro-regexps: \ c-noise-macro-with-parens-names is invalid: %s" c-noise-macro-with-parens-names)))) (setq c-noise-macro-name-re - (cond ((null c-noise-macro-names) "a\\`") ; Never matches anything. + (cond ((null c-noise-macro-names) regexp-unmatchable) ((consp c-noise-macro-names) (concat (regexp-opt c-noise-macro-names t) "\$[^[:alnum:]_$]\\|$\$")) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 85f9078d46..79178c4346 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -837,7 +837,8 @@ This function is called from `compilation-filter-hook'." grep-mode-line-matches) ;; compilation-directory-matcher can't be nil, so we set it to a regexp that ;; can never match. - (set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`")) + (set (make-local-variable 'compilation-directory-matcher) + (list regexp-unmatchable)) (set (make-local-variable 'compilation-process-setup-function) 'grep-process-setup) (set (make-local-variable 'compilation-disable-input) t) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index 52e5fd477f..8a7e24e5ad 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -1691,7 +1691,7 @@ code line." (eval-and-compile (require 'help-mode)) ;; Don't highlight `EXAMPLE' as elisp symbols by using a regexp that ;; can never match. - (setq-local help-xref-symbol-regexp "x\\`")) + (setq-local help-xref-symbol-regexp regexp-unmatchable)) (defun octave-help (fn) "Display the documentation of FN." diff --git a/lisp/subr.el b/lisp/subr.el index be21dc67a0..05fb9fea68 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5544,4 +5544,8 @@ returned list are in the same order as in TREE. ;; for discoverability: (defalias 'flatten-list 'flatten-tree) +;; The initial anchoring is for better performance in searching matches. +(defconst regexp-unmatchable "\\`a\\`" + "Standard regexp guaranteed not to match any string at all.") + ;;; subr.el ends here diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 6553a2799b..0c5e6a183b 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -4016,7 +4016,7 @@ You can bind this to the key C-c i in GNUS or mail by adding to (defun ispell-non-empty-string (string) (if (or (not string) (string-equal string "")) - "\\'\\`" ; An unmatchable string if string is null. + regexp-unmatchable (regexp-quote string))) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index ab5a449cd3..ee1646cae5 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -702,7 +702,7 @@ or a superior directory.") (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. (require 'add-log) (set (make-local-variable 'log-view-per-file-logs) nil) - (set (make-local-variable 'log-view-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-message-re) (if (eq vc-log-view-type 'short) "^ *\$[0-9.]+\$: \$.*?\$[ \t]+\$[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\$\$ \\[merge\\]\$?" @@ -1319,7 +1319,8 @@ stream. Standard error output is discarded." ((string-match "\\`annotate:" string) (completion-table-with-context (substring string 0 (match-end 0)) - (apply-partially #'completion-table-with-terminator '(":" . "\\`a\\`") + (apply-partially #'completion-table-with-terminator + (cons ":" regexp-unmatchable) #'completion-file-name-table) (substring string (match-end 0)) pred action)) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 192e6cf68f..61c13026cc 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1087,7 +1087,7 @@ If LIMIT is a revision string, use it as an end-revision." (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; We need the faces add-log. ;; Don't have file markers, so use impossible regexp. - (set (make-local-variable 'log-view-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) (if (not (eq vc-log-view-type 'long)) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index d3f132dae7..876d824cea 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -444,7 +444,7 @@ If LIMIT is non-nil, show no more than this many entries." (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces - (set (make-local-variable 'log-view-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) (if (eq vc-log-view-type 'short) diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index f0b12489c1..91cc28021c 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -240,7 +240,7 @@ If LIMIT is non-nil, show no more than this many entries." (define-derived-mode vc-mtn-log-view-mode log-view-mode "Mtn-Log-View" ;; Don't match anything. - (set (make-local-variable 'log-view-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-per-file-logs) nil) ;; TODO: Use a more precise regexp than "[ |/]+" to avoid false positives ;; in the ChangeLog text. commit d0ebc389ebba0ca5b99e019c47c4a616941378ac Author: John Shahid Date: Wed May 15 16:29:58 2019 +0200 Avoid infinitly looping in tramp-interrupt-process (bug#35506) * lisp/net/tramp.el (tramp-interrupt-process): Remove with-timeout. Instead pass a timeout to tramp-accept-process-output. tramp-accept-process-output stops timers from running which makes the with-timeout ineffective. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 0a3129fd45..2aa62eba80 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4861,10 +4861,9 @@ Only works for Bourne-like shells." (format "kill -2 -%d" pid)) ;; Wait, until the process has disappeared. If it doesn't, ;; fall back to the default implementation. - (with-timeout (1 (ignore)) - (while (tramp-accept-process-output proc)) - ;; Report success. - proc))))) + (and (tramp-accept-process-output proc 1) + ;; Report success. + proc))))) ;; `interrupt-process-functions' exists since Emacs 26.1. (when (boundp 'interrupt-process-functions) commit 356fb18a1f64e58559fef92016be258b8cc70753 Author: Alan Mackenzie Date: Wed May 15 08:58:31 2019 +0000 CC Mode: fix indentation in switch statement after "case a(1):". * lisp/progmodes/cc-engine.el (c-beginning-of-statement-1): Enhance the analysis of case labels to handle parenthesised expressions (e.g. macros). * lisp/progmodes/cc-langs.el (c-nonlabel-nonparen-token-key): New lang const and lang var. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index a25d059553..ed8310d0e6 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1253,12 +1253,20 @@ comment at the start of cc-engine.el for more info." ;; (including a case label) or something like C++'s "public:"? ;; A case label might use an expression rather than a token. (setq after-case:-pos (or tok start)) - (if (or (looking-at c-nonlabel-token-key) ; e.g. "while" or "'a'" + (if (or (looking-at c-nonlabel-nonparen-token-key) + ; e.g. "while" or "'a'" ;; Catch C++'s inheritance construct "class foo : bar". (save-excursion (and (c-safe (c-backward-sexp) t) - (looking-at c-nonlabel-token-2-key)))) + (looking-at c-nonlabel-token-2-key))) + ;; Catch C++'s "case a(1):" + (and (c-major-mode-is 'c++-mode) + (eq (char-after) ?\() + (save-excursion + (not (and + (zerop (c-backward-token-2 2)) + (looking-at c-case-kwds-regexp)))))) (setq c-maybe-labelp nil) (if after-labels-pos ; Have we already encountered a label? (if (not last-label-pos) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 8b7e4ef7c0..30da10a6c0 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -3674,6 +3674,31 @@ i.e. before \":\". Only used if `c-recognize-colon-labels' is set." c++ (concat "\\s(\\|\"\\|" (c-lang-const c-nonlabel-token-key))) (c-lang-defvar c-nonlabel-token-key (c-lang-const c-nonlabel-token-key)) +(c-lang-defconst c-nonlabel-nonparen-token-key + "Regexp matching things that can't occur in generic colon labels, +neither in a statement nor in a declaration context, with the +exception of an open parenthesis. The regexp is tested at the +beginning of every sexp in a suspected label, i.e. before \":\". +Only used if `c-recognize-colon-labels' is set." + ;; This lang const is the same as `c-nonlabel-token-key', except for a + ;; slight difference in the c++-mode value. + t (concat + ;; All keywords except `c-label-kwds' and `c-protection-kwds'. + (c-make-keywords-re t + (c--set-difference (c-lang-const c-keywords) + (append (c-lang-const c-label-kwds) + (c-lang-const c-protection-kwds)) + :test 'string-equal))) + ;; Don't allow string literals, except in AWK and Java. Character constants are OK. + (c objc pike idl) (concat "\"\\|" + (c-lang-const c-nonlabel-nonparen-token-key)) + ;; Also check for open parens in C++, to catch member init lists in + ;; constructors. We normally allow it so that macros with arguments + ;; work in labels. + c++ (concat "[{[]\\|\"\\|" (c-lang-const c-nonlabel-nonparen-token-key))) +(c-lang-defvar c-nonlabel-nonparen-token-key + (c-lang-const c-nonlabel-nonparen-token-key)) + (c-lang-defconst c-nonlabel-token-2-key "Regexp matching things that can't occur two symbols before a colon in a label construct. This catches C++'s inheritance construct \"class foo