Mercurial > hg > xemacs-beta

comparison src/lread.c @ 1261:465bd3c7d932

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-02-06 06:35:47 by ben] various bug fixes mule/cyril-util.el: Fix compile warning. loadup.el, make-docfile.el, update-elc-2.el, update-elc.el: Set stack-trace-on-error, load-always-display-messages so we get better debug results. update-elc-2.el: Fix typo in name of lisp/mule, leading to compile failure. simple.el: Omit M-S-home/end from motion keys. update-elc.el: Overhaul: -- allow list of "early-compile" files to be specified, not hardcoded -- fix autoload checking to include all .el files, not just dumped ones -- be smarter about regenerating autoloads, so we don't need to use loadup-el if not necessary -- use standard methods for loading/not loading auto-autoloads.el (maybe fixes "Already loaded" error?) -- rename misleading NOBYTECOMPILE flag file. window-xemacs.el: Fix bug in default param. window-xemacs.el: Fix compile warnings. lwlib-Xm.c: Fix compile warning. lispref/mule.texi: Lots of Mule rewriting. internals/internals.texi: Major fixup. Correct for new names of Bytebpos, Ichar, etc. and lots of Mule rewriting. config.inc.samp: Various fixups. Makefile.in.in: NOBYTECOMPILE -> BYTECOMPILE_CHANGE. esd.c: Warning fixes. fns.c: Eliminate bogus require-prints-loading-message; use already existent load-always-display-messages instead. Make sure `load' knows we are coming from `require'. lread.c: Turn on `load-warn-when-source-newer' by default. Change loading message to indicate when we are `require'ing. Eliminate purify_flag hacks to display more messages; instead, loadup and friends specify this explicitly with `load-always-display-messages'. Add spaces when batch to clearly indicate recursive loading. Fassoc() does not GC so no need to gcpro. gui-x.c, gui-x.h, menubar-x.c: Fix up crashes when selecting menubar items due to lack of GCPROing of callbacks in lwlib structures. eval.c, lisp.h, print.c: Don't canonicalize to selected-frame when noninteractive, or backtraces get all screwed up as some values are printed through the stream console and some aren't. Export canonicalize_printcharfun() and use in Fbacktrace().
author ben
date Thu, 06 Feb 2003 06:36:17 +0000
parents 37bdd24225ef
children b5a5863da615
comparison
equal deleted inserted replaced
1260:278c9cd3435e 1261:465bd3c7d932
1 /* Lisp parsing and input streams. 1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc. 2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems. 3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996, 2001, 2002 Ben Wing. 4 Copyright (C) 1996, 2001, 2002, 2003 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
211 EXFUN (Fread_from_string, 3); 211 EXFUN (Fread_from_string, 3);
212 212
213 /* When errors are signaled, the actual readcharfun should not be used 213 /* When errors are signaled, the actual readcharfun should not be used
214 as an argument if it is an lstream, so that lstreams don't escape 214 as an argument if it is an lstream, so that lstreams don't escape
215 to the Lisp level. */ 215 to the Lisp level. */
216 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \ 216 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
217 ? (build_msg_string ("internal input stream")) \ 217 ? (build_msg_string ("internal input stream")) \
218 : (x)) 218 : (x))
219 219
220 220
221 static DOESNT_RETURN 221 static DOESNT_RETURN
222 read_syntax_error (const char *string) 222 read_syntax_error (const char *string)
498 Lisp_Object handler = Qnil; 498 Lisp_Object handler = Qnil;
499 Lisp_Object found = Qnil; 499 Lisp_Object found = Qnil;
500 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; 500 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
501 int reading_elc = 0; 501 int reading_elc = 0;
502 int from_require = EQ (nomessage, Qrequire); 502 int from_require = EQ (nomessage, Qrequire);
503 int message_p = 503 int message_p = NILP (nomessage) || load_always_display_messages;
504 NILP (nomessage) || from_require || load_always_display_messages;
505 /*#ifdef DEBUG_XEMACS*/
506 static Lisp_Object last_file_loaded; 504 static Lisp_Object last_file_loaded;
507 /*#endif*/
508 struct stat s1, s2; 505 struct stat s1, s2;
509 GCPRO4 (file, newer, older, found); 506 GCPRO4 (file, newer, older, found);
507 Ibyte *spaces = alloca_ibytes (load_in_progress * 2 + 10);
508 int i;
510 509
511 CHECK_STRING (file); 510 CHECK_STRING (file);
512 511
513 /*#ifdef DEBUG_XEMACS*/ 512 if (noninteractive)
514 if (purify_flag && noninteractive) 513 last_file_loaded = file;
515 {
516 message_p = 1;
517 last_file_loaded = file;
518 }
519 /*#endif / * DEBUG_XEMACS */
520 514
521 /* If file name is magic, call the handler. */ 515 /* If file name is magic, call the handler. */
522 handler = Ffind_file_name_handler (file, Qload); 516 handler = Ffind_file_name_handler (file, Qload);
523 if (!NILP (handler)) 517 if (!NILP (handler))
524 RETURN_UNGCPRO (call5 (handler, Qload, file, noerror, 518 RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
528 the need to gcpro noerror, nomessage and nosuffix. 522 the need to gcpro noerror, nomessage and nosuffix.
529 (Below here, we care only whether they are nil or not.) */ 523 (Below here, we care only whether they are nil or not.) */
530 file = Fsubstitute_in_file_name (file); 524 file = Fsubstitute_in_file_name (file);
531 if (!NILP (used_codesys)) 525 if (!NILP (used_codesys))
532 CHECK_SYMBOL (used_codesys); 526 CHECK_SYMBOL (used_codesys);
527
528 if (noninteractive)
529 {
530 for (i = 0; i < load_in_progress * 2; i++)
531 spaces[i] = ' ';
532 spaces[i] = '\0';
533 }
534 else
535 spaces[0] = '\0';
533 536
534 /* Avoid weird lossage with null string as arg, 537 /* Avoid weird lossage with null string as arg,
535 since it would try to load a directory as a Lisp file. 538 since it would try to load a directory as a Lisp file.
536 Unix truly sucks. */ 539 Unix truly sucks. */
537 if (XSTRING_LENGTH (file) > 0) 540 if (XSTRING_LENGTH (file) > 0)
619 #define PRINT_LOADING_MESSAGE_1(loading, done) \ 622 #define PRINT_LOADING_MESSAGE_1(loading, done) \
620 do { \ 623 do { \
621 if (load_ignore_elc_files) \ 624 if (load_ignore_elc_files) \
622 { \ 625 { \
623 if (message_p) \ 626 if (message_p) \
624 message (loading done, \ 627 message (loading done, spaces, \
625 XSTRING_DATA (load_show_full_path_in_messages ? \ 628 XSTRING_DATA (load_show_full_path_in_messages ? \
626 found : newer)); \ 629 found : newer)); \
627 } \ 630 } \
628 else if (!NILP (older)) \ 631 else if (!NILP (older)) \
629 { \ 632 { \
630 assert (load_ignore_out_of_date_elc_files); \ 633 assert (load_ignore_out_of_date_elc_files); \
631 message (loading done " (file %s is out-of-date)", \ 634 message (loading done " (file %s is out-of-date)", spaces, \
632 XSTRING_DATA (load_show_full_path_in_messages ? \ 635 XSTRING_DATA (load_show_full_path_in_messages ? \
633 found : newer), \ 636 found : newer), \
634 XSTRING_DATA (older)); \ 637 XSTRING_DATA (older)); \
635 } \ 638 } \
636 else if (!NILP (newer)) \ 639 else if (!NILP (newer)) \
637 message (loading done " (file %s is newer)", \ 640 message (loading done " (file %s is newer)", spaces, \
638 XSTRING_DATA (load_show_full_path_in_messages ? \ 641 XSTRING_DATA (load_show_full_path_in_messages ? \
639 found : file), \ 642 found : file), \
640 XSTRING_DATA (newer)); \ 643 XSTRING_DATA (newer)); \
641 else if (source_only) \ 644 else if (source_only) \
642 message (loading done " (file %s.elc does not exist)", \ 645 message (loading done " (file %s.elc does not exist)", spaces, \
643 XSTRING_DATA (load_show_full_path_in_messages ? \ 646 XSTRING_DATA (load_show_full_path_in_messages ? \
644 found : file), \ 647 found : file), \
645 XSTRING_DATA (Ffile_name_nondirectory (file))); \ 648 XSTRING_DATA (Ffile_name_nondirectory (file))); \
646 else if (message_p) \ 649 else if (message_p) \
647 message (loading done, \ 650 message (loading done, spaces, \
648 XSTRING_DATA (load_show_full_path_in_messages ? \ 651 XSTRING_DATA (load_show_full_path_in_messages ? \
649 found : file)); \ 652 found : file)); \
650 } while (0) 653 } while (0)
651 654
652 #define PRINT_LOADING_MESSAGE(done) \ 655 #define PRINT_LOADING_MESSAGE(done) \
653 do { \ 656 do { \
654 if (from_require) \ 657 if (from_require) \
655 PRINT_LOADING_MESSAGE_1 ("Requiring %s...", done); \ 658 PRINT_LOADING_MESSAGE_1 ("%sRequiring %s...", done); \
656 else \ 659 else \
657 PRINT_LOADING_MESSAGE_1 ("Loading %s...", done); \ 660 PRINT_LOADING_MESSAGE_1 ("%sLoading %s...", done); \
658 } while (0) 661 } while (0)
659 662
660 PRINT_LOADING_MESSAGE (""); 663 PRINT_LOADING_MESSAGE ("");
661 664
662 { 665 {
734 Lisp_Object name = file; 737 Lisp_Object name = file;
735 738
736 if (!NILP (Ffile_name_absolute_p (file))) 739 if (!NILP (Ffile_name_absolute_p (file)))
737 name = Ffile_name_nondirectory (file); 740 name = Ffile_name_nondirectory (file);
738 741
739 { 742 tem = Fassoc (name, Vafter_load_alist);
740 struct gcpro ngcpro1;
741
742 NGCPRO1 (name);
743 tem = Fassoc (name, Vafter_load_alist);
744 NUNGCPRO;
745 }
746 if (!NILP (tem)) 743 if (!NILP (tem))
747 { 744 {
748 struct gcpro ngcpro1; 745 struct gcpro ngcpro1;
749 746
750 NGCPRO1 (tem); 747 NGCPRO1 (tem);
753 Feval (tem); 750 Feval (tem);
754 NUNGCPRO; 751 NUNGCPRO;
755 } 752 }
756 } 753 }
757 754
758 /* #ifdef DEBUG_XEMACS */ 755 if (message_p && noninteractive && !EQ (last_file_loaded, file))
759 if (purify_flag && noninteractive) 756 {
760 { 757 if (from_require)
761 if (!EQ (last_file_loaded, file)) 758 message ("%sRequiring %s ...done", spaces, XSTRING_DATA (file));
762 message ("Loading %s ...done", XSTRING_DATA (file)); 759 else
763 } 760 message ("%sLoading %s ...done", spaces, XSTRING_DATA (file));
764 /* #endif / * DEBUG_XEMACS */ 761 }
765 762
766 if (!noninteractive) 763 if (!noninteractive)
767 PRINT_LOADING_MESSAGE ("done"); 764 PRINT_LOADING_MESSAGE ("done");
768 765
769 UNGCPRO; 766 UNGCPRO;
3114 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /* 3111 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3115 *Whether `load' should check whether the source is newer than the binary. 3112 *Whether `load' should check whether the source is newer than the binary.
3116 If this variable is true, then when a `.elc' file is being loaded and the 3113 If this variable is true, then when a `.elc' file is being loaded and the
3117 corresponding `.el' is newer, a warning message will be printed. 3114 corresponding `.el' is newer, a warning message will be printed.
3118 */ ); 3115 */ );
3119 load_warn_when_source_newer = 0; 3116 load_warn_when_source_newer = 1;
3120 3117
3121 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /* 3118 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3122 *Whether `load' should warn when loading a `.el' file instead of an `.elc'. 3119 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3123 If this variable is true, then when `load' is called with a filename without 3120 If this variable is true, then when `load' is called with a filename without
3124 an extension, and the `.elc' version doesn't exist but the `.el' version does, 3121 an extension, and the `.elc' version doesn't exist but the `.el' version does,