Return to doc.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src

Annotation of 43BSD/contrib/emacs/src/doc.c, revision 1.1

1.1     ! root        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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.