code.delx.au - gnu-emacs/blob - src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   6 GNU Emacs is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with GNU Emacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21
  22 #include <config.h>
  23
  24 #include <sys/types.h>
  25 #include <sys/file.h>   /* Must be after sys/types.h for USG and BSD4_1*/
  26
  27 #ifdef USG5
  28 #include <fcntl.h>
  29 #endif
  30
  31 #ifdef HAVE_UNISTD_H
  32 #include <unistd.h>
  33 #endif
  34
  35 #ifndef O_RDONLY
  36 #define O_RDONLY 0
  37 #endif
  38
  39 #include "lisp.h"
  40 #include "buffer.h"
  41 #include "keyboard.h"
  42 #include "charset.h"
  43
  44 #ifdef HAVE_INDEX
  45 extern char *index P_ ((const char *, int));
  46 #endif
  47
  48 Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
  49
  50 Lisp_Object Qfunction_documentation;
  51
  52 extern Lisp_Object Voverriding_local_map;
  53
  54 /* For VMS versions with limited file name syntax,
  55    convert the name to something VMS will allow. */
  56 static void
  57 munge_doc_file_name (name)
  58      char *name;
  59 {
  60 #ifdef VMS
  61 #ifndef VMS4_4
  62   /* For VMS versions with limited file name syntax,
  63      convert the name to something VMS will allow.  */
  64   p = name;
  65   while (*p)
  66     {
  67       if (*p == '-')
  68         *p = '_';
  69       p++;
  70     }
  71 #endif /* not VMS4_4 */
  72 #ifdef VMS4_4
  73   strcpy (name, sys_translate_unix (name));
  74 #endif /* VMS4_4 */
  75 #endif /* VMS */
  76 }
  77
  78 /* Buffer used for reading from documentation file.  */
  79 static char *get_doc_string_buffer;
  80 static int get_doc_string_buffer_size;
  81
  82 static unsigned char *read_bytecode_pointer;
  83
  84 /* readchar in lread.c calls back here to fetch the next byte.
  85    If UNREADFLAG is 1, we unread a byte.  */
  86
  87 int
  88 read_bytecode_char (unreadflag)
  89      int unreadflag;
  90 {
  91   if (unreadflag)
  92     {
  93       read_bytecode_pointer--;
  94       return 0;
  95     }
  96   return *read_bytecode_pointer++;
  97 }
  98
  99 /* Extract a doc string from a file.  FILEPOS says where to get it.
 100    If it is an integer, use that position in the standard DOC-... file.
 101    If it is (FILE . INTEGER), use FILE as the file name
 102    and INTEGER as the position in that file.
 103    But if INTEGER is negative, make it positive.
 104    (A negative integer is used for user variables, so we can distinguish
 105    them without actually fetching the doc string.)
 106
 107    If UNIBYTE is nonzero, always make a unibyte string.
 108
 109    If DEFINITION is nonzero, assume this is for reading
 110    a dynamic function definition; convert the bytestring
 111    and the constants vector with appropriate byte handling,
 112    and return a cons cell.  */
 113
 114 Lisp_Object
 115 get_doc_string (filepos, unibyte, definition)
 116      Lisp_Object filepos;
 117      int unibyte, definition;
 118 {
 119   char *from, *to;
 120   register int fd;
 121   register char *name;
 122   register char *p, *p1;
 123   int minsize;
 124   int offset, position;
 125   Lisp_Object file, tem;
 126
 127   if (INTEGERP (filepos))
 128     {
 129       file = Vdoc_file_name;
 130       position = XINT (filepos);
 131     }
 132   else if (CONSP (filepos))
 133     {
 134       file = XCAR (filepos);
 135       position = XINT (XCDR (filepos));
 136       if (position < 0)
 137         position = - position;
 138     }
 139   else
 140     return Qnil;
 141
 142   if (!STRINGP (Vdoc_directory))
 143     return Qnil;
 144
 145   if (!STRINGP (file))
 146     return Qnil;
 147
 148   /* Put the file name in NAME as a C string.
 149      If it is relative, combine it with Vdoc_directory.  */
 150
 151   tem = Ffile_name_absolute_p (file);
 152   if (NILP (tem))
 153     {
 154       minsize = XSTRING (Vdoc_directory)->size;
 155       /* sizeof ("../etc/") == 8 */
 156       if (minsize < 8)
 157         minsize = 8;
 158       name = (char *) alloca (minsize + XSTRING (file)->size + 8);
 159       strcpy (name, XSTRING (Vdoc_directory)->data);
 160       strcat (name, XSTRING (file)->data);
 161       munge_doc_file_name (name);
 162     }
 163   else
 164     {
 165       name = (char *) XSTRING (file)->data;
 166     }
 167
 168   fd = emacs_open (name, O_RDONLY, 0);
 169   if (fd < 0)
 170     {
 171 #ifndef CANNOT_DUMP
 172       if (!NILP (Vpurify_flag))
 173         {
 174           /* Preparing to dump; DOC file is probably not installed.
 175              So check in ../etc. */
 176           strcpy (name, "../etc/");
 177           strcat (name, XSTRING (file)->data);
 178           munge_doc_file_name (name);
 179
 180           fd = emacs_open (name, O_RDONLY, 0);
 181         }
 182 #endif
 183       if (fd < 0)
 184         error ("Cannot open doc string file \"%s\"", name);
 185     }
 186
 187   /* Seek only to beginning of disk block.  */
 188   offset = position % (8 * 1024);
 189   if (0 > lseek (fd, position - offset, 0))
 190     {
 191       emacs_close (fd);
 192       error ("Position %ld out of range in doc string file \"%s\"",
 193              position, name);
 194     }
 195
 196   /* Read the doc string into get_doc_string_buffer.
 197      P points beyond the data just read.  */
 198
 199   p = get_doc_string_buffer;
 200   while (1)
 201     {
 202       int space_left = (get_doc_string_buffer_size
 203                         - (p - get_doc_string_buffer));
 204       int nread;
 205
 206       /* Allocate or grow the buffer if we need to.  */
 207       if (space_left == 0)
 208         {
 209           int in_buffer = p - get_doc_string_buffer;
 210           get_doc_string_buffer_size += 16 * 1024;
 211           get_doc_string_buffer
 212             = (char *) xrealloc (get_doc_string_buffer,
 213                                  get_doc_string_buffer_size + 1);
 214           p = get_doc_string_buffer + in_buffer;
 215           space_left = (get_doc_string_buffer_size
 216                         - (p - get_doc_string_buffer));
 217         }
 218
 219       /* Read a disk block at a time.
 220          If we read the same block last time, maybe skip this?  */
 221       if (space_left > 1024 * 8)
 222         space_left = 1024 * 8;
 223       nread = emacs_read (fd, p, space_left);
 224       if (nread < 0)
 225         {
 226           emacs_close (fd);
 227           error ("Read error on documentation file");
 228         }
 229       p[nread] = 0;
 230       if (!nread)
 231         break;
 232       if (p == get_doc_string_buffer)
 233         p1 = (char *) index (p + offset, '\037');
 234       else
 235         p1 = (char *) index (p, '\037');
 236       if (p1)
 237         {
 238           *p1 = 0;
 239           p = p1;
 240           break;
 241         }
 242       p += nread;
 243     }
 244   emacs_close (fd);
 245
 246   /* Scan the text and perform quoting with ^A (char code 1).
 247      ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_.  */
 248   from = get_doc_string_buffer + offset;
 249   to = get_doc_string_buffer + offset;
 250   while (from != p)
 251     {
 252       if (*from == 1)
 253         {
 254           int c;
 255
 256           from++;
 257           c = *from++;
 258           if (c == 1)
 259             *to++ = c;
 260           else if (c == '0')
 261             *to++ = 0;
 262           else if (c == '_')
 263             *to++ = 037;
 264           else
 265             error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
 266         }
 267       else
 268         *to++ = *from++;
 269     }
 270
 271   /* If DEFINITION, read from this buffer
 272      the same way we would read bytes from a file.  */
 273   if (definition)
 274     {
 275       read_bytecode_pointer = get_doc_string_buffer + offset;
 276       return Fread (Qlambda);
 277     }
 278
 279   if (unibyte)
 280     return make_unibyte_string (get_doc_string_buffer + offset,
 281                                 to - (get_doc_string_buffer + offset));
 282   else
 283     {
 284       /* Let the data determine whether the string is multibyte,
 285          even if Emacs is running in --unibyte mode.  */
 286       int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
 287                                             to - (get_doc_string_buffer + offset));
 288       return make_string_from_bytes (get_doc_string_buffer + offset,
 289                                      nchars,
 290                                      to - (get_doc_string_buffer + offset));
 291     }
 292 }
 293
 294 /* Get a string from position FILEPOS and pass it through the Lisp reader.
 295    We use this for fetching the bytecode string and constants vector
 296    of a compiled function from the .elc file.  */
 297
 298 Lisp_Object
 299 read_doc_string (filepos)
 300      Lisp_Object filepos;
 301 {
 302   return get_doc_string (filepos, 0, 1);
 303 }
 304
 305 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 306   "Return the documentation string of FUNCTION.\n\
 307 Unless a non-nil second argument RAW is given, the\n\
 308 string is passed through `substitute-command-keys'.")
 309   (function, raw)
 310      Lisp_Object function, raw;
 311 {
 312   Lisp_Object fun;
 313   Lisp_Object funcar;
 314   Lisp_Object tem, doc;
 315
 316   doc = Qnil;
 317
 318   if (SYMBOLP (function)
 319       && (tem = Fget (function, Qfunction_documentation),
 320           !NILP (tem)))
 321     return Fdocumentation_property (function, Qfunction_documentation, raw);
 322
 323   fun = Findirect_function (function);
 324   if (SUBRP (fun))
 325     {
 326       if (XSUBR (fun)->doc == 0)
 327         return Qnil;
 328       else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
 329         doc = build_string (XSUBR (fun)->doc);
 330       else
 331         doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
 332                               0, 0);
 333       if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
 334         doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
 335     }
 336   else if (COMPILEDP (fun))
 337     {
 338       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
 339         return Qnil;
 340       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 341       if (STRINGP (tem))
 342         doc = tem;
 343       else if (NATNUMP (tem) || CONSP (tem))
 344         doc = get_doc_string (tem, 0, 0);
 345       else
 346         return Qnil;
 347     }
 348   else if (STRINGP (fun) || VECTORP (fun))
 349     {
 350       return build_string ("Keyboard macro.");
 351     }
 352   else if (CONSP (fun))
 353     {
 354       funcar = Fcar (fun);
 355       if (!SYMBOLP (funcar))
 356         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 357       else if (EQ (funcar, Qkeymap))
 358         return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
 359       else if (EQ (funcar, Qlambda)
 360                || EQ (funcar, Qautoload))
 361         {
 362           Lisp_Object tem1;
 363           tem1 = Fcdr (Fcdr (fun));
 364           tem = Fcar (tem1);
 365           if (STRINGP (tem))
 366             doc = tem;
 367           /* Handle a doc reference--but these never come last
 368              in the function body, so reject them if they are last.  */
 369           else if ((NATNUMP (tem) || CONSP (tem))
 370                    && ! NILP (XCDR (tem1)))
 371             doc = get_doc_string (tem, 0, 0);
 372           else
 373             return Qnil;
 374         }
 375       else if (EQ (funcar, Qmocklisp))
 376         return Qnil;
 377       else if (EQ (funcar, Qmacro))
 378         return Fdocumentation (Fcdr (fun), raw);
 379       else
 380         goto oops;
 381     }
 382   else
 383     {
 384     oops:
 385       Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 386     }
 387
 388   if (NILP (raw))
 389     doc = Fsubstitute_command_keys (doc);
 390   return doc;
 391 }
 392
 393 DEFUN ("documentation-property", Fdocumentation_property,
 394        Sdocumentation_property, 2, 3, 0,
 395   "Return the documentation string that is SYMBOL's PROP property.\n\
 396 Third argument RAW omitted or nil means pass the result through\n\
 397 `substitute-command-keys' if it is a string.\n\
 398 \n\
 399 This is differs from `get' in that it can refer to strings stored in the\n\
 400 `etc/DOC' file; and that it evaluates documentation properties that\n\
 401 aren't strings.")
 402   (symbol, prop, raw)
 403      Lisp_Object symbol, prop, raw;
 404 {
 405   Lisp_Object tem;
 406
 407   tem = Fget (symbol, prop);
 408   if (INTEGERP (tem))
 409     tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
 410   else if (CONSP (tem) && INTEGERP (XCDR (tem)))
 411     tem = get_doc_string (tem, 0, 0);
 412   else if (!STRINGP (tem))
 413     /* Feval protects its argument.  */
 414     tem = Feval (tem);
 415
 416   if (NILP (raw) && STRINGP (tem))
 417     tem = Fsubstitute_command_keys (tem);
 418   return tem;
 419 }
 420 \f
 421 /* Scanning the DOC files and placing docstring offsets into functions.  */
 422
 423 static void
 424 store_function_docstring (fun, offset)
 425      Lisp_Object fun;
 426      /* Use EMACS_INT because we get this from pointer subtraction.  */
 427      EMACS_INT offset;
 428 {
 429   fun = indirect_function (fun);
 430
 431   /* The type determines where the docstring is stored.  */
 432
 433   /* Lisp_Subrs have a slot for it.  */
 434   if (SUBRP (fun))
 435     XSUBR (fun)->doc = (char *) - offset;
 436
 437   /* If it's a lisp form, stick it in the form.  */
 438   else if (CONSP (fun))
 439     {
 440       Lisp_Object tem;
 441
 442       tem = XCAR (fun);
 443       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 444         {
 445           tem = Fcdr (Fcdr (fun));
 446           if (CONSP (tem) && INTEGERP (XCAR (tem)))
 447             XSETFASTINT (XCAR (tem), offset);
 448         }
 449       else if (EQ (tem, Qmacro))
 450         store_function_docstring (XCDR (fun), offset);
 451     }
 452
 453   /* Bytecode objects sometimes have slots for it.  */
 454   else if (COMPILEDP (fun))
 455     {
 456       /* This bytecode object must have a slot for the
 457          docstring, since we've found a docstring for it.  */
 458       if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
 459         XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
 460     }
 461 }
 462
 463
 464 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 465   1, 1, 0,
 466   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 467 to find pointers to doc strings stored in `etc/DOC...' and\n\
 468 record them in function definitions.\n\
 469 One arg, FILENAME, a string which does not include a directory.\n\
 470 The file is found in `../etc' now; found in the `data-directory'\n\
 471 when doc strings are referred to later in the dumped Emacs.")
 472   (filename)
 473      Lisp_Object filename;
 474 {
 475   int fd;
 476   char buf[1024 + 1];
 477   register int filled;
 478   register int pos;
 479   register char *p, *end;
 480   Lisp_Object sym;
 481   char *name;
 482
 483 #ifndef CANNOT_DUMP
 484   if (NILP (Vpurify_flag))
 485     error ("Snarf-documentation can only be called in an undumped Emacs");
 486 #endif
 487
 488   CHECK_STRING (filename, 0);
 489
 490 #ifndef CANNOT_DUMP
 491   name = (char *) alloca (XSTRING (filename)->size + 14);
 492   strcpy (name, "../etc/");
 493 #else /* CANNOT_DUMP */
 494   CHECK_STRING (Vdoc_directory, 0);
 495   name = (char *) alloca (XSTRING (filename)->size +
 496                           XSTRING (Vdoc_directory)->size + 1);
 497   strcpy (name, XSTRING (Vdoc_directory)->data);
 498 #endif /* CANNOT_DUMP */
 499   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 500 #ifdef VMS
 501 #ifndef VMS4_4
 502   /* For VMS versions with limited file name syntax,
 503      convert the name to something VMS will allow.  */
 504   p = name;
 505   while (*p)
 506     {
 507       if (*p == '-')
 508         *p = '_';
 509       p++;
 510     }
 511 #endif /* not VMS4_4 */
 512 #ifdef VMS4_4
 513   strcpy (name, sys_translate_unix (name));
 514 #endif /* VMS4_4 */
 515 #endif /* VMS */
 516
 517   fd = emacs_open (name, O_RDONLY, 0);
 518   if (fd < 0)
 519     report_file_error ("Opening doc string file",
 520                        Fcons (build_string (name), Qnil));
 521   Vdoc_file_name = filename;
 522   filled = 0;
 523   pos = 0;
 524   while (1)
 525     {
 526       if (filled < 512)
 527         filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
 528       if (!filled)
 529         break;
 530
 531       buf[filled] = 0;
 532       p = buf;
 533       end = buf + (filled < 512 ? filled : filled - 128);
 534       while (p != end && *p != '\037') p++;
 535       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 536       if (p != end)
 537         {
 538           end = (char *) index (p, '\n');
 539           sym = oblookup (Vobarray, p + 2,
 540                           multibyte_chars_in_text (p + 2, end - p - 2),
 541                           end - p - 2);
 542           if (SYMBOLP (sym))
 543             {
 544               /* Attach a docstring to a variable?  */
 545               if (p[1] == 'V')
 546                 {
 547                   /* Install file-position as variable-documentation property
 548                      and make it negative for a user-variable
 549                      (doc starts with a `*').  */
 550                   Fput (sym, Qvariable_documentation,
 551                         make_number ((pos + end + 1 - buf)
 552                                      * (end[1] == '*' ? -1 : 1)));
 553                 }
 554
 555               /* Attach a docstring to a function?  */
 556               else if (p[1] == 'F')
 557                 store_function_docstring (sym, pos + end + 1 - buf);
 558
 559               else
 560                 error ("DOC file invalid at position %d", pos);
 561             }
 562         }
 563       pos += end - buf;
 564       filled -= end - buf;
 565       bcopy (end, buf, filled);
 566     }
 567   emacs_close (fd);
 568   return Qnil;
 569 }
 570 \f
 571 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 572   Ssubstitute_command_keys, 1, 1, 0,
 573   "Substitute key descriptions for command names in STRING.\n\
 574 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 575 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 576 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 577 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 578 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 579 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 580 as the keymap for future \\=\\[COMMAND] substrings.\n\
 581 \\=\\= quotes the following character and is discarded;\n\
 582 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 583   (string)
 584      Lisp_Object string;
 585 {
 586   unsigned char *buf;
 587   int changed = 0;
 588   register unsigned char *strp;
 589   register unsigned char *bufp;
 590   int idx;
 591   int bsize;
 592   Lisp_Object tem;
 593   Lisp_Object keymap;
 594   unsigned char *start;
 595   int length, length_byte;
 596   Lisp_Object name;
 597   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 598   int multibyte;
 599   int nchars;
 600
 601   if (NILP (string))
 602     return Qnil;
 603
 604   CHECK_STRING (string, 0);
 605   tem = Qnil;
 606   keymap = Qnil;
 607   name = Qnil;
 608   GCPRO4 (string, tem, keymap, name);
 609
 610   multibyte = STRING_MULTIBYTE (string);
 611   nchars = 0;
 612
 613   /* KEYMAP is either nil (which means search all the active keymaps)
 614      or a specified local map (which means search just that and the
 615      global map).  If non-nil, it might come from Voverriding_local_map,
 616      or from a \\<mapname> construct in STRING itself..  */
 617   keymap = current_kboard->Voverriding_terminal_local_map;
 618   if (NILP (keymap))
 619     keymap = Voverriding_local_map;
 620
 621   bsize = STRING_BYTES (XSTRING (string));
 622   bufp = buf = (unsigned char *) xmalloc (bsize);
 623
 624   strp = (unsigned char *) XSTRING (string)->data;
 625   while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
 626     {
 627       if (strp[0] == '\\' && strp[1] == '=')
 628         {
 629           /* \= quotes the next character;
 630              thus, to put in \[ without its special meaning, use \=\[.  */
 631           changed = 1;
 632           strp += 2;
 633           if (multibyte)
 634             {
 635               int len;
 636               int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 637
 638               STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 639               if (len == 1)
 640                 *bufp = *strp;
 641               else
 642                 bcopy (strp, bufp, len);
 643               strp += len;
 644               bufp += len;
 645               nchars++;
 646             }
 647           else
 648             *bufp++ = *strp++, nchars++;
 649         }
 650       else if (strp[0] == '\\' && strp[1] == '[')
 651         {
 652           Lisp_Object firstkey;
 653           int start_idx;
 654
 655           changed = 1;
 656           strp += 2;            /* skip \[ */
 657           start = strp;
 658           start_idx = start - XSTRING (string)->data;
 659
 660           while ((strp - (unsigned char *) XSTRING (string)->data
 661                   < STRING_BYTES (XSTRING (string)))
 662                  && *strp != ']')
 663             strp++;
 664           length_byte = strp - start;
 665
 666           strp++;               /* skip ] */
 667
 668           /* Save STRP in IDX.  */
 669           idx = strp - (unsigned char *) XSTRING (string)->data;
 670           tem = Fintern (make_string (start, length_byte), Qnil);
 671
 672           /* Note the Fwhere_is_internal can GC, so we have to take
 673              relocation of string contents into account.  */
 674           tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
 675           strp = XSTRING (string)->data + idx;
 676           start = XSTRING (string)->data + start_idx;
 677
 678           /* Disregard menu bar bindings; it is positively annoying to
 679              mention them when there's no menu bar, and it isn't terribly
 680              useful even when there is a menu bar.  */
 681           if (!NILP (tem))
 682             {
 683               firstkey = Faref (tem, make_number (0));
 684               if (EQ (firstkey, Qmenu_bar))
 685                 tem = Qnil;
 686             }
 687
 688           if (NILP (tem))       /* but not on any keys */
 689             {
 690               int offset = bufp - buf;
 691               buf = (unsigned char *) xrealloc (buf, bsize += 4);
 692               bufp = buf + offset;
 693               bcopy ("M-x ", bufp, 4);
 694               bufp += 4;
 695               nchars += 4;
 696               if (multibyte)
 697                 length = multibyte_chars_in_text (start, length_byte);
 698               else
 699                 length = length_byte;
 700               goto subst;
 701             }
 702           else
 703             {                   /* function is on a key */
 704               tem = Fkey_description (tem);
 705               goto subst_string;
 706             }
 707         }
 708       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 709          \<foo> just sets the keymap used for \[cmd].  */
 710       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 711         {
 712           struct buffer *oldbuf;
 713           int start_idx;
 714
 715           changed = 1;
 716           strp += 2;            /* skip \{ or \< */
 717           start = strp;
 718           start_idx = start - XSTRING (string)->data;
 719
 720           while ((strp - (unsigned char *) XSTRING (string)->data
 721                   < XSTRING (string)->size)
 722                  && *strp != '}' && *strp != '>')
 723             strp++;
 724
 725           length_byte = strp - start;
 726           strp++;                       /* skip } or > */
 727
 728           /* Save STRP in IDX.  */
 729           idx = strp - (unsigned char *) XSTRING (string)->data;
 730
 731           /* Get the value of the keymap in TEM, or nil if undefined.
 732              Do this while still in the user's current buffer
 733              in case it is a local variable.  */
 734           name = Fintern (make_string (start, length_byte), Qnil);
 735           tem = Fboundp (name);
 736           if (! NILP (tem))
 737             {
 738               tem = Fsymbol_value (name);
 739               if (! NILP (tem))
 740                 {
 741                   tem = get_keymap (tem, 0, 1);
 742                   /* Note that get_keymap can GC.  */
 743                   strp = XSTRING (string)->data + idx;
 744                   start = XSTRING (string)->data + start_idx;
 745                 }
 746             }
 747
 748           /* Now switch to a temp buffer.  */
 749           oldbuf = current_buffer;
 750           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 751
 752           if (NILP (tem))
 753             {
 754               name = Fsymbol_name (name);
 755               insert_string ("\nUses keymap \"");
 756               insert_from_string (name, 0, 0,
 757                                   XSTRING (name)->size,
 758                                   STRING_BYTES (XSTRING (name)), 1);
 759               insert_string ("\", which is not currently defined.\n");
 760               if (start[-1] == '<') keymap = Qnil;
 761             }
 762           else if (start[-1] == '<')
 763             keymap = tem;
 764           else
 765             describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
 766           tem = Fbuffer_string ();
 767           Ferase_buffer ();
 768           set_buffer_internal (oldbuf);
 769
 770         subst_string:
 771           start = XSTRING (tem)->data;
 772           length = XSTRING (tem)->size;
 773           length_byte = STRING_BYTES (XSTRING (tem));
 774         subst:
 775           {
 776             int offset = bufp - buf;
 777             buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
 778             bufp = buf + offset;
 779             bcopy (start, bufp, length_byte);
 780             bufp += length_byte;
 781             nchars += length;
 782             /* Check STRING again in case gc relocated it.  */
 783             strp = (unsigned char *) XSTRING (string)->data + idx;
 784           }
 785         }
 786       else if (! multibyte)             /* just copy other chars */
 787         *bufp++ = *strp++, nchars++;
 788       else
 789         {
 790           int len;
 791           int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
 792
 793           STRING_CHAR_AND_LENGTH (strp, maxlen, len);
 794           if (len == 1)
 795             *bufp = *strp;
 796           else
 797             bcopy (strp, bufp, len);
 798           strp += len;
 799           bufp += len;
 800           nchars++;
 801         }
 802     }
 803
 804   if (changed)                  /* don't bother if nothing substituted */
 805     tem = make_string_from_bytes (buf, nchars, bufp - buf);
 806   else
 807     tem = string;
 808   xfree (buf);
 809   RETURN_UNGCPRO (tem);
 810 }
 811 \f
 812 void
 813 syms_of_doc ()
 814 {
 815   Qfunction_documentation = intern ("function-documentation");
 816   staticpro (&Qfunction_documentation);
 817
 818   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 819     "Name of file containing documentation strings of built-in symbols.");
 820   Vdoc_file_name = Qnil;
 821   DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
 822     "Alist of primitive functions and descriptions of their arg lists.\n\
 823 All special forms and primitives which effectively have &rest args\n\
 824 should have an entry here so that `documentation' can provide their\n\
 825 arg list.");
 826   Vhelp_manyarg_func_alist = Qnil;
 827
 828   defsubr (&Sdocumentation);
 829   defsubr (&Sdocumentation_property);
 830   defsubr (&Ssnarf_documentation);
 831   defsubr (&Ssubstitute_command_keys);
 832 }