src/doc.c

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