(setq ansi-color-for-comint-mode 'filter))
;;;###autoload
-(defun ansi-color-process-output (ignored)
+(defun ansi-color-process-output (_ignored)
"Maybe translate SGR control sequences of comint output into text properties.
Depending on variable `ansi-color-for-comint-mode' the comint output is
"*Customize Apropos*")))
;;;###autoload
-(defun customize-apropos-options (regexp &optional ignored)
+(defun customize-apropos-options (regexp &optional _ignored)
"Customize all loaded customizable options matching REGEXP."
(interactive (list (apropos-read-pattern "options")))
(customize-apropos regexp 'options))
(widget-create 'push-button
:tag " Revert "
:help-echo "Revert this buffer to its original state."
- :action (lambda (&rest ignored) (revert-buffer)))
+ :action (lambda (&rest _) (revert-buffer)))
(widget-insert "\n\nTheme name : ")
(setq custom-theme-name
. ,(lambda () spec-args))
macroexpand-all-environment)))
(require 'cl-lib) ;Needed to expand `cl-flet' and `cl-function'.
- (when (interactive-form (cadr fun))
+ (when (assq 'interactive body)
(message "Interactive forms unsupported in generic functions: %S"
- (interactive-form (cadr fun))))
+ (assq 'interactive body)))
;; First macroexpand away the cl-function stuff (e.g. &key and
;; destructuring args, `declare' and whatnot).
(pcase (macroexpand fun macroenv)
(pcase-let* ((`(,uses-cnm . ,fun) (cl--generic-lambda args body)))
`(progn
,(and (get name 'byte-obsolete-info)
- (or (not (fboundp 'byte-compile-warning-enabled-p))
- (byte-compile-warning-enabled-p 'obsolete name))
(let* ((obsolete (get name 'byte-obsolete-info)))
(macroexp-warn-and-return
(macroexp--obsolete-warning name obsolete "generic function")
- nil)))
+ nil
+ (list 'obsolete name))))
;; You could argue that `defmethod' modifies rather than defines the
;; function, so warnings like "not known to be defined" are fair game.
;; But in practice, it's common to use `cl-defmethod'
(defvar cl--generic-dispatchers (make-hash-table :test #'equal))
+
+(defvar cl--generic-compiler
+ ;; Don't byte-compile the dispatchers if cl-generic itself is not
+ ;; byte compiled. Otherwise the byte-compiler and all the code on
+ ;; which it depends needs to be usable before cl-generic is loaded,
+ ;; which imposes a significant burden on the bootstrap.
+ (if (byte-code-function-p (lambda (x) (+ x 1)))
+ #'byte-compile (lambda (exp) (eval exp t))))
+
(defun cl--generic-get-dispatcher (dispatch)
(with-memoization
(gethash dispatch cl--generic-dispatchers)
;; FIXME: For generic functions with a single method (or with 2 methods,
;; one of which always matches), using a tagcode + hash-table is
;; overkill: better just use a `cl-typep' test.
- (byte-compile
+ (funcall
+ cl--generic-compiler
`(lambda (generic dispatches-left methods)
;; FIXME: We should find a way to expand `with-memoize' once
;; and forall so we don't need `subr-x' when we get here.
`(,arg-or-context
,@(apply #'append
(mapcar #'cl-generic-generalizers specializers))
- ,cl--generic-t-generalizer))))
+ ,cl--generic-t-generalizer)))
+ ;; When compiling `cl-generic' during bootstrap, make sure
+ ;; we prefill with compiled dispatchers even though the loaded
+ ;; `cl-generic' is still interpreted.
+ (cl--generic-compiler
+ (if (featurep 'bytecomp) #'byte-compile cl--generic-compiler)))
;; Recompute dispatch at run-time, since the generalizers may be slightly
;; different (e.g. byte-compiled rather than interpreted).
;; FIXME: There is a risk that the run-time generalizer is not equivalent
(push 'skip macroexp--pending-eager-loads)
form))
(t
- (condition-case err
- (let ((macroexp--pending-eager-loads
- (cons load-file-name macroexp--pending-eager-loads)))
- (if full-p
- (macroexpand-all form)
- (macroexpand form)))
- (error
- ;; Hopefully this shouldn't happen thanks to the cycle detection,
- ;; but in case it does happen, let's catch the error and give the
- ;; code a chance to macro-expand later.
- (message "Eager macro-expansion failure: %S" err)
- form)))))
+ (let ((macroexp--pending-eager-loads
+ (cons load-file-name macroexp--pending-eager-loads)))
+ (if full-p
+ (macroexpand-all form)
+ (macroexpand form))))))
;; ¡¡¡ Big Ugly Hack !!!
;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
(define-obsolete-function-alias 'syntax-ppss-after-change-function
#'syntax-ppss-flush-cache "27.1")
-(defun syntax-ppss-flush-cache (beg &rest ignored)
+(defun syntax-ppss-flush-cache (beg &rest _)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
(unless syntax-propertize--inhibit-flush
defaults to `point-min'."
(overlays-at (or pos (point-min))))
-(defun tabulated-list-revert (&rest ignored)
+(defun tabulated-list-revert (&rest _)
"The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(interactive)
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
- (let (all-vars risky-vars unsafe-vars ignored)
+ (let (all-vars risky-vars unsafe-vars)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
"Return dotted pair (RES . 1)."
(cons res 1))
-(defun ido-choose-completion-string (choice &rest ignored)
+(defun ido-choose-completion-string (choice &rest _)
(when (ido-active)
;; Insert the completion into the buffer where completion was requested.
(and ido-completion-buffer
(load "emacs-lisp/nadvice")
(load "obarray") ;abbrev.el is implemented in terms of obarrays.
(load "abbrev") ;lisp-mode.el and simple.el use define-abbrev-table.
-(load "simple")
-
(load "help")
(load "jka-cmpr-hook")
(let ((max-specpdl-size (max max-specpdl-size 1800)))
;; A particularly demanding file to load; 1600 does not seem to be enough.
(load "emacs-lisp/cl-generic"))
+(load "simple")
(load "minibuffer") ;Needs cl-generic (and define-minor-mode).
(load "frame")
(load "startup")
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(declare-function widget-convert "wid-edit" (type &rest args))
(declare-function shell-mode "shell" ())
(with-suppressed-warnings ((interactive-only execute-extended-command))
(execute-extended-command prefixarg command-name typed)))
+(cl-defgeneric function-docstring (function)
+ "Extract the raw docstring info from FUNCTION.
+FUNCTION is expected to be a function value rather than, say, a mere symbol."
+ (pcase function
+ ((pred byte-code-function-p)
+ (if (> (length function) 4) (aref function 4)))
+ ((or (pred stringp) (pred vectorp)) "Keyboard macro.")
+ (`(keymap . ,_)
+ "Prefix command (definition is a keymap associating keystrokes with commands).")
+ ((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
+ `(autoload ,_file . ,body))
+ (let ((doc (car body)))
+ (when (and (or (stringp doc)
+ (fixnump doc) (fixnump (cdr-safe doc)))
+ ;; Handle a doc reference--but these never come last
+ ;; in the function body, so reject them if they are last.
+ (cdr body))
+ doc)))
+ (_ (signal 'invalid-function))))
+
+(cl-defgeneric interactive-form (cmd)
+ "Return the interactive form of CMD or nil if none.
+If CMD is not a command, the return value is nil.
+Value, if non-nil, is a list (interactive SPEC)."
+ (let ((fun (indirect-function cmd))) ;Check cycles.
+ (when fun
+ (named-let loop ((fun cmd))
+ (pcase fun
+ ((pred symbolp)
+ (or (get fun 'interactive-form)
+ (loop (symbol-function fun))))
+ ((pred byte-code-function-p)
+ (when (> (length fun) 5)
+ (let ((form (aref fun 5)))
+ (if (vectorp form)
+ ;; The vector form is the new form, where the first
+ ;; element is the interactive spec, and the second is the
+ ;; command modes.
+ (list 'interactive (aref form 0))
+ (list 'interactive form)))))
+ ((pred autoloadp)
+ (interactive-form (autoload-do-load fun cmd)))
+ ((or `(lambda ,_args . ,body)
+ `(closure ,_env ,_args . ,body))
+ (let ((spec (assq 'interactive body)))
+ (if (cddr spec)
+ ;; Drop the "applicable modes" info.
+ (list 'interactive (cadr spec))
+ spec)))
+ (_ (internal--interactive-form fun)))))))
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
Lisp_Object up_event = Qnil;
/* Set SPECS to the interactive form, or barf if not interactive. */
- Lisp_Object form = Finteractive_form (function);
+ Lisp_Object form = call1 (Qinteractive_form, function);
if (! CONSP (form))
wrong_type_argument (Qcommandp, function);
Lisp_Object specs = Fcar (XCDR (form));
#endif
-DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
- doc: /* Return the interactive form of CMD or nil if none.
+DEFUN ("internal--interactive-form", Finternal__interactive_form, Sinternal__interactive_form, 1, 1, 0,
+ doc: /* Return the interactive form of FUN or nil if none.
If CMD is not a command, the return value is nil.
Value, if non-nil, is a list (interactive SPEC). */)
- (Lisp_Object cmd)
+ (Lisp_Object fun)
{
- Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
-
- if (NILP (fun))
- return Qnil;
-
- /* Use an `interactive-form' property if present, analogous to the
- function-documentation property. */
- fun = cmd;
- while (SYMBOLP (fun))
- {
- Lisp_Object tmp = Fget (fun, Qinteractive_form);
- if (!NILP (tmp))
- return tmp;
- else
- fun = Fsymbol_function (fun);
- }
-
if (SUBRP (fun))
{
if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec))
(*spec != '(') ? build_string (spec) :
Fcar (Fread_from_string (build_string (spec), Qnil, Qnil)));
}
- else if (COMPILEDP (fun))
- {
- if (PVSIZE (fun) > COMPILED_INTERACTIVE)
- {
- Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
- if (VECTORP (form))
- /* The vector form is the new form, where the first
- element is the interactive spec, and the second is the
- command modes. */
- return list2 (Qinteractive, AREF (form, 0));
- else
- /* Old form -- just the interactive spec. */
- return list2 (Qinteractive, form);
- }
- }
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
{
return form;
}
#endif
- else if (AUTOLOADP (fun))
- return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
- else if (CONSP (fun))
- {
- Lisp_Object funcar = XCAR (fun);
- if (EQ (funcar, Qclosure)
- || EQ (funcar, Qlambda))
- {
- Lisp_Object form = Fcdr (XCDR (fun));
- if (EQ (funcar, Qclosure))
- form = Fcdr (form);
- Lisp_Object spec = Fassq (Qinteractive, form);
- if (NILP (Fcdr (Fcdr (spec))))
- return spec;
- else
- return list2 (Qinteractive, Fcar (Fcdr (spec)));
- }
- }
return Qnil;
}
DEFSYM (Qbyte_code_function_p, "byte-code-function-p");
defsubr (&Sindirect_variable);
- defsubr (&Sinteractive_form);
+ defsubr (&Sinternal__interactive_form);
defsubr (&Scommand_modes);
defsubr (&Seq);
defsubr (&Snull);
xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
+ /* FIXME: The code for subrs and module functions should be
+ in `function-docstring`. */
#ifdef HAVE_NATIVE_COMP
if (!NILP (Fsubr_native_elisp_p (fun)))
doc = native_function_doc (fun);
else if (MODULE_FUNCTIONP (fun))
doc = module_function_documentation (XMODULE_FUNCTION (fun));
#endif
- else if (COMPILEDP (fun))
- {
- if (PVSIZE (fun) <= COMPILED_DOC_STRING)
- return Qnil;
- else
- {
- Lisp_Object tem = AREF (fun, COMPILED_DOC_STRING);
- if (STRINGP (tem))
- doc = tem;
- else if (FIXNATP (tem) || CONSP (tem))
- doc = tem;
- else
- return Qnil;
- }
- }
- else if (STRINGP (fun) || VECTORP (fun))
- {
- return build_string ("Keyboard macro.");
- }
- else if (CONSP (fun))
- {
- Lisp_Object funcar = XCAR (fun);
- if (!SYMBOLP (funcar))
- xsignal1 (Qinvalid_function, fun);
- else if (EQ (funcar, Qkeymap))
- return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
- else if (EQ (funcar, Qlambda)
- || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1))
- || EQ (funcar, Qautoload))
- {
- Lisp_Object tem1 = Fcdr (Fcdr (fun));
- Lisp_Object tem = Fcar (tem1);
- if (STRINGP (tem))
- doc = tem;
- /* Handle a doc reference--but these never come last
- in the function body, so reject them if they are last. */
- else if ((FIXNATP (tem) || (CONSP (tem) && FIXNUMP (XCDR (tem))))
- && !NILP (XCDR (tem1)))
- doc = tem;
- else
- return Qnil;
- }
- else
- goto oops;
- }
else
- {
- oops:
- xsignal1 (Qinvalid_function, fun);
- }
+ doc = call1 (intern ("function-docstring"), fun);
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
(Lisp_Object function, Lisp_Object for_call_interactively)
{
register Lisp_Object fun;
- register Lisp_Object funcar;
- Lisp_Object if_prop = Qnil;
+ bool genfun = false;
fun = function;
if (NILP (fun))
return Qnil;
- /* Check an `interactive-form' property if present, analogous to the
- function-documentation property. */
- fun = function;
- while (SYMBOLP (fun))
- {
- Lisp_Object tmp = Fget (fun, Qinteractive_form);
- if (!NILP (tmp))
- if_prop = Qt;
- fun = Fsymbol_function (fun);
- }
-
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
if (SUBRP (fun))
- return XSUBR (fun)->intspec ? Qt : if_prop;
-
+ {
+ if (XSUBR (fun)->intspec)
+ return Qt;
+ }
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
else if (COMPILEDP (fun))
- return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
+ {
+ if (PVSIZE (fun) > COMPILED_INTERACTIVE)
+ return Qt;
+ else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+ genfun = true;
+ }
#ifdef HAVE_MODULES
/* Module functions are interactive if their `interactive_form'
field is non-nil. */
else if (MODULE_FUNCTIONP (fun))
- return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
- ? if_prop
- : Qt;
+ {
+ if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))))
+ return Qt;
+ }
#endif
/* Strings and vectors are keyboard macros. */
- if (STRINGP (fun) || VECTORP (fun))
+ else if (STRINGP (fun) || VECTORP (fun))
return (NILP (for_call_interactively) ? Qt : Qnil);
/* Lists may represent commands. */
- if (!CONSP (fun))
+ else if (!CONSP (fun))
return Qnil;
- funcar = XCAR (fun);
- if (EQ (funcar, Qclosure))
- return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
- ? Qt : if_prop);
- else if (EQ (funcar, Qlambda))
- return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
- else if (EQ (funcar, Qautoload))
- return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
+ else
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qautoload))
+ {
+ if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))))
+ return Qt;
+ }
+ else
+ {
+ Lisp_Object body = CDR_SAFE (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ body = CDR_SAFE (body);
+ else if (!EQ (funcar, Qlambda))
+ return Qnil;
+ if (!NILP (Fassq (Qinteractive, body)))
+ return Qt;
+ else
+ {
+ body = CAR_SAFE (body);
+ if (!NILP (CDR_SAFE (body))
+ && (STRINGP (body) || FIXNUMP (body) ||
+ FIXNUMP (CDR_SAFE (body))))
+ genfun = true;
+ }
+ }
+ }
+
+ /* By now, if it's not a function we already returned nil. */
+
+ /* Check an `interactive-form' property if present, analogous to the
+ function-documentation property. */
+ fun = function;
+ while (SYMBOLP (fun))
+ {
+ Lisp_Object tmp = Fget (fun, Qinteractive_form);
+ if (!NILP (tmp))
+ return Qt;
+ fun = Fsymbol_function (fun);
+ }
+
+ /* If there's no immdiate interactive form but there's a docstring,
+ then delegate to the generic-function in case it's an FCR with
+ a type-specific interactive-form. */
+ if (genfun
+ /* Avoid burping during bootstrap. */
+ && !NILP (Fsymbol_function (Qinteractive_form)))
+ {
+ Lisp_Object iform = call1 (Qinteractive_form, fun);
+ return NILP (iform) ? Qnil : Qt;
+ }
else
return Qnil;
}
projects / emacs.git / commitdiff