; Merge from branch 'master'scratch/raeburn-startup

8 files changed, 159 insertions, 47 deletions

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c64376b940f..1a3f8e1f4d5 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
 (defmacro cl--generic (name)
   `(get ,name 'cl--generic))
 
+(defun cl-generic-p (f)
+  "Return non-nil if F is a generic function."
+  (and (symbolp f) (cl--generic f)))
+
 (defun cl-generic-ensure-function (name &optional noerror)
   (let (generic
         (origname name))
@@ -182,8 +186,7 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
              origname))
     (if generic
         (cl-assert (eq name (cl--generic-name generic)))
-      (setf (cl--generic name) (setq generic (cl--generic-make name)))
-      (defalias name (cl--generic-make-function generic)))
+      (setf (cl--generic name) (setq generic (cl--generic-make name))))
     generic))
 
 ;;;###autoload
@@ -410,7 +413,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
 \(and can be extended) by the various methods of `cl-generic-generalizers'.
 
 \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
-  (declare (doc-string 3) (indent 2)
+  (declare (doc-string 3) (indent defun)
            (debug
             (&define                    ; this means we are defining something
              [&or name ("setf" name :name setf)]
@@ -501,25 +504,26 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
               (cons method mt)
             ;; Keep the ordering; important for methods with :extra qualifiers.
             (mapcar (lambda (x) (if (eq x (car me)) method x)) mt)))
-    (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
-                                   (cl--generic-name generic)
-                                   qualifiers specializers))
-                current-load-list :test #'equal)
-    ;; FIXME: Try to avoid re-constructing a new function if the old one
-    ;; is still valid (e.g. still empty method cache)?
-    (let ((gfun (cl--generic-make-function generic))
-          ;; Prevent `defalias' from recording this as the definition site of
-          ;; the generic function.
-          current-load-list)
-      ;; For aliases, cl--generic-name gives us the actual name.
-      (let ((purify-flag
-             ;; BEWARE!  Don't purify this function definition, since that leads
-             ;; to memory corruption if the hash-tables it holds are modified
-             ;; (the GC doesn't trace those pointers).
-             nil))
+    (let ((sym (cl--generic-name generic))) ; Actual name (for aliases).
+      (unless (symbol-function sym)
+        (defalias sym 'dummy))   ;Record definition into load-history.
+      (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
+                                     (cl--generic-name generic)
+                                     qualifiers specializers))
+                  current-load-list :test #'equal)
+      ;; FIXME: Try to avoid re-constructing a new function if the old one
+      ;; is still valid (e.g. still empty method cache)?
+      (let ((gfun (cl--generic-make-function generic))
+            ;; Prevent `defalias' from recording this as the definition site of
+            ;; the generic function.
+            current-load-list
+            ;; BEWARE!  Don't purify this function definition, since that leads
+            ;; to memory corruption if the hash-tables it holds are modified
+            ;; (the GC doesn't trace those pointers).
+            (purify-flag nil))
         ;; But do use `defalias', so that it interacts properly with nadvice,
         ;; e.g. for tracing/debug-on-entry.
-        (defalias (cl--generic-name generic) gfun)))))
+        (defalias sym gfun)))))
 
 (defmacro cl--generic-with-memoization (place &rest code)
   (declare (indent 1) (debug t))
@@ -1023,6 +1027,20 @@ The value returned is a list of elements of the form
           (push (cl--generic-method-info method) docs))))
     docs))
 
+(defun cl--generic-method-files (method)
+  "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'.  Filenames are absolute."
+  (let (result)
+    (pcase-dolist (`(,file . ,defs) load-history)
+      (dolist (def defs)
+        (when (and (eq (car-safe def) 'cl-defmethod)
+                   (eq (cadr def) method))
+          (push (cons file (cdr def)) result))))
+    result))
+
 ;;; Support for (head <val>) specializers.
 
 ;; For both the `eql' and the `head' specializers, the dispatch
@@ -1210,5 +1228,18 @@ Used internally for the (major-mode MODE) context specializers."
                     (progn (cl-assert (null modes)) mode)
                   `(derived-mode ,mode . ,modes))))
 
+;;; Support for unloading.
+
+(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
+  (pcase-let*
+      ((`(,name ,qualifiers . ,specializers) (cdr x))
+       (generic (cl-generic-ensure-function name 'noerror)))
+    (when generic
+      (let* ((mt (cl--generic-method-table generic))
+             (me (cl--generic-member-method specializers qualifiers mt)))
+        (when me
+          (setf (cl--generic-method-table generic) (delq (car me) mt)))))))
+
+
 (provide 'cl-generic)
 ;;; cl-generic.el ends here
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 1494ed1d9c3..c6ef8d7a99c 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error."
      ((consp func-marker)
       (message "%s is already instrumented." func)
       (list func))
-     ((get func 'cl--generic)
-      (let ((method-defs (method-files func))
+     ((cl-generic-p func)
+      (let ((method-defs (cl--generic-method-files func))
             symbols)
         (unless method-defs
           (error "Could not find any method definitions for %s" func))
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index e6e6d118709..8403a8a655f 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -165,7 +165,8 @@ Summary:
   (if (memq method '(no-next-method no-applicable-method))
       (symbol-function method)
     (let ((generic (cl-generic-ensure-function method)))
-      (symbol-function (cl--generic-name generic)))))
+      (or (symbol-function (cl--generic-name generic))
+          (cl--generic-make-function generic)))))
 
 ;;;###autoload
 (defun eieio--defmethod (method kind argclass code)
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index a05bd7cc4d4..bca40ab87da 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -160,6 +160,10 @@ This is used to determine if `eldoc-idle-delay' is changed by the user.")
 It should receive the same arguments as `message'.")
 
 (defun eldoc-edit-message-commands ()
+  "Return an obarray containing common editing commands.
+
+When `eldoc-print-after-edit' is non-nil, ElDoc messages are only
+printed after commands contained in this obarray."
   (let ((cmds (make-vector 31 0))
 	(re (regexp-opt '("delete" "insert" "edit" "electric" "newline"))))
     (mapatoms (lambda (s)
@@ -211,16 +215,21 @@ expression point is on."
 
 ;;;###autoload
 (defun turn-on-eldoc-mode ()
-  "Turn on `eldoc-mode' if the buffer has eldoc support enabled.
+  "Turn on `eldoc-mode' if the buffer has ElDoc support enabled.
 See `eldoc-documentation-function' for more detail."
   (when (eldoc--supported-p)
     (eldoc-mode 1)))
 
 (defun eldoc--supported-p ()
+  "Non-nil if an ElDoc function is set for this buffer."
   (not (memq eldoc-documentation-function '(nil ignore))))
 
 
 (defun eldoc-schedule-timer ()
+  "Ensure `eldoc-timer' is running.
+
+If the user has changed `eldoc-idle-delay', update the timer to
+reflect the change."
   (or (and eldoc-timer
            (memq eldoc-timer timer-idle-list)) ;FIXME: Why?
       (setq eldoc-timer
@@ -229,8 +238,7 @@ See `eldoc-documentation-function' for more detail."
 	     (lambda ()
                (when (or eldoc-mode
                          (and global-eldoc-mode
-                              (not (memq eldoc-documentation-function
-                                         '(nil ignore)))))
+                              (eldoc--supported-p)))
                  (eldoc-print-current-symbol-info))))))
 
   ;; If user has changed the idle delay, update the timer.
@@ -268,16 +276,19 @@ Otherwise work like `message'."
           (force-mode-line-update)))
     (apply 'message format-string args)))
 
-(defun eldoc-message (&rest args)
+(defun eldoc-message (&optional format-string &rest args)
+  "Display FORMAT-STRING formatted with ARGS as an ElDoc message.
+
+Store the message (if any) in `eldoc-last-message', and return it."
   (let ((omessage eldoc-last-message))
     (setq eldoc-last-message
-	  (cond ((eq (car args) eldoc-last-message) eldoc-last-message)
-		((null (car args)) nil)
+	  (cond ((eq format-string eldoc-last-message) eldoc-last-message)
+		((null format-string) nil)
 		;; If only one arg, no formatting to do, so put it in
 		;; eldoc-last-message so eq test above might succeed on
 		;; subsequent calls.
-		((null (cdr args)) (car args))
-		(t (apply #'format-message args))))
+		((null args) format-string)
+		(t (apply #'format-message format-string args))))
     ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
     ;; are recorded in a log.  Do not put eldoc messages in that log since
     ;; they are Legion.
@@ -289,6 +300,7 @@ Otherwise work like `message'."
   eldoc-last-message)
 
 (defun eldoc--message-command-p (command)
+  "Return non-nil if COMMAND is in `eldoc-message-commands'."
   (and (symbolp command)
        (intern-soft (symbol-name command) eldoc-message-commands)))
 
@@ -299,6 +311,7 @@ Otherwise work like `message'."
 ;; before the next command executes, which does away with the flicker.
 ;; This doesn't seem to be required for Emacs 19.28 and earlier.
 (defun eldoc-pre-command-refresh-echo-area ()
+  "Reprint `eldoc-last-message' in the echo area."
   (and eldoc-last-message
        (not (minibufferp))      ;We don't use the echo area when in minibuffer.
        (if (and (eldoc-display-message-no-interference-p)
@@ -310,6 +323,7 @@ Otherwise work like `message'."
 
 ;; Decide whether now is a good time to display a message.
 (defun eldoc-display-message-p ()
+  "Return non-nil when it is appropriate to display an ElDoc message."
   (and (eldoc-display-message-no-interference-p)
        ;; If this-command is non-nil while running via an idle
        ;; timer, we're still in the middle of executing a command,
@@ -322,6 +336,7 @@ Otherwise work like `message'."
 ;; Check various conditions about the current environment that might make
 ;; it undesirable to print eldoc messages right this instant.
 (defun eldoc-display-message-no-interference-p ()
+  "Return nil if displaying a message would cause interference."
   (not (or executing-kbd-macro (bound-and-true-p edebug-active))))
 
 
@@ -347,6 +362,7 @@ variable) is taken into account if the major mode specific function does not
 return any documentation.")
 
 (defun eldoc-print-current-symbol-info ()
+  "Print the text produced by `eldoc-documentation-function'."
   ;; This is run from post-command-hook or some idle timer thing,
   ;; so we need to be careful that errors aren't ignored.
   (with-demoted-errors "eldoc error: %s"
@@ -361,6 +377,13 @@ return any documentation.")
 ;; truncated or eliminated entirely from the output to make room for the
 ;; description.
 (defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
+  "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
+
+When PREFIX is a symbol, propertize its symbol name with FACE
+before combining it with DOC.  If FACE is not provided, just
+apply the nil face.
+
+See also: `eldoc-echo-area-use-multiline-p'."
   (when (symbolp prefix)
     (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
   (let* ((ea-multi eldoc-echo-area-use-multiline-p)
@@ -390,22 +413,26 @@ return any documentation.")
 ;; These functions do display-command table management.
 
 (defun eldoc-add-command (&rest cmds)
+  "Add each of CMDS to the obarray `eldoc-message-commands'."
   (dolist (name cmds)
     (and (symbolp name)
          (setq name (symbol-name name)))
     (set (intern name eldoc-message-commands) t)))
 
 (defun eldoc-add-command-completions (&rest names)
+  "Pass every prefix completion of NAMES to `eldoc-add-command'."
   (dolist (name names)
     (apply #'eldoc-add-command (all-completions name obarray 'commandp))))
 
 (defun eldoc-remove-command (&rest cmds)
+  "Remove each of CMDS from the obarray `eldoc-message-commands'."
   (dolist (name cmds)
     (and (symbolp name)
          (setq name (symbol-name name)))
     (unintern name eldoc-message-commands)))
 
 (defun eldoc-remove-command-completions (&rest names)
+  "Pass every prefix completion of NAMES to `eldoc-remove-command'."
   (dolist (name names)
     (apply #'eldoc-remove-command
            (all-completions name eldoc-message-commands))))
@@ -418,9 +445,9 @@ return any documentation.")
  "down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-"
  "handle-select-window" "indent-for-tab-command" "left-" "mark-page"
  "mark-paragraph" "mouse-set-point" "move-" "move-beginning-of-"
- "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" "previous-"
- "recenter" "right-" "scroll-" "self-insert-command" "split-window-"
- "up-list")
+ "move-end-of-" "newline" "next-" "other-window" "pop-global-mark"
+ "previous-" "recenter" "right-" "scroll-" "self-insert-command"
+ "split-window-" "up-list")
 
 (provide 'eldoc)
 
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index d4500f131a2..7bdd749d5ab 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -583,6 +583,11 @@ displayed."
   (elp-restore-all)
   ;; continue standard unloading
   nil)
+
+(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun)))
+  "Un-instrument before unloading a function."
+  (elp-restore-function (cdr x)))
+
 
 (provide 'elp)
 
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index cee225cc8e0..d7bd331c11b 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -135,7 +135,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
     ;; Note that nil is still a valid value for the `name' slot in
     ;; ert-test objects.  It designates an anonymous test.
     (error "Attempt to define a test named nil"))
-  (put symbol 'ert--test definition)
+  (define-symbol-prop symbol 'ert--test definition)
   definition)
 
 (defun ert-make-test-unbound (symbol)
@@ -214,12 +214,6 @@ description of valid values for RESULT-TYPE.
                         ,@(when tags-supplied-p
                             `(:tags ,tags))
                         :body (lambda () ,@body)))
-         ;; This hack allows `symbol-file' to associate `ert-deftest'
-         ;; forms with files, and therefore enables `find-function' to
-         ;; work with tests.  However, it leads to warnings in
-         ;; `unload-feature', which doesn't know how to undefine tests
-         ;; and has no mechanism for extension.
-         (push '(ert-deftest . ,name) current-load-list)
          ',name))))
 
 ;; We use these `put' forms in addition to the (declare (indent)) in
@@ -2405,8 +2399,7 @@ To be used in the ERT results buffer."
            (buffer-disable-undo)
            (erase-buffer)
            (ert-simple-view-mode)
-           ;; Use unibyte because `debugger-setup-buffer' also does so.
-           (set-buffer-multibyte nil)
+           (set-buffer-multibyte t)     ; mimic debugger-setup-buffer
            (setq truncate-lines t)
            (ert--print-backtrace backtrace t)
            (goto-char (point-min))
@@ -2539,7 +2532,7 @@ To be used in the ERT results buffer."
           (insert (if test-name (format "%S" test-name) "<anonymous test>"))
           (insert " is a test")
           (let ((file-name (and test-name
-                                (symbol-file test-name 'ert-deftest))))
+                                (symbol-file test-name 'ert--test))))
             (when file-name
               (insert (format-message " defined in `%s'"
                                       (file-name-nondirectory file-name)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4a06ab25d3e..253b60e7534 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -418,8 +418,8 @@ to this macro."
     (when decl (setq body (remove decl body)))
     `(progn
        (defun ,fsym ,args ,@body)
-       (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
-       (put ',name 'pcase-macroexpander #',fsym))))
+       (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
+       (define-symbol-prop ',name 'pcase-macroexpander #',fsym))))
 
 (defun pcase--match (val upat)
   "Build a MATCH structure, hoisting all `or's and `and's outside."
@@ -930,6 +930,5 @@ QPAT can take the following forms:
    ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
    (t (error "Unknown QPAT: %S" qpat))))
 
-
 (provide 'pcase)
 ;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 386232c6eef..b66f2c6d512 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1169,6 +1169,62 @@ enclosed in `(and ...)'.
 	 (rx-to-string `(and ,@regexps) t))
 	(t
 	 (rx-to-string (car regexps) t))))
+
+
+(pcase-defmacro rx (&rest regexps)
+  "Build a `pcase' pattern matching `rx' regexps.
+The REGEXPS are interpreted as by `rx'.  The pattern matches if
+the regular expression so constructed matches the object, as if
+by `string-match'.
+
+In addition to the usual `rx' constructs, REGEXPS can contain the
+following constructs:
+
+  (let VAR FORM...)  creates a new explicitly numbered submatch
+                     that matches FORM and binds the match to
+                     VAR.
+  (backref VAR)      creates a backreference to the submatch
+                     introduced by a previous (let VAR ...)
+                     construct.
+
+The VARs are associated with explicitly numbered submatches
+starting from 1.  Multiple occurrences of the same VAR refer to
+the same submatch.
+
+If a case matches, the match data is modified as usual so you can
+use it in the case body, but you still have to pass the correct
+string as argument to `match-string'."
+  (let* ((vars ())
+         (rx-constituents
+          `((let
+             ,(lambda (form)
+                (rx-check form)
+                (let ((var (cadr form)))
+                  (cl-check-type var symbol)
+                  (let ((i (or (cl-position var vars :test #'eq)
+                               (prog1 (length vars)
+                                 (setq vars `(,@vars ,var))))))
+                    (rx-form `(submatch-n ,(1+ i) ,@(cddr form))))))
+             1 nil)
+            (backref
+             ,(lambda (form)
+                (rx-check form)
+                (rx-backref
+                 `(backref ,(let ((var (cadr form)))
+                              (if (integerp var) var
+                                (1+ (cl-position var vars :test #'eq)))))))
+             1 1
+             ,(lambda (var)
+                (cond ((integerp var) (rx-check-backref var))
+                      ((memq var vars) t)
+                      (t (error "rx `backref' variable must be one of %s: %s"
+                                vars var)))))
+            ,@rx-constituents))
+         (regexp (rx-to-string `(seq ,@regexps) :no-group)))
+    `(and (pred (string-match ,regexp))
+          ,@(cl-loop for i from 1
+                     for var in vars
+                     collect `(app (match-string ,i) ,var)))))
 
 ;; ;; sregex.el replacement