summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorGlenn Morris <rgm@gnu.org>2020-03-04 13:57:58 -0800
committerGlenn Morris <rgm@gnu.org>2020-03-04 13:57:58 -0800
commit6a0e1c41040059d1a463fbf69be52e898b30691a (patch)
treea230d2d3d62c8b9124da17e9f55d21d6fcc1ccbb /lisp/emacs-lisp
parentb6c39214065272e33a544d09b9a341bbe17ed47b (diff)
parenta4e4510ccd92da8ca17743c7dab9b32fc9d850e7 (diff)
downloademacs-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.el2
-rw-r--r--lisp/emacs-lisp/rx.el82
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)