Add missing declaration for make_bigz
[sxemacs] / src / doc.c
1 /* Record indices of function doc strings stored in a file.
2    Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
3    Free Software Foundation, Inc.
4
5 This file is part of SXEmacs
6
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
11
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
19
20
21 /* Synched up with: FSF 19.30. */
22
23 /* This file has been Mule-ized except as noted. */
24
25 #include <config.h>
26 #include "lisp.h"
27
28 #include "buffer.h"
29 #include "bytecode.h"
30 #include "ui/insdel.h"
31 #include "ui/keymap.h"
32 #include "sysfile.h"
33
34 Lisp_Object Vinternal_doc_file_name;
35 Lisp_Object Vinternal_doc_fd;
36
37 Lisp_Object QSsubstitute, Qdefvar;
38
39 #ifdef WITH_PDUMP
40 extern unsigned int dump_id;
41 #endif
42
43 /* Work out what source file a function or variable came from, taking the
44    information from the documentation file. */
45
46 static Lisp_Object extract_object_file_name (int fd, EMACS_INT doc_pos,
47                                              SBufbyte *name_nonreloc,
48                                              Lisp_Object name_reloc,
49                                              int standard_doc_file)
50 {
51         Bufbyte buf[DOC_MAX_FILENAME_LENGTH+1];
52         Bufbyte *buffer = buf;
53         int buffer_size = sizeof (buf) - 1, space_left;
54         Bufbyte *from, *to;
55         REGISTER Bufbyte *p = buffer;
56         Lisp_Object return_me;
57         EMACS_INT position, seenS = 0;
58
59         position = doc_pos > buffer_size  ?
60                 doc_pos - buffer_size : 0;
61
62         if (0 > lseek (fd, position, 0)) {
63                 if (name_nonreloc)
64                         name_reloc = build_string (name_nonreloc);
65                 return_me = list3 (build_string
66                                    ("Position out of range in doc string file"),
67                                    name_reloc, make_int (position));
68                 goto done;
69         }
70
71         space_left = buffer_size - (p - buffer);
72         while (space_left > 0) {
73                 int nread;
74
75                 nread = read (fd, p, space_left);
76                 if (nread < 0) {
77                         return_me
78                                 = list1 (build_string
79                                          ("Read error on documentation file"));
80                         goto done;
81                 }
82
83                 p[nread] = 0;
84
85                 if (!nread)
86                         break;
87
88                 p += nread;
89                 space_left = buffer_size - (p - buffer);
90         }
91
92         /* First, search backward for the "\037S" that marks the beginning
93            of the file name, then search forward from that to the newline or
94            to the end of the buffer. */
95         from = p;
96
97         while (from > buf) {
98                 --from;
99                 if (seenS) {
100                         if ('\037' == *from) {
101
102                                 /* Got a file name; adjust `from' to point
103                                    to it, break out of the loop.  */
104                                 from += 2;
105                                 break;
106                         }
107                 }
108                 /* Is *from 'S' ? */
109                 seenS = ('S' == *from);
110         }
111
112         if (buf == from) {
113                 /* We've scanned back to the beginning of the buffer without
114                    hitting the file name. Either the file name plus the
115                    symbol name is longer than DOC_MAX_FILENAME_LENGTH--which
116                    shouldn't happen, because it'll trigger an assertion
117                    failure in make-docfile, the DOC file is corrupt, or it
118                    was produced by a version of make-docfile that doesn't
119                    store the file name with the symbol name and
120                    docstring.  */
121                 return_me = list1 (build_string
122                                    ("Object file name not stored in doc file"));
123                 goto done;
124         }
125
126         to = from;
127         /* Search for the end of the file name. */
128         while (++to < p) {
129                 if ('\n' == *to || '\037' == *to) {
130                         break;
131                 }
132         }
133
134         /* Don't require the file name to end in a newline. */
135         return_me = make_string (from, to - from);
136
137 done:
138
139         return return_me;
140 }
141
142 /* Read and return doc string from open file descriptor FD
143    at position POSITION.  Does not close the file.  Returns
144    string; or if error, returns a cons holding the error
145    data to pass to Fsignal.  NAME_NONRELOC and NAME_RELOC
146    are only used for the error messages. */
147
148 Lisp_Object
149 unparesseuxify_doc_string(int fd, EMACS_INT position,
150                           char *name_nonreloc, Lisp_Object name_reloc)
151 {
152         char buf[512 * 8 + 1];
153         char *buffer = buf;
154         int buffer_size = sizeof(buf)-1;
155         char *from, *to;
156         REGISTER char *p = buffer;
157         Lisp_Object return_me;
158
159         if (0 > lseek(fd, position, 0)) {
160                 if (name_nonreloc)
161                         name_reloc = build_string(name_nonreloc);
162                 return_me = list3(build_string
163                                   ("Position out of range in doc string file"),
164                                   name_reloc, make_int(position));
165                 goto done;
166         }
167
168         /* Read the doc string into a buffer.
169            Use the fixed buffer BUF if it is big enough; otherwise allocate one.
170            We store the buffer in use in BUFFER and its size in BUFFER_SIZE.  */
171
172         while (1) {
173                 int space_left = buffer_size - (p - buffer);
174                 int nread;
175
176                 /* Switch to a bigger buffer if we need one.  */
177                 if (space_left == 0) {
178                         char *old_buffer = buffer;
179                         buffer_size *= 2;
180                         if (buffer == buf) {
181                                 buffer = (char*)xmalloc_atomic(buffer_size + 1);
182                                 memcpy(buffer, old_buffer, p - old_buffer);
183                         } else {
184                                 char *foo = xrealloc(buffer, buffer_size + 1);
185                                 buffer = foo;
186                         }
187                         p += buffer - old_buffer;
188                         space_left = buffer_size - (p - buffer);
189                 }
190
191                 /* Don't read too much at one go.  */
192                 if (space_left > 1024 * 8)
193                         space_left = 1024 * 8;
194                 nread = read(fd, p, space_left);
195                 if (nread < 0) {
196                         return_me = list1(build_string
197                                           ("Read error on documentation file"));
198                         goto done;
199                 }
200                 p[nread] = 0;
201                 if (!nread)
202                         break;
203                 {
204                         char *p1 = strchr(p, '\037');   /* End of doc string marker */
205                         if (p1) {
206                                 *p1 = 0;
207                                 p = p1;
208                                 break;
209                         }
210                 }
211                 p += nread;
212         }
213
214         /* Scan the text and remove quoting with ^A (char code 1).
215            ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
216         from = to = buffer;
217         while (from < p) {
218                 if (*from != 1 /*^A */ )
219                         *to++ = *from++;
220                 else {
221                         int c = *(++from);
222
223                         from++;
224                         switch (c) {
225                         case 1:
226                                 *to++ = c;
227                                 break;
228                         case '0':
229                                 *to++ = '\0';
230                                 break;
231                         case '_':
232                                 *to++ = '\037';
233                                 break;
234                         default:
235                                 return_me = list2(build_string
236                                                   ("Invalid data in documentation file -- ^A followed by weird code"),
237                                                   make_int(c));
238                                 goto done;
239                         }
240                 }
241         }
242
243         /* #### mrb: following STILL completely broken */
244         return_me = make_ext_string(buffer, to - buffer, Qbinary);
245
246       done:
247         if (buffer != buf)      /* We must have allocated buffer above */
248                 xfree(buffer);
249         return return_me;
250 }
251
252 #define string_join(dest, s1, s2) \
253   memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
254   memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \
255           (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2));  \
256           dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
257
258 /* Extract a doc string from a file.  FILEPOS says where to get it.
259    (This could actually be byte code instructions/constants instead
260    of a doc string.)
261    If it is an integer, use that position in the standard DOC file.
262    If it is (FILE . INTEGER), use FILE as the file name
263    and INTEGER as the position in that file.
264    But if INTEGER is negative, make it positive.
265    (A negative integer is used for user variables, so we can distinguish
266    them without actually fetching the doc string.)  */
267
268 static Lisp_Object
269 get_doc_string(Lisp_Object filepos)
270 {
271         /* !!#### This function has not been Mule-ized */
272         REGISTER int fd = -1;
273         REGISTER char *name_nonreloc = 0;
274         EMACS_INT position;
275         Lisp_Object file, tem;
276         Lisp_Object name_reloc = Qnil;
277
278         if (INTP(filepos)) {
279                 file = Vinternal_doc_file_name;
280                 position = XINT(filepos);
281                 if ( INTP(Vinternal_doc_fd) )
282                         fd = XINT(Vinternal_doc_fd);
283                 else
284                         fd = -2;
285         } else if (CONSP(filepos) && INTP(XCDR(filepos))) {
286                 file = XCAR(filepos);
287                 position = XINT(XCDR(filepos));
288                 if (position < 0)
289                         position = -position;
290         } else
291                 return Qnil;
292
293         if (!STRINGP(file))
294                 return Qnil;
295
296         if ( fd < 0 ) {
297                 int ofd;
298
299                 /* Put the file name in NAME as a C string.
300                    If it is relative, combine it with Vdoc_directory.  */
301
302                 tem = Ffile_name_absolute_p(file);
303                 if (NILP(tem)) {
304                         size_t minsize;
305                         /* XEmacs: Move this check here.  OK if called during loadup to
306                            load byte code instructions. */
307                         if (!STRINGP(Vdoc_directory))
308                                 return Qnil;
309
310                         minsize = XSTRING_LENGTH(Vdoc_directory);
311                         /* sizeof ("./") == 3 */
312                         if (minsize < 3)
313                                 minsize = 3;
314                         name_nonreloc =
315                                 (char *)alloca(minsize + XSTRING_LENGTH(file) + 8);
316                         string_join(name_nonreloc, Vdoc_directory, file);
317                 } else
318                         name_reloc = file;
319
320                 ofd = open(name_nonreloc ? name_nonreloc :
321                            (char *)XSTRING_DATA(name_reloc), O_RDONLY | OPEN_BINARY, 0);
322                 if ( fd == -2 )
323                         Vinternal_doc_fd = make_int(ofd);
324                 fd = ofd;
325         }
326         if (fd < 0) {
327 #ifndef CANNOT_DUMP
328                 if (purify_flag) {
329                         /* sizeof ("./") == 3 */
330                         name_nonreloc =
331                             (char *)alloca(3 + XSTRING_LENGTH(file) + 8);
332                         /* Preparing to dump; DOC file is probably not installed.
333                            So check in ../lib-src. */
334                         strcpy(name_nonreloc, "./");
335                         strcat(name_nonreloc, (char *)XSTRING_DATA(file));
336
337                         fd = open(name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
338                 }
339 #endif                          /* CANNOT_DUMP */
340
341                 if (fd < 0)
342                         error("Cannot open doc string file \"%s\"",
343                               name_nonreloc ? name_nonreloc :
344                               (char *)XSTRING_DATA(name_reloc));
345         }
346
347         tem =
348             unparesseuxify_doc_string(fd, position, name_nonreloc, name_reloc);
349         if (!INTP(Vinternal_doc_fd) || (fd != XINT(Vinternal_doc_fd))) {
350                 Vinternal_doc_fd = make_int(-2);
351                 close(fd);
352         } else
353                 lseek(fd,0,0);
354
355
356         if (!STRINGP(tem))
357                 signal_error(Qerror, tem);
358
359         return tem;
360 }
361
362 /* Get a string from position FILEPOS and pass it through the Lisp reader.
363    We use this for fetching the bytecode string and constants vector
364    of a compiled function from the .elc file.  */
365
366 Lisp_Object read_doc_string(Lisp_Object filepos)
367 {
368         Lisp_Object string = get_doc_string(filepos);
369
370         if (!STRINGP(string))
371                 signal_simple_error("loading bytecode failed to return string",
372                                     string);
373         return Fread(string);
374 }
375
376 static Lisp_Object get_object_file_name (Lisp_Object filepos) {
377         REGISTER int fd = -1;
378         REGISTER SBufbyte *name_nonreloc = 0;
379         EMACS_INT position;
380         Lisp_Object file, tem;
381         Lisp_Object name_reloc = Qnil;
382         int standard_doc_file = 0;
383
384         if (INTP (filepos)) {
385                 file = Vinternal_doc_file_name;
386                 standard_doc_file = 1;
387                 position = XINT (filepos);
388                 if ( INTP(Vinternal_doc_fd) )
389                         fd = XINT(Vinternal_doc_fd);
390                 else
391                         fd = -2;
392         } else if (CONSP (filepos) && INTP (XCDR (filepos))) {
393                 file = XCAR (filepos);
394                 position = XINT (XCDR (filepos));
395                 if (position < 0)
396                         position = - position;
397         } else return Qnil;
398
399         if (!STRINGP (file))
400                 return Qnil;
401
402         /* Put the file name in NAME as a C string.
403            If it is relative, combine it with Vdoc_directory.  */
404
405         tem = Ffile_name_absolute_p (file);
406         if (NILP (tem)) {
407                 Bytecount minsize;
408                 /* XEmacs: Move this check here.  OK if called during loadup to
409                    load byte code instructions. */
410                 if (!STRINGP (Vdoc_directory))
411                         return Qnil;
412
413                 minsize = XSTRING_LENGTH (Vdoc_directory);
414                 /* sizeof ("../lib-src/") == 12 */
415                 if (minsize < 12)
416                         minsize = 12;
417                 name_nonreloc = alloca_array (SBufbyte,
418                                               minsize +
419                                               XSTRING_LENGTH (file) + 8);
420                 string_join (name_nonreloc, Vdoc_directory, file);
421         } else name_reloc = file;
422
423         if (fd < 0) {
424                 int ofd;
425
426                 if (purify_flag) {
427                         /* sizeof ("../lib-src/") == 12 */
428                         name_nonreloc
429                                 = alloca_array (SBufbyte,
430                                                 12 + XSTRING_LENGTH (file) + 8);
431                         /* Preparing to dump; DOC file is probably not
432                            installed.  So check in ../lib-src. */
433
434                         strcpy (name_nonreloc, "../lib-src/");
435                         strcat (name_nonreloc, (char *)XSTRING_DATA (file));
436
437                         fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
438                 }
439
440                 ofd = open (name_nonreloc ? name_nonreloc :
441                             (char *)XSTRING_DATA (name_reloc),
442                             O_RDONLY | OPEN_BINARY, 0);
443
444                 if (fd == -2)
445                         Vinternal_doc_fd = make_int (ofd);
446                 fd = ofd;
447         }
448         if (fd < 0) {
449                 report_file_error ("Cannot open doc string file",
450                                    name_nonreloc ?
451                                    build_string (name_nonreloc) :
452                                    name_reloc);
453         }
454
455         tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc,
456                                         standard_doc_file);
457         if (!INTP(Vinternal_doc_fd) || (fd != XINT(Vinternal_doc_fd))) {
458                 Vinternal_doc_fd = make_int(-2);
459                 close(fd);
460         } else
461                 lseek(fd,0,0);
462
463         if (!STRINGP (tem))
464                 signal_error (Qinvalid_byte_code, tem);
465
466         return tem;
467 }
468
469 \f
470 static void
471 weird_doc(Lisp_Object sym, const char *weirdness, const char *type, int pos)
472 {
473         if (!strcmp(weirdness, GETTEXT("duplicate")))
474                 return;
475         message("Note: Strange doc (%s) for %s %s @ %d",
476                 weirdness, type, string_data(XSYMBOL(sym)->name), pos);
477 }
478
479 DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /*
480 Return the C source file built-in symbol SYM comes from.
481 Don't use this.  Use the more general `symbol-file' (q.v.) instead.
482
483 If TYPE is nil or omitted, any kind of definition is acceptable.
484 If TYPE is `defun', then function, subr, special form or macro definitions
485 are acceptable.
486 If TYPE is `defvar', then variable definitions are acceptable.
487 */
488        (symbol, type))
489 {
490         /* This function can GC */
491         Lisp_Object fun;
492         Lisp_Object filename = Qnil;
493
494         if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) {
495                 fun = Findirect_function (symbol);
496
497                 if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun)))
498                                     && (fun = Fcdr_safe (fun), SUBRP (fun)))) {
499                         if (XSUBR (fun)->doc == 0)
500                                 return Qnil;
501
502                         if ((EMACS_INT) XSUBR (fun)->doc >= 0) {
503                                 weird_doc
504                                         (symbol,
505                                          "No file info available for function",
506                                          GETTEXT("function"), 0);
507                                 return Qnil;
508                         } else {
509                                 filename = get_object_file_name
510                                         (make_int (-
511                                                    (EMACS_INT)
512                                                    XSUBR (fun)->doc));
513                                 return filename;
514                         }
515                 }
516
517                 if (COMPILED_FUNCTIONP (fun)
518                     || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun)))
519                         && (fun = Fcdr_safe (fun),
520                             COMPILED_FUNCTIONP (fun)))) {
521                         Lisp_Object tem;
522                         Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
523
524                         if (! (f->flags.documentationp))
525                                 return Qnil;
526                         tem = compiled_function_documentation (f);
527                         if (NATNUMP (tem) || CONSP (tem)) {
528                                 filename = get_object_file_name (tem);
529                                 return filename;
530                         }
531                 }
532         }
533
534         if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) {
535                 Lisp_Object doc_offset
536                         = Fget (symbol, Qvariable_documentation, Qnil);
537
538                 if (!NILP(doc_offset)) {
539                         if (INTP(doc_offset)) {
540                                 filename = get_object_file_name
541                                         (XINT (doc_offset) > 0 ? doc_offset
542                                          : make_int (- XINT (doc_offset)));
543                         } else if (CONSP(doc_offset)) {
544                                 filename = get_object_file_name(doc_offset);
545                         }
546                         return filename;
547                 }
548         }
549         return Qnil;
550 }
551
552 DEFUN("documentation", Fdocumentation, 1, 2, 0, /*
553 Return the documentation string of FUNCTION.
554 Unless a non-nil second argument RAW is given, the
555 string is passed through `substitute-command-keys'.
556 */
557       (function, raw))
558 {
559         /* This function can GC */
560         Lisp_Object fun;
561         Lisp_Object doc;
562
563         fun = Findirect_function(function);
564
565         if (SUBRP(fun)) {
566                 if (XSUBR(fun)->doc == 0)
567                         return Qnil;
568                 if ((EMACS_INT) XSUBR(fun)->doc >= 0)
569                         doc = build_string(XSUBR(fun)->doc);
570                 else
571                         doc =
572                             get_doc_string(make_int
573                                            (-(EMACS_INT) XSUBR(fun)->doc));
574         } else if (COMPILED_FUNCTIONP(fun)) {
575                 Lisp_Object tem;
576                 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION(fun);
577                 if (!(f->flags.documentationp))
578                         return Qnil;
579                 tem = compiled_function_documentation(f);
580                 if (STRINGP(tem))
581                         doc = tem;
582                 else if (NATNUMP(tem) || CONSP(tem))
583                         doc = get_doc_string(tem);
584                 else
585                         return Qnil;
586         } else if (KEYMAPP(fun))
587                 return
588                     build_translated_string
589                     ("Prefix command (definition is a keymap of subcommands).");
590         else if (STRINGP(fun) || VECTORP(fun))
591                 return build_translated_string("Keyboard macro.");
592         else if (CONSP(fun)) {
593                 Lisp_Object funcar = Fcar(fun);
594
595                 if (!SYMBOLP(funcar))
596                         return Fsignal(Qinvalid_function, list1(fun));
597                 else if (EQ(funcar, Qlambda)
598                          || EQ(funcar, Qautoload)) {
599                         Lisp_Object tem, tem1;
600                         tem1 = Fcdr(Fcdr(fun));
601                         tem = Fcar(tem1);
602                         if (STRINGP(tem))
603                                 doc = tem;
604                         /* Handle a doc reference--but these never come last
605                            in the function body, so reject them if they are last.  */
606                         else if ((NATNUMP(tem) || CONSP(tem))
607                                  && !NILP(XCDR(tem1)))
608                                 doc = get_doc_string(tem);
609                         else
610                                 return Qnil;
611                 } else if (EQ(funcar, Qmacro))
612                         return Fdocumentation(Fcdr(fun), raw);
613                 else
614                         goto oops;
615         } else {
616               oops:
617                 return Fsignal(Qinvalid_function, list1(fun));
618         }
619
620         if (NILP(raw)) {
621                 struct gcpro gcpro1;
622 #ifdef I18N3
623                 Lisp_Object domain = Qnil;
624                 if (COMPILED_FUNCTIONP(fun))
625                         domain =
626                             compiled_function_domain(XCOMPILED_FUNCTION(fun));
627                 if (NILP(domain))
628                         doc = Fgettext(doc);
629                 else
630                         doc = Fdgettext(domain, doc);
631 #endif
632
633                 GCPRO1(doc);
634                 doc = Fsubstitute_command_keys(doc);
635                 UNGCPRO;
636         }
637         return doc;
638 }
639
640 DEFUN("documentation-property", Fdocumentation_property, 2, 3, 0,       /*
641 Return the documentation string that is SYMBOL's PROP property.
642 This is like `get', but it can refer to strings stored in the
643 `doc-directory/DOC' file; and if the value is a string, it is passed
644 through `substitute-command-keys'.  A non-nil third argument avoids this
645 translation.
646 */
647       (symbol, prop, raw))
648 {
649         /* This function can GC */
650         REGISTER Lisp_Object doc = Qnil;
651 #ifdef I18N3
652         REGISTER Lisp_Object domain;
653 #endif
654         struct gcpro gcpro1;
655
656         GCPRO1(doc);
657
658         doc = Fget(symbol, prop, Qnil);
659         if (INTP(doc))
660                 doc =
661                     get_doc_string(XINT(doc) > 0 ? doc : make_int(-XINT(doc)));
662         else if (CONSP(doc))
663                 doc = get_doc_string(doc);
664 #ifdef I18N3
665         if (!NILP(doc)) {
666                 domain = Fget(symbol, Qvariable_domain, Qnil);
667                 if (NILP(domain))
668                         doc = Fgettext(doc);
669                 else
670                         doc = Fdgettext(domain, doc);
671         }
672 #endif
673         if (NILP(raw) && STRINGP(doc))
674                 doc = Fsubstitute_command_keys(doc);
675         UNGCPRO;
676         return doc;
677 }
678 \f
679
680 DEFUN("Snarf-documentation", Fsnarf_documentation, 1, 1, 0,     /*
681 Used during Emacs initialization, before dumping runnable Emacs,
682 to find pointers to doc strings stored in `.../lib-src/DOC' and
683 record them in function definitions.
684 One arg, FILENAME, a string which does not include a directory.
685 The file is written to `../lib-src', and later found in `exec-directory'
686 when doc strings are referred to in the dumped Emacs.
687 */
688       (filename))
689 {
690         /* !!#### This function has not been Mule-ized */
691         int fd;
692         char buf[1024 + 1];
693         REGISTER int filled;
694         REGISTER int pos;
695         REGISTER char *p, *end;
696         Lisp_Object sym, fun, tem;
697         char *name;
698
699 #ifndef CANNOT_DUMP
700         if (!purify_flag)
701                 error("Snarf-documentation can only be called in an undumped "
702                       "SXEmacs");
703 #endif
704
705         CHECK_STRING(filename);
706
707 #ifdef CANNOT_DUMP
708         if (!NILP(Vdoc_directory)) {
709                 int alloca_sz = XSTRING_LENGTH(filename)
710                         + XSTRING_LENGTH(Vdoc_directory) + 1 + 9;
711                 int prt;
712                 CHECK_STRING(Vdoc_directory);
713                 name = (char *)alloca(alloca_sz);
714                 prt = snprintf(name, alloca_sz, "%s%s",
715                                (char*)XSTRING_DATA(Vdoc_directory),
716                                (char*)XSTRING_DATA(filename));
717                 assert(prt>=0 && prt < alloca_sz);
718         } else
719 #endif                          /* CANNOT_DUMP */
720         {
721                 int alloca_sz = 2 + XSTRING_LENGTH(filename) + 3 + 9 + 1;
722                 int prt;
723                 name = (char *)alloca(alloca_sz);
724                 prt = snprintf(name, alloca_sz, "./%s",
725                          (char*)XSTRING_DATA(filename));
726                 assert(prt >= 0 && prt < alloca_sz);
727         }
728
729         fd = open(name, O_RDONLY | OPEN_BINARY, 0);
730         if (fd < 0)
731                 report_file_error("Opening doc string file",
732                                   Fcons(build_string(name), Qnil));
733         Vinternal_doc_file_name = filename;
734         filled = 0;
735         pos = 0;
736         while (1) {
737                 if (filled < 512)
738                         filled +=
739                             read(fd, &buf[filled], sizeof buf - 1 - filled);
740                 if (!filled)
741                         break;
742
743                 buf[filled] = 0;
744                 p = buf;
745                 end = buf + (filled < 512 ? filled : filled - 128);
746                 while (p != end && *p != '\037')
747                         p++;
748                 /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
749                 if (p != end) {
750                         end = strchr(p, '\n');
751                         if (end == NULL) {
752                                 report_file_error("Bad format in file",
753                                                   Fcons(build_string(name), Qnil)); 
754                                 close(fd);
755                                 return Qnil;
756                         }
757                         sym =
758                             oblookup(Vobarray, (Bufbyte *) p + 2, end - p - 2);
759                         if (SYMBOLP(sym)) {
760                                 Lisp_Object offset =
761                                     make_int(pos + end + 1 - buf);
762                                 /* Attach a docstring to a variable */
763                                 if (p[1] == 'V') {
764                                         /* Install file-position as variable-documentation property
765                                            and make it negative for a user-variable
766                                            (doc starts with a `*').  */
767                                         Lisp_Object old =
768                                             Fget(sym, Qvariable_documentation,
769                                                  Qzero);
770                                         if (!ZEROP(old)) {
771                                                 weird_doc(sym,
772                                                           GETTEXT("duplicate"),
773                                                           GETTEXT("variable"),
774                                                           pos);
775                                                 /* In the case of duplicate doc file entries, always
776                                                    take the later one.  But if the doc is not an int
777                                                    (a string, say) leave it alone. */
778                                                 if (!INTP(old))
779                                                         goto weird;
780                                         }
781                                         Fput(sym, Qvariable_documentation,
782                                              ((end[1] == '*')
783                                               ? make_int(-XINT(offset))
784                                               : offset));
785                                 }
786                                 /* Attach a docstring to a function.
787                                    The type determines where the docstring is stored.  */
788                                 else if (p[1] == 'F') {
789                                         fun = indirect_function(sym, 0);
790
791                                         if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
792                                                 fun = XCDR(fun);
793
794                                         if (UNBOUNDP(fun)) {
795                                                 /* May have been #if'ed out or something */
796                                                 weird_doc(sym,
797                                                           GETTEXT
798                                                           ("not fboundp"),
799                                                           GETTEXT("function"),
800                                                           pos);
801                                                 goto weird;
802                                         } else if (SUBRP(fun)) {
803                                                 /* Lisp_Subrs have a slot for it.  */
804                                                 if (XSUBR(fun)->doc) {
805                                                         weird_doc(sym,
806                                                                   GETTEXT
807                                                                   ("duplicate"),
808                                                                   GETTEXT
809                                                                   ("subr"),
810                                                                   pos);
811                                                         goto weird;
812                                                 }
813                                                 XSUBR(fun)->doc =
814                                                     (char *)(-XINT(offset));
815                                         } else if (CONSP(fun)) {
816                                                 /* If it's a lisp form, stick it in the form.  */
817                                                 tem = XCAR(fun);
818                                                 if (EQ(tem, Qlambda)
819                                                     || EQ(tem, Qautoload)) {
820                                                         tem = Fcdr(Fcdr(fun));
821                                                         if (CONSP(tem) &&
822                                                             INTP(XCAR(tem))) {
823                                                                 Lisp_Object old
824                                                                     = XCAR(tem);
825                                                                 if (!ZEROP(old)) {
826                                                                         weird_doc
827                                                                             (sym,
828                                                                              GETTEXT
829                                                                              ("duplicate"),
830                                                                              (EQ
831                                                                               (tem,
832                                                                                Qlambda)
833                                                                               ?
834                                                                               GETTEXT
835                                                                               ("lambda")
836                                                                               :
837                                                                               GETTEXT
838                                                                               ("autoload")),
839                                                                              pos);
840                                                                         /* In the case of duplicate doc file entries,
841                                                                            always take the later one.  But if the doc
842                                                                            is not an int (a string, say) leave it
843                                                                            alone. */
844                                                                         if (!INTP(old))
845                                                                                 goto weird;
846                                                                 }
847                                                                 XCAR(tem) =
848                                                                     offset;
849                                                         } else if (!CONSP(tem)) {
850                                                                 weird_doc(sym,
851                                                                           GETTEXT
852                                                                           ("!CONSP(tem)"),
853                                                                           GETTEXT
854                                                                           ("function"),
855                                                                           pos);
856                                                                 goto cont;
857                                                         } else {
858                                                                 /* DOC string is a string not integer 0 */
859 #if 0
860                                                                 weird_doc(sym,
861                                                                           GETTEXT
862                                                                           ("!INTP(XCAR(tem))"),
863                                                                           GETTEXT
864                                                                           ("function"),
865                                                                           pos);
866 #endif
867                                                                 goto cont;
868                                                         }
869                                                 } else {
870                                                         weird_doc(sym,
871                                                                   GETTEXT
872                                                                   ("not lambda or autoload"),
873                                                                   GETTEXT
874                                                                   ("function"),
875                                                                   pos);
876                                                         goto cont;
877                                                 }
878                                         } else if (COMPILED_FUNCTIONP(fun)) {
879                                                 /* Compiled-Function objects sometimes have
880                                                    slots for it.  */
881                                                 Lisp_Compiled_Function *f =
882                                                     XCOMPILED_FUNCTION(fun);
883
884                                                 /* This compiled-function object must have a
885                                                    slot for the docstring, since we've found a
886                                                    docstring for it.  Unless there were multiple
887                                                    definitions of it, and the latter one didn't
888                                                    have any doc, which is a legal if slightly
889                                                    bogus situation, so don't blow up. */
890
891                                                 if (!(f->flags.documentationp)) {
892                                                         weird_doc(sym,
893                                                                   GETTEXT
894                                                                   ("no doc slot"),
895                                                                   GETTEXT
896                                                                   ("bytecode"),
897                                                                   pos);
898                                                         goto weird;
899                                                 } else {
900                                                         Lisp_Object old =
901                                                             compiled_function_documentation
902                                                             (f);
903                                                         if (!ZEROP(old)) {
904                                                                 weird_doc(sym,
905                                                                           GETTEXT
906                                                                           ("duplicate"),
907                                                                           GETTEXT
908                                                                           ("bytecode"),
909                                                                           pos);
910                                                                 /* In the case of duplicate doc file entries,
911                                                                    always take the later one.  But if the doc is
912                                                                    not an int (a string, say) leave it alone. */
913                                                                 if (!INTP(old))
914                                                                         goto weird;
915                                                         }
916                                                         set_compiled_function_documentation
917                                                             (f, offset);
918                                                 }
919                                         } else {
920                                                 /* Otherwise the function is undefined or
921                                                    otherwise weird.   Ignore it. */
922                                                 weird_doc(sym,
923                                                           GETTEXT
924                                                           ("weird function"),
925                                                           GETTEXT("function"),
926                                                           pos);
927                                                 goto weird;
928                                         }
929                                 } else {
930                                         /* lose: */
931                                         error("DOC file invalid at position %d",
932                                               pos);
933                                       weird:
934                                         /* goto lose */ ;
935                                 }
936                         }
937                 }
938               cont:
939                 pos += end - buf;
940                 filled -= end - buf;
941                 memmove(buf, end, filled);
942         }
943         close(fd);
944         return Qnil;
945 }
946
947 #if 1                           /* Don't warn about functions whose doc was lost because they were
948                                    wrapped by advice-freeze.el... */
949 static int kludgily_ignore_lost_doc_p(Lisp_Object sym)
950 {
951 # define kludge_prefix "ad-Orig-"
952         Lisp_String *name = XSYMBOL(sym)->name;
953         return (string_length(name) > (Bytecount) (sizeof(kludge_prefix)) &&
954                 !strncmp((char *)string_data(name), kludge_prefix,
955                          sizeof(kludge_prefix) - 1));
956 # undef kludge_prefix
957 }
958 #else
959 # define kludgily_ignore_lost_doc_p(sym) 0
960 #endif
961
962 static int verify_doc_mapper(Lisp_Object sym, void *arg)
963 {
964         Lisp_Object closure = *(Lisp_Object *) arg;
965
966         if (!NILP(Ffboundp(sym))) {
967                 int doc = 0;
968                 Lisp_Object fun = XSYMBOL(sym)->function;
969                 if (CONSP(fun) && EQ(XCAR(fun), Qmacro))
970                         fun = XCDR(fun);
971
972                 if (SUBRP(fun))
973                         doc = (EMACS_INT) XSUBR(fun)->doc;
974                 else if (SYMBOLP(fun))
975                         doc = -1;
976                 else if (KEYMAPP(fun))
977                         doc = -1;
978                 else if (CONSP(fun)) {
979                         Lisp_Object tem = XCAR(fun);
980                         if (EQ(tem, Qlambda) || EQ(tem, Qautoload)) {
981                                 doc = -1;
982                                 tem = Fcdr(Fcdr(fun));
983                                 if (CONSP(tem) && INTP(XCAR(tem)))
984                                         doc = XINT(XCAR(tem));
985                         }
986                 } else if (COMPILED_FUNCTIONP(fun)) {
987                         Lisp_Compiled_Function *f = XCOMPILED_FUNCTION(fun);
988                         if (!(f->flags.documentationp))
989                                 doc = -1;
990                         else {
991                                 Lisp_Object tem =
992                                     compiled_function_documentation(f);
993                                 if (INTP(tem))
994                                         doc = XINT(tem);
995                         }
996                 }
997
998                 if (doc == 0 && !kludgily_ignore_lost_doc_p(sym)) {
999                         message("Warning: doc lost for function %s.",
1000                                 string_data(XSYMBOL(sym)->name));
1001                         XCDR(closure) = Qt;
1002                 }
1003         }
1004         if (!NILP(Fboundp(sym))) {
1005                 Lisp_Object doc = Fget(sym, Qvariable_documentation, Qnil);
1006                 if (ZEROP(doc)) {
1007                         message("Warning: doc lost for variable %s.",
1008                                 string_data(XSYMBOL(sym)->name));
1009                         XCDR(closure) = Qt;
1010                 }
1011         }
1012         return 0;               /* Never stop */
1013 }
1014
1015 DEFUN("Verify-documentation", Fverify_documentation, 0, 0, 0,   /*
1016 Used to make sure everything went well with Snarf-documentation.
1017 Writes to stderr if not.
1018 */
1019       ())
1020 {
1021         Lisp_Object closure = Fcons(Qnil, Qnil);
1022         struct gcpro gcpro1;
1023         GCPRO1(closure);
1024         map_obarray(Vobarray, verify_doc_mapper, &closure);
1025         if (!NILP(Fcdr(closure)))
1026                 message("\n"
1027                         "This is usually because some files were preloaded by loaddefs.el or\n"
1028                         "site-load.el, but were not passed to make-docfile by Makefile.\n");
1029         UNGCPRO;
1030         return NILP(Fcdr(closure)) ? Qt : Qnil;
1031 }
1032 \f
1033 DEFUN("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0,     /*
1034 Substitute key descriptions for command names in STRING.
1035 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
1036 replaced by either:  a keystroke sequence that will invoke COMMAND,
1037 or "M-x COMMAND" if COMMAND is not on any keys.
1038 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
1039 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
1040 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
1041 as the keymap for future \\=\\[COMMAND] substrings.
1042 \\=\\= quotes the following character and is discarded;
1043 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
1044 */
1045       (string))
1046 {
1047         /* This function can GC */
1048         Bufbyte *buf;
1049         int changed = 0;
1050         REGISTER Bufbyte *strdata;
1051         REGISTER Bufbyte *bufp;
1052         Bytecount strlength;
1053         Bytecount idx;
1054         Bytecount bsize;
1055         Bufbyte *new;
1056         Lisp_Object tem = Qnil;
1057         Lisp_Object keymap = Qnil;
1058         Lisp_Object name = Qnil;
1059         Bufbyte *start;
1060         Bytecount length;
1061         struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1062
1063         if (NILP(string))
1064                 return Qnil;
1065
1066         CHECK_STRING(string);
1067         GCPRO4(string, tem, keymap, name);
1068
1069         /* There is the possibility that the string is not destined for a
1070            translating stream, and it could be argued that we should do the
1071            same thing here as in Fformat(), but there are very few times
1072            when this will be the case and many calls to this function
1073            would have to have `gettext' calls added. (I18N3) */
1074         string = LISP_GETTEXT(string);
1075
1076         /* KEYMAP is either nil (which means search all the active keymaps)
1077            or a specified local map (which means search just that and the
1078            global map).  If non-nil, it might come from Voverriding_local_map,
1079            or from a \\<mapname> construct in STRING itself..  */
1080 #if 0                           /* FSFmacs */
1081         /* This is really weird and garbagey.  If keymap is nil and there's
1082            an overriding-local-map, `where-is-internal' will correctly note
1083            this, so there's no reason to do it here.  Maybe FSFmacs
1084            `where-is-internal' is broken. */
1085         /*
1086            keymap = current_kboard->Voverriding_terminal_local_map;
1087            if (NILP (keymap))
1088            keymap = Voverriding_local_map;
1089          */
1090 #endif
1091
1092         strlength = XSTRING_LENGTH(string);
1093         bsize = 1 + strlength;
1094         buf = (Bufbyte*)xmalloc_atomic(bsize);
1095         bufp = buf;
1096
1097         /* Have to reset strdata every time GC might be called */
1098         strdata = XSTRING_DATA(string);
1099         for (idx = 0; idx < strlength;) {
1100                 Bufbyte *strp = strdata + idx;
1101
1102                 if (strp[0] != '\\') {
1103                         /* just copy other chars */
1104                         /* As it happens, this will work with Mule even if the
1105                            character quoted is multi-byte; the remaining multi-byte
1106                            characters will just be copied by this loop. */
1107                         *bufp++ = *strp;
1108                         idx++;
1109                 } else
1110                         switch (strp[1]) {
1111                         default: {
1112                                 /* just copy unknown escape sequences */
1113                                 *bufp++ = *strp;
1114                                 idx++;
1115                                 break;
1116                         }
1117                         case '=': {
1118                                 /* \= quotes the next character; thus, to put in
1119                                    \[ without its special meaning, use \=\[.  */
1120                                 /* As it happens, this will work with Mule even
1121                                    if the character quoted is multi-byte; the
1122                                    remaining multi-byte characters will just be
1123                                    copied by this loop. */
1124                                 changed = 1;
1125                                 *bufp++ = strp[2];
1126                                 idx += 3;
1127                                 break;
1128                         }
1129                         case '[': {
1130                                 changed = 1;
1131                                 idx += 2;       /* skip \[ */
1132                                 strp += 2;
1133                                 start = strp;
1134
1135                                 while ((idx < strlength)
1136                                        && *strp != ']') {
1137                                         strp++;
1138                                         idx++;
1139                                 }
1140                                 length = strp - start;
1141                                 idx++;  /* skip ] */
1142
1143                                 tem = Fintern(make_string(start, length), Qnil);
1144                                 tem = Fwhere_is_internal(
1145                                         tem, keymap, Qt, Qnil, Qnil);
1146
1147 #if 0                           /* FSFmacs */
1148                                 /* Disregard menu bar bindings; it is
1149                                    positively annoying to mention them
1150                                    when there's no menu bar, and it
1151                                    isn't terribly useful even when there
1152                                    is a menu bar.  */
1153                                 if (!NILP(tem)) {
1154                                         firstkey = Faref(tem, Qzero);
1155                                         if (EQ(firstkey, Qmenu_bar))
1156                                                 tem = Qnil;
1157                                 }
1158 #endif
1159
1160                                 if (NILP(tem)) {
1161                                         /* but not on any keys */
1162                                         new = xrealloc(buf, bsize += 4);
1163                                         bufp += new - buf;
1164                                         buf = new;
1165                                         memcpy(bufp, "M-x ", 4);
1166                                         bufp += 4;
1167                                         goto subst;
1168                                 } else {        /* function is on a key */
1169                                         tem = Fkey_description(tem);
1170                                         goto subst_string;
1171                                 }
1172                         }
1173                         case '{':
1174                         case '<': {
1175                                 Lisp_Object buffer =
1176                                         Fget_buffer_create(QSsubstitute);
1177                                 struct buffer *buf_ = XBUFFER(buffer);
1178
1179                                 Fbuffer_disable_undo(buffer);
1180                                 Ferase_buffer(buffer);
1181
1182                                 /* \{foo} is replaced with a summary of keymap
1183                                    (symbol-value foo).  \<foo> just sets the
1184                                    keymap used for \[cmd]. */
1185                                 changed = 1;
1186                                 idx += 2;       /* skip \{ or \< */
1187                                 strp += 2;
1188                                 start = strp;
1189
1190                                 while ((idx < strlength)
1191                                        && *strp != '}' && *strp != '>') {
1192                                         strp++;
1193                                         idx++;
1194                                 }
1195                                 length = strp - start;
1196                                 idx++;  /* skip } or > */
1197
1198                                         /* Get the value of the keymap in TEM,
1199                                            or nil if undefined.  Do this while
1200                                            still in the user's current buffer in
1201                                            case it is a local variable.  */
1202                                 name = Fintern(
1203                                         make_string(start, length), Qnil);
1204                                 tem = Fboundp(name);
1205                                 if (!NILP(tem)) {
1206                                         tem = Fsymbol_value(name);
1207                                         if (!NILP(tem)) {
1208                                                 tem = get_keymap(tem, 0, 1);
1209                                         }
1210                                 }
1211
1212                                 if (NILP(tem)) {
1213                                         buffer_insert_c_string(
1214                                                 buf_, "(uses keymap \"");
1215                                         buffer_insert_lisp_string(
1216                                                 buf_, Fsymbol_name(name));
1217                                         buffer_insert_c_string(
1218                                                 buf_, "\", which is not "
1219                                                 "currently defined) ");
1220
1221                                         if (start[-1] == '<') {
1222                                                 keymap = Qnil;
1223                                         }
1224                                 } else if (start[-1] == '<') {
1225                                         keymap = tem;
1226                                 } else {
1227                                         describe_map_tree(
1228                                                 tem, 1, Qnil, Qnil, 0, buffer);
1229                                 }
1230                                 tem = make_string_from_buffer(
1231                                         buf_, BUF_BEG(buf_),
1232                                         BUF_Z(buf_) - BUF_BEG(buf_));
1233                                 Ferase_buffer(buffer);
1234                         }
1235                                 goto subst_string;
1236
1237                         subst_string:
1238                                 start = XSTRING_DATA(tem);
1239                                 length = XSTRING_LENGTH(tem);
1240                         subst:
1241                                 bsize += length;
1242                                 new = (Bufbyte *)xrealloc(buf, bsize);
1243                                 bufp += new - buf;
1244                                 buf = new;
1245                                 memcpy(bufp, start, length);
1246                                 bufp += length;
1247
1248                                 /* Reset STRDATA in case gc relocated it.  */
1249                                 strdata = XSTRING_DATA(string);
1250
1251                                 break;
1252                         }
1253         }
1254
1255         if (changed) {
1256                 /* don't bother if nothing substituted */
1257                 tem = make_string(buf, bufp - buf);
1258         } else {
1259                 tem = string;
1260         }
1261         xfree(buf);
1262         UNGCPRO;
1263         return tem;
1264 }
1265 \f
1266 /************************************************************************/
1267 /*                            initialization                            */
1268 /************************************************************************/
1269
1270 void syms_of_doc(void)
1271 {
1272         DEFSUBR(Fdocumentation);
1273         DEFSUBR(Fdocumentation_property);
1274         DEFSUBR(Fsnarf_documentation);
1275         DEFSUBR(Fverify_documentation);
1276         DEFSUBR(Fsubstitute_command_keys);
1277         DEFSUBR(Fbuilt_in_symbol_file);
1278
1279         DEFSYMBOL (Qdefvar);
1280 }
1281
1282 void vars_of_doc(void)
1283 {
1284         DEFVAR_LISP("internal-doc-file-name", &Vinternal_doc_file_name  /*
1285 Name of file containing documentation strings of built-in symbols.
1286                                                                          */ );
1287         Vinternal_doc_file_name = Qnil;
1288
1289         /* We don't really want this accessible from lisp... */
1290         Vinternal_doc_fd = make_int(-2);
1291
1292         QSsubstitute = build_string(" *substitute*");
1293         staticpro(&QSsubstitute);
1294 }