diff options
author | Glenn Morris <rgm@gnu.org> | 2020-03-04 13:57:58 -0800 |
---|---|---|
committer | Glenn Morris <rgm@gnu.org> | 2020-03-04 13:57:58 -0800 |
commit | 6a0e1c41040059d1a463fbf69be52e898b30691a (patch) | |
tree | a230d2d3d62c8b9124da17e9f55d21d6fcc1ccbb /lisp/emacs-lisp | |
parent | b6c39214065272e33a544d09b9a341bbe17ed47b (diff) | |
parent | a4e4510ccd92da8ca17743c7dab9b32fc9d850e7 (diff) | |
download | emacs-6a0e1c41040059d1a463fbf69be52e898b30691a.tar.gz emacs-6a0e1c41040059d1a463fbf69be52e898b30691a.tar.bz2 emacs-6a0e1c41040059d1a463fbf69be52e898b30691a.zip |
Merge from origin/emacs-27
a4e4510ccd Fix handling MS-Windows keyboard input above the BMP
a38bebb0c1 * etc/NEWS: More complete description of rx 'not' changes.
d373647e8f ; * doc/emacs/mini.texi (Yes or No Prompts): Fix last change.
1ca6d15656 * doc/emacs/mini.texi (Yes or No Prompts): 'y-or-n-p' now ...
fe1a447d52 Don't attempt to cache glyph metrics for FONT_INVALID_CODE
b42b894d1d Fix fit-frame-to-buffer for multi-monitor setup
366fd4fd07 (emacs-27) ; * etc/NEWS: Fix typo.
49d3cd90bd rx: Improve 'or' compositionality (bug#37659)
6b48aedb6b * lisp/tab-line.el: Fix auto-hscrolling (bug#39649)
c5f255d681 (tag: emacs-27.0.90) ; Update lisp/ldefs-boot.el
60c84ad992 ; * etc/TODO: Fix last change.
5af9e5baad ; Add an entry to TODO
d424195905 Fix rx charset generation
9908b5a614 Merge branch 'emacs-27' of git.savannah.gnu.org:/srv/git/e...
6dc2ebe00e Fix overquoting in mule.el
5cca73dd82 * src/timefns.c (time_arith): Omit incorrect comment.
d767c357ca Merge branch 'emacs-27' of git.savannah.gnu.org:/srv/git/e...
4dec693f70 * lisp/vc/vc-cvs.el (vc-cvs-ignore): Copy-edit doc string
ff729e3f97 ; bug#39779: Fix some typos in documentation.
696ee02c3a checkdoc: Don't mistake "cf." for sentence end
# Conflicts:
# etc/NEWS
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/checkdoc.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/rx.el | 82 |
2 files changed, 54 insertions, 30 deletions
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index ccdddb47c35..e15836ee7d8 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2073,7 +2073,7 @@ If the offending word is in a piece of quoted text, then it is skipped." ;; piece of an abbreviation ;; FIXME etc (looking-at - "\\([a-zA-Z]\\|[iI]\\.?e\\|[eE]\\.?g\\)\\.")) + "\\([a-zA-Z]\\|[iI]\\.?e\\|[eE]\\.?g\\|[cC]f\\)\\.")) (error t)))) (if (checkdoc-autofix-ask-replace b e diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index b4cab5715da..a0b2444346a 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -254,22 +254,39 @@ Left-fold the list L, starting with X, by the binary function F." (setq l (cdr l))) x) +(defun rx--normalise-or-arg (form) + "Normalise the `or' argument FORM. +Characters become strings, user-definitions and `eval' forms are expanded, +and `or' forms are normalised recursively." + (cond ((characterp form) + (char-to-string form)) + ((and (consp form) (memq (car form) '(or |))) + (cons (car form) (mapcar #'rx--normalise-or-arg (cdr form)))) + ((and (consp form) (eq (car form) 'eval)) + (rx--normalise-or-arg (rx--expand-eval (cdr form)))) + (t + (let ((expanded (rx--expand-def form))) + (if expanded + (rx--normalise-or-arg expanded) + form))))) + +(defun rx--all-string-or-args (body) + "If BODY only consists of strings or such `or' forms, return all the strings. +Otherwise throw `rx--nonstring'." + (mapcan (lambda (form) + (cond ((stringp form) (list form)) + ((and (consp form) (memq (car form) '(or |))) + (rx--all-string-or-args (cdr form))) + (t (throw 'rx--nonstring nil)))) + body)) + (defun rx--translate-or (body) "Translate an or-pattern of zero or more rx items. Return (REGEXP . PRECEDENCE)." ;; FIXME: Possible improvements: ;; - ;; - Turn single characters to strings: (or ?a ?b) -> (or "a" "b"), - ;; so that they can be candidates for regexp-opt. - ;; - ;; - Translate compile-time strings (`eval' forms), again for regexp-opt. - ;; ;; - Flatten sub-patterns first: (or (or A B) (or C D)) -> (or A B C D) - ;; in order to improve effectiveness of regexp-opt. - ;; This would also help composability. - ;; - ;; - Use associativity to run regexp-opt on contiguous subsets of arguments - ;; if not all of them are strings. Example: + ;; Then call regexp-opt on runs of string arguments. Example: ;; (or (+ digit) "CHARLIE" "CHAN" (+ blank)) ;; -> (or (+ digit) (or "CHARLIE" "CHAN") (+ blank)) ;; @@ -279,33 +296,32 @@ Return (REGEXP . PRECEDENCE)." ;; so that (or "@" "%" digit (any "A-Z" space) (syntax word)) ;; -> (any "@" "%" digit "A-Z" space word) ;; -> "[A-Z@%[:digit:][:space:][:word:]]" - ;; - ;; Problem: If a subpattern is carefully written to be - ;; optimizable by regexp-opt, how do we prevent the transforms - ;; above from destroying that property? - ;; Example: (or "a" (or "abc" "abd" "abe")) (cond ((null body) ; No items: a never-matching regexp. (rx--empty)) ((null (cdr body)) ; Single item. (rx--translate (car body))) - ((rx--every #'stringp body) ; All strings. - (cons (list (regexp-opt body nil)) - t)) - ((rx--every #'rx--charset-p body) ; All charsets. - (rx--translate-union nil body)) (t - (cons (append (car (rx--translate (car body))) - (mapcan (lambda (item) - (cons "\\|" (car (rx--translate item)))) - (cdr body))) - nil)))) + (let* ((args (mapcar #'rx--normalise-or-arg body)) + (all-strings (catch 'rx--nonstring (rx--all-string-or-args args)))) + (cond + (all-strings ; Only strings. + (cons (list (regexp-opt all-strings nil)) + t)) + ((rx--every #'rx--charset-p args) ; All charsets. + (rx--translate-union nil args)) + (t + (cons (append (car (rx--translate (car args))) + (mapcan (lambda (item) + (cons "\\|" (car (rx--translate item)))) + (cdr args))) + nil))))))) (defun rx--charset-p (form) "Whether FORM looks like a charset, only consisting of character intervals and set operations." (or (and (consp form) - (or (and (memq (car form) '(any 'in 'char)) + (or (and (memq (car form) '(any in char)) (rx--every (lambda (x) (not (symbolp x))) (cdr form))) (and (memq (car form) '(not or | intersection)) (rx--every #'rx--charset-p (cdr form))))) @@ -450,6 +466,10 @@ classes." (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 (cons @@ -836,11 +856,15 @@ Return (REGEXP . PRECEDENCE)." (cons (list (list 'regexp-quote arg)) 'seq)) (t (error "rx `literal' form with non-string argument"))))) -(defun rx--translate-eval (body) - "Translate the `eval' form. Return (REGEXP . PRECEDENCE)." +(defun rx--expand-eval (body) + "Expand `eval' arguments. Return a new rx form." (unless (and body (null (cdr body))) (error "rx `eval' form takes exactly one argument")) - (rx--translate (eval (car body)))) + (eval (car body))) + +(defun rx--translate-eval (body) + "Translate the `eval' form. Return (REGEXP . PRECEDENCE)." + (rx--translate (rx--expand-eval body))) (defvar rx--regexp-atomic-regexp nil) |