Return to doc.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

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

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