1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
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 2, or (at your option)
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.
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, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
24 #include <sys/types.h>
25 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
46 extern char *index
P_ ((const char *, int));
49 Lisp_Object Vdoc_file_name
, Vhelp_manyarg_func_alist
;
51 Lisp_Object Qfunction_documentation
;
53 extern Lisp_Object Voverriding_local_map
;
55 /* For VMS versions with limited file name syntax,
56 convert the name to something VMS will allow. */
58 munge_doc_file_name (name
)
63 /* For VMS versions with limited file name syntax,
64 convert the name to something VMS will allow. */
72 #endif /* not VMS4_4 */
74 strcpy (name
, sys_translate_unix (name
));
79 /* Buffer used for reading from documentation file. */
80 static char *get_doc_string_buffer
;
81 static int get_doc_string_buffer_size
;
83 static unsigned char *read_bytecode_pointer
;
85 /* readchar in lread.c calls back here to fetch the next byte.
86 If UNREADFLAG is 1, we unread a byte. */
89 read_bytecode_char (unreadflag
)
94 read_bytecode_pointer
--;
97 return *read_bytecode_pointer
++;
100 /* Extract a doc string from a file. FILEPOS says where to get it.
101 If it is an integer, use that position in the standard DOC-... file.
102 If it is (FILE . INTEGER), use FILE as the file name
103 and INTEGER as the position in that file.
104 But if INTEGER is negative, make it positive.
105 (A negative integer is used for user variables, so we can distinguish
106 them without actually fetching the doc string.)
108 If UNIBYTE is nonzero, always make a unibyte string.
110 If DEFINITION is nonzero, assume this is for reading
111 a dynamic function definition; convert the bytestring
112 and the constants vector with appropriate byte handling,
113 and return a cons cell. */
116 get_doc_string (filepos
, unibyte
, definition
)
118 int unibyte
, definition
;
123 register char *p
, *p1
;
125 int offset
, position
;
126 Lisp_Object file
, tem
;
128 if (INTEGERP (filepos
))
130 file
= Vdoc_file_name
;
131 position
= XINT (filepos
);
133 else if (CONSP (filepos
))
135 file
= XCAR (filepos
);
136 position
= XINT (XCDR (filepos
));
138 position
= - position
;
143 if (!STRINGP (Vdoc_directory
))
149 /* Put the file name in NAME as a C string.
150 If it is relative, combine it with Vdoc_directory. */
152 tem
= Ffile_name_absolute_p (file
);
155 minsize
= XSTRING (Vdoc_directory
)->size
;
156 /* sizeof ("../etc/") == 8 */
159 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
160 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
161 strcat (name
, XSTRING (file
)->data
);
162 munge_doc_file_name (name
);
166 name
= (char *) XSTRING (file
)->data
;
169 fd
= emacs_open (name
, O_RDONLY
, 0);
173 if (!NILP (Vpurify_flag
))
175 /* Preparing to dump; DOC file is probably not installed.
176 So check in ../etc. */
177 strcpy (name
, "../etc/");
178 strcat (name
, XSTRING (file
)->data
);
179 munge_doc_file_name (name
);
181 fd
= emacs_open (name
, O_RDONLY
, 0);
185 error ("Cannot open doc string file \"%s\"", name
);
188 /* Seek only to beginning of disk block. */
189 offset
= position
% (8 * 1024);
190 if (0 > lseek (fd
, position
- offset
, 0))
193 error ("Position %ld out of range in doc string file \"%s\"",
197 /* Read the doc string into get_doc_string_buffer.
198 P points beyond the data just read. */
200 p
= get_doc_string_buffer
;
203 int space_left
= (get_doc_string_buffer_size
204 - (p
- get_doc_string_buffer
));
207 /* Allocate or grow the buffer if we need to. */
210 int in_buffer
= p
- get_doc_string_buffer
;
211 get_doc_string_buffer_size
+= 16 * 1024;
212 get_doc_string_buffer
213 = (char *) xrealloc (get_doc_string_buffer
,
214 get_doc_string_buffer_size
+ 1);
215 p
= get_doc_string_buffer
+ in_buffer
;
216 space_left
= (get_doc_string_buffer_size
217 - (p
- get_doc_string_buffer
));
220 /* Read a disk block at a time.
221 If we read the same block last time, maybe skip this? */
222 if (space_left
> 1024 * 8)
223 space_left
= 1024 * 8;
224 nread
= emacs_read (fd
, p
, space_left
);
228 error ("Read error on documentation file");
233 if (p
== get_doc_string_buffer
)
234 p1
= (char *) index (p
+ offset
, '\037');
236 p1
= (char *) index (p
, '\037');
247 /* Scan the text and perform quoting with ^A (char code 1).
248 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
249 from
= get_doc_string_buffer
+ offset
;
250 to
= get_doc_string_buffer
+ offset
;
266 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
272 /* If DEFINITION, read from this buffer
273 the same way we would read bytes from a file. */
276 read_bytecode_pointer
= get_doc_string_buffer
+ offset
;
277 return Fread (Qlambda
);
281 return make_unibyte_string (get_doc_string_buffer
+ offset
,
282 to
- (get_doc_string_buffer
+ offset
));
285 /* Let the data determine whether the string is multibyte,
286 even if Emacs is running in --unibyte mode. */
287 int nchars
= multibyte_chars_in_text (get_doc_string_buffer
+ offset
,
288 to
- (get_doc_string_buffer
+ offset
));
289 return make_string_from_bytes (get_doc_string_buffer
+ offset
,
291 to
- (get_doc_string_buffer
+ offset
));
295 /* Get a string from position FILEPOS and pass it through the Lisp reader.
296 We use this for fetching the bytecode string and constants vector
297 of a compiled function from the .elc file. */
300 read_doc_string (filepos
)
303 return get_doc_string (filepos
, 0, 1);
306 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
307 "Return the documentation string of FUNCTION.\n\
308 Unless a non-nil second argument RAW is given, the\n\
309 string is passed through `substitute-command-keys'.")
311 Lisp_Object function
, raw
;
315 Lisp_Object tem
, doc
;
319 if (SYMBOLP (function
)
320 && (tem
= Fget (function
, Qfunction_documentation
),
322 return Fdocumentation_property (function
, Qfunction_documentation
, raw
);
324 fun
= Findirect_function (function
);
327 if (XSUBR (fun
)->doc
== 0)
329 else if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
330 doc
= build_string (XSUBR (fun
)->doc
);
332 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
),
334 if (! NILP (tem
= Fassq (function
, Vhelp_manyarg_func_alist
)))
335 doc
= concat3 (doc
, build_string ("\n"), Fcdr (tem
));
337 else if (COMPILEDP (fun
))
339 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
341 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
344 else if (NATNUMP (tem
) || CONSP (tem
))
345 doc
= get_doc_string (tem
, 0, 0);
349 else if (STRINGP (fun
) || VECTORP (fun
))
351 return build_string ("Keyboard macro.");
353 else if (CONSP (fun
))
356 if (!SYMBOLP (funcar
))
357 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
358 else if (EQ (funcar
, Qkeymap
))
359 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
360 else if (EQ (funcar
, Qlambda
)
361 || EQ (funcar
, Qautoload
))
364 tem1
= Fcdr (Fcdr (fun
));
368 /* Handle a doc reference--but these never come last
369 in the function body, so reject them if they are last. */
370 else if ((NATNUMP (tem
) || CONSP (tem
))
371 && ! NILP (XCDR (tem1
)))
372 doc
= get_doc_string (tem
, 0, 0);
376 else if (EQ (funcar
, Qmocklisp
))
378 else if (EQ (funcar
, Qmacro
))
379 return Fdocumentation (Fcdr (fun
), raw
);
386 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
390 doc
= Fsubstitute_command_keys (doc
);
394 DEFUN ("documentation-property", Fdocumentation_property
,
395 Sdocumentation_property
, 2, 3, 0,
396 "Return the documentation string that is SYMBOL's PROP property.\n\
397 Third argument RAW omitted or nil means pass the result through\n\
398 `substitute-command-keys' if it is a string.\n\
400 This differs from `get' in that it can refer to strings stored in the\n\
401 `etc/DOC' file; and that it evaluates documentation properties that\n\
404 Lisp_Object symbol
, prop
, raw
;
408 tem
= Fget (symbol
, prop
);
410 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
411 else if (CONSP (tem
) && INTEGERP (XCDR (tem
)))
412 tem
= get_doc_string (tem
, 0, 0);
413 else if (!STRINGP (tem
))
414 /* Feval protects its argument. */
417 if (NILP (raw
) && STRINGP (tem
))
418 tem
= Fsubstitute_command_keys (tem
);
422 /* Scanning the DOC files and placing docstring offsets into functions. */
425 store_function_docstring (fun
, offset
)
427 /* Use EMACS_INT because we get this from pointer subtraction. */
430 fun
= indirect_function (fun
);
432 /* The type determines where the docstring is stored. */
434 /* Lisp_Subrs have a slot for it. */
436 XSUBR (fun
)->doc
= (char *) - offset
;
438 /* If it's a lisp form, stick it in the form. */
439 else if (CONSP (fun
))
444 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
446 tem
= Fcdr (Fcdr (fun
));
447 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
448 XSETCARFASTINT (tem
, offset
);
450 else if (EQ (tem
, Qmacro
))
451 store_function_docstring (XCDR (fun
), offset
);
454 /* Bytecode objects sometimes have slots for it. */
455 else if (COMPILEDP (fun
))
457 /* This bytecode object must have a slot for the
458 docstring, since we've found a docstring for it. */
459 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
460 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
465 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
467 "Used during Emacs initialization, before dumping runnable Emacs,\n\
468 to find pointers to doc strings stored in `etc/DOC...' and\n\
469 record them in function definitions.\n\
470 One arg, FILENAME, a string which does not include a directory.\n\
471 The file is found in `../etc' now; found in the `data-directory'\n\
472 when doc strings are referred to later in the dumped Emacs.")
474 Lisp_Object filename
;
480 register char *p
, *end
;
485 if (NILP (Vpurify_flag
))
486 error ("Snarf-documentation can only be called in an undumped Emacs");
489 CHECK_STRING (filename
, 0);
492 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
493 strcpy (name
, "../etc/");
494 #else /* CANNOT_DUMP */
495 CHECK_STRING (Vdoc_directory
, 0);
496 name
= (char *) alloca (XSTRING (filename
)->size
+
497 XSTRING (Vdoc_directory
)->size
+ 1);
498 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
499 #endif /* CANNOT_DUMP */
500 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
503 /* For VMS versions with limited file name syntax,
504 convert the name to something VMS will allow. */
512 #endif /* not VMS4_4 */
514 strcpy (name
, sys_translate_unix (name
));
518 fd
= emacs_open (name
, O_RDONLY
, 0);
520 report_file_error ("Opening doc string file",
521 Fcons (build_string (name
), Qnil
));
522 Vdoc_file_name
= filename
;
528 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
534 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
535 while (p
!= end
&& *p
!= '\037') p
++;
536 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
539 end
= (char *) index (p
, '\n');
540 sym
= oblookup (Vobarray
, p
+ 2,
541 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
545 /* Attach a docstring to a variable? */
548 /* Install file-position as variable-documentation property
549 and make it negative for a user-variable
550 (doc starts with a `*'). */
551 Fput (sym
, Qvariable_documentation
,
552 make_number ((pos
+ end
+ 1 - buf
)
553 * (end
[1] == '*' ? -1 : 1)));
556 /* Attach a docstring to a function? */
557 else if (p
[1] == 'F')
558 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
561 error ("DOC file invalid at position %d", pos
);
566 bcopy (end
, buf
, filled
);
572 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
573 Ssubstitute_command_keys
, 1, 1, 0,
574 "Substitute key descriptions for command names in STRING.\n\
575 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
576 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
577 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
578 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
579 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
580 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
581 as the keymap for future \\=\\[COMMAND] substrings.\n\
582 \\=\\= quotes the following character and is discarded;\n\
583 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
589 register unsigned char *strp
;
590 register unsigned char *bufp
;
595 unsigned char *start
;
596 int length
, length_byte
;
598 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
605 CHECK_STRING (string
, 0);
609 GCPRO4 (string
, tem
, keymap
, name
);
611 multibyte
= STRING_MULTIBYTE (string
);
614 /* KEYMAP is either nil (which means search all the active keymaps)
615 or a specified local map (which means search just that and the
616 global map). If non-nil, it might come from Voverriding_local_map,
617 or from a \\<mapname> construct in STRING itself.. */
618 keymap
= current_kboard
->Voverriding_terminal_local_map
;
620 keymap
= Voverriding_local_map
;
622 bsize
= STRING_BYTES (XSTRING (string
));
623 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
625 strp
= (unsigned char *) XSTRING (string
)->data
;
626 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
628 if (strp
[0] == '\\' && strp
[1] == '=')
630 /* \= quotes the next character;
631 thus, to put in \[ without its special meaning, use \=\[. */
637 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
639 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
643 bcopy (strp
, bufp
, len
);
649 *bufp
++ = *strp
++, nchars
++;
651 else if (strp
[0] == '\\' && strp
[1] == '[')
653 Lisp_Object firstkey
;
657 strp
+= 2; /* skip \[ */
659 start_idx
= start
- XSTRING (string
)->data
;
661 while ((strp
- (unsigned char *) XSTRING (string
)->data
662 < STRING_BYTES (XSTRING (string
)))
665 length_byte
= strp
- start
;
669 /* Save STRP in IDX. */
670 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
671 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
673 /* Note the Fwhere_is_internal can GC, so we have to take
674 relocation of string contents into account. */
675 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
676 strp
= XSTRING (string
)->data
+ idx
;
677 start
= XSTRING (string
)->data
+ start_idx
;
679 /* Disregard menu bar bindings; it is positively annoying to
680 mention them when there's no menu bar, and it isn't terribly
681 useful even when there is a menu bar. */
684 firstkey
= Faref (tem
, make_number (0));
685 if (EQ (firstkey
, Qmenu_bar
))
689 if (NILP (tem
)) /* but not on any keys */
691 int offset
= bufp
- buf
;
692 buf
= (unsigned char *) xrealloc (buf
, bsize
+= 4);
694 bcopy ("M-x ", bufp
, 4);
698 length
= multibyte_chars_in_text (start
, length_byte
);
700 length
= length_byte
;
704 { /* function is on a key */
705 tem
= Fkey_description (tem
);
709 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
710 \<foo> just sets the keymap used for \[cmd]. */
711 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
713 struct buffer
*oldbuf
;
717 strp
+= 2; /* skip \{ or \< */
719 start_idx
= start
- XSTRING (string
)->data
;
721 while ((strp
- (unsigned char *) XSTRING (string
)->data
722 < XSTRING (string
)->size
)
723 && *strp
!= '}' && *strp
!= '>')
726 length_byte
= strp
- start
;
727 strp
++; /* skip } or > */
729 /* Save STRP in IDX. */
730 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
732 /* Get the value of the keymap in TEM, or nil if undefined.
733 Do this while still in the user's current buffer
734 in case it is a local variable. */
735 name
= Fintern (make_string (start
, length_byte
), Qnil
);
736 tem
= Fboundp (name
);
739 tem
= Fsymbol_value (name
);
742 tem
= get_keymap (tem
, 0, 1);
743 /* Note that get_keymap can GC. */
744 strp
= XSTRING (string
)->data
+ idx
;
745 start
= XSTRING (string
)->data
+ start_idx
;
749 /* Now switch to a temp buffer. */
750 oldbuf
= current_buffer
;
751 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
755 name
= Fsymbol_name (name
);
756 insert_string ("\nUses keymap \"");
757 insert_from_string (name
, 0, 0,
758 XSTRING (name
)->size
,
759 STRING_BYTES (XSTRING (name
)), 1);
760 insert_string ("\", which is not currently defined.\n");
761 if (start
[-1] == '<') keymap
= Qnil
;
763 else if (start
[-1] == '<')
766 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
767 tem
= Fbuffer_string ();
769 set_buffer_internal (oldbuf
);
772 start
= XSTRING (tem
)->data
;
773 length
= XSTRING (tem
)->size
;
774 length_byte
= STRING_BYTES (XSTRING (tem
));
777 int offset
= bufp
- buf
;
778 buf
= (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
780 bcopy (start
, bufp
, length_byte
);
783 /* Check STRING again in case gc relocated it. */
784 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
787 else if (! multibyte
) /* just copy other chars */
788 *bufp
++ = *strp
++, nchars
++;
792 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
794 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
798 bcopy (strp
, bufp
, len
);
805 if (changed
) /* don't bother if nothing substituted */
806 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
810 RETURN_UNGCPRO (tem
);
816 Qfunction_documentation
= intern ("function-documentation");
817 staticpro (&Qfunction_documentation
);
819 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
820 "Name of file containing documentation strings of built-in symbols.");
821 Vdoc_file_name
= Qnil
;
822 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist
,
823 "Alist of primitive functions and descriptions of their arg lists.\n\
824 All special forms and primitives which effectively have &rest args\n\
825 should have an entry here so that `documentation' can provide their\n\
827 Vhelp_manyarg_func_alist
= Qnil
;
829 defsubr (&Sdocumentation
);
830 defsubr (&Sdocumentation_property
);
831 defsubr (&Ssnarf_documentation
);
832 defsubr (&Ssubstitute_command_keys
);