Mercurial > hg > xemacs-beta

comparison src/doc.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Record indices of function doc strings stored in a file. 1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 Copyright (C) 2001 Ben Wing.
4 5
5 This file is part of XEmacs. 6 This file is part of XEmacs.
6 7
7 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
8 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
42 data to pass to Fsignal. NAME_NONRELOC and NAME_RELOC 43 data to pass to Fsignal. NAME_NONRELOC and NAME_RELOC
43 are only used for the error messages. */ 44 are only used for the error messages. */
44 45
45 Lisp_Object 46 Lisp_Object
46 unparesseuxify_doc_string (int fd, EMACS_INT position, 47 unparesseuxify_doc_string (int fd, EMACS_INT position,
47 char *name_nonreloc, Lisp_Object name_reloc) 48 Intbyte *name_nonreloc, Lisp_Object name_reloc)
48 { 49 {
49 char buf[512 * 32 + 1]; 50 Intbyte buf[512 * 32 + 1];
50 char *buffer = buf; 51 Intbyte *buffer = buf;
51 int buffer_size = sizeof (buf); 52 int buffer_size = sizeof (buf);
52 char *from, *to; 53 Intbyte *from, *to;
53 REGISTER char *p = buffer; 54 REGISTER Intbyte *p = buffer;
54 Lisp_Object return_me; 55 Lisp_Object return_me;
55 56
56 if (0 > lseek (fd, position, 0)) 57 if (0 > lseek (fd, position, 0))
57 { 58 {
58 if (name_nonreloc) 59 if (name_nonreloc)
59 name_reloc = build_string (name_nonreloc); 60 name_reloc = build_intstring (name_nonreloc);
60 return_me = list3 (build_string 61 return_me = list3 (build_msg_string
61 ("Position out of range in doc string file"), 62 ("Position out of range in doc string file"),
62 name_reloc, make_int (position)); 63 name_reloc, make_int (position));
63 goto done; 64 goto done;
64 } 65 }
65 66
73 int nread; 74 int nread;
74 75
75 /* Switch to a bigger buffer if we need one. */ 76 /* Switch to a bigger buffer if we need one. */
76 if (space_left == 0) 77 if (space_left == 0)
77 { 78 {
78 char * old_buffer = buffer; 79 Intbyte *old_buffer = buffer;
79 if (buffer == buf) { 80 if (buffer == buf)
80 buffer = (char *) xmalloc (buffer_size *= 2); 81 {
81 memcpy (buffer, old_buffer, p - old_buffer); 82 buffer = (Intbyte *) xmalloc (buffer_size *= 2);
82 } else { 83 memcpy (buffer, old_buffer, p - old_buffer);
83 buffer = (char *) xrealloc (buffer, buffer_size *= 2); 84 }
84 } 85 else
86 buffer = (Intbyte *) xrealloc (buffer, buffer_size *= 2);
85 p += buffer - old_buffer; 87 p += buffer - old_buffer;
86 space_left = buffer_size - (p - buffer); 88 space_left = buffer_size - (p - buffer);
87 } 89 }
88 90
89 /* Don't read too much at one go. */ 91 /* Don't read too much at one go. */
90 if (space_left > 1024 * 8) 92 if (space_left > 1024 * 8)
91 space_left = 1024 * 8; 93 space_left = 1024 * 8;
92 nread = read (fd, p, space_left); 94 nread = retry_read (fd, p, space_left);
93 if (nread < 0) 95 if (nread < 0)
94 { 96 {
95 return_me = list1 (build_string 97 return_me = list1 (build_msg_string
96 ("Read error on documentation file")); 98 ("Read error on documentation file"));
97 goto done; 99 goto done;
98 } 100 }
99 p[nread] = 0; 101 p[nread] = 0;
100 if (!nread) 102 if (!nread)
101 break; 103 break;
102 { 104 {
103 char *p1 = strchr (p, '\037'); /* End of doc string marker */ 105 Intbyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */
104 if (p1) 106 if (p1)
105 { 107 {
106 *p1 = 0; 108 *p1 = 0;
107 p = p1; 109 p = p1;
108 break; 110 break;
127 { 129 {
128 case 1: *to++ = c; break; 130 case 1: *to++ = c; break;
129 case '0': *to++ = '\0'; break; 131 case '0': *to++ = '\0'; break;
130 case '_': *to++ = '\037'; break; 132 case '_': *to++ = '\037'; break;
131 default: 133 default:
132 return_me = list2 (build_string 134 return_me = list2 (build_msg_string
133 ("Invalid data in documentation file -- ^A followed by weird code"), 135 ("Invalid data in documentation file -- ^A followed by weird code"),
134 make_int (c)); 136 make_int (c));
135 goto done; 137 goto done;
136 } 138 }
137 } 139 }
138 } 140 }
139 141
140 /* #### mrb: following STILL completely broken */ 142 /* !!#### mrb: following STILL completely broken */
141 return_me = make_ext_string (buffer, to - buffer, Qbinary); 143 return_me = make_ext_string ((Extbyte *) buffer, to - buffer, Qbinary);
142 144
143 done: 145 done:
144 if (buffer != buf) /* We must have allocated buffer above */ 146 if (buffer != buf) /* We must have allocated buffer above */
145 xfree (buffer); 147 xfree (buffer);
146 return return_me; 148 return return_me;
147 } 149 }
148 150
149 #define string_join(dest, s1, s2) \ 151 #define string_join(dest, s1, s2) \
150 memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \ 152 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
151 memcpy ((void *) ((Intbyte *) dest + XSTRING_LENGTH (s1)), \ 153 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \
152 (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2)); \ 154 XSTRING_LENGTH (s2)); \
153 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0' 155 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
154 156
155 /* Extract a doc string from a file. FILEPOS says where to get it. 157 /* Extract a doc string from a file. FILEPOS says where to get it.
156 (This could actually be byte code instructions/constants instead 158 (This could actually be byte code instructions/constants instead
157 of a doc string.) 159 of a doc string.)
163 them without actually fetching the doc string.) */ 165 them without actually fetching the doc string.) */
164 166
165 static Lisp_Object 167 static Lisp_Object
166 get_doc_string (Lisp_Object filepos) 168 get_doc_string (Lisp_Object filepos)
167 { 169 {
168 /* !!#### This function has not been Mule-ized */
169 REGISTER int fd; 170 REGISTER int fd;
170 REGISTER char *name_nonreloc = 0; 171 REGISTER Intbyte *name_nonreloc = 0;
171 EMACS_INT position; 172 EMACS_INT position;
172 Lisp_Object file, tem; 173 Lisp_Object file, tem;
173 Lisp_Object name_reloc = Qnil; 174 Lisp_Object name_reloc = Qnil;
174 175
175 if (INTP (filepos)) 176 if (INTP (filepos))
204 205
205 minsize = XSTRING_LENGTH (Vdoc_directory); 206 minsize = XSTRING_LENGTH (Vdoc_directory);
206 /* sizeof ("../lib-src/") == 12 */ 207 /* sizeof ("../lib-src/") == 12 */
207 if (minsize < 12) 208 if (minsize < 12)
208 minsize = 12; 209 minsize = 12;
209 name_nonreloc = 210 name_nonreloc = alloca_intbytes (minsize + XSTRING_LENGTH (file) + 8);
210 (char *) alloca (minsize + XSTRING_LENGTH (file) + 8);
211 string_join (name_nonreloc, Vdoc_directory, file); 211 string_join (name_nonreloc, Vdoc_directory, file);
212 } 212 }
213 else 213 else
214 name_reloc = file; 214 name_reloc = file;
215 215
216 fd = open (name_nonreloc ? name_nonreloc : 216 fd = qxe_open (name_nonreloc ? name_nonreloc :
217 (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); 217 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
218 if (fd < 0) 218 if (fd < 0)
219 { 219 {
220 #ifndef CANNOT_DUMP 220 #ifndef CANNOT_DUMP
221 if (purify_flag) 221 if (purify_flag)
222 { 222 {
223 /* sizeof ("../lib-src/") == 12 */ 223 /* sizeof ("../lib-src/") == 12 */
224 name_nonreloc = (char *) alloca (12 + XSTRING_LENGTH (file) + 8); 224 name_nonreloc = (Intbyte *) alloca (12 + XSTRING_LENGTH (file) + 8);
225 /* Preparing to dump; DOC file is probably not installed. 225 /* Preparing to dump; DOC file is probably not installed.
226 So check in ../lib-src. */ 226 So check in ../lib-src. */
227 strcpy (name_nonreloc, "../lib-src/"); 227 qxestrcpy (name_nonreloc, (Intbyte *) "../lib-src/");
228 strcat (name_nonreloc, (char *) XSTRING_DATA (file)); 228 qxestrcat (name_nonreloc, XSTRING_DATA (file));
229 229
230 fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); 230 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
231 } 231 }
232 #endif /* CANNOT_DUMP */ 232 #endif /* CANNOT_DUMP */
233 233
234 if (fd < 0) 234 if (fd < 0)
235 signal_error (Qfile_error, "Cannot open doc string file", 235 signal_error (Qfile_error, "Cannot open doc string file",
236 name_nonreloc ? build_string (name_nonreloc) : 236 name_nonreloc ? build_intstring (name_nonreloc) :
237 name_reloc); 237 name_reloc);
238 } 238 }
239 239
240 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc); 240 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc);
241 close (fd); 241 retry_close (fd);
242 242
243 if (!STRINGP (tem)) 243 if (!STRINGP (tem))
244 signal_error_1 (Qinvalid_byte_code, tem); 244 signal_error_1 (Qinvalid_byte_code, tem);
245 245
246 return tem; 246 return tem;
295 doc = get_doc_string (tem); 295 doc = get_doc_string (tem);
296 else 296 else
297 return Qnil; 297 return Qnil;
298 } 298 }
299 else if (KEYMAPP (fun)) 299 else if (KEYMAPP (fun))
300 return build_translated_string ("Prefix command (definition is a keymap of subcommands)."); 300 return build_msg_string ("Prefix command (definition is a keymap of subcommands).");
301 else if (STRINGP (fun) || VECTORP (fun)) 301 else if (STRINGP (fun) || VECTORP (fun))
302 return build_translated_string ("Keyboard macro."); 302 return build_msg_string ("Keyboard macro.");
303 else if (CONSP (fun)) 303 else if (CONSP (fun))
304 { 304 {
305 Lisp_Object funcar = Fcar (fun); 305 Lisp_Object funcar = Fcar (fun);
306 306
307 if (!SYMBOLP (funcar)) 307 if (!SYMBOLP (funcar))
391 UNGCPRO; 391 UNGCPRO;
392 return doc; 392 return doc;
393 } 393 }
394 394
395 static void 395 static void
396 weird_doc (Lisp_Object sym, const char *weirdness, const char *type, int pos) 396 weird_doc (Lisp_Object sym, const CIntbyte *weirdness, const CIntbyte *type,
397 int pos)
397 { 398 {
398 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return; 399 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
399 message ("Note: Strange doc (%s) for %s %s @ %d", 400 message ("Note: Strange doc (%s) for %s %s @ %d",
400 weirdness, type, string_data (XSYMBOL (sym)->name), pos); 401 weirdness, type, string_data (XSYMBOL (sym)->name), pos);
401 } 402 }
409 The file is written to `../lib-src', and later found in `exec-directory' 410 The file is written to `../lib-src', and later found in `exec-directory'
410 when doc strings are referred to in the dumped Emacs. 411 when doc strings are referred to in the dumped Emacs.
411 */ 412 */
412 (filename)) 413 (filename))
413 { 414 {
414 /* !!#### This function has not been Mule-ized */
415 int fd; 415 int fd;
416 char buf[1024 + 1]; 416 Intbyte buf[1024 + 1];
417 REGISTER int filled; 417 REGISTER int filled;
418 REGISTER int pos; 418 REGISTER int pos;
419 REGISTER char *p, *end; 419 REGISTER Intbyte *p, *end;
420 Lisp_Object sym, fun, tem; 420 Lisp_Object sym, fun, tem;
421 char *name; 421 Intbyte *name;
422 422
423 #ifndef CANNOT_DUMP 423 #ifndef CANNOT_DUMP
424 if (!purify_flag) 424 if (!purify_flag)
425 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound); 425 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound);
426 #endif 426 #endif
427 427
428 CHECK_STRING (filename); 428 CHECK_STRING (filename);
429 429
430 #ifdef CANNOT_DUMP 430 #ifdef CANNOT_DUMP
431 if (!NILP(Vdoc_directory)) 431 if (!NILP (Vdoc_directory))
432 { 432 {
433 CHECK_STRING (Vdoc_directory); 433 CHECK_STRING (Vdoc_directory);
434 name = (char *) alloca (XSTRING_LENGTH (filename) 434 name = alloca_intbytes (XSTRING_LENGTH (filename)
435 + XSTRING_LENGTH (Vdoc_directory) 435 + XSTRING_LENGTH (Vdoc_directory)
436 + 1); 436 + 1);
437 strcpy (name, (char *) XSTRING_DATA (Vdoc_directory)); 437 qxestrcpy (name, XSTRING_DATA (Vdoc_directory));
438 } 438 }
439 else 439 else
440 #endif /* CANNOT_DUMP */ 440 #endif /* CANNOT_DUMP */
441 { 441 {
442 name = (char *) alloca (XSTRING_LENGTH (filename) + 14); 442 name = alloca_intbytes (XSTRING_LENGTH (filename) + 14);
443 strcpy (name, "../lib-src/"); 443 qxestrcpy (name, (Intbyte *) "../lib-src/");
444 } 444 }
445 445
446 strcat (name, (char *) XSTRING_DATA (filename)); 446 qxestrcat (name, XSTRING_DATA (filename));
447 447
448 fd = open (name, O_RDONLY | OPEN_BINARY, 0); 448 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0);
449 if (fd < 0) 449 if (fd < 0)
450 report_file_error ("Opening doc string file", build_string (name)); 450 report_file_error ("Opening doc string file", build_intstring (name));
451 Vinternal_doc_file_name = filename; 451 Vinternal_doc_file_name = filename;
452 filled = 0; 452 filled = 0;
453 pos = 0; 453 pos = 0;
454 while (1) 454 while (1)
455 { 455 {
456 if (filled < 512) 456 if (filled < 512)
457 filled += read (fd, &buf[filled], sizeof (buf) - 1 - filled); 457 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled);
458 if (!filled) 458 if (!filled)
459 break; 459 break;
460 460
461 buf[filled] = 0; 461 buf[filled] = 0;
462 p = buf; 462 p = buf;
463 end = buf + (filled < 512 ? filled : filled - 128); 463 end = buf + (filled < 512 ? filled : filled - 128);
464 while (p != end && *p != '\037') p++; 464 while (p != end && *p != '\037') p++;
465 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ 465 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
466 if (p != end) 466 if (p != end)
467 { 467 {
468 end = strchr (p, '\n'); 468 end = qxestrchr (p, '\n');
469 sym = oblookup (Vobarray, (Intbyte *) p + 2, end - p - 2); 469 sym = oblookup (Vobarray, p + 2, end - p - 2);
470 if (SYMBOLP (sym)) 470 if (SYMBOLP (sym))
471 { 471 {
472 Lisp_Object offset = make_int (pos + end + 1 - buf); 472 Lisp_Object offset = make_int (pos + end + 1 - buf);
473 /* Attach a docstring to a variable */ 473 /* Attach a docstring to a variable */
474 if (p[1] == 'V') 474 if (p[1] == 'V')
501 if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) 501 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
502 fun = XCDR (fun); 502 fun = XCDR (fun);
503 503
504 if (UNBOUNDP (fun)) 504 if (UNBOUNDP (fun))
505 { 505 {
506 #if 0 /* There are lots of legitimate cases where this message will appear
507 (e.g. any function that's only defined when MULE is defined,
508 provided that the function is used somewhere in a dumped Lisp
509 file, so that the symbol is interned in the dumped XEmacs), and
510 there's not a lot that can be done to eliminate the warning other
511 than kludges like moving the function to a Mule-only source file,
512 which often results in ugly code. Furthermore, the only point of
513 this warning is to warn you when you have a DEFUN that you forget
514 to DEFSUBR, but the compiler will also warn you, because the DEFUN
515 declares a static object, and the object will be unused -- you'll
516 get something like
517
518 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used
519
520 So I'm disabling this. --ben */
521
506 /* May have been #if'ed out or something */ 522 /* May have been #if'ed out or something */
507 weird_doc (sym, GETTEXT ("not fboundp"), 523 weird_doc (sym, GETTEXT ("not fboundp"),
508 GETTEXT ("function"), pos); 524 GETTEXT ("function"), pos);
525 #endif
509 goto weird; 526 goto weird;
510 } 527 }
511 else if (SUBRP (fun)) 528 else if (SUBRP (fun))
512 { 529 {
513 /* Lisp_Subrs have a slot for it. */ 530 /* Lisp_Subrs have a slot for it. */
615 } 632 }
616 } 633 }
617 else 634 else
618 { 635 {
619 /* lose: */ 636 /* lose: */
620 signal_error (Qfile_error, "DOC file invalid at position", make_int (pos)); 637 signal_error (Qfile_error, "DOC file invalid at position",
638 make_int (pos));
621 weird: 639 weird:
622 /* goto lose */; 640 /* goto lose */;
623 } 641 }
624 } 642 }
625 } 643 }
626 cont: 644 cont:
627 pos += end - buf; 645 pos += end - buf;
628 filled -= end - buf; 646 filled -= end - buf;
629 memmove (buf, end, filled); 647 memmove (buf, end, filled);
630 } 648 }
631 close (fd); 649 retry_close (fd);
632 return Qnil; 650 return Qnil;
633 } 651 }
634 652
635 653
636 #if 1 /* Don't warn about functions whose doc was lost because they were 654 #if 1 /* Don't warn about functions whose doc was lost because they were