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