(defmacro ad-get-advice-info-macro (function)
`(get ,function 'ad-advice-info))
-(defmacro ad-set-advice-info (function advice-info)
- `(put ,function 'ad-advice-info ,advice-info))
+(defsubst ad-set-advice-info (function advice-info)
+ (cond
+ (advice-info (put function 'defalias-fset-function #'ad--defalias-fset))
+ ((get function 'defalias-fset-function)
+ (put function 'defalias-fset-function nil)))
+ (put function 'ad-advice-info advice-info))
(defmacro ad-copy-advice-info (function)
`(copy-tree (get ,function 'ad-advice-info)))
;; @@ Dealing with automatic advice activation via `fset/defalias':
;; ================================================================
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
+;; Automatic activation happens when a function gets defined via `defalias',
+;; which calls the `defalias-fset-function' (which we set to
+;; `ad--defalias-fset') instead of `fset', if non-nil.
-;; The functionality of the new `fset' is as follows:
-;;
-;; fset(sym,newdef)
-;; assign NEWDEF to SYM
-;; if (get SYM 'ad-advice-info)
-;; ad-activate-internal(SYM, nil)
-;; return (symbol-function SYM)
-;;
;; Whether advised definitions created by automatic activations will be
;; compiled depends on the value of `ad-default-compilation-action'.
;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
;; appropriate, especially in a safe version of `fset'.
+(defun ad--defalias-fset (function definition)
+ (fset function definition)
+ (ad-activate-internal function nil))
+
;; For now define `ad-activate-internal' to the dummy definition:
(defun ad-activate-internal (_function &optional _compile)
"Automatic advice activation is disabled. `ad-start-advice' enables it."
`(let ((ad-activate-on-top-level nil))
,@body))
-(defun ad-safe-fset (symbol definition)
- "A safe `fset' which will never call `ad-activate-internal' recursively."
- (ad-with-auto-activation-disabled
- (fset symbol definition)))
-
-
;; @@ Access functions for original definitions:
;; ============================================
;; The advice-info of an advised function contains its `origname' which is
(symbol-function origname))))
(defmacro ad-set-orig-definition (function definition)
- `(ad-safe-fset
- (ad-get-advice-info-field ,function 'origname) ,definition))
+ `(fset (ad-get-advice-info-field ,function 'origname) ,definition))
(defmacro ad-clear-orig-definition (function)
`(fmakunbound (ad-get-advice-info-field ,function 'origname)))
(ad-set-advice-info function old-advice-info)
;; Don't `fset' function to nil if it was previously unbound:
(if function-defined-p
- (ad-safe-fset function old-definition)
+ (fset function old-definition)
(fmakunbound function)))))
(error
"ad-make-freeze-definition: `%s' is not yet defined"
function))
- (let* ((name (ad-advice-name advice))
- ;; With a unique origname we can have multiple freeze advices
- ;; for the same function, each overloading the previous one:
- (unique-origname
- (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
- (orig-definition
- ;; If FUNCTION is already advised, we'll use its current origdef
- ;; as the original definition of the frozen advice:
- (or (ad-get-orig-definition function)
- (symbol-function function)))
- (old-advice-info
- (if (ad-is-advised function)
- (ad-copy-advice-info function)))
- (real-docstring-fn
- (symbol-function 'ad-make-advised-definition-docstring))
- (real-origname-fn
- (symbol-function 'ad-make-origname))
- (frozen-definition
- (unwind-protect
- (progn
- ;; Make sure we construct a proper docstring:
- (ad-safe-fset 'ad-make-advised-definition-docstring
- 'ad-make-freeze-docstring)
- ;; Make sure `unique-origname' is used as the origname:
- (ad-safe-fset 'ad-make-origname (lambda (_x) unique-origname))
- ;; No we reset all current advice information to nil and
- ;; generate an advised definition that's solely determined
- ;; by ADVICE and the current origdef of FUNCTION:
- (ad-set-advice-info function nil)
- (ad-add-advice function advice class position)
- ;; The following will provide proper real docstrings as
- ;; well as a definition that will make the compiler happy:
- (ad-set-orig-definition function orig-definition)
- (ad-make-advised-definition function))
- ;; Restore the old advice state:
- (ad-set-advice-info function old-advice-info)
- ;; Restore functions:
- (ad-safe-fset
- 'ad-make-advised-definition-docstring real-docstring-fn)
- (ad-safe-fset 'ad-make-origname real-origname-fn))))
+ (cl-letf*
+ ((name (ad-advice-name advice))
+ ;; With a unique origname we can have multiple freeze advices
+ ;; for the same function, each overloading the previous one:
+ (unique-origname
+ (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
+ (orig-definition
+ ;; If FUNCTION is already advised, we'll use its current origdef
+ ;; as the original definition of the frozen advice:
+ (or (ad-get-orig-definition function)
+ (symbol-function function)))
+ (old-advice-info
+ (if (ad-is-advised function)
+ (ad-copy-advice-info function)))
+ ;; Make sure we construct a proper docstring:
+ ((symbol-function 'ad-make-advised-definition-docstring)
+ #'ad-make-freeze-docstring)
+ ;; Make sure `unique-origname' is used as the origname:
+ ((symbol-function 'ad-make-origname) (lambda (_x) unique-origname))
+ (frozen-definition
+ (unwind-protect
+ (progn
+ ;; No we reset all current advice information to nil and
+ ;; generate an advised definition that's solely determined
+ ;; by ADVICE and the current origdef of FUNCTION:
+ (ad-set-advice-info function nil)
+ (ad-add-advice function advice class position)
+ ;; The following will provide proper real docstrings as
+ ;; well as a definition that will make the compiler happy:
+ (ad-set-orig-definition function orig-definition)
+ (ad-make-advised-definition function))
+ ;; Restore the old advice state:
+ (ad-set-advice-info function old-advice-info))))
(if frozen-definition
(let* ((macro-p (ad-macro-p frozen-definition))
(body (cdr (if macro-p
(ad-lambdafy frozen-definition)
- frozen-definition))))
+ frozen-definition))))
`(progn
- (if (not (fboundp ',unique-origname))
- (fset ',unique-origname
- ;; avoid infinite recursion in case the function
- ;; we want to freeze is already advised:
- (or (ad-get-orig-definition ',function)
- (symbol-function ',function))))
- (,(if macro-p 'defmacro 'defun)
- ,function
- ,@body))))))
+ (if (not (fboundp ',unique-origname))
+ (fset ',unique-origname
+ ;; avoid infinite recursion in case the function
+ ;; we want to freeze is already advised:
+ (or (ad-get-orig-definition ',function)
+ (symbol-function ',function))))
+ (,(if macro-p 'defmacro 'defun)
+ ,function
+ ,@body))))))
;; @@ Activation and definition handling:
(let ((verified-cached-definition
(if (ad-verify-cache-id function)
(ad-get-cache-definition function))))
- (ad-safe-fset function
+ (fset function
(or verified-cached-definition
(ad-make-advised-definition function)))
(if (ad-should-compile function compile)
(error "ad-handle-definition (see its doc): `%s' %s"
function "invalidly redefined")
(if (eq ad-redefinition-action 'discard)
- (ad-safe-fset function original-definition)
+ (fset function original-definition)
(ad-set-orig-definition function current-definition)
(if (eq ad-redefinition-action 'warn)
(message "ad-handle-definition: `%s' got redefined"
(if (not (ad-get-orig-definition function))
(error "ad-deactivate: `%s' has no original definition"
function)
- (ad-safe-fset function (ad-get-orig-definition function))
+ (fset function (ad-get-orig-definition function))
(ad-set-advice-info-field function 'active nil)
(eval (ad-make-hook-form function 'deactivation))
function)))))
(completing-read "Recover advised function: " obarray nil t))))
(cond ((ad-is-advised function)
(cond ((ad-get-orig-definition function)
- (ad-safe-fset function (ad-get-orig-definition function))
+ (fset function (ad-get-orig-definition function))
(ad-clear-orig-definition function)))
(ad-set-advice-info function nil)
(ad-pop-advised-function function))))
(setq index -1)
(mapcar (lambda (function)
(setq index (1+ index))
- `(ad-safe-fset
- ',function
+ `(fset ',function
(or (ad-get-orig-definition ',function)
,(car (nth index current-bindings)))))
functions))
(setq index -1)
(mapcar (lambda (function)
(setq index (1+ index))
- `(ad-safe-fset
- ',function
+ `(fset ',function
,(car (nth index current-bindings))))
functions))))))
(interactive)
;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate))
+ (fset 'ad-activate-internal 'ad-activate))
(defun ad-stop-advice ()
"Stop the automatic advice handling magic.
(interactive)
;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off))
+ (fset 'ad-activate-internal 'ad-activate-internal-off))
(defun ad-recover-normality ()
"Undo all advice related redefinitions and unadvises everything.
(interactive)
;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil)
- (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)
+ (fset 'ad-activate-internal 'ad-activate-internal-off)
(ad-recover-all)
(ad-do-advised-functions (function)
(message "Oops! Left over advised function %S" function)
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
static Lisp_Object Qdefun;
-Lisp_Object Qinteractive_form;
+Lisp_Object Qinteractive_form, Qdefalias_fset_function;
static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
}
\f
-/* Extract and set components of lists */
+/* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil.
(register Lisp_Object symbol, Lisp_Object definition)
{
register Lisp_Object function;
-
CHECK_SYMBOL (symbol);
- if (NILP (symbol) || EQ (symbol, Qt))
- xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function;
if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
- if (CONSP (function) && EQ (XCAR (function), Qautoload))
+ if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function));
set_symbol_function (symbol, definition);
- /* Handle automatic advice activation. */
- if (CONSP (XSYMBOL (symbol)->plist)
- && !NILP (Fget (symbol, Qad_advice_info)))
- {
- call2 (Qad_activate_internal, symbol, Qnil);
- definition = XSYMBOL (symbol)->function;
- }
+
return definition;
}
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{
CHECK_SYMBOL (symbol);
- if (CONSP (XSYMBOL (symbol)->function)
- && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
- LOADHIST_ATTACH (Fcons (Qt, symbol));
if (!NILP (Vpurify_flag)
/* If `definition' is a keymap, immutable (and copying) is wrong. */
&& !KEYMAPP (definition))
definition = Fpurecopy (definition);
- definition = Ffset (symbol, definition);
- LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+
+ {
+ bool autoload = AUTOLOADP (definition);
+ if (NILP (Vpurify_flag) || !autoload)
+ { /* Only add autoload entries after dumping, because the ones before are
+ not useful and else we get loads of them from the loaddefs.el. */
+
+ if (AUTOLOADP (XSYMBOL (symbol)->function))
+ /* Remember that the function was already an autoload. */
+ LOADHIST_ATTACH (Fcons (Qt, symbol));
+ LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
+ }
+ }
+
+ { /* Handle automatic advice activation. */
+ Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
+ if (!NILP (hook))
+ call2 (hook, symbol, definition);
+ else
+ Ffset (symbol, definition);
+ }
+
if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring);
/* We used to return `definition', but now that `defun' and `defmacro' expand
CHECK_SUBR (subr);
minargs = XSUBR (subr)->min_args;
maxargs = XSUBR (subr)->max_args;
- if (maxargs == MANY)
- return Fcons (make_number (minargs), Qmany);
- else if (maxargs == UNEVALLED)
- return Fcons (make_number (minargs), Qunevalled);
- else
- return Fcons (make_number (minargs), make_number (maxargs));
+ return Fcons (make_number (minargs),
+ maxargs == MANY ? Qmany
+ : maxargs == UNEVALLED ? Qunevalled
+ : make_number (maxargs));
}
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
return Qnil;
/* Use an `interactive-form' property if present, analogous to the
- function-documentation property. */
+ function-documentation property. */
fun = cmd;
while (SYMBOLP (fun))
{
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
}
+ else if (AUTOLOADP (fun))
+ return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
else if (CONSP (fun))
{
Lisp_Object funcar = XCAR (fun);
return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
- else if (EQ (funcar, Qautoload))
- {
- struct gcpro gcpro1;
- GCPRO1 (cmd);
- Fautoload_do_load (fun, cmd, Qnil);
- UNGCPRO;
- return Finteractive_form (cmd);
- }
}
return Qnil;
}
return arith_driver (Amult, nargs, args);
}
-DEFUN ("/", Fquo, Squo, 2, MANY, 0,
+DEFUN ("/", Fquo, Squo, 1, MANY, 0,
doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers.
-usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */)
+usage: (/ DIVIDEND &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t argnum;
DEFSYM (Qfont_object, "font-object");
DEFSYM (Qinteractive_form, "interactive-form");
+ DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form);
projects / emacs.git / commitdiff