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

2 files changed, 76 insertions, 72 deletions

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 4c2f58907de..954731b06b8 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -75,7 +75,7 @@
 ;; one, you may want to amend the other, too.
 ;;;###autoload
 (define-obsolete-function-alias 'cl--compiler-macro-cXXr
-  'internal--compiler-macro-cXXr "25.1")
+  #'internal--compiler-macro-cXXr "25.1")
 
 ;;; Some predicates for analyzing Lisp forms.
 ;; These are used by various
@@ -328,8 +328,7 @@ FORM is of the form (ARGS . BODY)."
                 (setq cl--bind-lets (nreverse cl--bind-lets))
                 ;; (cl-assert (eq :dummy (nth 1 (car cl--bind-lets))))
                 (list '&rest (car (pop cl--bind-lets))))))))
-      `(nil
-        (,@(nreverse simple-args) ,@rest-args)
+      `((,@(nreverse simple-args) ,@rest-args)
         ,@header
         ,(macroexp-let* cl--bind-lets
                         (macroexp-progn
@@ -366,9 +365,7 @@ more details.
                      def-body))
            (doc-string 3)
            (indent 2))
-  (let* ((res (cl--transform-lambda (cons args body) name))
-	 (form `(defun ,name ,@(cdr res))))
-    (if (car res) `(progn ,(car res) ,form) form)))
+  `(defun ,name ,@(cl--transform-lambda (cons args body) name)))
 
 ;;;###autoload
 (defmacro cl-iter-defun (name args &rest body)
@@ -387,9 +384,7 @@ and BODY is implicitly surrounded by (cl-block NAME ...).
            (doc-string 3)
            (indent 2))
   (require 'generator)
-  (let* ((res (cl--transform-lambda (cons args body) name))
-         (form `(iter-defun ,name ,@(cdr res))))
-    (if (car res) `(progn ,(car res) ,form) form)))
+  `(iter-defun ,name ,@(cl--transform-lambda (cons args body) name)))
 
 ;; The lambda list for macros is different from that of normal lambdas.
 ;; Note that &environment is only allowed as first or last items in the
@@ -455,9 +450,7 @@ more details.
             (&define name cl-macro-list cl-declarations-or-string def-body))
            (doc-string 3)
            (indent 2))
-  (let* ((res (cl--transform-lambda (cons args body) name))
-	 (form `(defmacro ,name ,@(cdr res))))
-    (if (car res) `(progn ,(car res) ,form) form)))
+  `(defmacro ,name ,@(cl--transform-lambda (cons args body) name)))
 
 (def-edebug-spec cl-lambda-expr
   (&define ("lambda" cl-lambda-list
@@ -480,9 +473,7 @@ Like normal `function', except that if argument is a lambda form,
 its argument list allows full Common Lisp conventions."
   (declare (debug (&or symbolp cl-lambda-expr)))
   (if (eq (car-safe func) 'lambda)
-      (let* ((res (cl--transform-lambda (cdr func) 'cl-none))
-	     (form `(function (lambda . ,(cdr res)))))
-	(if (car res) `(progn ,(car res) ,form) form))
+      `(function (lambda . ,(cl--transform-lambda (cdr func) 'cl-none)))
     `(function ,func)))
 
 (defun cl--make-usage-var (x)
@@ -723,9 +714,9 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
       (let ((comp (or (memq 'compile when) (memq :compile-toplevel when)))
 	    (cl--not-toplevel t))
 	(if (or (memq 'load when) (memq :load-toplevel when))
-	    (if comp (cons 'progn (mapcar 'cl--compile-time-too body))
+	    (if comp (cons 'progn (mapcar #'cl--compile-time-too body))
 	      `(if nil nil ,@body))
-	  (progn (if comp (eval (cons 'progn body))) nil)))
+	  (progn (if comp (eval (cons 'progn body) lexical-binding)) nil)))
     (and (or (memq 'eval when) (memq :execute when))
 	 (cons 'progn body))))
 
@@ -734,13 +725,13 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level.
       (setq form (macroexpand
 		  form (cons '(cl-eval-when) byte-compile-macro-environment))))
   (cond ((eq (car-safe form) 'progn)
-	 (cons 'progn (mapcar 'cl--compile-time-too (cdr form))))
+	 (cons 'progn (mapcar #'cl--compile-time-too (cdr form))))
 	((eq (car-safe form) 'cl-eval-when)
 	 (let ((when (nth 1 form)))
 	   (if (or (memq 'eval when) (memq :execute when))
 	       `(cl-eval-when (compile ,@when) ,@(cddr form))
 	     form)))
-	(t (eval form) form)))
+	(t (eval form lexical-binding) form)))
 
 ;;;###autoload
 (defmacro cl-load-time-value (form &optional _read-only)
@@ -766,7 +757,7 @@ The result of the body appears to the compiler as a quoted constant."
           ;; temp is set before we use it.
           (print set byte-compile--outbuffer))
 	temp)
-    `',(eval form)))
+    `',(eval form lexical-binding)))
 
 
 ;;; Conditional control structures.
@@ -1504,8 +1495,8 @@ For more details, see Info node `(cl)Loop Facility'.
 	  (pop cl--loop-args))
 	(if (and ands loop-for-bindings)
 	    (push (nreverse loop-for-bindings) cl--loop-bindings)
-	  (setq cl--loop-bindings (nconc (mapcar 'list loop-for-bindings)
-				     cl--loop-bindings)))
+	  (setq cl--loop-bindings (nconc (mapcar #'list loop-for-bindings)
+				         cl--loop-bindings)))
 	(if loop-for-sets
 	    (push `(progn
                      ,(cl--loop-let (nreverse loop-for-sets) 'setq ands)
@@ -1513,7 +1504,7 @@ For more details, see Info node `(cl)Loop Facility'.
                   cl--loop-body))
 	(when loop-for-steps
 	  (push (cons (if ands 'cl-psetq 'setq)
-		      (apply 'append (nreverse loop-for-steps)))
+		      (apply #'append (nreverse loop-for-steps)))
 		cl--loop-steps))))
 
      ((eq word 'repeat)
@@ -1706,7 +1697,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings."
           (push binding new))))
     (if (eq body 'setq)
 	(let ((set (cons (if par 'cl-psetq 'setq)
-                         (apply 'nconc (nreverse new)))))
+                         (apply #'nconc (nreverse new)))))
 	  (if temps `(let* ,(nreverse temps) ,set) set))
       `(,(if par 'let 'let*)
         ,(nconc (nreverse temps) (nreverse new)) ,@body))))
@@ -1832,7 +1823,7 @@ For more details, see `cl-do*' description in Info node `(cl) Iteration'.
             (and sets
                  (list (cons (if (or star (not (cdr sets)))
                                  'setq 'cl-psetq)
-                             (apply 'append sets))))))
+                             (apply #'append sets))))))
       ,@(or (cdr endtest) '(nil)))))
 
 ;;;###autoload
@@ -2111,10 +2102,9 @@ This is like `cl-flet', but for macros instead of functions.
     (if (null bindings) (macroexp-progn body)
       (let* ((name (caar bindings))
 	     (res (cl--transform-lambda (cdar bindings) name)))
-	(eval (car res))
 	(macroexpand-all (macroexp-progn body)
 			 (cons (cons name
-                                     (eval `(cl-function (lambda ,@(cdr res))) t))
+                                     (eval `(function (lambda ,@res)) t))
 			       macroexpand-all-environment))))))
 
 (defun cl--sm-macroexpand (orig-fun exp &optional env)
@@ -2478,7 +2468,7 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
 
 \(fn PLACE...)"
   (declare (debug (&rest place)))
-  (if (not (memq nil (mapcar 'symbolp args)))
+  (if (not (memq nil (mapcar #'symbolp args)))
       (and (cdr args)
 	   (let ((sets nil)
 		 (first (car args)))
@@ -3138,13 +3128,27 @@ Of course, we really can't know that for sure, so it's just a heuristic."
            (or (cdr (assq sym byte-compile-function-environment))
                (cdr (assq sym byte-compile-macro-environment))))))
 
-(put 'null 'cl-deftype-satisfies #'null)
-(put 'atom 'cl-deftype-satisfies #'atom)
-(put 'real 'cl-deftype-satisfies #'numberp)
-(put 'fixnum 'cl-deftype-satisfies #'integerp)
-(put 'base-char 'cl-deftype-satisfies #'characterp)
-(put 'character 'cl-deftype-satisfies #'natnump)
-
+(pcase-dolist (`(,type . ,pred)
+               '((null		. null)
+                 (atom		. atom)
+                 (real		. numberp)
+                 (fixnum	. integerp)
+                 (base-char	. characterp)
+                 (character	. natnump)
+                 ;; "Obvious" mappings.
+                 (string	. stringp)
+                 (list		. listp)
+                 (symbol	. symbolp)
+                 (function	. functionp)
+                 (integer	. integerp)
+                 (float		. floatp)
+                 (boolean	. booleanp)
+                 (vector	. vectorp)
+                 (array		. arrayp)
+                 ;; FIXME: Do we really want to consider this a type?
+                 (integer-or-marker . integer-or-marker-p)
+                 ))
+  (put type 'cl-deftype-satisfies pred))
 
 ;;;###autoload
 (define-inline cl-typep (val type)
@@ -3213,7 +3217,10 @@ STRING is an optional description of the desired type."
        (macroexp-let2 macroexp-copyable-p temp form
          `(progn (or (cl-typep ,temp ',type)
                      (signal 'wrong-type-argument
-                             (list ,(or string `',type) ,temp ',form)))
+                             (list ,(or string `',(if (eq 'satisfies
+                                                          (car-safe type))
+                                                      (cadr type) type))
+                                   ,temp ',form)))
                  nil))))
 
 ;;;###autoload
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6e35018b100..4a2e7488eb0 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -32,13 +32,9 @@
 ;; the one-line documentation for that variable instead, to remind you of
 ;; that variable's meaning.
 
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;;      (add-hook 'emacs-lisp-mode-hook 'eldoc-mode)
-;;      (add-hook 'lisp-interaction-mode-hook 'eldoc-mode)
-;;      (add-hook 'ielm-mode-hook 'eldoc-mode)
-;;      (add-hook 'eval-expression-minibuffer-setup-hook 'eldoc-mode)
+;; This mode is now enabled by default in all major modes that provide
+;; support for it, such as `emacs-lisp-mode'.
+;; This is controlled by `global-eldoc-mode'.
 
 ;; Major modes for other languages may use ElDoc by adding an
 ;; appropriate function to the buffer-local value of
@@ -57,20 +53,17 @@ If user input arrives before this interval of time has elapsed after the
 last input, no documentation will be printed.
 
 If this variable is set to 0, no idle time is required."
-  :type 'number
-  :group 'eldoc)
+  :type 'number)
 
 (defcustom eldoc-print-after-edit nil
   "If non-nil eldoc info is only shown when editing.
 Changing the value requires toggling `eldoc-mode'."
-  :type 'boolean
-  :group 'eldoc)
+  :type 'boolean)
 
 ;;;###autoload
 (defcustom eldoc-minor-mode-string (purecopy " ElDoc")
   "String to display in mode line when ElDoc Mode is enabled; nil for none."
-  :type '(choice string (const :tag "None" nil))
-  :group 'eldoc)
+  :type '(choice string (const :tag "None" nil)))
 
 (defcustom eldoc-argument-case #'identity
   "Case to display argument names of functions, as a symbol.
@@ -82,8 +75,7 @@ Note that this variable has no effect, unless
 `eldoc-documentation-function' handles it explicitly."
   :type '(radio (function-item upcase)
 		(function-item downcase)
-                function)
-  :group 'eldoc)
+                function))
 (make-obsolete-variable 'eldoc-argument-case nil "25.1")
 
 (defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
@@ -106,15 +98,13 @@ Note that this variable has no effect, unless
   :type '(radio (const :tag "Always" t)
                 (const :tag "Never" nil)
                 (const :tag "Yes, but truncate symbol names if it will\
- enable argument list to fit on one line" truncate-sym-name-if-fit))
-  :group 'eldoc)
+ enable argument list to fit on one line" truncate-sym-name-if-fit)))
 
 (defface eldoc-highlight-function-argument
   '((t (:inherit bold)))
   "Face used for the argument at point in a function's argument list.
 Note that this face has no effect unless the `eldoc-documentation-function'
-handles it explicitly."
-  :group 'eldoc)
+handles it explicitly.")
 
 ;;; No user options below here.
 
@@ -182,8 +172,7 @@ area displays information about a function or variable in the
 text where point is.  If point is on a documented variable, it
 displays the first line of that variable's doc string.  Otherwise
 it displays the argument list of the function called in the
-expression point is on."
-  :group 'eldoc :lighter eldoc-minor-mode-string
+expression point is on." :lighter eldoc-minor-mode-string
   (setq eldoc-last-message nil)
   (cond
    ((not (eldoc--supported-p))
@@ -193,19 +182,18 @@ expression point is on."
    (eldoc-mode
     (when eldoc-print-after-edit
       (setq-local eldoc-message-commands (eldoc-edit-message-commands)))
-    (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
-    (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area nil t))
+    (add-hook 'post-command-hook #'eldoc-schedule-timer nil t)
+    (add-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area nil t))
    (t
     (kill-local-variable 'eldoc-message-commands)
-    (remove-hook 'post-command-hook 'eldoc-schedule-timer t)
-    (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t)
+    (remove-hook 'post-command-hook #'eldoc-schedule-timer t)
+    (remove-hook 'pre-command-hook #'eldoc-pre-command-refresh-echo-area t)
     (when eldoc-timer
       (cancel-timer eldoc-timer)
       (setq eldoc-timer nil)))))
 
 ;;;###autoload
 (define-globalized-minor-mode global-eldoc-mode eldoc-mode turn-on-eldoc-mode
-  :group 'eldoc
   :initialize 'custom-initialize-delay
   :init-value t
   ;; For `read--expression', the usual global mode mechanism of
@@ -284,7 +272,7 @@ Otherwise work like `message'."
                 (when (stringp format-string)
                   (apply #'format-message format-string args)))
           (force-mode-line-update)))
-    (apply 'message format-string args)))
+    (apply #'message format-string args)))
 
 (defun eldoc-message (&optional string)
   "Display STRING as an ElDoc message if it's non-nil.
@@ -292,9 +280,7 @@ Otherwise work like `message'."
 Also store it in `eldoc-last-message' and return that value."
   (let ((omessage eldoc-last-message))
     (setq eldoc-last-message string)
-    ;; 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.
+    ;; Do not put eldoc messages in the log since they are Legion.
     ;; Emacs way of preventing log messages.
     (let ((message-log-max nil))
       (cond (eldoc-last-message
@@ -307,12 +293,15 @@ Also store it in `eldoc-last-message' and return that value."
   (and (symbolp command)
        (intern-soft (symbol-name command) eldoc-message-commands)))
 
-;; This function goes on pre-command-hook for XEmacs or when using idle
-;; timers in Emacs.  Motion commands clear the echo area for some reason,
+;; This function goes on pre-command-hook.
+;; Motion commands clear the echo area for some reason,
 ;; which make eldoc messages flicker or disappear just before motion
 ;; begins.  This function reprints the last eldoc message immediately
 ;; before the next command executes, which does away with the flicker.
 ;; This doesn't seem to be required for Emacs 19.28 and earlier.
+;; FIXME: The above comment suggests we don't really understand why
+;; this is needed.  Maybe it's not needed any more, but if it is
+;; we should figure out why.
 (defun eldoc-pre-command-refresh-echo-area ()
   "Reprint `eldoc-last-message' in the echo area."
   (and eldoc-last-message
@@ -385,7 +374,7 @@ Meant as a value for `eldoc-documentation-function'."
 (defcustom eldoc-documentation-function #'eldoc-documentation-default
   "Function to call to return doc string.
 The function of no args should return a one-line string for displaying
-doc about a function etc. appropriate to the context around point.
+doc about a function etc.  appropriate to the context around point.
 It should return nil if there's no doc appropriate for the context.
 Typically doc is returned if point is on a function-like name or in its
 arg list.
@@ -398,13 +387,21 @@ effect."
   :type '(radio (function-item eldoc-documentation-default)
                 (function-item eldoc-documentation-compose)
                 (function :tag "Other function"))
-  :version "28.1"
-  :group 'eldoc)
+  :version "28.1")
 
 (defun eldoc--supported-p ()
   "Non-nil if an ElDoc function is set for this buffer."
   (and (not (memq eldoc-documentation-function '(nil ignore)))
-       eldoc-documentation-functions))
+       (or eldoc-documentation-functions
+           ;; The old API had major modes set `eldoc-documentation-function'
+           ;; to provide eldoc support.  It's impossible now to determine
+           ;; reliably whether the `eldoc-documentation-function' provides
+           ;; eldoc support (as in the old API) or whether it just provides
+           ;; a way to combine the results of the
+           ;; `eldoc-documentation-functions' (as in the new API).
+           ;; But at least if it's set buffer-locally it's a good hint that
+           ;; there's some eldoc support in the current buffer.
+           (local-variable-p 'eldoc-documentation-function))))
 
 (defun eldoc-print-current-symbol-info ()
   "Print the text produced by `eldoc-documentation-function'."