aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-12-21 18:14:20 +0000
committerRichard M. Stallman1994-12-21 18:14:20 +0000
commit20ea2964cdf89eec255fb7d66064a9f1ab9e1575 (patch)
tree2bd88255ae3c4a47468a56a4f29db9cccf84e729
parentb5ff43cc2ee7a8c582aedf45f164adb5b784f0ac (diff)
downloademacs-20ea2964cdf89eec255fb7d66064a9f1ab9e1575.tar.gz
emacs-20ea2964cdf89eec255fb7d66064a9f1ab9e1575.zip
(Qload_file_name, Vload_file_name): New variables.
(syms_of_lread): Initialize and staticpro it. (Fload): Bind it. (read_list): Before dumping, ignore (#$ . WHATEVER)--return 0.
-rw-r--r--src/lread.c52
1 files changed, 49 insertions, 3 deletions
diff --git a/src/lread.c b/src/lread.c
index 4034085a38b..d19c15787a4 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -67,7 +67,7 @@ extern int errno;
67 67
68Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list; 68Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
69Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; 69Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
70Lisp_Object Qascii_character, Qload; 70Lisp_Object Qascii_character, Qload, Qload_file_name;
71 71
72extern Lisp_Object Qevent_symbol_element_mask; 72extern Lisp_Object Qevent_symbol_element_mask;
73 73
@@ -81,9 +81,12 @@ Lisp_Object Vload_path;
81 lists of defs in their load files. */ 81 lists of defs in their load files. */
82Lisp_Object Vload_history; 82Lisp_Object Vload_history;
83 83
84/* This is useud to build the load history. */ 84/* This is used to build the load history. */
85Lisp_Object Vcurrent_load_list; 85Lisp_Object Vcurrent_load_list;
86 86
87/* Name of file actually being read by `load'. */
88Lisp_Object Vload_file_name;
89
87/* List of descriptors now open for Fload. */ 90/* List of descriptors now open for Fload. */
88static Lisp_Object load_descriptor_list; 91static Lisp_Object load_descriptor_list;
89 92
@@ -436,6 +439,7 @@ Return t if file exists.")
436 XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff); 439 XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff);
437 record_unwind_protect (load_unwind, lispstream); 440 record_unwind_protect (load_unwind, lispstream);
438 record_unwind_protect (load_descriptor_unwind, load_descriptor_list); 441 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
442 specbind (Qload_file_name, found);
439 load_descriptor_list 443 load_descriptor_list
440 = Fcons (make_number (fileno (stream)), load_descriptor_list); 444 = Fcons (make_number (fileno (stream)), load_descriptor_list);
441 load_in_progress++; 445 load_in_progress++;
@@ -1183,6 +1187,31 @@ read1 (readcharfun, pch)
1183 return tmp; 1187 return tmp;
1184 } 1188 }
1185#endif 1189#endif
1190 /* #@NUMBER is used to skip NUMBER following characters.
1191 That's used in .elc files to skip over doc strings
1192 and function definitions. */
1193 if (c == '@')
1194 {
1195 int i, nskip = 0;
1196
1197 /* Read a decimal integer. */
1198 while ((c = READCHAR) >= 0
1199 && c >= '0' && c <= '9')
1200 {
1201 nskip *= 10;
1202 nskip += c - '0';
1203 }
1204 if (c >= 0)
1205 UNREAD (c);
1206
1207 /* Skip that many characters. */
1208 for (i = 0; i < nskip && c >= 0; i++)
1209 c = READCHAR;
1210 goto retry;
1211 }
1212 if (c == '$')
1213 return Vload_file_name;
1214
1186 UNREAD (c); 1215 UNREAD (c);
1187 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); 1216 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
1188 1217
@@ -1471,6 +1500,7 @@ read_list (flag, readcharfun)
1471 Lisp_Object val, tail; 1500 Lisp_Object val, tail;
1472 register Lisp_Object elt, tem; 1501 register Lisp_Object elt, tem;
1473 struct gcpro gcpro1, gcpro2; 1502 struct gcpro gcpro1, gcpro2;
1503 int cancel = 0;
1474 1504
1475 val = Qnil; 1505 val = Qnil;
1476 tail = Qnil; 1506 tail = Qnil;
@@ -1481,6 +1511,15 @@ read_list (flag, readcharfun)
1481 GCPRO2 (val, tail); 1511 GCPRO2 (val, tail);
1482 elt = read1 (readcharfun, &ch); 1512 elt = read1 (readcharfun, &ch);
1483 UNGCPRO; 1513 UNGCPRO;
1514
1515 /* If purifying, and the list starts with #$,
1516 return 0 instead. This is a doc string reference
1517 and it will be replaced anyway by Snarf-documentation,
1518 so don't waste pure space with it. */
1519 if (EQ (elt, Vload_file_name)
1520 && !NILP (Vpurify_flag) && NILP (Vdoc_file_name))
1521 cancel = 1;
1522
1484 if (ch) 1523 if (ch)
1485 { 1524 {
1486 if (flag > 0) 1525 if (flag > 0)
@@ -1501,7 +1540,7 @@ read_list (flag, readcharfun)
1501 read1 (readcharfun, &ch); 1540 read1 (readcharfun, &ch);
1502 UNGCPRO; 1541 UNGCPRO;
1503 if (ch == ')') 1542 if (ch == ')')
1504 return val; 1543 return (cancel ? make_number (0) : val);
1505 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil)); 1544 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
1506 } 1545 }
1507 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil)); 1546 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
@@ -2020,6 +2059,10 @@ The remaining elements of each list are symbols defined as functions\n\
2020or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'."); 2059or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2021 Vload_history = Qnil; 2060 Vload_history = Qnil;
2022 2061
2062 DEFVAR_LISP ("load-file-name", &Vload_file_name,
2063 "Full name of file being loaded by `load'.");
2064 Vload_file_name = Qnil;
2065
2023 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list, 2066 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
2024 "Used for internal purposes by `load'."); 2067 "Used for internal purposes by `load'.");
2025 Vcurrent_load_list = Qnil; 2068 Vcurrent_load_list = Qnil;
@@ -2044,4 +2087,7 @@ or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
2044 2087
2045 Qload = intern ("load"); 2088 Qload = intern ("load");
2046 staticpro (&Qload); 2089 staticpro (&Qload);
2090
2091 Qload_file_name = intern ("load-file-name");
2092 staticpro (&Qload_file_name);
2047} 2093}