aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorStefan Monnier2022-01-28 13:19:11 -0500
committerStefan Monnier2022-01-28 13:19:11 -0500
commit7531bf096eb3f1b0b6612e94eb5211405e049fee (patch)
tree387cb37020e6256d7491f9407f8f844de90de6be /src
parent1f5fa1de7fc2f23ebd7e68db219da4faee916a6f (diff)
downloademacs-7531bf096eb3f1b0b6612e94eb5211405e049fee.tar.gz
emacs-7531bf096eb3f1b0b6612e94eb5211405e049fee.zip
Reduce code duplication in parts of (auto)load&defalias
* src/data.c (defalias): New function, extracted from `Fdefalias`. (Fdefalias): Use it. (Ffset): Don't handle `Vautoload_queue` here, handle it in `defalias` instead. * src/comp.c (comp--register-subr): Use `defalias` instead of duplicating its code. * src/eval.c (load_with_autoload_queue): New function, extracted from `Fautoload_do_load`. (Fautoload_do_load): Use it. (un_autoload): Mark it as static. * src/fns.c (Frequire): Use it as well. * src/lisp.h (defalias, load_with_autoload_queue): New declarations. (un_autoload): Remove declaration.
Diffstat (limited to 'src')
-rw-r--r--src/comp.c14
-rw-r--r--src/data.c51
-rw-r--r--src/eval.c46
-rw-r--r--src/fns.c8
-rw-r--r--src/lisp.h5
5 files changed, 63 insertions, 61 deletions
diff --git a/src/comp.c b/src/comp.c
index 56e583eb5c8..9342712a389 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5500,19 +5500,7 @@ This gets called by top_level_run during the load phase. */)
5500 make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx, 5500 make_subr (SYMBOL_NAME (name), minarg, maxarg, c_name, type, doc_idx,
5501 intspec, comp_u); 5501 intspec, comp_u);
5502 5502
5503 if (AUTOLOADP (XSYMBOL (name)->u.s.function)) 5503 defalias (name, tem);
5504 /* Remember that the function was already an autoload. */
5505 LOADHIST_ATTACH (Fcons (Qt, name));
5506 LOADHIST_ATTACH (Fcons (Qdefun, name));
5507
5508 { /* Handle automatic advice activation (bug#42038).
5509 See `defalias'. */
5510 Lisp_Object hook = Fget (name, Qdefalias_fset_function);
5511 if (!NILP (hook))
5512 call2 (hook, name, tem);
5513 else
5514 Ffset (name, tem);
5515 }
5516 5504
5517 return tem; 5505 return tem;
5518} 5506}
diff --git a/src/data.c b/src/data.c
index 7422348e392..dd6ec4c41a8 100644
--- a/src/data.c
+++ b/src/data.c
@@ -846,9 +846,6 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
846 846
847 function = XSYMBOL (symbol)->u.s.function; 847 function = XSYMBOL (symbol)->u.s.function;
848 848
849 if (!NILP (Vautoload_queue) && !NILP (function))
850 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
851
852 if (AUTOLOADP (function)) 849 if (AUTOLOADP (function))
853 Fput (symbol, Qautoload, XCDR (function)); 850 Fput (symbol, Qautoload, XCDR (function));
854 851
@@ -866,35 +863,23 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
866 return definition; 863 return definition;
867} 864}
868 865
869DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0, 866void
870 doc: /* Set SYMBOL's function definition to DEFINITION. 867defalias (Lisp_Object symbol, Lisp_Object definition)
871Associates the function with the current load file, if any.
872The optional third argument DOCSTRING specifies the documentation string
873for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
874determined by DEFINITION.
875
876Internally, this normally uses `fset', but if SYMBOL has a
877`defalias-fset-function' property, the associated value is used instead.
878
879The return value is undefined. */)
880 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
881{ 868{
882 CHECK_SYMBOL (symbol);
883 if (!NILP (Vpurify_flag)
884 /* If `definition' is a keymap, immutable (and copying) is wrong. */
885 && !KEYMAPP (definition))
886 definition = Fpurecopy (definition);
887
888 { 869 {
889 bool autoload = AUTOLOADP (definition); 870 bool autoload = AUTOLOADP (definition);
890 if (!will_dump_p () || !autoload) 871 if (!will_dump_p () || !autoload)
891 { /* Only add autoload entries after dumping, because the ones before are 872 { /* Only add autoload entries after dumping, because the ones before are
892 not useful and else we get loads of them from the loaddefs.el. */ 873 not useful and else we get loads of them from the loaddefs.el. */
874 Lisp_Object function = XSYMBOL (symbol)->u.s.function;
893 875
894 if (AUTOLOADP (XSYMBOL (symbol)->u.s.function)) 876 if (AUTOLOADP (function))
895 /* Remember that the function was already an autoload. */ 877 /* Remember that the function was already an autoload. */
896 LOADHIST_ATTACH (Fcons (Qt, symbol)); 878 LOADHIST_ATTACH (Fcons (Qt, symbol));
897 LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); 879 LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
880
881 if (!NILP (Vautoload_queue) && !NILP (function))
882 Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
898 } 883 }
899 } 884 }
900 885
@@ -905,6 +890,28 @@ The return value is undefined. */)
905 else 890 else
906 Ffset (symbol, definition); 891 Ffset (symbol, definition);
907 } 892 }
893}
894
895DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
896 doc: /* Set SYMBOL's function definition to DEFINITION.
897Associates the function with the current load file, if any.
898The optional third argument DOCSTRING specifies the documentation string
899for SYMBOL; if it is omitted or nil, SYMBOL uses the documentation string
900determined by DEFINITION.
901
902Internally, this normally uses `fset', but if SYMBOL has a
903`defalias-fset-function' property, the associated value is used instead.
904
905The return value is undefined. */)
906 (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
907{
908 CHECK_SYMBOL (symbol);
909 if (!NILP (Vpurify_flag)
910 /* If `definition' is a keymap, immutable (and copying) is wrong. */
911 && !KEYMAPP (definition))
912 definition = Fpurecopy (definition);
913
914 defalias (symbol, definition);
908 915
909 maybe_defer_native_compilation (symbol, definition); 916 maybe_defer_native_compilation (symbol, definition);
910 917
diff --git a/src/eval.c b/src/eval.c
index 205a0b0db2a..b083a00a791 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2247,7 +2247,7 @@ this does nothing and returns nil. */)
2247 Qnil); 2247 Qnil);
2248} 2248}
2249 2249
2250void 2250static void
2251un_autoload (Lisp_Object oldqueue) 2251un_autoload (Lisp_Object oldqueue)
2252{ 2252{
2253 Lisp_Object queue, first, second; 2253 Lisp_Object queue, first, second;
@@ -2269,6 +2269,32 @@ un_autoload (Lisp_Object oldqueue)
2269 } 2269 }
2270} 2270}
2271 2271
2272Lisp_Object
2273load_with_autoload_queue
2274 (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
2275 Lisp_Object nosuffix, Lisp_Object must_suffix)
2276{
2277 ptrdiff_t count = SPECPDL_INDEX ();
2278
2279 /* If autoloading gets an error (which includes the error of failing
2280 to define the function being called), we use Vautoload_queue
2281 to undo function definitions and `provide' calls made by
2282 the function. We do this in the specific case of autoloading
2283 because autoloading is not an explicit request "load this file",
2284 but rather a request to "call this function".
2285
2286 The value saved here is to be restored into Vautoload_queue. */
2287 record_unwind_protect (un_autoload, Vautoload_queue);
2288 Vautoload_queue = Qt;
2289 Lisp_Object tem
2290 = save_match_data_load (file, noerror, nomessage, nosuffix, must_suffix);
2291
2292 /* Once loading finishes, don't undo it. */
2293 Vautoload_queue = Qt;
2294 unbind_to (count, Qnil);
2295 return tem;
2296}
2297
2272/* Load an autoloaded function. 2298/* Load an autoloaded function.
2273 FUNNAME is the symbol which is the function's name. 2299 FUNNAME is the symbol which is the function's name.
2274 FUNDEF is the autoload definition (a list). */ 2300 FUNDEF is the autoload definition (a list). */
@@ -2281,8 +2307,6 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if
2281it defines a macro. */) 2307it defines a macro. */)
2282 (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) 2308 (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only)
2283{ 2309{
2284 ptrdiff_t count = SPECPDL_INDEX ();
2285
2286 if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) 2310 if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
2287 return fundef; 2311 return fundef;
2288 2312
@@ -2299,26 +2323,12 @@ it defines a macro. */)
2299 2323
2300 CHECK_SYMBOL (funname); 2324 CHECK_SYMBOL (funname);
2301 2325
2302 /* If autoloading gets an error (which includes the error of failing
2303 to define the function being called), we use Vautoload_queue
2304 to undo function definitions and `provide' calls made by
2305 the function. We do this in the specific case of autoloading
2306 because autoloading is not an explicit request "load this file",
2307 but rather a request to "call this function".
2308
2309 The value saved here is to be restored into Vautoload_queue. */
2310 record_unwind_protect (un_autoload, Vautoload_queue);
2311 Vautoload_queue = Qt;
2312 /* If `macro_only' is set and fundef isn't a macro, assume this autoload to 2326 /* If `macro_only' is set and fundef isn't a macro, assume this autoload to
2313 be a "best-effort" (e.g. to try and find a compiler macro), 2327 be a "best-effort" (e.g. to try and find a compiler macro),
2314 so don't signal an error if autoloading fails. */ 2328 so don't signal an error if autoloading fails. */
2315 Lisp_Object ignore_errors 2329 Lisp_Object ignore_errors
2316 = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only; 2330 = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
2317 save_match_data_load (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt); 2331 load_with_autoload_queue (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
2318
2319 /* Once loading finishes, don't undo it. */
2320 Vautoload_queue = Qt;
2321 unbind_to (count, Qnil);
2322 2332
2323 if (NILP (funname) || !NILP (ignore_errors)) 2333 if (NILP (funname) || !NILP (ignore_errors))
2324 return Qnil; 2334 return Qnil;
diff --git a/src/fns.c b/src/fns.c
index 16f1ebe4392..c67871da744 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3249,12 +3249,8 @@ FILENAME are suppressed. */)
3249 record_unwind_protect (require_unwind, require_nesting_list); 3249 record_unwind_protect (require_unwind, require_nesting_list);
3250 require_nesting_list = Fcons (feature, require_nesting_list); 3250 require_nesting_list = Fcons (feature, require_nesting_list);
3251 3251
3252 /* Value saved here is to be restored into Vautoload_queue */
3253 record_unwind_protect (un_autoload, Vautoload_queue);
3254 Vautoload_queue = Qt;
3255
3256 /* Load the file. */ 3252 /* Load the file. */
3257 tem = save_match_data_load 3253 tem = load_with_autoload_queue
3258 (NILP (filename) ? Fsymbol_name (feature) : filename, 3254 (NILP (filename) ? Fsymbol_name (feature) : filename,
3259 noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil)); 3255 noerror, Qt, Qnil, (NILP (filename) ? Qt : Qnil));
3260 3256
@@ -3276,8 +3272,6 @@ FILENAME are suppressed. */)
3276 SDATA (tem3), tem2); 3272 SDATA (tem3), tem2);
3277 } 3273 }
3278 3274
3279 /* Once loading finishes, don't undo it. */
3280 Vautoload_queue = Qt;
3281 feature = unbind_to (count, feature); 3275 feature = unbind_to (count, feature);
3282 } 3276 }
3283 3277
diff --git a/src/lisp.h b/src/lisp.h
index 8c55ad72a9c..10f45057d50 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -620,6 +620,7 @@ extern bool symbols_with_pos_enabled;
620extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object); 620extern AVOID args_out_of_range_3 (Lisp_Object, Lisp_Object, Lisp_Object);
621extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object); 621extern AVOID wrong_type_argument (Lisp_Object, Lisp_Object);
622extern Lisp_Object default_value (Lisp_Object symbol); 622extern Lisp_Object default_value (Lisp_Object symbol);
623extern void defalias (Lisp_Object symbol, Lisp_Object definition);
623 624
624 625
625/* Defined in emacs.c. */ 626/* Defined in emacs.c. */
@@ -4366,7 +4367,9 @@ extern AVOID verror (const char *, va_list)
4366 ATTRIBUTE_FORMAT_PRINTF (1, 0); 4367 ATTRIBUTE_FORMAT_PRINTF (1, 0);
4367extern Lisp_Object vformat_string (const char *, va_list) 4368extern Lisp_Object vformat_string (const char *, va_list)
4368 ATTRIBUTE_FORMAT_PRINTF (1, 0); 4369 ATTRIBUTE_FORMAT_PRINTF (1, 0);
4369extern void un_autoload (Lisp_Object); 4370extern Lisp_Object load_with_autoload_queue
4371 (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
4372 Lisp_Object nosuffix, Lisp_Object must_suffix);
4370extern Lisp_Object call_debugger (Lisp_Object arg); 4373extern Lisp_Object call_debugger (Lisp_Object arg);
4371extern void init_eval_once (void); 4374extern void init_eval_once (void);
4372extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); 4375extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);