X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c6045832a14f0c18966c00cea7025f5069b3f610..d093c3ac08ef48f862971dd9b1f35f72c6228976:/src/doc.c diff --git a/src/doc.c b/src/doc.c index 952268ccdb..9cab00f199 100644 --- a/src/doc.c +++ b/src/doc.c @@ -1,5 +1,5 @@ /* Record indices of function doc strings stored in a file. - Copyright (C) 1985, 1986 Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1993 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -31,9 +31,9 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #define O_RDONLY 0 #endif -#undef NULL #include "lisp.h" #include "buffer.h" +#include "keyboard.h" Lisp_Object Vdoc_file_name; @@ -48,13 +48,13 @@ get_doc_string (filepos) register int count; extern char *index (); - if (XTYPE (Vexec_directory) != Lisp_String + if (XTYPE (Vdata_directory) != Lisp_String || XTYPE (Vdoc_file_name) != Lisp_String) return Qnil; - name = (char *) alloca (XSTRING (Vexec_directory)->size + name = (char *) alloca (XSTRING (Vdata_directory)->size + XSTRING (Vdoc_file_name)->size + 8); - strcpy (name, XSTRING (Vexec_directory)->data); + strcpy (name, XSTRING (Vdata_directory)->data); strcat (name, XSTRING (Vdoc_file_name)->data); #ifdef VMS #ifndef VMS4_4 @@ -102,41 +102,40 @@ get_doc_string (filepos) return make_string (buf, p - buf); } -DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0, - "Return the documentation string of FUNCTION.") - (fun1) - Lisp_Object fun1; +DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, + "Return the documentation string of FUNCTION.\n\ +Unless a non-nil second argument is given, the\n\ +string is passed through `substitute-command-keys'.") + (function, raw) + Lisp_Object function, raw; { Lisp_Object fun; Lisp_Object funcar; - Lisp_Object tem; + Lisp_Object tem, doc; - fun = fun1; - while (XTYPE (fun) == Lisp_Symbol) - { - QUIT; - fun = Fsymbol_function (fun); - } + fun = Findirect_function (function); switch (XTYPE (fun)) { case Lisp_Subr: if (XSUBR (fun)->doc == 0) return Qnil; if ((int) XSUBR (fun)->doc >= 0) - return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc)); + doc = build_string (XSUBR (fun)->doc); else - return - Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc)); + doc = get_doc_string (- (int) XSUBR (fun)->doc); + break; case Lisp_Compiled: if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) return Qnil; tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING]; if (XTYPE (tem) == Lisp_String) - return Fsubstitute_command_keys (tem); - if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) - return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem))); - return Qnil; + doc = tem; + else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) + doc = get_doc_string (XFASTINT (tem)); + else + return Qnil; + break; case Lisp_String: case Lisp_Vector: @@ -146,54 +145,115 @@ DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0, funcar = Fcar (fun); if (XTYPE (funcar) != Lisp_Symbol) return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); - if (XSYMBOL (funcar) == XSYMBOL (Qkeymap)) + else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\ subcommands.)"); - if (XSYMBOL (funcar) == XSYMBOL (Qlambda) - || XSYMBOL (funcar) == XSYMBOL (Qautoload)) + else if (EQ (funcar, Qlambda) + || EQ (funcar, Qautoload)) { tem = Fcar (Fcdr (Fcdr (fun))); if (XTYPE (tem) == Lisp_String) - return Fsubstitute_command_keys (tem); - if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) - return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem))); - return Qnil; + doc = tem; + else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) + doc = get_doc_string (XFASTINT (tem)); + else + return Qnil; + + break; } - if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp)) + else if (EQ (funcar, Qmocklisp)) return Qnil; - if (XSYMBOL (funcar) == XSYMBOL (Qmacro)) - return Fdocumentation (Fcdr (fun)); + else if (EQ (funcar, Qmacro)) + return Fdocumentation (Fcdr (fun), raw); /* Fall through to the default to report an error. */ default: return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); } + + if (NILP (raw)) + { + struct gcpro gcpro1; + + GCPRO1 (doc); + doc = Fsubstitute_command_keys (doc); + UNGCPRO; + } + return doc; } -DEFUN ("documentation-property", Fdocumentation_property, - Sdocumentation_property, 2, 2, 0, +DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 2, 0, "Return the documentation string that is SYMBOL's PROP property.\n\ -This differs from using `get' only in that it can refer to strings\n\ -stored in the `etc/DOC' file.") - (sym, prop) - Lisp_Object sym, prop; +This is like `get', but it can refer to strings stored in the\n\ +`etc/DOC' file; and if the value is a string, it is passed through\n\ +`substitute-command-keys'. A non-nil third argument avoids this\n\ +translation.") + (sym, prop, raw) + Lisp_Object sym, prop, raw; { register Lisp_Object tem; tem = Fget (sym, prop); if (XTYPE (tem) == Lisp_Int) tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem)); - return Fsubstitute_command_keys (tem); + if (NILP (raw) && XTYPE (tem) == Lisp_String) + return Fsubstitute_command_keys (tem); + return tem; } +/* Scanning the DOC files and placing docstring offsets into functions. */ + +static void +store_function_docstring (fun, offset) + Lisp_Object fun; + int offset; +{ + fun = indirect_function (fun); + + /* The type determines where the docstring is stored. */ + + /* Lisp_Subrs have a slot for it. */ + if (XTYPE (fun) == Lisp_Subr) + XSUBR (fun)->doc = (char *) - offset; + + /* If it's a lisp form, stick it in the form. */ + else if (CONSP (fun)) + { + Lisp_Object tem; + + tem = XCONS (fun)->car; + if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) + { + tem = Fcdr (Fcdr (fun)); + if (CONSP (tem) && + XTYPE (XCONS (tem)->car) == Lisp_Int) + XFASTINT (XCONS (tem)->car) = offset; + } + else if (EQ (tem, Qmacro)) + store_function_docstring (XCONS (fun)->cdr, offset); + } + + /* Bytecode objects sometimes have slots for it. */ + else if (XTYPE (fun) == Lisp_Compiled) + { + /* This bytecode object must have a slot for the + docstring, since we've found a docstring for it. */ + if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) + abort (); + + XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING]) = offset; + } +} + + DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, 1, 1, 0, "Used during Emacs initialization, before dumping runnable Emacs,\n\ to find pointers to doc strings stored in `etc/DOC...' and\n\ record them in function definitions.\n\ One arg, FILENAME, a string which does not include a directory.\n\ -The file is found in `../etc' now; found in the `exec-directory'\n\ +The file is found in `../etc' now; found in the `data-directory'\n\ when doc strings are referred to later in the dumped Emacs.") (filename) Lisp_Object filename; @@ -207,16 +267,21 @@ when doc strings are referred to later in the dumped Emacs.") char *name; extern char *index (); +#ifndef CANNOT_DUMP + if (NILP (Vpurify_flag)) + error ("Snarf-documentation can only be called in an undumped Emacs"); +#endif + CHECK_STRING (filename, 0); #ifndef CANNOT_DUMP - name = (char *) alloca (XSTRING (filename)->size + 8); + name = (char *) alloca (XSTRING (filename)->size + 14); strcpy (name, "../etc/"); #else /* CANNOT_DUMP */ - CHECK_STRING (Vexec_directory, 0); + CHECK_STRING (Vdata_directory, 0); name = (char *) alloca (XSTRING (filename)->size + - XSTRING (Vexec_directory)->size + 1); - strcpy (name, XSTRING (Vexec_directory)->data); + XSTRING (Vdata_directory)->size + 1); + strcpy (name, XSTRING (Vdata_directory)->data); #endif /* CANNOT_DUMP */ strcat (name, XSTRING (filename)->data); /*** Add this line ***/ #ifdef VMS @@ -272,42 +337,12 @@ when doc strings are referred to later in the dumped Emacs.") * (end[1] == '*' ? -1 : 1))); } - /* Attach a docstring to a function? The type determines where - the docstring is stored. */ + /* Attach a docstring to a function? */ else if (p[1] == 'F') - { - fun = XSYMBOL (sym)->function; - - /* Lisp_Subrs have a slot for it. */ - if (XTYPE (fun) == Lisp_Subr) - XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf); - - /* If it's a lisp form, stick it in the form. */ - else if (CONSP (fun)) - { - tem = XCONS (fun)->car; - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) - { - tem = Fcdr (Fcdr (fun)); - if (CONSP (tem) && - XTYPE (XCONS (tem)->car) == Lisp_Int) - XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf); - } - } - - /* Bytecode objects sometimes have slots for it. */ - else if (XTYPE (fun) == Lisp_Compiled) - { - /* This bytecode object must have a slot for the - docstring, since we've found a docstring for it. */ - if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) - abort (); - - XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING]) - = pos + end + 1 - buf; - } - } - else error ("DOC file invalid at position %d", pos); + store_function_docstring (sym, pos + end + 1 - buf); + + else + error ("DOC file invalid at position %d", pos); } } pos += end - buf; @@ -340,17 +375,21 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int int idx; int bsize; unsigned char *new; - register Lisp_Object tem; + Lisp_Object tem; Lisp_Object keymap; unsigned char *start; int length; - struct gcpro gcpro1; + Lisp_Object name; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - if (NULL (str)) + if (NILP (str)) return Qnil; CHECK_STRING (str, 0); - GCPRO1 (str); + tem = Qnil; + keymap = Qnil; + name = Qnil; + GCPRO4 (str, tem, keymap, name); keymap = current_buffer->keymap; @@ -386,7 +425,7 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int tem = Fintern (make_string (start, length), Qnil); tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, Qnil); - if (NULL (tem)) /* but not on any keys */ + if (NILP (tem)) /* but not on any keys */ { new = (unsigned char *) xrealloc (buf, bsize += 4); bufp += new - buf; @@ -406,7 +445,6 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) { struct buffer *oldbuf; - Lisp_Object name; changed = 1; strp += 2; /* skip \{ or \< */ @@ -427,18 +465,18 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int in case it is a local variable. */ name = Fintern (make_string (start, length), Qnil); tem = Fboundp (name); - if (! NULL (tem)) + if (! NILP (tem)) { tem = Fsymbol_value (name); - if (! NULL (tem)) - tem = get_keymap_1 (tem, 0); + if (! NILP (tem)) + tem = get_keymap_1 (tem, 0, 1); } /* Now switch to a temp buffer. */ oldbuf = current_buffer; set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); - if (NULL (tem)) + if (NILP (tem)) { name = Fsymbol_name (name); insert_string ("\nUses keymap \""); @@ -474,9 +512,8 @@ thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ int tem = make_string (buf, bufp - buf); else tem = str; - UNGCPRO; - free (buf); - return tem; + xfree (buf); + RETURN_UNGCPRO (tem); } syms_of_doc ()