aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorStefan Monnier2012-11-09 17:20:47 -0500
committerStefan Monnier2012-11-09 17:20:47 -0500
commit32e5c58ca969ec30d31520da52c9866cafa62927 (patch)
treeaab212d158443e5a04d5828b78a26eca4d5db88c /src/data.c
parentda03ef8a9d38ef6f059aaeddb8c97dc7e76d3917 (diff)
downloademacs-32e5c58ca969ec30d31520da52c9866cafa62927.tar.gz
emacs-32e5c58ca969ec30d31520da52c9866cafa62927.zip
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*.
Diffstat (limited to 'src/data.c')
-rw-r--r--src/data.c71
1 files changed, 36 insertions, 35 deletions
diff --git a/src/data.c b/src/data.c
index abcdd4dca0d..663e25e7063 100644
--- a/src/data.c
+++ b/src/data.c
@@ -80,7 +80,7 @@ static Lisp_Object Qsubrp, Qmany, Qunevalled;
80Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; 80Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
81static Lisp_Object Qdefun; 81static Lisp_Object Qdefun;
82 82
83Lisp_Object Qinteractive_form; 83Lisp_Object Qinteractive_form, Qdefalias_fset_function;
84 84
85static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); 85static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *);
86 86
@@ -444,7 +444,7 @@ DEFUN ("floatp", Ffloatp, Sfloatp, 1, 1, 0,
444} 444}
445 445
446 446
447/* Extract and set components of lists */ 447/* Extract and set components of lists. */
448 448
449DEFUN ("car", Fcar, Scar, 1, 1, 0, 449DEFUN ("car", Fcar, Scar, 1, 1, 0,
450 doc: /* Return the car of LIST. If arg is nil, return nil. 450 doc: /* Return the car of LIST. If arg is nil, return nil.
@@ -608,27 +608,18 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
608 (register Lisp_Object symbol, Lisp_Object definition) 608 (register Lisp_Object symbol, Lisp_Object definition)
609{ 609{
610 register Lisp_Object function; 610 register Lisp_Object function;
611
612 CHECK_SYMBOL (symbol); 611 CHECK_SYMBOL (symbol);
613 if (NILP (symbol) || EQ (symbol, Qt))
614 xsignal1 (Qsetting_constant, symbol);
615 612
616 function = XSYMBOL (symbol)->function; 613 function = XSYMBOL (symbol)->function;
617 614
618 if (!NILP (Vautoload_queue) && !EQ (function, Qunbound)) 615 if (!NILP (Vautoload_queue) && !EQ (function, Qunbound))
619 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); 616 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
620 617
621 if (CONSP (function) && EQ (XCAR (function), Qautoload)) 618 if (AUTOLOADP (function))
622 Fput (symbol, Qautoload, XCDR (function)); 619 Fput (symbol, Qautoload, XCDR (function));
623 620
624 set_symbol_function (symbol, definition); 621 set_symbol_function (symbol, definition);
625 /* Handle automatic advice activation. */ 622
626 if (CONSP (XSYMBOL (symbol)->plist)
627 && !NILP (Fget (symbol, Qad_advice_info)))
628 {
629 call2 (Qad_activate_internal, symbol, Qnil);
630 definition = XSYMBOL (symbol)->function;
631 }
632 return definition; 623 return definition;
633} 624}
634 625
@@ -642,15 +633,32 @@ The return value is undefined. */)
642 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) 633 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
643{ 634{
644 CHECK_SYMBOL (symbol); 635 CHECK_SYMBOL (symbol);
645 if (CONSP (XSYMBOL (symbol)->function)
646 && EQ (XCAR (XSYMBOL (symbol)->function), Qautoload))
647 LOADHIST_ATTACH (Fcons (Qt, symbol));
648 if (!NILP (Vpurify_flag) 636 if (!NILP (Vpurify_flag)
649 /* If `definition' is a keymap, immutable (and copying) is wrong. */ 637 /* If `definition' is a keymap, immutable (and copying) is wrong. */
650 && !KEYMAPP (definition)) 638 && !KEYMAPP (definition))
651 definition = Fpurecopy (definition); 639 definition = Fpurecopy (definition);
652 definition = Ffset (symbol, definition); 640
653 LOADHIST_ATTACH (Fcons (Qdefun, symbol)); 641 {
642 bool autoload = AUTOLOADP (definition);
643 if (NILP (Vpurify_flag) || !autoload)
644 { /* Only add autoload entries after dumping, because the ones before are
645 not useful and else we get loads of them from the loaddefs.el. */
646
647 if (AUTOLOADP (XSYMBOL (symbol)->function))
648 /* Remember that the function was already an autoload. */
649 LOADHIST_ATTACH (Fcons (Qt, symbol));
650 LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
651 }
652 }
653
654 { /* Handle automatic advice activation. */
655 Lisp_Object hook = Fget (symbol, Qdefalias_fset_function);
656 if (!NILP (hook))
657 call2 (hook, symbol, definition);
658 else
659 Ffset (symbol, definition);
660 }
661
654 if (!NILP (docstring)) 662 if (!NILP (docstring))
655 Fput (symbol, Qfunction_documentation, docstring); 663 Fput (symbol, Qfunction_documentation, docstring);
656 /* We used to return `definition', but now that `defun' and `defmacro' expand 664 /* 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 CHECK_SUBR (subr); 688 CHECK_SUBR (subr);
681 minargs = XSUBR (subr)->min_args; 689 minargs = XSUBR (subr)->min_args;
682 maxargs = XSUBR (subr)->max_args; 690 maxargs = XSUBR (subr)->max_args;
683 if (maxargs == MANY) 691 return Fcons (make_number (minargs),
684 return Fcons (make_number (minargs), Qmany); 692 maxargs == MANY ? Qmany
685 else if (maxargs == UNEVALLED) 693 : maxargs == UNEVALLED ? Qunevalled
686 return Fcons (make_number (minargs), Qunevalled); 694 : make_number (maxargs));
687 else
688 return Fcons (make_number (minargs), make_number (maxargs));
689} 695}
690 696
691DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, 697DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0,
@@ -711,7 +717,7 @@ Value, if non-nil, is a list \(interactive SPEC). */)
711 return Qnil; 717 return Qnil;
712 718
713 /* Use an `interactive-form' property if present, analogous to the 719 /* Use an `interactive-form' property if present, analogous to the
714 function-documentation property. */ 720 function-documentation property. */
715 fun = cmd; 721 fun = cmd;
716 while (SYMBOLP (fun)) 722 while (SYMBOLP (fun))
717 { 723 {
@@ -735,6 +741,8 @@ Value, if non-nil, is a list \(interactive SPEC). */)
735 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE) 741 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE)
736 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); 742 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
737 } 743 }
744 else if (AUTOLOADP (fun))
745 return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
738 else if (CONSP (fun)) 746 else if (CONSP (fun))
739 { 747 {
740 Lisp_Object funcar = XCAR (fun); 748 Lisp_Object funcar = XCAR (fun);
@@ -742,14 +750,6 @@ Value, if non-nil, is a list \(interactive SPEC). */)
742 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); 750 return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))));
743 else if (EQ (funcar, Qlambda)) 751 else if (EQ (funcar, Qlambda))
744 return Fassq (Qinteractive, Fcdr (XCDR (fun))); 752 return Fassq (Qinteractive, Fcdr (XCDR (fun)));
745 else if (EQ (funcar, Qautoload))
746 {
747 struct gcpro gcpro1;
748 GCPRO1 (cmd);
749 Fautoload_do_load (fun, cmd, Qnil);
750 UNGCPRO;
751 return Finteractive_form (cmd);
752 }
753 } 753 }
754 return Qnil; 754 return Qnil;
755} 755}
@@ -2695,10 +2695,10 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
2695 return arith_driver (Amult, nargs, args); 2695 return arith_driver (Amult, nargs, args);
2696} 2696}
2697 2697
2698DEFUN ("/", Fquo, Squo, 2, MANY, 0, 2698DEFUN ("/", Fquo, Squo, 1, MANY, 0,
2699 doc: /* Return first argument divided by all the remaining arguments. 2699 doc: /* Return first argument divided by all the remaining arguments.
2700The arguments must be numbers or markers. 2700The arguments must be numbers or markers.
2701usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) 2701usage: (/ DIVIDEND &rest DIVISORS) */)
2702 (ptrdiff_t nargs, Lisp_Object *args) 2702 (ptrdiff_t nargs, Lisp_Object *args)
2703{ 2703{
2704 ptrdiff_t argnum; 2704 ptrdiff_t argnum;
@@ -3063,6 +3063,7 @@ syms_of_data (void)
3063 DEFSYM (Qfont_object, "font-object"); 3063 DEFSYM (Qfont_object, "font-object");
3064 3064
3065 DEFSYM (Qinteractive_form, "interactive-form"); 3065 DEFSYM (Qinteractive_form, "interactive-form");
3066 DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
3066 3067
3067 defsubr (&Sindirect_variable); 3068 defsubr (&Sindirect_variable);
3068 defsubr (&Sinteractive_form); 3069 defsubr (&Sinteractive_form);