4.3BSD - /usr/src/new/emacs/src/doc.c

   1: /* Record indices of function doc strings stored in a file.
   2:    Copyright (C) 1985 Richard M. Stallman.
   3: 
   4: This file is part of GNU Emacs.
   5: 
   6: GNU Emacs is distributed in the hope that it will be useful,
   7: but WITHOUT ANY WARRANTY.  No author or distributor
   8: accepts responsibility to anyone for the consequences of using it
   9: or for whether it serves any particular purpose or works at all,
  10: unless he says so in writing.  Refer to the GNU Emacs General Public
  11: License for full details.
  12: 
  13: Everyone is granted permission to copy, modify and redistribute
  14: GNU Emacs, but only under the conditions described in the
  15: GNU Emacs General Public License.   A copy of this license is
  16: supposed to have been given to you along with GNU Emacs so you
  17: can know your rights and responsibilities.  It should be in a
  18: file named COPYING.  Among other things, the copyright notice
  19: and this notice must be preserved on all copies.  */
  20: 
  21: 
  22: #include "config.h"
  23: #include "lisp.h"
  24: #include "buffer.h"
  25: #include "paths.h"
  26: 
  27: #include <sys/types.h>
  28: #include <sys/file.h>   /* Must be after sys/types.h for USG and BSD4_1*/
  29: 
  30: #ifdef USG5
  31: #include <fcntl.h>
  32: #endif
  33: 
  34: #ifndef O_RDONLY
  35: #define O_RDONLY 0
  36: #endif
  37: 
  38: Lisp_Object Vdoc_file_name;
  39: 
  40: Lisp_Object
  41: get_doc_string (filepos)
  42:      long filepos;
  43: {
  44:   char buf[512 * 32 + 1];
  45:   register int fd;
  46:   register char *name;
  47:   register char *p, *p1;
  48:   register int count;
  49:   extern char *index ();
  50: 
  51:   if (XTYPE (Vexec_directory) != Lisp_String
  52:       || XTYPE (Vdoc_file_name) != Lisp_String)
  53:     return Qnil;
  54: 
  55:   name = (char *) alloca (XSTRING (Vexec_directory)->size
  56:               + XSTRING (Vdoc_file_name)->size + 2);
  57:   strcpy (name, XSTRING (Vexec_directory)->data);
  58:   strcat (name, XSTRING (Vdoc_file_name)->data);
  59: 
  60:   fd = open (name, O_RDONLY, 0);
  61:   if (fd < 0)
  62:     error ("Cannot open doc string file \"%s\"", name);
  63:   if (0 > lseek (fd, filepos, 0))
  64:     {
  65:       close (fd);
  66:       error ("Position %ld out of range in doc string file \"%s\"",
  67:          filepos, name);
  68:     }
  69:   p = buf;
  70:   while (p != buf + sizeof buf - 1)
  71:     {
  72:       count = read (fd, p, 512);
  73:       p[count] = 0;
  74:       if (!count)
  75:     break;
  76:       p1 = index (p, '\037');
  77:       if (p1)
  78:     {
  79:       *p1 = 0;
  80:       p = p1;
  81:       break;
  82:     }
  83:       p += count;
  84:     }
  85:   close (fd);
  86:   return make_string (buf, p - buf);
  87: }
  88: 
  89: DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0,
  90:   "Return the documentation string of FUNCTION.")
  91:   (fun1)
  92:      Lisp_Object fun1;
  93: {
  94:   Lisp_Object fun;
  95:   Lisp_Object funcar;
  96:   Lisp_Object tem;
  97: 
  98:   fun = fun1;
  99:   while (XTYPE (fun) == Lisp_Symbol)
 100:     fun = Fsymbol_function (fun);
 101:   if (XTYPE (fun) == Lisp_Subr)
 102:     {
 103:       if (XSUBR (fun)->doc == 0) return Qnil;
 104:       if ((int) XSUBR (fun)->doc >= 0)
 105:     return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc));
 106:       return Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc));
 107:     }
 108:   if (XTYPE (fun) == Lisp_Vector)
 109:     return build_string ("Prefix command (definition is a Lisp vector of subcommands).");
 110:   if (XTYPE (fun) == Lisp_String)
 111:     return build_string ("Keyboard macro.");
 112:   if (!LISTP(fun))
 113:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 114:   funcar = Fcar (fun);
 115:   if (XTYPE (funcar) != Lisp_Symbol)
 116:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 117:   if (XSYMBOL (funcar) == XSYMBOL (Qkeymap))
 118:     return build_string ("Prefix command (definition is a list whose cdr is an alist of subcommands.)");
 119:   if (XSYMBOL (funcar) == XSYMBOL (Qlambda)
 120:       || XSYMBOL (funcar) == XSYMBOL (Qautoload))
 121:     {
 122:       tem = Fcar (Fcdr (Fcdr (fun)));
 123:       if (XTYPE (tem) == Lisp_String)
 124:     return Fsubstitute_command_keys (tem);
 125:       if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
 126:     return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem)));
 127:       return Qnil;
 128:     }
 129:   if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp))
 130:     return Qnil;
 131:   if (XSYMBOL (funcar) == XSYMBOL (Qmacro))
 132:     return Fdocumentation (Fcdr (fun));
 133:   else
 134:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
 135: }
 136: 
 137: DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
 138:   1, 1, 0,
 139:   "Used during Emacs initialization, before dumping runnable Emacs,\n\
 140: to find pointers to doc strings stored in etc/DOC... and\n\
 141: record them in function definitions.\n\
 142: One arg, FILENAME, a string which does not include a directory.\n\
 143: The file is found in ../etc now; found in the exec-directory\n\
 144: when doc strings are referred to later in the dumped Emacs.")
 145:   (filename)
 146:      Lisp_Object filename;
 147: {
 148:   int fd;
 149:   char buf[1024 + 1];
 150:   register int filled;
 151:   register int pos;
 152:   register char *p, *end;
 153:   Lisp_Object sym, fun, tem;
 154:   char *name;
 155:   extern char *index ();
 156: 
 157:   CHECK_STRING (filename, 0);
 158: 
 159: #ifndef CANNOT_DUMP
 160:   name = (char *) alloca (XSTRING (filename)->size + 8);
 161:   strcpy (name, "../etc/");
 162: #else /* CANNOT_DUMP */
 163:   name = (char *) alloca (XSTRING (filename)->size + sizeof(PATH_EXEC)+1);
 164:   strcpy (name, PATH_EXEC);
 165:   strcat (name, "/");
 166: #endif /* CANNOT_DUMP */
 167:   strcat (name, XSTRING (filename)->data);  /*** Add this line ***/
 168: 
 169:   fd = open (name, O_RDONLY, 0);
 170:   if (fd < 0)
 171:     report_file_error ("Opening doc string file", Fcons (filename, Qnil));
 172:   Vdoc_file_name = filename;
 173:   filled = 0;
 174:   pos = 0;
 175:   while (1)
 176:     {
 177:       if (filled < 512)
 178:     filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
 179:       if (!filled)
 180:     break;
 181: 
 182:       buf[filled] = 0;
 183:       p = buf;
 184:       end = buf + (filled < 512 ? filled : filled - 128);
 185:       while (p != end && *p != '\037') p++;
 186:       if (p != end)
 187:     {
 188:       end = index (p, '\n');
 189:       sym = oblookup (Vobarray, p + 1, end - p - 1);
 190:       if (XTYPE (sym) == Lisp_Symbol)
 191:         {
 192:           fun = XSYMBOL (sym)->function;
 193:           if (XTYPE (fun) == Lisp_Subr)
 194:         XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
 195:           else if (LISTP (fun))
 196:         {
 197:           tem = XCONS (fun)->car;
 198:           if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
 199:             {
 200:               tem = Fcdr (Fcdr (fun));
 201:               if (LISTP (tem) && XTYPE (XCONS (tem)->car) == Lisp_Int)
 202:             XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
 203:             }
 204:         }
 205:         }
 206:     }
 207:       pos += end - buf;
 208:       filled -= end - buf;
 209:       bcopy (end, buf, filled);
 210:     }
 211:   close (fd);
 212:   return Qnil;
 213: }
 214: 
 215: extern Lisp_Object where_is_in_buffer ();
 216: 
 217: DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
 218:   Ssubstitute_command_keys, 1, 1, 0,
 219:   "Return the STRING with substrings of the form \\=\\[COMMAND]\n\
 220: replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
 221: or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
 222: Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
 223: \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
 224: \\=\\= quotes the following character and is discarded;\n\
 225: thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
 226:   (str)
 227:      Lisp_Object str;
 228: {
 229:   unsigned char *buf;
 230:   int didone = 0;
 231:   register unsigned char *strp;
 232:   register unsigned char *bufp;
 233:   register unsigned char *send;
 234:   int bsize;
 235:   unsigned char *new;
 236:   Lisp_Object key, tem;
 237:   unsigned char *funp;
 238:   int func;
 239:   struct buffer *oldbuf;
 240: 
 241:   if (NULL (str))
 242:     return Qnil;
 243: 
 244:   CHECK_STRING (str, 0);
 245:   strp = (unsigned char *) XSTRING (str)->data;
 246:   send = strp + XSTRING (str)->size;
 247: 
 248:   bsize = XSTRING (str)->size;
 249:   bufp = buf = (unsigned char *) xmalloc (bsize);
 250: 
 251:   while (strp < send)
 252:     {
 253:       if (strp[0] == '\\' && strp[1] == '=')
 254:     {
 255:       /* \= quotes the next character;
 256: 	     thus, to put in \[ without its special meaning, use \=\[.  */
 257:       didone = 1;
 258:       *bufp++ = strp[2];
 259:       strp += 3;
 260:     }
 261:       else if (strp[0] == '\\' && strp[1] == '[')
 262:     {
 263:       didone = 1;
 264:       strp += 2;        /* skip \[ */
 265:       funp = strp;
 266: 
 267:       while (strp < send && *strp != ']')
 268:         strp++;
 269:       func = strp - funp;
 270: 
 271:       key = Fintern (make_string (funp, func), Qnil);
 272:       key = where_is_in_buffer (key, bf_cur, 1);
 273:       strp++;           /* skip ] */
 274: 
 275:       if (NULL (key))   /* but not on any keys */
 276:         {
 277:           new = (unsigned char *) xrealloc (buf, bsize += 4);
 278:           bufp += new - buf;
 279:           buf = new;
 280:           strcpy (bufp, "M-x ");
 281:           bufp += 4;
 282:         }
 283:       else
 284:         {       /* function is on a key */
 285:           key = Fkey_description (key);
 286:           funp = XSTRING (key)->data;
 287:           func = XSTRING (key)->size;
 288:         }
 289: 
 290:     subst:
 291:       new = (unsigned char *) xrealloc (buf, bsize += func);
 292:       bufp += new - buf;
 293:       buf = new;
 294:       bcopy (funp, bufp, func);
 295:       bufp += func;
 296:     }
 297:       else if (strp[0] == '\\' && strp[1] == '{')
 298:     {
 299:       didone = 1;
 300:       strp += 2;        /* skip \( */
 301:       funp = strp;
 302: 
 303:       while (strp < send && *strp != '}')
 304:         strp++;
 305:       func = strp - funp;
 306:       strp++;           /* skip } */
 307: 
 308:       oldbuf = bf_cur;
 309:       SetBfp (XBUFFER (Vprin1_to_string_buffer));
 310:       key = Fintern (make_string (funp, func), Qnil);
 311:       if ((tem = (Fboundp (key)), NULL (tem)) ||
 312:           (tem = (Fsymbol_value (key)), NULL (tem)))
 313:         {
 314:           key = Fsymbol_name (key);
 315:           InsStr ("\nUses keymap \"");
 316:           InsCStr (XSTRING (key)->data, XSTRING (key)->size);
 317:           InsStr ("\", which is not currently defined.\n");
 318:         }
 319:       else
 320:         {
 321:           key = Fsymbol_value (key);
 322:           describe_map_tree (key, 1);
 323:         }
 324:       key = Fbuffer_string ();
 325:       Ferase_buffer ();
 326:       SetBfp (oldbuf);
 327:       funp = XSTRING (key)->data;
 328:       func = XSTRING (key)->size;
 329:       goto subst;
 330:     }
 331:       else          /* just copy other chars */
 332:     *bufp++ = *strp++;
 333:     }
 334: 
 335:   if (didone)           /* don't bother if nothing substituted */
 336:     key = make_string (buf, bufp - buf);
 337:   else
 338:     key = str;
 339:   free (buf);
 340:   return key;
 341: }
 342: 
 343: syms_of_doc ()
 344: {
 345:   staticpro (&Vdoc_file_name);
 346:   Vdoc_file_name = Qnil;
 347: 
 348:   defsubr (&Sdocumentation);
 349:   defsubr (&Ssnarf_documentation);
 350:   defsubr (&Ssubstitute_command_keys);
 351: }

Defined functions

Defined variables

Defined macros