(o-UU+4EDE): Use U+4EBB instead of <CJK RADICAL PERSON> in
[chise/xemacs-chise.git.1] / 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 XEmacs.
6
7 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 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: FSF 19.30. */
23
24 /* This file has been Mule-ized except as noted. */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "buffer.h"
30 #include "bytecode.h"
31 #include "insdel.h"
32 #include "keymap.h"
33 #include "sysfile.h"
34
35 Lisp_Object Vinternal_doc_file_name;
36
37 Lisp_Object QSsubstitute;
38
39 /* Read and return doc string from open file descriptor FD
40    at position POSITION.  Does not close the file.  Returns
41    string; or if error, returns a cons holding the error
42    data to pass to Fsignal.  NAME_NONRELOC and NAME_RELOC
43    are only used for the error messages. */
44
45 Lisp_Object
46 unparesseuxify_doc_string (int fd, EMACS_INT position,
47                            char *name_nonreloc, Lisp_Object name_reloc)
48 {
49   char buf[512 * 32 + 1];
50   char *buffer = buf;
51   int buffer_size = sizeof (buf);
52   char *from, *to;
53   REGISTER char *p = buffer;
54   Lisp_Object return_me;
55
56   if (0 > lseek (fd, position, 0))
57     {
58       if (name_nonreloc)
59         name_reloc = build_string (name_nonreloc);
60       return_me = list3 (build_string
61                          ("Position out of range in doc string file"),
62                           name_reloc, make_int (position));
63       goto done;
64     }
65
66   /* Read the doc string into a buffer.
67      Use the fixed buffer BUF if it is big enough; otherwise allocate one.
68      We store the buffer in use in BUFFER and its size in BUFFER_SIZE.  */
69
70   while (1)
71     {
72       int space_left = buffer_size - (p - buffer);
73       int nread;
74
75       /* Switch to a bigger buffer if we need one.  */
76       if (space_left == 0)
77         {
78           char * old_buffer = buffer;
79           if (buffer == buf) {
80             buffer = (char *) xmalloc (buffer_size *= 2);
81             memcpy (buffer, old_buffer, p - old_buffer);
82           } else {
83             buffer = (char *) xrealloc (buffer, buffer_size *= 2);
84           }
85           p += buffer - old_buffer;
86           space_left = buffer_size - (p - buffer);
87         }
88
89       /* Don't read too much at one go.  */
90       if (space_left > 1024 * 8)
91         space_left = 1024 * 8;
92       nread = read (fd, p, space_left);
93       if (nread < 0)
94         {
95           return_me = list1 (build_string
96                              ("Read error on documentation file"));
97           goto done;
98         }
99       p[nread] = 0;
100       if (!nread)
101         break;
102       {
103         char *p1 = strchr (p, '\037'); /* End of doc string marker */
104         if (p1)
105           {
106             *p1 = 0;
107             p = p1;
108             break;
109           }
110       }
111       p += nread;
112     }
113
114   /* Scan the text and remove quoting with ^A (char code 1).
115      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
116   from = to = buffer;
117   while (from < p)
118     {
119       if (*from != 1 /*^A*/)
120         *to++ = *from++;
121       else
122         {
123           int c = *(++from);
124
125           from++;
126           switch (c)
127             {
128             case 1:   *to++ =  c;     break;
129             case '0': *to++ = '\0';   break;
130             case '_': *to++ = '\037'; break;
131             default:
132               return_me = list2 (build_string
133         ("Invalid data in documentation file -- ^A followed by weird code"),
134                                  make_int (c));
135               goto done;
136             }
137         }
138     }
139
140   /* #### mrb: following STILL completely broken */
141   return_me = make_ext_string (buffer, to - buffer, Qbinary);
142
143  done:
144   if (buffer != buf) /* We must have allocated buffer above */
145     xfree (buffer);
146   return return_me;
147 }
148
149 #define string_join(dest, s1, s2) \
150   memcpy ((void *) dest, (void *) XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
151   memcpy ((void *) ((Bufbyte *) dest + XSTRING_LENGTH (s1)), \
152           (void *) XSTRING_DATA (s2), XSTRING_LENGTH (s2));  \
153           dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
154
155 /* Extract a doc string from a file.  FILEPOS says where to get it.
156    (This could actually be byte code instructions/constants instead
157    of a doc string.)
158    If it is an integer, use that position in the standard DOC file.
159    If it is (FILE . INTEGER), use FILE as the file name
160    and INTEGER as the position in that file.
161    But if INTEGER is negative, make it positive.
162    (A negative integer is used for user variables, so we can distinguish
163    them without actually fetching the doc string.)  */
164
165 static Lisp_Object
166 get_doc_string (Lisp_Object filepos)
167 {
168   /* !!#### This function has not been Mule-ized */
169   REGISTER int fd;
170   REGISTER char *name_nonreloc = 0;
171   EMACS_INT position;
172   Lisp_Object file, tem;
173   Lisp_Object name_reloc = Qnil;
174
175   if (INTP (filepos))
176     {
177       file = Vinternal_doc_file_name;
178       position = XINT (filepos);
179     }
180   else if (CONSP (filepos) && INTP (XCDR (filepos)))
181     {
182       file = XCAR (filepos);
183       position = XINT (XCDR (filepos));
184       if (position < 0)
185         position = - position;
186     }
187   else
188     return Qnil;
189
190   if (!STRINGP (file))
191     return Qnil;
192
193   /* Put the file name in NAME as a C string.
194      If it is relative, combine it with Vdoc_directory.  */
195
196   tem = Ffile_name_absolute_p (file);
197   if (NILP (tem))
198     {
199       size_t minsize;
200       /* XEmacs: Move this check here.  OK if called during loadup to
201          load byte code instructions. */
202       if (!STRINGP (Vdoc_directory))
203         return Qnil;
204
205       minsize = XSTRING_LENGTH (Vdoc_directory);
206       /* sizeof ("../lib-src/") == 12 */
207       if (minsize < 12)
208         minsize = 12;
209       name_nonreloc = (char *) alloca (minsize + XSTRING_LENGTH (file) + 8);
210       string_join (name_nonreloc, Vdoc_directory, file);
211     }
212   else
213     name_reloc = file;
214
215   fd = open (name_nonreloc ? name_nonreloc :
216              (char *) XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
217   if (fd < 0)
218     {
219 #ifndef CANNOT_DUMP
220       if (purify_flag)
221         {
222             /* sizeof ("../lib-src/") == 12 */
223           name_nonreloc = (char *) alloca (12 + XSTRING_LENGTH (file) + 8);
224           /* Preparing to dump; DOC file is probably not installed.
225              So check in ../lib-src. */
226           strcpy (name_nonreloc, "../lib-src/");
227           strcat (name_nonreloc, (char *) XSTRING_DATA (file));
228
229           fd = open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
230         }
231 #endif /* CANNOT_DUMP */
232
233       if (fd < 0)
234         error ("Cannot open doc string file \"%s\"",
235                name_nonreloc ? name_nonreloc :
236                (char *) XSTRING_DATA (name_reloc));
237     }
238
239   tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc);
240   close (fd);
241
242   if (!STRINGP (tem))
243     signal_error (Qerror, tem);
244
245   return tem;
246 }
247
248 /* Get a string from position FILEPOS and pass it through the Lisp reader.
249    We use this for fetching the bytecode string and constants vector
250    of a compiled function from the .elc file.  */
251
252 Lisp_Object
253 read_doc_string (Lisp_Object filepos)
254 {
255   Lisp_Object string = get_doc_string (filepos);
256
257   if (!STRINGP (string))
258     signal_simple_error ("loading bytecode failed to return string", string);
259   return Fread (string);
260 }
261
262 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
263 Return the documentation string of FUNCTION.
264 Unless a non-nil second argument RAW is given, the
265 string is passed through `substitute-command-keys'.
266 */
267        (function, raw))
268 {
269   /* This function can GC */
270   Lisp_Object fun;
271   Lisp_Object doc;
272
273   fun = Findirect_function (function);
274
275   if (SUBRP (fun))
276     {
277       if (XSUBR (fun)->doc == 0)
278         return Qnil;
279       if ((EMACS_INT) XSUBR (fun)->doc >= 0)
280         doc = build_string (XSUBR (fun)->doc);
281       else
282         doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
283     }
284   else if (COMPILED_FUNCTIONP (fun))
285     {
286       Lisp_Object tem;
287       Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
288       if (! (f->flags.documentationp))
289         return Qnil;
290       tem = compiled_function_documentation (f);
291       if (STRINGP (tem))
292         doc = tem;
293       else if (NATNUMP (tem) || CONSP (tem))
294         doc = get_doc_string (tem);
295       else
296         return Qnil;
297     }
298   else if (KEYMAPP (fun))
299     return build_translated_string ("Prefix command (definition is a keymap of subcommands).");
300   else if (STRINGP (fun) || VECTORP (fun))
301     return build_translated_string ("Keyboard macro.");
302   else if (CONSP (fun))
303     {
304       Lisp_Object funcar = Fcar (fun);
305
306       if (!SYMBOLP (funcar))
307         return Fsignal (Qinvalid_function, list1 (fun));
308       else if (EQ (funcar, Qlambda)
309              || EQ (funcar, Qautoload))
310         {
311           Lisp_Object tem, tem1;
312           tem1 = Fcdr (Fcdr (fun));
313           tem = Fcar (tem1);
314           if (STRINGP (tem))
315             doc = tem;
316           /* Handle a doc reference--but these never come last
317              in the function body, so reject them if they are last.  */
318           else if ((NATNUMP (tem) || CONSP (tem))
319                    && ! NILP (XCDR (tem1)))
320             doc = get_doc_string (tem);
321           else
322             return Qnil;
323         }
324       else if (EQ (funcar, Qmacro))
325         return Fdocumentation (Fcdr (fun), raw);
326       else
327         goto oops;
328     }
329   else
330     {
331     oops:
332       return Fsignal (Qinvalid_function, list1 (fun));
333     }
334
335   if (NILP (raw))
336     {
337       struct gcpro gcpro1;
338 #ifdef I18N3
339       Lisp_Object domain = Qnil;
340       if (COMPILED_FUNCTIONP (fun))
341         domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
342       if (NILP (domain))
343         doc = Fgettext (doc);
344       else
345         doc = Fdgettext (domain, doc);
346 #endif
347
348       GCPRO1 (doc);
349       doc = Fsubstitute_command_keys (doc);
350       UNGCPRO;
351     }
352   return doc;
353 }
354
355 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
356 Return the documentation string that is SYMBOL's PROP property.
357 This is like `get', but it can refer to strings stored in the
358 `doc-directory/DOC' file; and if the value is a string, it is passed
359 through `substitute-command-keys'.  A non-nil third argument avoids this
360 translation.
361 */
362        (symbol, prop, raw))
363 {
364   /* This function can GC */
365   REGISTER Lisp_Object doc = Qnil;
366 #ifdef I18N3
367   REGISTER Lisp_Object domain;
368 #endif
369   struct gcpro gcpro1;
370
371   GCPRO1 (doc);
372
373   doc = Fget (symbol, prop, Qnil);
374   if (INTP (doc))
375     doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
376   else if (CONSP (doc))
377     doc = get_doc_string (doc);
378 #ifdef I18N3
379   if (!NILP (doc))
380     {
381       domain = Fget (symbol, Qvariable_domain, Qnil);
382       if (NILP (domain))
383         doc = Fgettext (doc);
384       else
385         doc = Fdgettext (domain, doc);
386     }
387 #endif
388   if (NILP (raw) && STRINGP (doc))
389     doc = Fsubstitute_command_keys (doc);
390   UNGCPRO;
391   return doc;
392 }
393 \f
394 static void
395 weird_doc (Lisp_Object sym, const char *weirdness, const char *type, int pos)
396 {
397   if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
398   message ("Note: Strange doc (%s) for %s %s @ %d",
399            weirdness, type, string_data (XSYMBOL (sym)->name), pos);
400 }
401
402
403 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
404 Used during Emacs initialization, before dumping runnable Emacs,
405 to find pointers to doc strings stored in `.../lib-src/DOC' and
406 record them in function definitions.
407 One arg, FILENAME, a string which does not include a directory.
408 The file is written to `../lib-src', and later found in `exec-directory'
409 when doc strings are referred to in the dumped Emacs.
410 */
411        (filename))
412 {
413   /* !!#### This function has not been Mule-ized */
414   int fd;
415   char buf[1024 + 1];
416   REGISTER int filled;
417   REGISTER int pos;
418   REGISTER char *p, *end;
419   Lisp_Object sym, fun, tem;
420   char *name;
421
422 #ifndef CANNOT_DUMP
423   if (!purify_flag)
424     error ("Snarf-documentation can only be called in an undumped Emacs");
425 #endif
426
427   CHECK_STRING (filename);
428
429 #ifdef CANNOT_DUMP
430   if (!NILP(Vdoc_directory))
431     {
432       CHECK_STRING (Vdoc_directory);
433       name = (char *) alloca (XSTRING_LENGTH (filename)
434                               + XSTRING_LENGTH (Vdoc_directory)
435                               + 1);
436       strcpy (name, (char *) XSTRING_DATA (Vdoc_directory));
437     }
438   else
439 #endif /* CANNOT_DUMP */
440     {
441       name = (char *) alloca (XSTRING_LENGTH (filename) + 14);
442       strcpy (name, "../lib-src/");
443     }
444
445   strcat (name, (char *) XSTRING_DATA (filename));
446
447   fd = open (name, O_RDONLY | OPEN_BINARY, 0);
448   if (fd < 0)
449     report_file_error ("Opening doc string file",
450                        Fcons (build_string (name), Qnil));
451   Vinternal_doc_file_name = filename;
452   filled = 0;
453   pos = 0;
454   while (1)
455     {
456       if (filled < 512)
457         filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
458       if (!filled)
459         break;
460
461       buf[filled] = 0;
462       p = buf;
463       end = buf + (filled < 512 ? filled : filled - 128);
464       while (p != end && *p != '\037') p++;
465       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
466       if (p != end)
467         {
468           end = strchr (p, '\n');
469           sym = oblookup (Vobarray, (Bufbyte *) p + 2, end - p - 2);
470           if (SYMBOLP (sym))
471             {
472               Lisp_Object offset = make_int (pos + end + 1 - buf);
473               /* Attach a docstring to a variable */
474               if (p[1] == 'V')
475                 {
476                   /* Install file-position as variable-documentation property
477                      and make it negative for a user-variable
478                      (doc starts with a `*').  */
479                   Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
480                   if (!ZEROP (old))
481                     {
482                       weird_doc (sym, GETTEXT ("duplicate"),
483                                  GETTEXT ("variable"), pos);
484                       /* In the case of duplicate doc file entries, always
485                          take the later one.  But if the doc is not an int
486                          (a string, say) leave it alone. */
487                       if (!INTP (old))
488                         goto weird;
489                     }
490                   Fput (sym, Qvariable_documentation,
491                         ((end[1] == '*')
492                          ? make_int (- XINT (offset))
493                          : offset));
494                 }
495               /* Attach a docstring to a function.
496                  The type determines where the docstring is stored.  */
497               else if (p[1] == 'F')
498                 {
499                   fun = indirect_function (sym,0);
500
501                   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
502                     fun = XCDR (fun);
503
504                   if (UNBOUNDP (fun))
505                     {
506                       /* May have been #if'ed out or something */
507                       weird_doc (sym, GETTEXT ("not fboundp"),
508                                  GETTEXT ("function"), pos);
509                       goto weird;
510                     }
511                   else if (SUBRP (fun))
512                     {
513                       /* Lisp_Subrs have a slot for it.  */
514                       if (XSUBR (fun)->doc)
515                         {
516                           weird_doc (sym, GETTEXT ("duplicate"),
517                                      GETTEXT ("subr"), pos);
518                           goto weird;
519                         }
520                       XSUBR (fun)->doc = (char *) (- XINT (offset));
521                     }
522                   else if (CONSP (fun))
523                     {
524                       /* If it's a lisp form, stick it in the form.  */
525                       tem = XCAR (fun);
526                       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
527                         {
528                           tem = Fcdr (Fcdr (fun));
529                           if (CONSP (tem) &&
530                               INTP (XCAR (tem)))
531                             {
532                               Lisp_Object old = XCAR (tem);
533                               if (!ZEROP (old))
534                                 {
535                                   weird_doc (sym, GETTEXT ("duplicate"),
536                                              (EQ (tem, Qlambda)
537                                               ? GETTEXT ("lambda")
538                                               : GETTEXT ("autoload")),
539                                              pos);
540                                   /* In the case of duplicate doc file entries,
541                                      always take the later one.  But if the doc
542                                      is not an int (a string, say) leave it
543                                      alone. */
544                                   if (!INTP (old))
545                                     goto weird;
546                                 }
547                               XCAR (tem) = offset;
548                             }
549                           else if (!CONSP (tem))
550                             {
551                               weird_doc (sym, GETTEXT ("!CONSP(tem)"),
552                                          GETTEXT ("function"), pos);
553                               goto cont;
554                             }
555                           else
556                             {
557                               /* DOC string is a string not integer 0 */
558 #if 0
559                               weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
560                                          GETTEXT ("function"), pos);
561 #endif
562                               goto cont;
563                             }
564                         }
565                       else
566                         {
567                           weird_doc (sym, GETTEXT ("not lambda or autoload"),
568                                      GETTEXT ("function"), pos);
569                           goto cont;
570                         }
571                     }
572                   else if (COMPILED_FUNCTIONP (fun))
573                     {
574                       /* Compiled-Function objects sometimes have
575                          slots for it.  */
576                       Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
577
578                       /* This compiled-function object must have a
579                          slot for the docstring, since we've found a
580                          docstring for it.  Unless there were multiple
581                          definitions of it, and the latter one didn't
582                          have any doc, which is a legal if slightly
583                          bogus situation, so don't blow up. */
584
585                       if (! (f->flags.documentationp))
586                         {
587                           weird_doc (sym, GETTEXT ("no doc slot"),
588                                      GETTEXT ("bytecode"), pos);
589                           goto weird;
590                         }
591                       else
592                         {
593                           Lisp_Object old =
594                             compiled_function_documentation (f);
595                           if (!ZEROP (old))
596                             {
597                               weird_doc (sym, GETTEXT ("duplicate"),
598                                          GETTEXT ("bytecode"), pos);
599                               /* In the case of duplicate doc file entries,
600                                  always take the later one.  But if the doc is
601                                  not an int (a string, say) leave it alone. */
602                               if (!INTP (old))
603                                 goto weird;
604                             }
605                           set_compiled_function_documentation (f, offset);
606                         }
607                     }
608                   else
609                     {
610                       /* Otherwise the function is undefined or
611                          otherwise weird.   Ignore it. */
612                       weird_doc (sym, GETTEXT ("weird function"),
613                                  GETTEXT ("function"), pos);
614                       goto weird;
615                     }
616                 }
617               else
618                 {
619                 /* lose: */
620                   error ("DOC file invalid at position %d", pos);
621                 weird:
622                   /* goto lose */;
623                 }
624             }
625         }
626     cont:
627       pos += end - buf;
628       filled -= end - buf;
629       memmove (buf, end, filled);
630     }
631   close (fd);
632   return Qnil;
633 }
634
635
636 #if 1   /* Don't warn about functions whose doc was lost because they were
637            wrapped by advice-freeze.el... */
638 static int
639 kludgily_ignore_lost_doc_p (Lisp_Object sym)
640 {
641 # define kludge_prefix "ad-Orig-"
642   Lisp_String *name = XSYMBOL (sym)->name;
643   return (string_length (name) > (Bytecount) (sizeof (kludge_prefix)) &&
644           !strncmp ((char *) string_data (name), kludge_prefix,
645                     sizeof (kludge_prefix) - 1));
646 # undef kludge_prefix
647 }
648 #else
649 # define kludgily_ignore_lost_doc_p(sym) 0
650 #endif
651
652
653 static int
654 verify_doc_mapper (Lisp_Object sym, void *arg)
655 {
656   Lisp_Object closure = *(Lisp_Object *)arg;
657
658   if (!NILP (Ffboundp (sym)))
659     {
660       int doc = 0;
661       Lisp_Object fun = XSYMBOL (sym)->function;
662       if (CONSP (fun) &&
663           EQ (XCAR (fun), Qmacro))
664         fun = XCDR (fun);
665
666       if (SUBRP (fun))
667         doc = (EMACS_INT) XSUBR (fun)->doc;
668       else if (SYMBOLP (fun))
669         doc = -1;
670       else if (KEYMAPP (fun))
671         doc = -1;
672       else if (CONSP (fun))
673         {
674           Lisp_Object tem = XCAR (fun);
675           if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
676             {
677               doc = -1;
678               tem = Fcdr (Fcdr (fun));
679               if (CONSP (tem) &&
680                   INTP (XCAR (tem)))
681                 doc = XINT (XCAR (tem));
682             }
683         }
684       else if (COMPILED_FUNCTIONP (fun))
685         {
686           Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
687           if (! (f->flags.documentationp))
688             doc = -1;
689           else
690             {
691               Lisp_Object tem = compiled_function_documentation (f);
692               if (INTP (tem))
693                 doc = XINT (tem);
694             }
695         }
696
697       if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
698         {
699           message ("Warning: doc lost for function %s.",
700                    string_data (XSYMBOL (sym)->name));
701           XCDR (closure) = Qt;
702         }
703     }
704   if (!NILP (Fboundp (sym)))
705     {
706       Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
707       if (ZEROP (doc))
708         {
709           message ("Warning: doc lost for variable %s.",
710                    string_data (XSYMBOL (sym)->name));
711           XCDR (closure) = Qt;
712         }
713     }
714   return 0; /* Never stop */
715 }
716
717 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
718 Used to make sure everything went well with Snarf-documentation.
719 Writes to stderr if not.
720 */
721        ())
722 {
723   Lisp_Object closure = Fcons (Qnil, Qnil);
724   struct gcpro gcpro1;
725   GCPRO1 (closure);
726   map_obarray (Vobarray, verify_doc_mapper, &closure);
727   if (!NILP (Fcdr (closure)))
728     message ("\n"
729 "This is usually because some files were preloaded by loaddefs.el or\n"
730 "site-load.el, but were not passed to make-docfile by Makefile.\n");
731   UNGCPRO;
732   return NILP (Fcdr (closure)) ? Qt : Qnil;
733 }
734
735 \f
736 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
737 Substitute key descriptions for command names in STRING.
738 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
739 replaced by either:  a keystroke sequence that will invoke COMMAND,
740 or "M-x COMMAND" if COMMAND is not on any keys.
741 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
742 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
743 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
744 as the keymap for future \\=\\[COMMAND] substrings.
745 \\=\\= quotes the following character and is discarded;
746 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
747 */
748        (string))
749 {
750   /* This function can GC */
751   Bufbyte *buf;
752   int changed = 0;
753   REGISTER Bufbyte *strdata;
754   REGISTER Bufbyte *bufp;
755   Bytecount strlength;
756   Bytecount idx;
757   Bytecount bsize;
758   Bufbyte *new;
759   Lisp_Object tem = Qnil;
760   Lisp_Object keymap = Qnil;
761   Lisp_Object name = Qnil;
762   Bufbyte *start;
763   Bytecount length;
764   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
765
766   if (NILP (string))
767     return Qnil;
768
769   CHECK_STRING (string);
770   GCPRO4 (string, tem, keymap, name);
771
772   /* There is the possibility that the string is not destined for a
773      translating stream, and it could be argued that we should do the
774      same thing here as in Fformat(), but there are very few times
775      when this will be the case and many calls to this function
776      would have to have `gettext' calls added. (I18N3) */
777   string = LISP_GETTEXT (string);
778
779   /* KEYMAP is either nil (which means search all the active keymaps)
780      or a specified local map (which means search just that and the
781      global map).  If non-nil, it might come from Voverriding_local_map,
782      or from a \\<mapname> construct in STRING itself..  */
783 #if 0 /* FSFmacs */
784   /* This is really weird and garbagey.  If keymap is nil and there's
785      an overriding-local-map, `where-is-internal' will correctly note
786      this, so there's no reason to do it here.  Maybe FSFmacs
787      `where-is-internal' is broken. */
788   /*
789   keymap = current_kboard->Voverriding_terminal_local_map;
790   if (NILP (keymap))
791     keymap = Voverriding_local_map;
792   */
793 #endif
794
795   strlength = XSTRING_LENGTH (string);
796   bsize = 1 + strlength;
797   buf = (Bufbyte *) xmalloc (bsize);
798   bufp = buf;
799
800   /* Have to reset strdata every time GC might be called */
801   strdata = XSTRING_DATA (string);
802   for (idx = 0; idx < strlength; )
803     {
804       Bufbyte *strp = strdata + idx;
805
806       if (strp[0] != '\\')
807         {
808           /* just copy other chars */
809           /* As it happens, this will work with Mule even if the
810              character quoted is multi-byte; the remaining multi-byte
811              characters will just be copied by this loop. */
812           *bufp++ = *strp;
813           idx++;
814         }
815       else switch (strp[1])
816         {
817         default:
818           {
819             /* just copy unknown escape sequences */
820             *bufp++ = *strp;
821             idx++;
822             break;
823           }
824         case '=':
825           {
826             /* \= quotes the next character;
827                thus, to put in \[ without its special meaning, use \=\[.  */
828             /* As it happens, this will work with Mule even if the
829                character quoted is multi-byte; the remaining multi-byte
830                characters will just be copied by this loop. */
831             changed = 1;
832             *bufp++ = strp[2];
833             idx += 3;
834             break;
835           }
836         case '[':
837           {
838             changed = 1;
839             idx += 2;           /* skip \[ */
840             strp += 2;
841             start = strp;
842
843             while ((idx < strlength)
844                    && *strp != ']')
845               {
846                 strp++;
847                 idx++;
848               }
849             length = strp - start;
850             idx++;              /* skip ] */
851
852             tem = Fintern (make_string (start, length), Qnil);
853             tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
854
855 #if 0 /* FSFmacs */
856             /* Disregard menu bar bindings; it is positively annoying to
857                mention them when there's no menu bar, and it isn't terribly
858                useful even when there is a menu bar.  */
859             if (!NILP (tem))
860               {
861                 firstkey = Faref (tem, Qzero);
862                 if (EQ (firstkey, Qmenu_bar))
863                   tem = Qnil;
864               }
865 #endif
866
867             if (NILP (tem))     /* but not on any keys */
868               {
869                 new = (Bufbyte *) xrealloc (buf, bsize += 4);
870                 bufp += new - buf;
871                 buf = new;
872                 memcpy (bufp, "M-x ", 4);
873                 bufp += 4;
874                 goto subst;
875               }
876             else
877               {                 /* function is on a key */
878                 tem = Fkey_description (tem);
879                 goto subst_string;
880               }
881           }
882         case '{':
883         case '<':
884           {
885             Lisp_Object buffer = Fget_buffer_create (QSsubstitute);
886             struct buffer *buf_ = XBUFFER (buffer);
887
888             Fbuffer_disable_undo (buffer);
889             Ferase_buffer (buffer);
890
891             /* \{foo} is replaced with a summary of keymap (symbol-value foo).
892                \<foo> just sets the keymap used for \[cmd].  */
893             changed = 1;
894             idx += 2;           /* skip \{ or \< */
895             strp += 2;
896             start = strp;
897
898             while ((idx < strlength)
899                    && *strp != '}' && *strp != '>')
900               {
901                 strp++;
902                 idx++;
903               }
904             length = strp - start;
905             idx++;              /* skip } or > */
906
907             /* Get the value of the keymap in TEM, or nil if undefined.
908                Do this while still in the user's current buffer
909                in case it is a local variable.  */
910             name = Fintern (make_string (start, length), Qnil);
911             tem = Fboundp (name);
912             if (! NILP (tem))
913               {
914                 tem = Fsymbol_value (name);
915                 if (! NILP (tem))
916                   tem = get_keymap (tem, 0, 1);
917               }
918
919             if (NILP (tem))
920               {
921                 buffer_insert_c_string (buf_, "(uses keymap \"");
922                 buffer_insert_lisp_string (buf_, Fsymbol_name (name));
923                 buffer_insert_c_string (buf_, "\", which is not currently defined) ");
924
925                 if (start[-1] == '<') keymap = Qnil;
926               }
927             else if (start[-1] == '<')
928               keymap = tem;
929             else
930               describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
931
932             tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
933                                            BUF_Z (buf_) - BUF_BEG (buf_));
934             Ferase_buffer (buffer);
935           }
936           goto subst_string;
937
938         subst_string:
939           start = XSTRING_DATA (tem);
940           length = XSTRING_LENGTH (tem);
941         subst:
942           bsize += length;
943           new = (Bufbyte *) xrealloc (buf, bsize);
944           bufp += new - buf;
945           buf = new;
946           memcpy (bufp, start, length);
947           bufp += length;
948
949           /* Reset STRDATA in case gc relocated it.  */
950           strdata = XSTRING_DATA (string);
951
952           break;
953         }
954     }
955
956   if (changed)                  /* don't bother if nothing substituted */
957     tem = make_string (buf, bufp - buf);
958   else
959     tem = string;
960   xfree (buf);
961   UNGCPRO;
962   return tem;
963 }
964
965 \f
966 /************************************************************************/
967 /*                            initialization                            */
968 /************************************************************************/
969
970 void
971 syms_of_doc (void)
972 {
973   DEFSUBR (Fdocumentation);
974   DEFSUBR (Fdocumentation_property);
975   DEFSUBR (Fsnarf_documentation);
976   DEFSUBR (Fverify_documentation);
977   DEFSUBR (Fsubstitute_command_keys);
978 }
979
980 void
981 vars_of_doc (void)
982 {
983   DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
984 Name of file containing documentation strings of built-in symbols.
985 */ );
986   Vinternal_doc_file_name = Qnil;
987
988   QSsubstitute = build_string (" *substitute*");
989   staticpro (&QSsubstitute);
990 }