diff options
| author | Stefan Monnier | 2012-11-09 17:20:47 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2012-11-09 17:20:47 -0500 |
| commit | 32e5c58ca969ec30d31520da52c9866cafa62927 (patch) | |
| tree | aab212d158443e5a04d5828b78a26eca4d5db88c /src | |
| parent | da03ef8a9d38ef6f059aaeddb8c97dc7e76d3917 (diff) | |
| download | emacs-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')
| -rw-r--r-- | src/ChangeLog | 13 | ||||
| -rw-r--r-- | src/data.c | 71 | ||||
| -rw-r--r-- | src/eval.c | 21 | ||||
| -rw-r--r-- | src/lisp.h | 2 |
4 files changed, 57 insertions, 50 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 43d60936d70..da3e96bbcc3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog | |||
| @@ -1,3 +1,14 @@ | |||
| 1 | 2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * lisp.h (AUTOLOADP): New macro. | ||
| 4 | * eval.c (Fautoload): Don't attach to loadhist, call Fdefalias instead. | ||
| 5 | * data.c (Ffset): Remove special ad-advice-info handling. | ||
| 6 | (Fdefalias): Handle autoload definitions and new Qdefalias_fset_function. | ||
| 7 | (Fsubr_arity): CSE. | ||
| 8 | (Finteractive_form): Simplify. | ||
| 9 | (Fquo): Don't insist on having at least 2 arguments. | ||
| 10 | (Qdefalias_fset_function): New var. | ||
| 11 | |||
| 1 | 2012-11-09 Jan Djärv <jan.h.d@swipnet.se> | 12 | 2012-11-09 Jan Djärv <jan.h.d@swipnet.se> |
| 2 | 13 | ||
| 3 | * image.c (xpm_make_color_table_h): Change to hashtest_equal. | 14 | * image.c (xpm_make_color_table_h): Change to hashtest_equal. |
| @@ -26,7 +37,7 @@ | |||
| 26 | 37 | ||
| 27 | 2012-11-09 Jan Djärv <jan.h.d@swipnet.se> | 38 | 2012-11-09 Jan Djärv <jan.h.d@swipnet.se> |
| 28 | 39 | ||
| 29 | * nsfont.m (ns_descriptor_to_entity): Qcondesed and Qexpanded has | 40 | * nsfont.m (ns_descriptor_to_entity): Qcondensed and Qexpanded has |
| 30 | been removed, so remove them here also. | 41 | been removed, so remove them here also. |
| 31 | 42 | ||
| 32 | 2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> | 43 | 2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> |
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; | |||
| 80 | Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; | 80 | Lisp_Object Qfont_spec, Qfont_entity, Qfont_object; |
| 81 | static Lisp_Object Qdefun; | 81 | static Lisp_Object Qdefun; |
| 82 | 82 | ||
| 83 | Lisp_Object Qinteractive_form; | 83 | Lisp_Object Qinteractive_form, Qdefalias_fset_function; |
| 84 | 84 | ||
| 85 | static void swap_in_symval_forwarding (struct Lisp_Symbol *, struct Lisp_Buffer_Local_Value *); | 85 | static 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 | ||
| 449 | DEFUN ("car", Fcar, Scar, 1, 1, 0, | 449 | DEFUN ("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 | ||
| 691 | DEFUN ("subr-name", Fsubr_name, Ssubr_name, 1, 1, 0, | 697 | DEFUN ("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 | ||
| 2698 | DEFUN ("/", Fquo, Squo, 2, MANY, 0, | 2698 | DEFUN ("/", 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. |
| 2700 | The arguments must be numbers or markers. | 2700 | The arguments must be numbers or markers. |
| 2701 | usage: (/ DIVIDEND DIVISOR &rest DIVISORS) */) | 2701 | usage: (/ 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); |
diff --git a/src/eval.c b/src/eval.c index 975204da017..dcd48cb7250 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1876,26 +1876,19 @@ this does nothing and returns nil. */) | |||
| 1876 | CHECK_STRING (file); | 1876 | CHECK_STRING (file); |
| 1877 | 1877 | ||
| 1878 | /* If function is defined and not as an autoload, don't override. */ | 1878 | /* If function is defined and not as an autoload, don't override. */ |
| 1879 | if ((CONSP (XSYMBOL (function)->function) | 1879 | if (!EQ (XSYMBOL (function)->function, Qunbound) |
| 1880 | && EQ (XCAR (XSYMBOL (function)->function), Qautoload))) | 1880 | && !AUTOLOADP (XSYMBOL (function)->function)) |
| 1881 | /* Remember that the function was already an autoload. */ | ||
| 1882 | LOADHIST_ATTACH (Fcons (Qt, function)); | ||
| 1883 | else if (!EQ (XSYMBOL (function)->function, Qunbound)) | ||
| 1884 | return Qnil; | 1881 | return Qnil; |
| 1885 | 1882 | ||
| 1886 | if (NILP (Vpurify_flag)) | 1883 | if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) |
| 1887 | /* Only add entries after dumping, because the ones before are | ||
| 1888 | not useful and else we get loads of them from the loaddefs.el. */ | ||
| 1889 | LOADHIST_ATTACH (Fcons (Qautoload, function)); | ||
| 1890 | else if (EQ (docstring, make_number (0))) | ||
| 1891 | /* `read1' in lread.c has found the docstring starting with "\ | 1884 | /* `read1' in lread.c has found the docstring starting with "\ |
| 1892 | and assumed the docstring will be provided by Snarf-documentation, so it | 1885 | and assumed the docstring will be provided by Snarf-documentation, so it |
| 1893 | passed us 0 instead. But that leads to accidental sharing in purecopy's | 1886 | passed us 0 instead. But that leads to accidental sharing in purecopy's |
| 1894 | hash-consing, so we use a (hopefully) unique integer instead. */ | 1887 | hash-consing, so we use a (hopefully) unique integer instead. */ |
| 1895 | docstring = make_number (XUNTAG (function, Lisp_Symbol)); | 1888 | docstring = make_number (XHASH (function)); |
| 1896 | return Ffset (function, | 1889 | return Fdefalias (function, |
| 1897 | Fpurecopy (list5 (Qautoload, file, docstring, | 1890 | list5 (Qautoload, file, docstring, interactive, type), |
| 1898 | interactive, type))); | 1891 | Qnil); |
| 1899 | } | 1892 | } |
| 1900 | 1893 | ||
| 1901 | Lisp_Object | 1894 | Lisp_Object |
diff --git a/src/lisp.h b/src/lisp.h index e2c1cc0e169..72e38fa4653 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1694,6 +1694,8 @@ typedef struct { | |||
| 1694 | #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) | 1694 | #define MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker) |
| 1695 | #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) | 1695 | #define SAVE_VALUEP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Save_Value) |
| 1696 | 1696 | ||
| 1697 | #define AUTOLOADP(x) (CONSP (x) && EQ (Qautoload, XCAR (x))) | ||
| 1698 | |||
| 1697 | #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) | 1699 | #define INTFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Int) |
| 1698 | #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) | 1700 | #define BOOLFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Bool) |
| 1699 | #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) | 1701 | #define OBJFWDP(x) (XFWDTYPE (x) == Lisp_Fwd_Obj) |