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
;
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
),
335 else if (COMPILEDP (fun
))
337 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
339 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
342 else if (NATNUMP (tem
) || CONSP (tem
))
343 doc
= get_doc_string (tem
, 0, 0);
347 else if (STRINGP (fun
) || VECTORP (fun
))
349 return build_string ("Keyboard macro.");
351 else if (CONSP (fun
))
354 if (!SYMBOLP (funcar
))
355 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
356 else if (EQ (funcar
, Qkeymap
))
357 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
358 else if (EQ (funcar
, Qlambda
)
359 || EQ (funcar
, Qautoload
))
362 tem1
= Fcdr (Fcdr (fun
));
366 /* Handle a doc reference--but these never come last
367 in the function body, so reject them if they are last. */
368 else if ((NATNUMP (tem
) || CONSP (tem
))
369 && ! NILP (XCDR (tem1
)))
370 doc
= get_doc_string (tem
, 0, 0);
374 else if (EQ (funcar
, Qmocklisp
))
376 else if (EQ (funcar
, Qmacro
))
377 return Fdocumentation (Fcdr (fun
), raw
);
384 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
388 doc
= Fsubstitute_command_keys (doc
);
392 DEFUN ("documentation-property", Fdocumentation_property
,
393 Sdocumentation_property
, 2, 3, 0,
394 "Return the documentation string that is SYMBOL's PROP property.\n\
395 Third argument RAW omitted or nil means pass the result through\n\
396 `substitute-command-keys' if it is a string.\n\
398 This differs from `get' in that it can refer to strings stored in the\n\
399 `etc/DOC' file; and that it evaluates documentation properties that\n\
402 Lisp_Object symbol
, prop
, raw
;
406 tem
= Fget (symbol
, prop
);
408 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
409 else if (CONSP (tem
) && INTEGERP (XCDR (tem
)))
410 tem
= get_doc_string (tem
, 0, 0);
411 else if (!STRINGP (tem
))
412 /* Feval protects its argument. */
415 if (NILP (raw
) && STRINGP (tem
))
416 tem
= Fsubstitute_command_keys (tem
);
420 /* Scanning the DOC files and placing docstring offsets into functions. */
423 store_function_docstring (fun
, offset
)
425 /* Use EMACS_INT because we get this from pointer subtraction. */
428 fun
= indirect_function (fun
);
430 /* The type determines where the docstring is stored. */
432 /* Lisp_Subrs have a slot for it. */
434 XSUBR (fun
)->doc
= (char *) - offset
;
436 /* If it's a lisp form, stick it in the form. */
437 else if (CONSP (fun
))
442 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
444 tem
= Fcdr (Fcdr (fun
));
445 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
446 XSETCARFASTINT (tem
, offset
);
448 else if (EQ (tem
, Qmacro
))
449 store_function_docstring (XCDR (fun
), offset
);
452 /* Bytecode objects sometimes have slots for it. */
453 else if (COMPILEDP (fun
))
455 /* This bytecode object must have a slot for the
456 docstring, since we've found a docstring for it. */
457 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
458 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
463 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
465 "Used during Emacs initialization, before dumping runnable Emacs,\n\
466 to find pointers to doc strings stored in `etc/DOC...' and\n\
467 record them in function definitions.\n\
468 One arg, FILENAME, a string which does not include a directory.\n\
469 The file is found in `../etc' now; found in the `data-directory'\n\
470 when doc strings are referred to later in the dumped Emacs.")
472 Lisp_Object filename
;
478 register char *p
, *end
;
483 if (NILP (Vpurify_flag
))
484 error ("Snarf-documentation can only be called in an undumped Emacs");
487 CHECK_STRING (filename
);
490 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
491 strcpy (name
, "../etc/");
492 #else /* CANNOT_DUMP */
493 CHECK_STRING (Vdoc_directory
);
494 name
= (char *) alloca (XSTRING (filename
)->size
495 + XSTRING (Vdoc_directory
)->size
+ 1);
496 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
497 #endif /* CANNOT_DUMP */
498 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
501 /* For VMS versions with limited file name syntax,
502 convert the name to something VMS will allow. */
510 #endif /* not VMS4_4 */
512 strcpy (name
, sys_translate_unix (name
));
516 fd
= emacs_open (name
, O_RDONLY
, 0);
518 report_file_error ("Opening doc string file",
519 Fcons (build_string (name
), Qnil
));
520 Vdoc_file_name
= filename
;
526 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
532 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
533 while (p
!= end
&& *p
!= '\037') p
++;
534 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
537 end
= (char *) index (p
, '\n');
538 sym
= oblookup (Vobarray
, p
+ 2,
539 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
543 /* Attach a docstring to a variable? */
546 /* Install file-position as variable-documentation property
547 and make it negative for a user-variable
548 (doc starts with a `*'). */
549 Fput (sym
, Qvariable_documentation
,
550 make_number ((pos
+ end
+ 1 - buf
)
551 * (end
[1] == '*' ? -1 : 1)));
554 /* Attach a docstring to a function? */
555 else if (p
[1] == 'F')
556 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
559 error ("DOC file invalid at position %d", pos
);
564 bcopy (end
, buf
, filled
);
570 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
571 Ssubstitute_command_keys
, 1, 1, 0,
572 "Substitute key descriptions for command names in STRING.\n\
573 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
574 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
575 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
576 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
577 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
578 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
579 as the keymap for future \\=\\[COMMAND] substrings.\n\
580 \\=\\= quotes the following character and is discarded;\n\
581 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
587 register unsigned char *strp
;
588 register unsigned char *bufp
;
593 unsigned char *start
;
594 int length
, length_byte
;
596 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
603 CHECK_STRING (string
);
607 GCPRO4 (string
, tem
, keymap
, name
);
609 multibyte
= STRING_MULTIBYTE (string
);
612 /* KEYMAP is either nil (which means search all the active keymaps)
613 or a specified local map (which means search just that and the
614 global map). If non-nil, it might come from Voverriding_local_map,
615 or from a \\<mapname> construct in STRING itself.. */
616 keymap
= current_kboard
->Voverriding_terminal_local_map
;
618 keymap
= Voverriding_local_map
;
620 bsize
= STRING_BYTES (XSTRING (string
));
621 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
623 strp
= (unsigned char *) XSTRING (string
)->data
;
624 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
626 if (strp
[0] == '\\' && strp
[1] == '=')
628 /* \= quotes the next character;
629 thus, to put in \[ without its special meaning, use \=\[. */
635 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
637 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
641 bcopy (strp
, bufp
, len
);
647 *bufp
++ = *strp
++, nchars
++;
649 else if (strp
[0] == '\\' && strp
[1] == '[')
651 Lisp_Object firstkey
;
655 strp
+= 2; /* skip \[ */
657 start_idx
= start
- XSTRING (string
)->data
;
659 while ((strp
- (unsigned char *) XSTRING (string
)->data
660 < STRING_BYTES (XSTRING (string
)))
663 length_byte
= strp
- start
;
667 /* Save STRP in IDX. */
668 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
669 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
671 /* Note the Fwhere_is_internal can GC, so we have to take
672 relocation of string contents into account. */
673 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
674 strp
= XSTRING (string
)->data
+ idx
;
675 start
= XSTRING (string
)->data
+ start_idx
;
677 /* Disregard menu bar bindings; it is positively annoying to
678 mention them when there's no menu bar, and it isn't terribly
679 useful even when there is a menu bar. */
682 firstkey
= Faref (tem
, make_number (0));
683 if (EQ (firstkey
, Qmenu_bar
))
687 if (NILP (tem
)) /* but not on any keys */
689 int offset
= bufp
- buf
;
690 buf
= (unsigned char *) xrealloc (buf
, bsize
+= 4);
692 bcopy ("M-x ", bufp
, 4);
696 length
= multibyte_chars_in_text (start
, length_byte
);
698 length
= length_byte
;
702 { /* function is on a key */
703 tem
= Fkey_description (tem
);
707 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
708 \<foo> just sets the keymap used for \[cmd]. */
709 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
711 struct buffer
*oldbuf
;
715 strp
+= 2; /* skip \{ or \< */
717 start_idx
= start
- XSTRING (string
)->data
;
719 while ((strp
- (unsigned char *) XSTRING (string
)->data
720 < XSTRING (string
)->size
)
721 && *strp
!= '}' && *strp
!= '>')
724 length_byte
= strp
- start
;
725 strp
++; /* skip } or > */
727 /* Save STRP in IDX. */
728 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
730 /* Get the value of the keymap in TEM, or nil if undefined.
731 Do this while still in the user's current buffer
732 in case it is a local variable. */
733 name
= Fintern (make_string (start
, length_byte
), Qnil
);
734 tem
= Fboundp (name
);
737 tem
= Fsymbol_value (name
);
740 tem
= get_keymap (tem
, 0, 1);
741 /* Note that get_keymap can GC. */
742 strp
= XSTRING (string
)->data
+ idx
;
743 start
= XSTRING (string
)->data
+ start_idx
;
747 /* Now switch to a temp buffer. */
748 oldbuf
= current_buffer
;
749 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
753 name
= Fsymbol_name (name
);
754 insert_string ("\nUses keymap \"");
755 insert_from_string (name
, 0, 0,
756 XSTRING (name
)->size
,
757 STRING_BYTES (XSTRING (name
)), 1);
758 insert_string ("\", which is not currently defined.\n");
759 if (start
[-1] == '<') keymap
= Qnil
;
761 else if (start
[-1] == '<')
764 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
765 tem
= Fbuffer_string ();
767 set_buffer_internal (oldbuf
);
770 start
= XSTRING (tem
)->data
;
771 length
= XSTRING (tem
)->size
;
772 length_byte
= STRING_BYTES (XSTRING (tem
));
775 int offset
= bufp
- buf
;
776 buf
= (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
778 bcopy (start
, bufp
, length_byte
);
781 /* Check STRING again in case gc relocated it. */
782 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
785 else if (! multibyte
) /* just copy other chars */
786 *bufp
++ = *strp
++, nchars
++;
790 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
792 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
796 bcopy (strp
, bufp
, len
);
803 if (changed
) /* don't bother if nothing substituted */
804 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
808 RETURN_UNGCPRO (tem
);
814 Qfunction_documentation
= intern ("function-documentation");
815 staticpro (&Qfunction_documentation
);
817 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
818 "Name of file containing documentation strings of built-in symbols.");
819 Vdoc_file_name
= Qnil
;
821 defsubr (&Sdocumentation
);
822 defsubr (&Sdocumentation_property
);
823 defsubr (&Ssnarf_documentation
);
824 defsubr (&Ssubstitute_command_keys
);