src/doc.c

   1 /* Record indices of function doc strings stored in a file.
   2    Copyright (C) 1985, 1986, 1993 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <config.h>
  22
  23 #include <sys/types.h>
  24 #include <sys/file.h>   /* Must be after sys/types.h for USG and BSD4_1*/
  25
  26 #ifdef USG5
  27 #include <fcntl.h>
  28 #endif
  29
  30 #ifndef O_RDONLY
  31 #define O_RDONLY 0
  32 #endif
  33
  34 #include "lisp.h"
  35 #include "buffer.h"
  36 #include "keyboard.h"
  37
  38 Lisp_Object Vdoc_file_name;
  39
  40 extern Lisp_Object Voverriding_local_map;
  41
  42 Lisp_Object
  43 get_doc_string (filepos)
  44      long filepos;
  45 {
  46   char buf[512 * 32 + 1];
  47   register int fd;
  48   register char *name;
  49   register char *p, *p1;
  50   register int count;
  51   extern char *index ();
  52
  53   if (XTYPE (Vdoc_directory) != Lisp_String
  54       || XTYPE (Vdoc_file_name) != Lisp_String)
  55     return Qnil;
  56
  57   name = (char *) alloca (XSTRING (Vdoc_directory)->size
  58                           + XSTRING (Vdoc_file_name)->size + 8);
  59   strcpy (name, XSTRING (Vdoc_directory)->data);
  60   strcat (name, XSTRING (Vdoc_file_name)->data);
  61 #ifdef VMS
  62 #ifndef VMS4_4
  63   /* For VMS versions with limited file name syntax,
  64      convert the name to something VMS will allow.  */
  65   p = name;
  66   while (*p)
  67     {
  68       if (*p == '-')
  69         *p = '_';
  70       p++;
  71     }
  72 #endif /* not VMS4_4 */
  73 #ifdef VMS4_4
  74   strcpy (name, sys_translate_unix (name));
  75 #endif /* VMS4_4 */
  76 #endif /* VMS */
  77
  78   fd = open (name, O_RDONLY, 0);
  79   if (fd < 0)
  80     error ("Cannot open doc string file \"%s\"", name);
  81   if (0 > lseek (fd, filepos, 0))
  82     {
  83       close (fd);
  84       error ("Position %ld out of range in doc string file \"%s\"",
  85              filepos, name);
  86     }
  87   p = buf;
  88   while (p != buf + sizeof buf - 1)
  89     {
  90       count = read (fd, p, 512);
  91       p[count] = 0;
  92       if (!count)
  93         break;
  94       p1 = index (p, '\037');
  95       if (p1)
  96         {
  97           *p1 = 0;
  98           p = p1;
  99           break;
 100         }
 101       p += count;
 102     }
 103   close (fd);
 104   return make_string (buf, p - buf);
 105 }
 106
 107 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
 108   "Return the documentation string of FUNCTION.\n\
 109 Unless a non-nil second argument is given, the\n\
 110 string is passed through `substitute-command-keys'.")
 111   (function, raw)
 112      Lisp_Object function, raw;
 113 {
 114   Lisp_Object fun;
 115   Lisp_Object funcar;
 116   Lisp_Object tem, doc;
 117
 118   fun = Findirect_function (function);
 119
 120   switch (XTYPE (fun))
 121     {
 122     case Lisp_Subr:
 123       if (XSUBR (fun)->doc == 0) return Qnil;
 124       if ((int) XSUBR (fun)->doc >= 0)
 125         doc = build_string (XSUBR (fun)->doc);
 126       else
 127         doc = get_doc_string (- (int) XSUBR (fun)->doc);
 128       break;
 129
 130     case Lisp_Compiled:
 131       if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
 132         return Qnil;
 133       tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
 134       if (XTYPE (tem) == Lisp_String)
 135         doc = tem;
 136       else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
 137         doc = get_doc_string (XFASTINT (tem));
 138       else
 139         return Qnil;
 140       break;
 141
 142     case Lisp_String:
 143     case Lisp_Vector:
 144       return build_string ("Keyboard macro.");
 145
 146     case Lisp_Cons:
 147       funcar = Fcar (fun);
 148       if (XTYPE (funcar) != Lisp_Symbol)
 149         return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 150       else if (EQ (funcar, Qkeymap))
 151         return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
 152 subcommands.)");
 153       else if (EQ (funcar, Qlambda)
 154                || EQ (funcar, Qautoload))
 155         {
 156           tem = Fcar (Fcdr (Fcdr (fun)));
 157           if (XTYPE (tem) == Lisp_String)
 158             doc = tem;
 159           else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
 160             doc = get_doc_string (XFASTINT (tem));
 161           else
 162             return Qnil;
 163
 164           break;
 165         }
 166       else if (EQ (funcar, Qmocklisp))
 167         return Qnil;
 168       else if (EQ (funcar, Qmacro))
 169         return Fdocumentation (Fcdr (fun), raw);
 170
 171       /* Fall through to the default to report an error.  */
 172
 173     default:
 174       return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 175     }
 176
 177   if (NILP (raw))
 178     {
 179       struct gcpro gcpro1;
 180
 181       GCPRO1 (doc);
 182       doc = Fsubstitute_command_keys (doc);
 183       UNGCPRO;
 184     }
 185   return doc;
 186 }
 187
 188 DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0,
 189   "Return the documentation string that is SYMBOL's PROP property.\n\
 190 This is like `get', but it can refer to strings stored in the\n\
 191 `etc/DOC' file; and if the value is a string, it is passed through\n\
 192 `substitute-command-keys'.  A non-nil third argument avoids this\n\
 193 translation.")
 194   (sym, prop, raw)
 195      Lisp_Object sym, prop, raw;
 196 {
 197   register Lisp_Object tem;
 198
 199   tem = Fget (sym, prop);
 200   if (XTYPE (tem) == Lisp_Int)
 201     tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
 202   if (NILP (raw) && XTYPE (tem) == Lisp_String)
 203     return Fsubstitute_command_keys (tem);
 204   return tem;
 205 }
 206 \f
 207 /* Scanning the DOC files and placing docstring offsets into functions.  */
 208
 209 static void
 210 store_function_docstring (fun, offset)
 211      Lisp_Object fun;
 212      int offset;
 213 {
 214   fun = indirect_function (fun);
 215
 216   /* The type determines where the docstring is stored.  */
 217
 218   /* Lisp_Subrs have a slot for it.  */
 219   if (XTYPE (fun) == Lisp_Subr)
 220     XSUBR (fun)->doc = (char *) - offset;
 221
 222   /* If it's a lisp form, stick it in the form.  */
 223   else if (CONSP (fun))
 224     {
 225       Lisp_Object tem;
 226
 227       tem = XCONS (fun)->car;
 228       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 229         {
 230           tem = Fcdr (Fcdr (fun));
 231           if (CONSP (tem) &&
 232               XTYPE (XCONS (tem)->car) == Lisp_Int)
 233             XFASTINT (XCONS (tem)->car) = offset;
 234         }
 235       else if (EQ (tem, Qmacro))
 236         store_function_docstring (XCONS (fun)->cdr, offset);
 237     }
 238
 239   /* Bytecode objects sometimes have slots for it.  */
 240   else if (XTYPE (fun) == Lisp_Compiled)
 241     {
 242       /* This bytecode object must have a slot for the
 243          docstring, since we've found a docstring for it.  */
 244       if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
 245         abort ();
 246
 247       XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING]) = offset;
 248     }
 249 }
 250
 251
 252 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 253   1, 1, 0,
 254   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 255 to find pointers to doc strings stored in `etc/DOC...' and\n\
 256 record them in function definitions.\n\
 257 One arg, FILENAME, a string which does not include a directory.\n\
 258 The file is found in `../etc' now; found in the `data-directory'\n\
 259 when doc strings are referred to later in the dumped Emacs.")
 260   (filename)
 261      Lisp_Object filename;
 262 {
 263   int fd;
 264   char buf[1024 + 1];
 265   register int filled;
 266   register int pos;
 267   register char *p, *end;
 268   Lisp_Object sym, fun, tem;
 269   char *name;
 270   extern char *index ();
 271
 272 #ifndef CANNOT_DUMP
 273   if (NILP (Vpurify_flag))
 274     error ("Snarf-documentation can only be called in an undumped Emacs");
 275 #endif
 276
 277   CHECK_STRING (filename, 0);
 278
 279 #ifndef CANNOT_DUMP
 280   name = (char *) alloca (XSTRING (filename)->size + 14);
 281   strcpy (name, "../etc/");
 282 #else /* CANNOT_DUMP */
 283   CHECK_STRING (Vdoc_directory, 0);
 284   name = (char *) alloca (XSTRING (filename)->size +
 285                           XSTRING (Vdoc_directory)->size + 1);
 286   strcpy (name, XSTRING (Vdoc_directory)->data);
 287 #endif /* CANNOT_DUMP */
 288   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 289 #ifdef VMS
 290 #ifndef VMS4_4
 291   /* For VMS versions with limited file name syntax,
 292      convert the name to something VMS will allow.  */
 293   p = name;
 294   while (*p)
 295     {
 296       if (*p == '-')
 297         *p = '_';
 298       p++;
 299     }
 300 #endif /* not VMS4_4 */
 301 #ifdef VMS4_4
 302   strcpy (name, sys_translate_unix (name));
 303 #endif /* VMS4_4 */
 304 #endif /* VMS */
 305
 306   fd = open (name, O_RDONLY, 0);
 307   if (fd < 0)
 308     report_file_error ("Opening doc string file",
 309                        Fcons (build_string (name), Qnil));
 310   Vdoc_file_name = filename;
 311   filled = 0;
 312   pos = 0;
 313   while (1)
 314     {
 315       if (filled < 512)
 316         filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
 317       if (!filled)
 318         break;
 319
 320       buf[filled] = 0;
 321       p = buf;
 322       end = buf + (filled < 512 ? filled : filled - 128);
 323       while (p != end && *p != '\037') p++;
 324       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 325       if (p != end)
 326         {
 327           end = index (p, '\n');
 328           sym = oblookup (Vobarray, p + 2, end - p - 2);
 329           if (XTYPE (sym) == Lisp_Symbol)
 330             {
 331               /* Attach a docstring to a variable?  */
 332               if (p[1] == 'V')
 333                 {
 334                   /* Install file-position as variable-documentation property
 335                      and make it negative for a user-variable
 336                      (doc starts with a `*').  */
 337                   Fput (sym, Qvariable_documentation,
 338                         make_number ((pos + end + 1 - buf)
 339                                      * (end[1] == '*' ? -1 : 1)));
 340                 }
 341
 342               /* Attach a docstring to a function?  */
 343               else if (p[1] == 'F')
 344                 store_function_docstring (sym, pos + end + 1 - buf);
 345
 346               else
 347                 error ("DOC file invalid at position %d", pos);
 348             }
 349         }
 350       pos += end - buf;
 351       filled -= end - buf;
 352       bcopy (end, buf, filled);
 353     }
 354   close (fd);
 355   return Qnil;
 356 }
 357 \f
 358 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 359   Ssubstitute_command_keys, 1, 1, 0,
 360   "Substitute key descriptions for command names in STRING.\n\
 361 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 362 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 363 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 364 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 365 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 366 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 367 as the keymap for future \\=\\[COMMAND] substrings.\n\
 368 \\=\\= quotes the following character and is discarded;\n\
 369 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 370   (str)
 371      Lisp_Object str;
 372 {
 373   unsigned char *buf;
 374   int changed = 0;
 375   register unsigned char *strp;
 376   register unsigned char *bufp;
 377   int idx;
 378   int bsize;
 379   unsigned char *new;
 380   Lisp_Object tem;
 381   Lisp_Object keymap;
 382   unsigned char *start;
 383   int length;
 384   Lisp_Object name;
 385   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 386
 387   if (NILP (str))
 388     return Qnil;
 389
 390   CHECK_STRING (str, 0);
 391   tem = Qnil;
 392   keymap = Qnil;
 393   name = Qnil;
 394   GCPRO4 (str, tem, keymap, name);
 395
 396   /* KEYMAP is either nil (which means search all the active keymaps)
 397      or a specified local map (which means search just that and the
 398      global map).  If non-nil, it might come from Voverriding_local_map,
 399      or from a \\<mapname> construct in STR itself..  */
 400   keymap = Voverriding_local_map;
 401
 402   bsize = XSTRING (str)->size;
 403   bufp = buf = (unsigned char *) xmalloc (bsize);
 404
 405   strp = (unsigned char *) XSTRING (str)->data;
 406   while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size)
 407     {
 408       if (strp[0] == '\\' && strp[1] == '=')
 409         {
 410           /* \= quotes the next character;
 411              thus, to put in \[ without its special meaning, use \=\[.  */
 412           changed = 1;
 413           *bufp++ = strp[2];
 414           strp += 3;
 415         }
 416       else if (strp[0] == '\\' && strp[1] == '[')
 417         {
 418           Lisp_Object firstkey;
 419
 420           changed = 1;
 421           strp += 2;            /* skip \[ */
 422           start = strp;
 423
 424           while ((strp - (unsigned char *) XSTRING (str)->data
 425                   < XSTRING (str)->size)
 426                  && *strp != ']')
 427             strp++;
 428           length = strp - start;
 429           strp++;               /* skip ] */
 430
 431           /* Save STRP in IDX.  */
 432           idx = strp - (unsigned char *) XSTRING (str)->data;
 433           tem = Fintern (make_string (start, length), Qnil);
 434           tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
 435
 436           /* Disregard menu bar bindings; it is positively annoying to
 437              mention them when there's no menu bar, and it isn't terribly
 438              useful even when there is a menu bar.  */
 439           if (!NILP (tem))
 440             {
 441               firstkey = Faref (tem, make_number (0));
 442               if (EQ (firstkey, Qmenu_bar))
 443                 tem = Qnil;
 444             }
 445
 446           if (NILP (tem))       /* but not on any keys */
 447             {
 448               new = (unsigned char *) xrealloc (buf, bsize += 4);
 449               bufp += new - buf;
 450               buf = new;
 451               bcopy ("M-x ", bufp, 4);
 452               bufp += 4;
 453               goto subst;
 454             }
 455           else
 456             {                   /* function is on a key */
 457               tem = Fkey_description (tem);
 458               goto subst_string;
 459             }
 460         }
 461       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 462          \<foo> just sets the keymap used for \[cmd].  */
 463       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 464         {
 465           struct buffer *oldbuf;
 466
 467           changed = 1;
 468           strp += 2;            /* skip \{ or \< */
 469           start = strp;
 470
 471           while ((strp - (unsigned char *) XSTRING (str)->data
 472                   < XSTRING (str)->size)
 473                  && *strp != '}' && *strp != '>')
 474             strp++;
 475           length = strp - start;
 476           strp++;                       /* skip } or > */
 477
 478           /* Save STRP in IDX.  */
 479           idx = strp - (unsigned char *) XSTRING (str)->data;
 480
 481           /* Get the value of the keymap in TEM, or nil if undefined.
 482              Do this while still in the user's current buffer
 483              in case it is a local variable.  */
 484           name = Fintern (make_string (start, length), Qnil);
 485           tem = Fboundp (name);
 486           if (! NILP (tem))
 487             {
 488               tem = Fsymbol_value (name);
 489               if (! NILP (tem))
 490                 tem = get_keymap_1 (tem, 0, 1);
 491             }
 492
 493           /* Now switch to a temp buffer.  */
 494           oldbuf = current_buffer;
 495           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 496
 497           if (NILP (tem))
 498             {
 499               name = Fsymbol_name (name);
 500               insert_string ("\nUses keymap \"");
 501               insert_from_string (name, 0, XSTRING (name)->size, 1);
 502               insert_string ("\", which is not currently defined.\n");
 503               if (start[-1] == '<') keymap = Qnil;
 504             }
 505           else if (start[-1] == '<')
 506             keymap = tem;
 507           else
 508             describe_map_tree (tem, 1, Qnil, Qnil, 0, 1);
 509           tem = Fbuffer_string ();
 510           Ferase_buffer ();
 511           set_buffer_internal (oldbuf);
 512
 513         subst_string:
 514           start = XSTRING (tem)->data;
 515           length = XSTRING (tem)->size;
 516         subst:
 517           new = (unsigned char *) xrealloc (buf, bsize += length);
 518           bufp += new - buf;
 519           buf = new;
 520           bcopy (start, bufp, length);
 521           bufp += length;
 522           /* Check STR again in case gc relocated it.  */
 523           strp = (unsigned char *) XSTRING (str)->data + idx;
 524         }
 525       else                      /* just copy other chars */
 526         *bufp++ = *strp++;
 527     }
 528
 529   if (changed)                  /* don't bother if nothing substituted */
 530     tem = make_string (buf, bufp - buf);
 531   else
 532     tem = str;
 533   xfree (buf);
 534   RETURN_UNGCPRO (tem);
 535 }
 536 \f
 537 syms_of_doc ()
 538 {
 539   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 540     "Name of file containing documentation strings of built-in symbols.");
 541   Vdoc_file_name = Qnil;
 542
 543   defsubr (&Sdocumentation);
 544   defsubr (&Sdocumentation_property);
 545   defsubr (&Ssnarf_documentation);
 546   defsubr (&Ssubstitute_command_keys);
 547 }