Merge remote-tracking branch 'savannah/master' into HEAD
This commit is contained in:
Andrea Corallo
commit
d0a504f5c4
16 changed files with 250 additions and 309 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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'."
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue