code.delx.au - gnu-emacs/blob - 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 #ifndef CANNOT_DUMP
 219   if (NILP (Vpurify_flag))
 220     error ("Snarf-documentation can only be called in an undumped Emacs");
 221 #endif
 222
 223   CHECK_STRING (filename, 0);
 224
 225 #ifndef CANNOT_DUMP
 226   name = (char *) alloca (XSTRING (filename)->size + 14);
 227   strcpy (name, "../etc/");
 228 #else /* CANNOT_DUMP */
 229   CHECK_STRING (Vdata_directory, 0);
 230   name = (char *) alloca (XSTRING (filename)->size +
 231                           XSTRING (Vdata_directory)->size + 1);
 232   strcpy (name, XSTRING (Vdata_directory)->data);
 233 #endif /* CANNOT_DUMP */
 234   strcat (name, XSTRING (filename)->data);      /*** Add this line ***/
 235 #ifdef VMS
 236 #ifndef VMS4_4
 237   /* For VMS versions with limited file name syntax,
 238      convert the name to something VMS will allow.  */
 239   p = name;
 240   while (*p)
 241     {
 242       if (*p == '-')
 243         *p = '_';
 244       p++;
 245     }
 246 #endif /* not VMS4_4 */
 247 #ifdef VMS4_4
 248   strcpy (name, sys_translate_unix (name));
 249 #endif /* VMS4_4 */
 250 #endif /* VMS */
 251
 252   fd = open (name, O_RDONLY, 0);
 253   if (fd < 0)
 254     report_file_error ("Opening doc string file",
 255                        Fcons (build_string (name), Qnil));
 256   Vdoc_file_name = filename;
 257   filled = 0;
 258   pos = 0;
 259   while (1)
 260     {
 261       if (filled < 512)
 262         filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
 263       if (!filled)
 264         break;
 265
 266       buf[filled] = 0;
 267       p = buf;
 268       end = buf + (filled < 512 ? filled : filled - 128);
 269       while (p != end && *p != '\037') p++;
 270       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
 271       if (p != end)
 272         {
 273           end = index (p, '\n');
 274           sym = oblookup (Vobarray, p + 2, end - p - 2);
 275           if (XTYPE (sym) == Lisp_Symbol)
 276             {
 277               /* Attach a docstring to a variable?  */
 278               if (p[1] == 'V')
 279                 {
 280                   /* Install file-position as variable-documentation property
 281                      and make it negative for a user-variable
 282                      (doc starts with a `*').  */
 283                   Fput (sym, Qvariable_documentation,
 284                         make_number ((pos + end + 1 - buf)
 285                                      * (end[1] == '*' ? -1 : 1)));
 286                 }
 287
 288               /* Attach a docstring to a function?  The type determines where
 289                  the docstring is stored.  */
 290               else if (p[1] == 'F')
 291                 {
 292                   fun = XSYMBOL (sym)->function;
 293
 294                   /* Lisp_Subrs have a slot for it.  */
 295                   if (XTYPE (fun) == Lisp_Subr)
 296                     XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
 297
 298                   /* If it's a lisp form, stick it in the form.  */
 299                   else if (CONSP (fun))
 300                     {
 301                       tem = XCONS (fun)->car;
 302                       if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 303                         {
 304                           tem = Fcdr (Fcdr (fun));
 305                           if (CONSP (tem) &&
 306                               XTYPE (XCONS (tem)->car) == Lisp_Int)
 307                             XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
 308                         }
 309                     }
 310
 311                   /* Bytecode objects sometimes have slots for it.  */
 312                   else if (XTYPE (fun) == Lisp_Compiled)
 313                     {
 314                       /* This bytecode object must have a slot for the
 315                          docstring, since we've found a docstring for it.  */
 316                       if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
 317                         abort ();
 318
 319                       XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING])
 320                         = pos + end + 1 - buf;
 321                     }
 322                 }
 323               else error ("DOC file invalid at position %d", pos);
 324             }
 325         }
 326       pos += end - buf;
 327       filled -= end - buf;
 328       bcopy (end, buf, filled);
 329     }
 330   close (fd);
 331   return Qnil;
 332 }
 333 \f
 334 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 335   Ssubstitute_command_keys, 1, 1, 0,
 336   "Substitute key descriptions for command names in STRING.\n\
 337 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
 338 replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 339 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 340 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 341 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 342 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
 343 as the keymap for future \\=\\[COMMAND] substrings.\n\
 344 \\=\\= quotes the following character and is discarded;\n\
 345 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 346   (str)
 347      Lisp_Object str;
 348 {
 349   unsigned char *buf;
 350   int changed = 0;
 351   register unsigned char *strp;
 352   register unsigned char *bufp;
 353   int idx;
 354   int bsize;
 355   unsigned char *new;
 356   register Lisp_Object tem;
 357   Lisp_Object keymap;
 358   unsigned char *start;
 359   int length;
 360   struct gcpro gcpro1;
 361
 362   if (NILP (str))
 363     return Qnil;
 364
 365   CHECK_STRING (str, 0);
 366   GCPRO1 (str);
 367
 368   keymap = current_buffer->keymap;
 369
 370   bsize = XSTRING (str)->size;
 371   bufp = buf = (unsigned char *) xmalloc (bsize);
 372
 373   strp = (unsigned char *) XSTRING (str)->data;
 374   while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size)
 375     {
 376       if (strp[0] == '\\' && strp[1] == '=')
 377         {
 378           /* \= quotes the next character;
 379              thus, to put in \[ without its special meaning, use \=\[.  */
 380           changed = 1;
 381           *bufp++ = strp[2];
 382           strp += 3;
 383         }
 384       else if (strp[0] == '\\' && strp[1] == '[')
 385         {
 386           changed = 1;
 387           strp += 2;            /* skip \[ */
 388           start = strp;
 389
 390           while ((strp - (unsigned char *) XSTRING (str)->data
 391                   < XSTRING (str)->size)
 392                  && *strp != ']')
 393             strp++;
 394           length = strp - start;
 395           strp++;               /* skip ] */
 396
 397           /* Save STRP in IDX.  */
 398           idx = strp - (unsigned char *) XSTRING (str)->data;
 399           tem = Fintern (make_string (start, length), Qnil);
 400           tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, Qnil);
 401
 402           if (NILP (tem))       /* but not on any keys */
 403             {
 404               new = (unsigned char *) xrealloc (buf, bsize += 4);
 405               bufp += new - buf;
 406               buf = new;
 407               bcopy ("M-x ", bufp, 4);
 408               bufp += 4;
 409               goto subst;
 410             }
 411           else
 412             {                   /* function is on a key */
 413               tem = Fkey_description (tem);
 414               goto subst_string;
 415             }
 416         }
 417       /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
 418          \<foo> just sets the keymap used for \[cmd].  */
 419       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
 420         {
 421           struct buffer *oldbuf;
 422           Lisp_Object name;
 423
 424           changed = 1;
 425           strp += 2;            /* skip \{ or \< */
 426           start = strp;
 427
 428           while ((strp - (unsigned char *) XSTRING (str)->data
 429                   < XSTRING (str)->size)
 430                  && *strp != '}' && *strp != '>')
 431             strp++;
 432           length = strp - start;
 433           strp++;                       /* skip } or > */
 434
 435           /* Save STRP in IDX.  */
 436           idx = strp - (unsigned char *) XSTRING (str)->data;
 437
 438           /* Get the value of the keymap in TEM, or nil if undefined.
 439              Do this while still in the user's current buffer
 440              in case it is a local variable.  */
 441           name = Fintern (make_string (start, length), Qnil);
 442           tem = Fboundp (name);
 443           if (! NILP (tem))
 444             {
 445               tem = Fsymbol_value (name);
 446               if (! NILP (tem))
 447                 tem = get_keymap_1 (tem, 0);
 448             }
 449
 450           /* Now switch to a temp buffer.  */
 451           oldbuf = current_buffer;
 452           set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
 453
 454           if (NILP (tem))
 455             {
 456               name = Fsymbol_name (name);
 457               insert_string ("\nUses keymap \"");
 458               insert_from_string (name, 0, XSTRING (name)->size);
 459               insert_string ("\", which is not currently defined.\n");
 460               if (start[-1] == '<') keymap = Qnil;
 461             }
 462           else if (start[-1] == '<')
 463             keymap = tem;
 464           else
 465             describe_map_tree (tem, 1, Qnil);
 466           tem = Fbuffer_string ();
 467           Ferase_buffer ();
 468           set_buffer_internal (oldbuf);
 469
 470         subst_string:
 471           start = XSTRING (tem)->data;
 472           length = XSTRING (tem)->size;
 473         subst:
 474           new = (unsigned char *) xrealloc (buf, bsize += length);
 475           bufp += new - buf;
 476           buf = new;
 477           bcopy (start, bufp, length);
 478           bufp += length;
 479           /* Check STR again in case gc relocated it.  */
 480           strp = (unsigned char *) XSTRING (str)->data + idx;
 481         }
 482       else                      /* just copy other chars */
 483         *bufp++ = *strp++;
 484     }
 485
 486   if (changed)                  /* don't bother if nothing substituted */
 487     tem = make_string (buf, bufp - buf);
 488   else
 489     tem = str;
 490   UNGCPRO;
 491   free (buf);
 492   return tem;
 493 }
 494 \f
 495 syms_of_doc ()
 496 {
 497   DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
 498     "Name of file containing documentation strings of built-in symbols.");
 499   Vdoc_file_name = Qnil;
 500
 501   defsubr (&Sdocumentation);
 502   defsubr (&Sdocumentation_property);
 503   defsubr (&Ssnarf_documentation);
 504   defsubr (&Ssubstitute_command_keys);
 505 }