Return to doc.c CVS log

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

Annotation of 43BSDReno/contrib/emacs-18.55/src/doc.c, revision 1.1

1.1     ! root        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 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: 
        !            26: #include <sys/types.h>
        !            27: #include <sys/file.h>  /* Must be after sys/types.h for USG and BSD4_1*/
        !            28: 
        !            29: #ifdef USG5
        !            30: #include <fcntl.h>
        !            31: #endif
        !            32: 
        !            33: #ifndef O_RDONLY
        !            34: #define O_RDONLY 0
        !            35: #endif
        !            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 (Vexec_directory) != Lisp_String
        !            51:       || XTYPE (Vdoc_file_name) != Lisp_String)
        !            52:     return Qnil;
        !            53: 
        !            54:   name = (char *) alloca (XSTRING (Vexec_directory)->size
        !            55:                          + XSTRING (Vdoc_file_name)->size + 8);
        !            56:   strcpy (name, XSTRING (Vexec_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:     fun = Fsymbol_function (fun);
        !           116:   if (XTYPE (fun) == Lisp_Subr)
        !           117:     {
        !           118:       if (XSUBR (fun)->doc == 0) return Qnil;
        !           119:       if ((int) XSUBR (fun)->doc >= 0)
        !           120:        return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc));
        !           121:       return Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc));
        !           122:     }
        !           123:   if (XTYPE (fun) == Lisp_Vector)
        !           124:     return build_string ("Prefix command (definition is a Lisp vector of subcommands).");
        !           125:   if (XTYPE (fun) == Lisp_String)
        !           126:     return build_string ("Keyboard macro.");
        !           127:   if (!CONSP (fun))
        !           128:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !           129:   funcar = Fcar (fun);
        !           130:   if (XTYPE (funcar) != Lisp_Symbol)
        !           131:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !           132:   if (XSYMBOL (funcar) == XSYMBOL (Qkeymap))
        !           133:     return build_string ("Prefix command (definition is a list whose cdr is an alist of subcommands.)");
        !           134:   if (XSYMBOL (funcar) == XSYMBOL (Qlambda)
        !           135:       || XSYMBOL (funcar) == XSYMBOL (Qautoload))
        !           136:     {
        !           137:       tem = Fcar (Fcdr (Fcdr (fun)));
        !           138:       if (XTYPE (tem) == Lisp_String)
        !           139:        return Fsubstitute_command_keys (tem);
        !           140:       if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
        !           141:        return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem)));
        !           142:       return Qnil;
        !           143:     }
        !           144:   if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp))
        !           145:     return Qnil;
        !           146:   if (XSYMBOL (funcar) == XSYMBOL (Qmacro))
        !           147:     return Fdocumentation (Fcdr (fun));
        !           148:   else
        !           149:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !           150: }
        !           151: 
        !           152: DEFUN ("documentation-property", Fdocumentation_property, 
        !           153:        Sdocumentation_property, 2, 2, 0,
        !           154:   "Return the documentation string that is SYMBOL's PROP property.\n\
        !           155: This differs from using `get' only in that it can refer to strings\n\
        !           156: stored in the etc/DOC file.")
        !           157:   (sym, prop)
        !           158:      Lisp_Object sym, prop;
        !           159: {
        !           160:   register Lisp_Object tem;
        !           161: 
        !           162:   tem = Fget (sym, prop);
        !           163:   if (XTYPE (tem) == Lisp_Int)
        !           164:     tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
        !           165:   return Fsubstitute_command_keys (tem);
        !           166: }
        !           167: 
        !           168: DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
        !           169:   1, 1, 0,
        !           170:   "Used during Emacs initialization, before dumping runnable Emacs,\n\
        !           171: to find pointers to doc strings stored in etc/DOC... and\n\
        !           172: record them in function definitions.\n\
        !           173: One arg, FILENAME, a string which does not include a directory.\n\
        !           174: The file is found in ../etc now; found in the exec-directory\n\
        !           175: when doc strings are referred to later in the dumped Emacs.")
        !           176:   (filename)
        !           177:      Lisp_Object filename;
        !           178: {
        !           179:   int fd;
        !           180:   char buf[1024 + 1];
        !           181:   register int filled;
        !           182:   register int pos;
        !           183:   register char *p, *end;
        !           184:   Lisp_Object sym, fun, tem;
        !           185:   char *name;
        !           186:   extern char *index ();
        !           187: 
        !           188:   CHECK_STRING (filename, 0);
        !           189: 
        !           190: #ifndef CANNOT_DUMP
        !           191:   name = (char *) alloca (XSTRING (filename)->size + 8);
        !           192:   strcpy (name, "../etc/");
        !           193: #else /* CANNOT_DUMP */
        !           194:   CHECK_STRING (Vexec_directory, 0);
        !           195:   name = (char *) alloca (XSTRING (filename)->size +
        !           196:                          XSTRING (Vexec_directory)->size + 1);
        !           197:   strcpy (name, XSTRING (Vexec_directory)->data);
        !           198: #endif /* CANNOT_DUMP */
        !           199:   strcat (name, XSTRING (filename)->data);     /*** Add this line ***/
        !           200: #ifdef VMS
        !           201: #ifndef VMS4_4
        !           202:   /* For VMS versions with limited file name syntax,
        !           203:      convert the name to something VMS will allow.  */
        !           204:   p = name;
        !           205:   while (*p)
        !           206:     {
        !           207:       if (*p == '-')
        !           208:        *p = '_';
        !           209:       p++;
        !           210:     }
        !           211: #endif /* not VMS4_4 */
        !           212: #ifdef VMS4_4
        !           213:   strcpy (name, sys_translate_unix (name));
        !           214: #endif /* VMS4_4 */
        !           215: #endif /* VMS */
        !           216: 
        !           217:   fd = open (name, O_RDONLY, 0);
        !           218:   if (fd < 0)
        !           219:     report_file_error ("Opening doc string file",
        !           220:                       Fcons (build_string (name), Qnil));
        !           221:   Vdoc_file_name = filename;
        !           222:   filled = 0;
        !           223:   pos = 0;
        !           224:   while (1)
        !           225:     {
        !           226:       if (filled < 512)
        !           227:        filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
        !           228:       if (!filled)
        !           229:        break;
        !           230: 
        !           231:       buf[filled] = 0;
        !           232:       p = buf;
        !           233:       end = buf + (filled < 512 ? filled : filled - 128);
        !           234:       while (p != end && *p != '\037') p++;
        !           235:       /* p points to ^_Ffunctionname\n or ^_Vvarname\n.  */
        !           236:       if (p != end)
        !           237:        {
        !           238:          end = index (p, '\n');
        !           239:          sym = oblookup (Vobarray, p + 2, end - p - 2);
        !           240:          if (XTYPE (sym) == Lisp_Symbol)
        !           241:            {
        !           242:              if (p[1] == 'V')
        !           243:                {
        !           244:                  /* Install file-position as variable-documentation property
        !           245:                     and make it negative for a user-variable
        !           246:                     (doc starts with a `*').  */
        !           247:                  Fput (sym, Qvariable_documentation,
        !           248:                        make_number ((pos + end + 1 - buf)
        !           249:                                     * (end[1] == '*' ? -1 : 1)));
        !           250:                }
        !           251:              else if (p[1] == 'F')
        !           252:                {
        !           253:                  fun = XSYMBOL (sym)->function;
        !           254:                  if (XTYPE (fun) == Lisp_Subr)
        !           255:                    XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
        !           256:                  else if (CONSP (fun))
        !           257:                    {
        !           258:                      tem = XCONS (fun)->car;
        !           259:                      if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
        !           260:                        {
        !           261:                          tem = Fcdr (Fcdr (fun));
        !           262:                          if (CONSP (tem) &&
        !           263:                              XTYPE (XCONS (tem)->car) == Lisp_Int)
        !           264:                            XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
        !           265:                        }
        !           266:                    }
        !           267:                }
        !           268:              else error ("DOC file invalid at position %d", pos);
        !           269:            }
        !           270:        }
        !           271:       pos += end - buf;
        !           272:       filled -= end - buf;
        !           273:       bcopy (end, buf, filled);
        !           274:     }
        !           275:   close (fd);
        !           276:   return Qnil;
        !           277: }
        !           278: 
        !           279: DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
        !           280:   Ssubstitute_command_keys, 1, 1, 0,
        !           281:   "Return the STRING with substrings of the form \\=\\[COMMAND]\n\
        !           282: replaced by either:  a keystroke sequence that will invoke COMMAND,\n\
        !           283: or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
        !           284: Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
        !           285: \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
        !           286: Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
        !           287: as the keymap for future \\=\\[COMMAND] substrings.\n\
        !           288: \\=\\= quotes the following character and is discarded;\n\
        !           289: thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
        !           290:   (str)
        !           291:      Lisp_Object str;
        !           292: {
        !           293:   unsigned char *buf;
        !           294:   int changed = 0;
        !           295:   register unsigned char *strp;
        !           296:   register unsigned char *bufp;
        !           297:   register unsigned char *send;
        !           298:   int bsize;
        !           299:   unsigned char *new;
        !           300:   register Lisp_Object tem;
        !           301:   Lisp_Object keymap;
        !           302:   unsigned char *start;
        !           303:   int length;
        !           304: 
        !           305:   if (NULL (str))
        !           306:     return Qnil;
        !           307: 
        !           308:   CHECK_STRING (str, 0);
        !           309:   strp = (unsigned char *) XSTRING (str)->data;
        !           310:   send = strp + XSTRING (str)->size;
        !           311: 
        !           312:   keymap = bf_cur->keymap;
        !           313: 
        !           314:   bsize = XSTRING (str)->size;
        !           315:   bufp = buf = (unsigned char *) xmalloc (bsize);
        !           316: 
        !           317:   while (strp < send)
        !           318:     {
        !           319:       if (strp[0] == '\\' && strp[1] == '=')
        !           320:        {
        !           321:          /* \= quotes the next character;
        !           322:             thus, to put in \[ without its special meaning, use \=\[.  */
        !           323:          changed = 1;
        !           324:          *bufp++ = strp[2];
        !           325:          strp += 3;
        !           326:        }
        !           327:       else if (strp[0] == '\\' && strp[1] == '[')
        !           328:        {
        !           329:          changed = 1;
        !           330:          strp += 2;            /* skip \[ */
        !           331:          start = strp;
        !           332: 
        !           333:          while (strp < send && *strp != ']')
        !           334:            strp++;
        !           335:          length = strp - start;
        !           336:          strp++;               /* skip ] */
        !           337: 
        !           338:          tem = Fintern (make_string (start, length), Qnil);
        !           339:          tem = Fwhere_is_internal (tem, keymap, Qt);
        !           340: 
        !           341:          if (NULL (tem))       /* but not on any keys */
        !           342:            {
        !           343:              new = (unsigned char *) xrealloc (buf, bsize += 4);
        !           344:              bufp += new - buf;
        !           345:              buf = new;
        !           346:              bcopy ("M-x ", bufp, 4);
        !           347:              bufp += 4;
        !           348:              goto subst;
        !           349:            }
        !           350:          else
        !           351:            {                   /* function is on a key */
        !           352:              tem = Fkey_description (tem);
        !           353:              goto subst_string;
        !           354:            }
        !           355:        }
        !           356:       /* \{foo} is replaced with a summary of the keymap (symeval foo).
        !           357:         \<foo> just sets the keymap used for \[cmd].  */
        !           358:       else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
        !           359:        {
        !           360:          struct buffer *oldbuf;
        !           361:          Lisp_Object name;
        !           362: 
        !           363:          changed = 1;
        !           364:          strp += 2;            /* skip \{ or \< */
        !           365:          start = strp;
        !           366: 
        !           367:          while (strp < send && *strp != '}' && *strp != '>')
        !           368:            strp++;
        !           369:          length = strp - start;
        !           370:          strp++;                       /* skip } or > */
        !           371: 
        !           372:          oldbuf = bf_cur;
        !           373:          SetBfp (XBUFFER (Vprin1_to_string_buffer));
        !           374:          name = Fintern (make_string (start, length), Qnil);
        !           375:          if ((tem = (Fboundp (name)), NULL (tem)) ||
        !           376:              (tem = (Fsymbol_value (name)), NULL (tem)) ||
        !           377:              (tem = (get_keymap_1 (tem, 0)), NULL (tem)))
        !           378:            {
        !           379:              name = Fsymbol_name (name);
        !           380:              InsStr ("\nUses keymap \"");
        !           381:              InsCStr (XSTRING (name)->data, XSTRING (name)->size);
        !           382:              InsStr ("\", which is not currently defined.\n");
        !           383:              if (start[-1] == '<') keymap = Qnil;
        !           384:            }
        !           385:          else if (start[-1] == '<')
        !           386:            keymap = tem;
        !           387:          else
        !           388:            describe_map_tree (tem, 1, Qnil);
        !           389:          tem = Fbuffer_string ();
        !           390:          Ferase_buffer ();
        !           391:          SetBfp (oldbuf);
        !           392: 
        !           393:        subst_string:
        !           394:          start = XSTRING (tem)->data;
        !           395:          length = XSTRING (tem)->size;
        !           396:        subst:
        !           397:          new = (unsigned char *) xrealloc (buf, bsize += length);
        !           398:          bufp += new - buf;
        !           399:          buf = new;
        !           400:          bcopy (start, bufp, length);
        !           401:          bufp += length;
        !           402:        }
        !           403:       else                     /* just copy other chars */
        !           404:        *bufp++ = *strp++;
        !           405:     }
        !           406: 
        !           407:   if (changed)                 /* don't bother if nothing substituted */
        !           408:     tem = make_string (buf, bufp - buf);
        !           409:   else
        !           410:     tem = str;
        !           411:   free (buf);
        !           412:   return tem;
        !           413: }
        !           414: 
        !           415: syms_of_doc ()
        !           416: {
        !           417:   staticpro (&Vdoc_file_name);
        !           418:   Vdoc_file_name = Qnil;
        !           419: 
        !           420:   defsubr (&Sdocumentation);
        !           421:   defsubr (&Sdocumentation_property);
        !           422:   defsubr (&Ssnarf_documentation);
        !           423:   defsubr (&Ssubstitute_command_keys);
        !           424: }

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