Merge remote-tracking branch 'savannah/master' into HEAD

7 files changed, 139 insertions, 150 deletions

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 72c6fc7bf86..fe5616be668 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2171,50 +2171,9 @@ With argument ARG, insert value in current buffer after the form."
 	;; Make warnings about unresolved functions
 	;; give the end of the file as their position.
 	(setq byte-compile-last-position (point-max))
-	(byte-compile-warn-about-unresolved-functions))
-      ;; Fix up the header at the front of the output
-      ;; if the buffer contains multibyte characters.
-      (and byte-compile-current-file
-	   (with-current-buffer byte-compile--outbuffer
-	     (byte-compile-fix-header byte-compile-current-file))))
+	(byte-compile-warn-about-unresolved-functions)))
      byte-compile--outbuffer)))
 
-(defun byte-compile-fix-header (_filename)
-  "If the current buffer has any multibyte characters, insert a version test."
-  (when (< (point-max) (position-bytes (point-max)))
-    (goto-char (point-min))
-    ;; Find the comment that describes the version condition.
-    (when (search-forward "\n;;; This file does not contain utf-8" nil t)
-      (narrow-to-region (line-beginning-position) (point-max))
-      ;; Find the first line of ballast semicolons.
-      (search-forward ";;;;;;;;;;")
-      (beginning-of-line)
-      (narrow-to-region (point-min) (point))
-      (let ((old-header-end (point))
-	    (minimum-version "23")
-	    delta)
-        (delete-region (point-min) (point-max))
-        (insert
-         ";;; This file contains utf-8 non-ASCII characters,\n"
-         ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
-         ;; Have to check if emacs-version is bound so that this works
-         ;; in files loaded early in loadup.el.
-         "(and (boundp 'emacs-version)\n"
-         ;; If there is a name at the end of emacs-version,
-         ;; don't try to check the version number.
-         "     (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
-         (format "     (string-lessp emacs-version \"%s\")\n" minimum-version)
-         ;; Because the header must fit in a fixed width, we cannot
-         ;; insert arbitrary-length file names (Bug#11585).
-         "     (error \"`%s' was compiled for "
-         (format "Emacs %s or later\" #$))\n\n" minimum-version))
-        ;; Now compensate for any change in size, to make sure all
-        ;; positions in the file remain valid.
-        (setq delta (- (point-max) old-header-end))
-        (goto-char (point-max))
-        (widen)
-        (delete-char delta)))))
-
 (defun byte-compile-insert-header (_filename outbuffer)
   "Insert a header at the start of OUTBUFFER.
 Call from the source buffer."
@@ -2232,7 +2191,19 @@ Call from the source buffer."
       ;; 0	string		;ELC		GNU Emacs Lisp compiled file,
       ;; >4	byte		x		version %d
       (insert
-       ";ELC" 23 "\000\000\000\n"
+       ";ELC"
+       (let ((version
+              (if (zerop emacs-minor-version)
+                  ;; Let's allow silently loading into Emacs-27
+                  ;; files compiled with Emacs-28.0.NN since the two can
+                  ;; be almost identical (e.g. right after cutting the
+                  ;; release branch) and people running the development
+                  ;; branch can be presumed to know that it's risky anyway.
+                  (1- emacs-major-version) emacs-major-version)))
+         ;; Make sure the version is a plain byte that doesn't end the comment!
+         (cl-assert (and (> version 13) (< version 128)))
+         version)
+       "\000\000\000\n"
        ";;; Compiled\n"
        ";;; in Emacs version " emacs-version "\n"
        ";;; with"
@@ -2244,16 +2215,7 @@ Call from the source buffer."
        ".\n"
        (if dynamic ";;; Function definitions are lazy-loaded.\n"
 	 "")
-       "\n"
-       ;; Note that byte-compile-fix-header may change this.
-       ";;; This file does not contain utf-8 non-ASCII characters,\n"
-       ";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
-       ;; Insert semicolons as ballast, so that byte-compile-fix-header
-       ;; can delete them so as to keep the buffer positions
-       ;; constant for the actual compiled code.
-       ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
-       ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
-       ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
+       "\n\n"))))
 
 (defun byte-compile-output-file-form (form)
   ;; Write the given form to the output buffer, being careful of docstrings
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index ccdddb47c35..fa5d1cff417 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -168,7 +168,7 @@
 ;;     not specifically docstring related.  Would this even be useful?
 
 ;;; Code:
-(defvar checkdoc-version "0.6.1"
+(defvar checkdoc-version "0.6.2"
   "Release version of checkdoc you are currently running.")
 
 (require 'cl-lib)
@@ -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/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index e3dabdfcef2..e9bfe8df5f2 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -556,11 +556,7 @@ too large if positive or too small if negative)."
 (defun cl-concatenate (type &rest sequences)
   "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
 \n(fn TYPE SEQUENCE...)"
-  (pcase type
-    ('vector (apply #'vconcat sequences))
-    ('string (apply #'concat sequences))
-    ('list (apply #'append (append sequences '(nil))))
-    (_ (error "Not a sequence type name: %S" type))))
+  (seq-concatenate type sequences))
 
 ;;; List functions.
 
diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el
index 7728e78c471..d50f7ad0be5 100644
--- a/lisp/emacs-lisp/cursor-sensor.el
+++ b/lisp/emacs-lisp/cursor-sensor.el
@@ -141,61 +141,63 @@ By convention, this is a list of symbols where each symbol stands for the
 ;;; Detect cursor movement.
 
 (defun cursor-sensor--detect (&optional window)
-  (unless cursor-sensor-inhibit
-    (let* ((point (window-point window))
-           ;; It's often desirable to make the cursor-sensor-functions property
-           ;; non-sticky on both ends, but that means get-pos-property might
-           ;; never see it.
-           (new (and (eq (current-buffer) (window-buffer))
-                     (or (get-char-property point 'cursor-sensor-functions)
-                         (unless (<= (point-min) point)
-                           (get-char-property (1- point) 'cursor-sensor-functions)))))
-           (old (window-parameter window 'cursor-sensor--last-state))
-           (oldposmark (car old))
-           (oldpos (or (if oldposmark (marker-position oldposmark))
-                       (point-min)))
-           (start (min oldpos point))
-           (end (max oldpos point)))
-      (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer)))
-        ;; `window' does not display the same buffer any more!
-        (setcdr old nil))
-      (if (or (and (null new) (null (cdr old)))
-              (and (eq new (cdr old))
-                   (eq (next-single-char-property-change
-                        start 'cursor-sensor-functions nil end)
-                       end)))
-          ;; Clearly nothing to do.
-          nil
-        ;; Maybe something to do.  Let's see exactly what needs to run.
-        (let* ((missing-p
-                (lambda (f)
-                  "Non-nil if F is missing somewhere between START and END."
-                  (let ((pos start)
-                        (missing nil))
-                    (while (< pos end)
-                      (setq pos (next-single-char-property-change
-                                 pos 'cursor-sensor-functions
-                                 nil end))
-                      (unless (memq f (get-char-property
-                                       pos 'cursor-sensor-functions))
-                        (setq missing t)))
-                    missing)))
-               (window (selected-window)))
-          (dolist (f (cdr old))
-            (unless (and (memq f new) (not (funcall missing-p f)))
-              (funcall f window oldpos 'left)))
-          (dolist (f new)
-            (unless (and (memq f (cdr old)) (not (funcall missing-p f)))
-              (funcall f window oldpos 'entered)))))
-
-      ;; Remember current state for next time.
-      ;; Re-read cursor-sensor-functions since the functions may have moved
-      ;; window-point!
-      (if old
-          (progn (move-marker (car old) point)
-                 (setcdr old new))
-        (set-window-parameter window 'cursor-sensor--last-state
-                              (cons (copy-marker point) new))))))
+  (with-current-buffer (window-buffer window)
+    (unless cursor-sensor-inhibit
+      (let* ((point (window-point window))
+             ;; It's often desirable to make the
+             ;; cursor-sensor-functions property non-sticky on both
+             ;; ends, but that means get-pos-property might never
+             ;; see it.
+             (new (or (get-char-property point 'cursor-sensor-functions)
+                      (unless (<= (point-min) point)
+                        (get-char-property (1- point)
+                                           'cursor-sensor-functions))))
+             (old (window-parameter window 'cursor-sensor--last-state))
+             (oldposmark (car old))
+             (oldpos (or (if oldposmark (marker-position oldposmark))
+                         (point-min)))
+             (start (min oldpos point))
+             (end (max oldpos point)))
+        (unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer)))
+          ;; `window' does not display the same buffer any more!
+          (setcdr old nil))
+        (if (or (and (null new) (null (cdr old)))
+                (and (eq new (cdr old))
+                     (eq (next-single-char-property-change
+                          start 'cursor-sensor-functions nil end)
+                         end)))
+            ;; Clearly nothing to do.
+            nil
+          ;; Maybe something to do.  Let's see exactly what needs to run.
+          (let* ((missing-p
+                  (lambda (f)
+                    "Non-nil if F is missing somewhere between START and END."
+                    (let ((pos start)
+                          (missing nil))
+                      (while (< pos end)
+                        (setq pos (next-single-char-property-change
+                                   pos 'cursor-sensor-functions
+                                   nil end))
+                        (unless (memq f (get-char-property
+                                         pos 'cursor-sensor-functions))
+                          (setq missing t)))
+                      missing)))
+                 (window (selected-window)))
+            (dolist (f (cdr old))
+              (unless (and (memq f new) (not (funcall missing-p f)))
+                (funcall f window oldpos 'left)))
+            (dolist (f new)
+              (unless (and (memq f (cdr old)) (not (funcall missing-p f)))
+                (funcall f window oldpos 'entered)))))
+
+        ;; Remember current state for next time.
+        ;; Re-read cursor-sensor-functions since the functions may have moved
+        ;; window-point!
+        (if old
+            (progn (move-marker (car old) point)
+                   (setcdr old new))
+          (set-window-parameter window 'cursor-sensor--last-state
+                                (cons (copy-marker point) new)))))))
 
 ;;;###autoload
 (define-minor-mode cursor-sensor-mode
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index b4cab5715da..aa4b2addd47 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -134,7 +134,7 @@ Each entry is:
                 (if (cdr def)
                     (error "Not an `rx' symbol definition: %s" form)
                   (car def)))))
-        ((consp form)
+        ((and (consp form) (symbolp (car form)))
          (let* ((op (car form))
                 (def (rx--lookup-def op)))
            (and def
@@ -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)))))
@@ -344,7 +360,7 @@ character X becomes (?X . ?X).  Return the intervals in a list."
                       (push (cons start end) intervals))
                      (t
                       (error "Invalid rx `any' range: %s"
-                             (substring str i 3))))
+                             (substring str i (+ i 3)))))
                (setq i (+ i 3))))
             (t
              ;; Single character.
@@ -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)
 
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 0b946dd7365..e3037a71901 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -58,6 +58,10 @@
 
 (eval-when-compile (require 'cl-generic))
 
+;; We used to use some sequence functions from cl-lib, but this
+;; dependency was swapped around so that it will be easier to make
+;; seq.el preloaded in the future.  See also Bug#39761#26.
+
 (defmacro seq-doseq (spec &rest body)
   "Loop over a sequence.
 Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
@@ -285,7 +289,11 @@ sorted.  FUNCTION must be a function of one argument."
 TYPE must be one of following symbols: vector, string or list.
 
 \n(fn TYPE SEQUENCE...)"
-  (apply #'cl-concatenate type (seq-map #'seq-into-sequence sequences)))
+  (pcase type
+    ('vector (apply #'vconcat sequences))
+    ('string (apply #'concat sequences))
+    ('list (apply #'append (append sequences '(nil))))
+    (_ (error "Not a sequence type name: %S" type))))
 
 (cl-defgeneric seq-into-sequence (sequence)
   "Convert SEQUENCE into a sequence.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 74a94957e73..61fd05cbb80 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -378,9 +378,6 @@ This function returns a timer object which you can use in
                                  (decoded-time-year now)
                                  (decoded-time-zone now)))))))
 
-  (or (consp time)
-      (error "Invalid time format"))
-
   (let ((timer (timer-create)))
     (timer-set-time timer time repeat)
     (timer-set-function timer function args)