Commit 32e5c58c authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Provide new `defalias-fset-function' symbol property.

* src/lisp.h (AUTOLOADP): New macro.
* src/eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead.
* src/data.c (Ffset): Remove special ad-advice-info handling.
(Fdefalias): Handle autoload definitions and new Qdefalias_fset_function.
(Fsubr_arity): CSE.
(Finteractive_form): Simplify.
(Fquo): Don't insist on having at least 2 arguments.
(Qdefalias_fset_function): New var.
* lisp/emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function.
(ad--defalias-fset): New function.
(ad-safe-fset): Remove.
(ad-make-freeze-definition): Use cl-letf*.
parent da03ef8a
...@@ -38,6 +38,9 @@ spurious warnings about an unused var. ...@@ -38,6 +38,9 @@ spurious warnings about an unused var.
** Docstrings can be made dynamic by adding a `dynamic-docstring-function' ** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
text-property on the first char. text-property on the first char.
** The `defalias-fset-function' property lets you catch calls to defalias
and redirect them to your own function instead of `fset'.
* Changes in Emacs 24.4 on non-free operating systems * Changes in Emacs 24.4 on non-free operating systems
......
2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function.
(ad--defalias-fset): New function.
(ad-safe-fset): Remove.
(ad-make-freeze-definition): Use cl-letf*.
2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> 2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
   
* subr.el (dolist): Don't bind VAR in RESULT. * subr.el (dolist): Don't bind VAR in RESULT.
......
...@@ -1846,8 +1846,12 @@ On each iteration VAR will be bound to the name of an advised function ...@@ -1846,8 +1846,12 @@ On each iteration VAR will be bound to the name of an advised function
(defmacro ad-get-advice-info-macro (function) (defmacro ad-get-advice-info-macro (function)
`(get ,function 'ad-advice-info)) `(get ,function 'ad-advice-info))
(defmacro ad-set-advice-info (function advice-info) (defsubst ad-set-advice-info (function advice-info)
`(put ,function 'ad-advice-info ,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) (defmacro ad-copy-advice-info (function)
`(copy-tree (get ,function 'ad-advice-info))) `(copy-tree (get ,function 'ad-advice-info)))
...@@ -1954,18 +1958,10 @@ Redefining advices affect the construction of an advised definition." ...@@ -1954,18 +1958,10 @@ Redefining advices affect the construction of an advised definition."
;; @@ Dealing with automatic advice activation via `fset/defalias': ;; @@ Dealing with automatic advice activation via `fset/defalias':
;; ================================================================ ;; ================================================================
;; Since Emacs 19.26 the built-in versions of `fset' and `defalias' ;; Automatic activation happens when a function gets defined via `defalias',
;; take care of automatic advice activation, hence, we don't have to ;; which calls the `defalias-fset-function' (which we set to
;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'. ;; `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 ;; Whether advised definitions created by automatic activations will be
;; compiled depends on the value of `ad-default-compilation-action'. ;; compiled depends on the value of `ad-default-compilation-action'.
...@@ -1977,6 +1973,10 @@ Redefining advices affect the construction of an advised definition." ...@@ -1977,6 +1973,10 @@ Redefining advices affect the construction of an advised definition."
;; to `ad-activate' by using `ad-with-auto-activation-disabled' where ;; to `ad-activate' by using `ad-with-auto-activation-disabled' where
;; appropriate, especially in a safe version of `fset'. ;; 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: ;; For now define `ad-activate-internal' to the dummy definition:
(defun ad-activate-internal (_function &optional _compile) (defun ad-activate-internal (_function &optional _compile)
"Automatic advice activation is disabled. `ad-start-advice' enables it." "Automatic advice activation is disabled. `ad-start-advice' enables it."
...@@ -1994,12 +1994,6 @@ Redefining advices affect the construction of an advised definition." ...@@ -1994,12 +1994,6 @@ Redefining advices affect the construction of an advised definition."
`(let ((ad-activate-on-top-level nil)) `(let ((ad-activate-on-top-level nil))
,@body)) ,@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: ;; @@ Access functions for original definitions:
;; ============================================ ;; ============================================
;; The advice-info of an advised function contains its `origname' which is ;; The advice-info of an advised function contains its `origname' which is
...@@ -2019,8 +2013,7 @@ Redefining advices affect the construction of an advised definition." ...@@ -2019,8 +2013,7 @@ Redefining advices affect the construction of an advised definition."
(symbol-function origname)))) (symbol-function origname))))
(defmacro ad-set-orig-definition (function definition) (defmacro ad-set-orig-definition (function definition)
`(ad-safe-fset `(fset (ad-get-advice-info-field ,function 'origname) ,definition))
(ad-get-advice-info-field ,function 'origname) ,definition))
(defmacro ad-clear-orig-definition (function) (defmacro ad-clear-orig-definition (function)
`(fmakunbound (ad-get-advice-info-field ,function 'origname))) `(fmakunbound (ad-get-advice-info-field ,function 'origname)))
...@@ -3151,7 +3144,7 @@ advised definition from scratch." ...@@ -3151,7 +3144,7 @@ advised definition from scratch."
(ad-set-advice-info function old-advice-info) (ad-set-advice-info function old-advice-info)
;; Don't `fset' function to nil if it was previously unbound: ;; Don't `fset' function to nil if it was previously unbound:
(if function-defined-p (if function-defined-p
(ad-safe-fset function old-definition) (fset function old-definition)
(fmakunbound function))))) (fmakunbound function)))))
...@@ -3182,7 +3175,8 @@ advised definition from scratch." ...@@ -3182,7 +3175,8 @@ advised definition from scratch."
(error (error
"ad-make-freeze-definition: `%s' is not yet defined" "ad-make-freeze-definition: `%s' is not yet defined"
function)) function))
(let* ((name (ad-advice-name advice)) (cl-letf*
((name (ad-advice-name advice))
;; With a unique origname we can have multiple freeze advices ;; With a unique origname we can have multiple freeze advices
;; for the same function, each overloading the previous one: ;; for the same function, each overloading the previous one:
(unique-origname (unique-origname
...@@ -3195,18 +3189,14 @@ advised definition from scratch." ...@@ -3195,18 +3189,14 @@ advised definition from scratch."
(old-advice-info (old-advice-info
(if (ad-is-advised function) (if (ad-is-advised function)
(ad-copy-advice-info function))) (ad-copy-advice-info function)))
(real-docstring-fn ;; Make sure we construct a proper docstring:
(symbol-function 'ad-make-advised-definition-docstring)) ((symbol-function 'ad-make-advised-definition-docstring)
(real-origname-fn #'ad-make-freeze-docstring)
(symbol-function 'ad-make-origname)) ;; Make sure `unique-origname' is used as the origname:
((symbol-function 'ad-make-origname) (lambda (_x) unique-origname))
(frozen-definition (frozen-definition
(unwind-protect (unwind-protect
(progn (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 ;; No we reset all current advice information to nil and
;; generate an advised definition that's solely determined ;; generate an advised definition that's solely determined
;; by ADVICE and the current origdef of FUNCTION: ;; by ADVICE and the current origdef of FUNCTION:
...@@ -3217,11 +3207,7 @@ advised definition from scratch." ...@@ -3217,11 +3207,7 @@ advised definition from scratch."
(ad-set-orig-definition function orig-definition) (ad-set-orig-definition function orig-definition)
(ad-make-advised-definition function)) (ad-make-advised-definition function))
;; Restore the old advice state: ;; Restore the old advice state:
(ad-set-advice-info function old-advice-info) (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))))
(if frozen-definition (if frozen-definition
(let* ((macro-p (ad-macro-p frozen-definition)) (let* ((macro-p (ad-macro-p frozen-definition))
(body (cdr (if macro-p (body (cdr (if macro-p
...@@ -3269,7 +3255,7 @@ The current definition and its cache-id will be put into the cache." ...@@ -3269,7 +3255,7 @@ The current definition and its cache-id will be put into the cache."
(let ((verified-cached-definition (let ((verified-cached-definition
(if (ad-verify-cache-id function) (if (ad-verify-cache-id function)
(ad-get-cache-definition function)))) (ad-get-cache-definition function))))
(ad-safe-fset function (fset function
(or verified-cached-definition (or verified-cached-definition
(ad-make-advised-definition function))) (ad-make-advised-definition function)))
(if (ad-should-compile function compile) (if (ad-should-compile function compile)
...@@ -3311,7 +3297,7 @@ the value of `ad-redefinition-action' and de/activate again." ...@@ -3311,7 +3297,7 @@ the value of `ad-redefinition-action' and de/activate again."
(error "ad-handle-definition (see its doc): `%s' %s" (error "ad-handle-definition (see its doc): `%s' %s"
function "invalidly redefined") function "invalidly redefined")
(if (eq ad-redefinition-action 'discard) (if (eq ad-redefinition-action 'discard)
(ad-safe-fset function original-definition) (fset function original-definition)
(ad-set-orig-definition function current-definition) (ad-set-orig-definition function current-definition)
(if (eq ad-redefinition-action 'warn) (if (eq ad-redefinition-action 'warn)
(message "ad-handle-definition: `%s' got redefined" (message "ad-handle-definition: `%s' got redefined"
...@@ -3386,7 +3372,7 @@ a call to `ad-activate'." ...@@ -3386,7 +3372,7 @@ a call to `ad-activate'."
(if (not (ad-get-orig-definition function)) (if (not (ad-get-orig-definition function))
(error "ad-deactivate: `%s' has no original definition" (error "ad-deactivate: `%s' has no original definition"
function) 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) (ad-set-advice-info-field function 'active nil)
(eval (ad-make-hook-form function 'deactivation)) (eval (ad-make-hook-form function 'deactivation))
function))))) function)))))
...@@ -3424,7 +3410,7 @@ Use in emergencies." ...@@ -3424,7 +3410,7 @@ Use in emergencies."
(completing-read "Recover advised function: " obarray nil t)))) (completing-read "Recover advised function: " obarray nil t))))
(cond ((ad-is-advised function) (cond ((ad-is-advised function)
(cond ((ad-get-orig-definition 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-clear-orig-definition function)))
(ad-set-advice-info function nil) (ad-set-advice-info function nil)
(ad-pop-advised-function function)))) (ad-pop-advised-function function))))
...@@ -3658,8 +3644,7 @@ undone on exit of this macro." ...@@ -3658,8 +3644,7 @@ undone on exit of this macro."
(setq index -1) (setq index -1)
(mapcar (lambda (function) (mapcar (lambda (function)
(setq index (1+ index)) (setq index (1+ index))
`(ad-safe-fset `(fset ',function
',function
(or (ad-get-orig-definition ',function) (or (ad-get-orig-definition ',function)
,(car (nth index current-bindings))))) ,(car (nth index current-bindings)))))
functions)) functions))
...@@ -3670,8 +3655,7 @@ undone on exit of this macro." ...@@ -3670,8 +3655,7 @@ undone on exit of this macro."
(setq index -1) (setq index -1)
(mapcar (lambda (function) (mapcar (lambda (function)
(setq index (1+ index)) (setq index (1+ index))
`(ad-safe-fset `(fset ',function
',function
,(car (nth index current-bindings)))) ,(car (nth index current-bindings))))
functions)))))) functions))))))
...@@ -3684,7 +3668,7 @@ undone on exit of this macro." ...@@ -3684,7 +3668,7 @@ undone on exit of this macro."
(interactive) (interactive)
;; Advising `ad-activate-internal' means death!! ;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil) (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 () (defun ad-stop-advice ()
"Stop the automatic advice handling magic. "Stop the automatic advice handling magic.
...@@ -3692,7 +3676,7 @@ You should only need this in case of Advice-related emergencies." ...@@ -3692,7 +3676,7 @@ You should only need this in case of Advice-related emergencies."
(interactive) (interactive)
;; Advising `ad-activate-internal' means death!! ;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil) (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 () (defun ad-recover-normality ()
"Undo all advice related redefinitions and unadvises everything. "Undo all advice related redefinitions and unadvises everything.
...@@ -3700,7 +3684,7 @@ Use only in REAL emergencies." ...@@ -3700,7 +3684,7 @@ Use only in REAL emergencies."
(interactive) (interactive)
;; Advising `ad-activate-internal' means death!! ;; Advising `ad-activate-internal' means death!!
(ad-set-advice-info 'ad-activate-internal nil) (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-recover-all)
(ad-do-advised-functions (function) (ad-do-advised-functions (function)
(message "Oops! Left over advised function %S" function) (message "Oops! Left over advised function %S" function)
......
2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp.h (AUTOLOADP): New macro.
* eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead.
* data.c (Ffset): Remove special ad-advice-info handling.
(Fdefalias): Handle autoload definitions and new Qdefalias_fset_function.
(Fsubr_arity): CSE.
(Finteractive_form): Simplify.
(Fquo): Don't insist on having at least 2 arguments.
(Qdefalias_fset_function): New var.
2012-11-09 Jan Djärv <jan.h.d@swipnet.se> 2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
   
* image.c (xpm_make_color_table_h): Change to hashtest_equal. * image.c (xpm_make_color_table_h): Change to hashtest_equal.
...@@ -26,7 +37,7 @@ ...@@ -26,7 +37,7 @@
   
2012-11-09 Jan Djärv <jan.h.d@swipnet.se> 2012-11-09 Jan Djärv <jan.h.d@swipnet.se>
   
* nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has * nsfont.m (ns_descriptor_to_entity): Qcondensed and Qexpanded has
been removed, so remove them here also. been removed, so remove them here also.
   
2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> 2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca>
......
...@@ -80,7 +80,7 @@ static Lisp_Object Qsubrp, Qmany, Qunevalled; ...@@ -80,7 +80,7 @@ static Lisp_Object Qsubrp, Qmany, Qunevalled;
Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
static Lisp_Object Qdefun; 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 *); static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
...@@ -444,7 +444,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0, ...@@ -444,7 +444,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
} }
/* Extract and set components of lists */ /* Extract and set components of lists. */
DEFUN ("car", Fcar, Scar, 1, 1, 0, DEFUN ("car", Fcar, Scar, 1, 1, 0,
doc: /* Return the car of LIST. If arg is nil, return nil. doc: /* Return the car of LIST. If arg is nil, return nil.
...@@ -608,27 +608,18 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, ...@@ -608,27 +608,18 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
(register Lisp_Object symbol, Lisp_Object definition) (register Lisp_Object symbol, Lisp_Object definition)
{ {
register Lisp_Object function; register Lisp_Object function;
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
if (NILP (symbol) || EQ (symbol, Qt))
xsignal1 (Qsetting_constant, symbol);
function = XSYMBOL (symbol)->function; function = XSYMBOL (symbol)->function;
if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
if (CONSP (function) && EQ (XCAR (function), Qautoload)) if (AUTOLOADP (function))
Fput (symbol, Qautoload, XCDR (function)); Fput (symbol, Qautoload, XCDR (function));
set_symbol_function (symbol, definition); 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; return definition;
} }
...@@ -642,15 +633,32 @@ The return value is undefined. */) ...@@ -642,15 +633,32 @@ The return value is undefined. */)
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
{ {
CHECK_SYMBOL (symbol); CHECK_SYMBOL (symbol);
if (CONSP (XSYMBOL (symbol)->function)
&& EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
LOADHIST_ATTACH (Fcons (Qt, symbol));
if (!NILP (Vpurify_flag) if (!NILP (Vpurify_flag)
/* If `definition' is a keymap, immutable (and copying) is wrong. */ /* If `definition' is a keymap, immutable (and copying) is wrong. */
&& !KEYMAPP (definition)) && !KEYMAPP (definition))
definition = Fpurecopy (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)) if (!NILP (docstring))
Fput (symbol, Qfunction_documentation, docstring); Fput (symbol, Qfunction_documentation, docstring);
/* We used to return `definition', but now that `defun' and `defmacro' expand /* We used to return `definition', but now that `defun' and `defmacro' expand
...@@ -680,12 +688,10 @@ function with `&rest' args, or `unevalled' for a special form. */) ...@@ -680,12 +688,10 @@ function with `&rest' args, or `unevalled' for a special form. */)
CHECK_SUBR (subr); CHECK_SUBR (subr);
minargs = XSUBR (subr)->min_args; minargs = XSUBR (subr)->min_args;
maxargs = XSUBR (subr)->max_args; maxargs = XSUBR (subr)->max_args;
if (maxargs == MANY) return Fcons (make_number (minargs),
return Fcons (make_number (minargs), Qmany); maxargs == MANY ? Qmany
else if (maxargs == UNEVALLED) : maxargs == UNEVALLED ? Qunevalled
return Fcons (make_number (minargs), Qunevalled); : make_number (maxargs));
else
return Fcons (make_number (minargs), make_number (maxargs));
} }
DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
...@@ -735,6 +741,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) ...@@ -735,6 +741,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
return list2 (Qinteractive, AREF (fun, 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)) else if (CONSP (fun))
{ {
Lisp_Object funcar = XCAR (fun); Lisp_Object funcar = XCAR (fun);
...@@ -742,14 +750,6 @@ Value, if non-nil, is a list \(interactive SPEC). */) ...@@ -742,14 +750,6 @@ Value, if non-nil, is a list \(interactive SPEC). */)
return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
else if (EQ (funcar, Qlambda)) else if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun))); 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 Qnil;
} }
...@@ -2695,10 +2695,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */) ...@@ -2695,10 +2695,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
return arith_driver (Amult, nargs, args); 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. doc: /* Return first argument divided by all the remaining arguments.
The arguments must be numbers or markers. The arguments must be numbers or markers.
usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) usage: (/ DIVIDEND &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args) (ptrdiff_t nargs, Lisp_Object *args)
{ {
ptrdiff_t argnum; ptrdiff_t argnum;
...@@ -3063,6 +3063,7 @@ syms_of_data (void) ...@@ -3063,6 +3063,7 @@ syms_of_data (void)
DEFSYM (Qfont_object, "font-object"); DEFSYM (Qfont_object, "font-object");
DEFSYM (Qinteractive_form, "interactive-form"); DEFSYM (Qinteractive_form, "interactive-form");
DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
defsubr (&Sindirect_variable); defsubr (&Sindirect_variable);
defsubr (&Sinteractive_form); defsubr (&Sinteractive_form);
......
...@@ -1876,26 +1876,19 @@ this does nothing and returns nil. */) ...@@ -1876,26 +1876,19 @@ this does nothing and returns nil. */)
CHECK_STRING (file); CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */ /* If function is defined and not as an autoload, don't override. */
if ((CONSP (XSYMBOL (function)->function) if (!EQ (XSYMBOL (function)->function, Qunbound)
&& EQ (XCAR (XSYMBOL (function)->function), Qautoload))) && !AUTOLOADP (XSYMBOL (function)->function))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, function));
else if (!EQ (XSYMBOL (function)->function, Qunbound))
return Qnil; return Qnil;
if (NILP (Vpurify_flag)) if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
/* Only add entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
LOADHIST_ATTACH (Fcons (Qautoload, function));
else if (EQ (docstring, make_number (0)))
/* `read1' in lread.c has found the docstring starting with "\ /* `read1' in lread.c has found the docstring starting with "\
and assumed the docstring will be provided by Snarf-documentation, so it and assumed the docstring will be provided by Snarf-documentation, so it
passed us 0 instead. But that leads to accidental sharing in purecopy's passed us 0 instead. But that leads to accidental sharing in purecopy's
hash-consing, so we use a (hopefully) unique integer instead. */ hash-consing, so we use a (hopefully) unique integer instead. */
docstring = make_number (XUNTAG (function, Lisp_Symbol)); docstring = make_number (XHASH (function));
return Ffset (function, return Fdefalias (function,
Fpurecopy (list5 (Qautoload, file, docstring, list5 (Qautoload, file, docstring, interactive, type),
interactive, type))); Qnil);
} }
Lisp_Object Lisp_Object
......
...@@ -1694,6 +1694,8 @@ typedef struct { ...@@ -1694,6 +1694,8 @@ typedef struct {
#define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
#define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value)
#define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x)))
#define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int)
#define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool)
#define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment