src/doc.c

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