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*/
52 Lisp_Object Vdoc_file_name
, Vhelp_manyarg_func_alist
;
54 Lisp_Object Qfunction_documentation
;
56 extern Lisp_Object Voverriding_local_map
;
58 /* For VMS versions with limited file name syntax,
59 convert the name to something VMS will allow. */
61 munge_doc_file_name (name
)
66 /* For VMS versions with limited file name syntax,
67 convert the name to something VMS will allow. */
75 #endif /* not VMS4_4 */
77 strcpy (name
, sys_translate_unix (name
));
82 /* Buffer used for reading from documentation file. */
83 static char *get_doc_string_buffer
;
84 static int get_doc_string_buffer_size
;
86 static unsigned char *read_bytecode_pointer
;
88 /* readchar in lread.c calls back here to fetch the next byte.
89 If UNREADFLAG is 1, we unread a byte. */
92 read_bytecode_char (unreadflag
)
97 read_bytecode_pointer
--;
100 return *read_bytecode_pointer
++;
103 /* Extract a doc string from a file. FILEPOS says where to get it.
104 If it is an integer, use that position in the standard DOC-... file.
105 If it is (FILE . INTEGER), use FILE as the file name
106 and INTEGER as the position in that file.
107 But if INTEGER is negative, make it positive.
108 (A negative integer is used for user variables, so we can distinguish
109 them without actually fetching the doc string.)
111 If UNIBYTE is nonzero, always make a unibyte string.
113 If DEFINITION is nonzero, assume this is for reading
114 a dynamic function definition; convert the bytestring
115 and the constants vector with appropriate byte handling,
116 and return a cons cell. */
119 get_doc_string (filepos
, unibyte
, definition
)
121 int unibyte
, definition
;
126 register char *p
, *p1
;
128 int offset
, position
;
129 Lisp_Object file
, tem
;
131 if (INTEGERP (filepos
))
133 file
= Vdoc_file_name
;
134 position
= XINT (filepos
);
136 else if (CONSP (filepos
))
138 file
= XCAR (filepos
);
139 position
= XINT (XCDR (filepos
));
141 position
= - position
;
146 if (!STRINGP (Vdoc_directory
))
152 /* Put the file name in NAME as a C string.
153 If it is relative, combine it with Vdoc_directory. */
155 tem
= Ffile_name_absolute_p (file
);
158 minsize
= XSTRING (Vdoc_directory
)->size
;
159 /* sizeof ("../etc/") == 8 */
162 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
163 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
164 strcat (name
, XSTRING (file
)->data
);
165 munge_doc_file_name (name
);
169 name
= (char *) XSTRING (file
)->data
;
172 fd
= emacs_open (name
, O_RDONLY
, 0);
176 if (!NILP (Vpurify_flag
))
178 /* Preparing to dump; DOC file is probably not installed.
179 So check in ../etc. */
180 strcpy (name
, "../etc/");
181 strcat (name
, XSTRING (file
)->data
);
182 munge_doc_file_name (name
);
184 fd
= emacs_open (name
, O_RDONLY
, 0);
188 error ("Cannot open doc string file \"%s\"", name
);
191 /* Seek only to beginning of disk block. */
192 offset
= position
% (8 * 1024);
193 if (0 > lseek (fd
, position
- offset
, 0))
196 error ("Position %ld out of range in doc string file \"%s\"",
200 /* Read the doc string into get_doc_string_buffer.
201 P points beyond the data just read. */
203 p
= get_doc_string_buffer
;
206 int space_left
= (get_doc_string_buffer_size
207 - (p
- get_doc_string_buffer
));
210 /* Allocate or grow the buffer if we need to. */
213 int in_buffer
= p
- get_doc_string_buffer
;
214 get_doc_string_buffer_size
+= 16 * 1024;
215 get_doc_string_buffer
216 = (char *) xrealloc (get_doc_string_buffer
,
217 get_doc_string_buffer_size
+ 1);
218 p
= get_doc_string_buffer
+ in_buffer
;
219 space_left
= (get_doc_string_buffer_size
220 - (p
- get_doc_string_buffer
));
223 /* Read a disk block at a time.
224 If we read the same block last time, maybe skip this? */
225 if (space_left
> 1024 * 8)
226 space_left
= 1024 * 8;
227 nread
= emacs_read (fd
, p
, space_left
);
231 error ("Read error on documentation file");
236 if (p
== get_doc_string_buffer
)
237 p1
= (char *) index (p
+ offset
, '\037');
239 p1
= (char *) index (p
, '\037');
250 /* Scan the text and perform quoting with ^A (char code 1).
251 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
252 from
= get_doc_string_buffer
+ offset
;
253 to
= get_doc_string_buffer
+ offset
;
269 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
275 /* If DEFINITION, read from this buffer
276 the same way we would read bytes from a file. */
279 read_bytecode_pointer
= get_doc_string_buffer
+ offset
;
280 return Fread (Qlambda
);
284 return make_unibyte_string (get_doc_string_buffer
+ offset
,
285 to
- (get_doc_string_buffer
+ offset
));
288 /* Let the data determine whether the string is multibyte,
289 even if Emacs is running in --unibyte mode. */
290 int nchars
= multibyte_chars_in_text (get_doc_string_buffer
+ offset
,
291 to
- (get_doc_string_buffer
+ offset
));
292 return make_string_from_bytes (get_doc_string_buffer
+ offset
,
294 to
- (get_doc_string_buffer
+ offset
));
298 /* Get a string from position FILEPOS and pass it through the Lisp reader.
299 We use this for fetching the bytecode string and constants vector
300 of a compiled function from the .elc file. */
303 read_doc_string (filepos
)
306 return get_doc_string (filepos
, 0, 1);
309 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
310 "Return the documentation string of FUNCTION.\n\
311 Unless a non-nil second argument RAW is given, the\n\
312 string is passed through `substitute-command-keys'.")
314 Lisp_Object function
, raw
;
318 Lisp_Object tem
, doc
;
320 if (SYMBOLP (function
)
321 && (tem
= Fget (function
, Qfunction_documentation
),
323 return Fdocumentation_property (function
, Qfunction_documentation
, raw
);
325 fun
= Findirect_function (function
);
328 if (XSUBR (fun
)->doc
== 0)
330 else if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
331 doc
= build_string (XSUBR (fun
)->doc
);
333 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
),
335 if (! NILP (tem
= Fassq (function
, Vhelp_manyarg_func_alist
)))
336 doc
= concat3 (doc
, build_string ("\n"), Fcdr (tem
));
338 else if (COMPILEDP (fun
))
340 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
342 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
345 else if (NATNUMP (tem
) || CONSP (tem
))
346 doc
= get_doc_string (tem
, 0, 0);
350 else if (STRINGP (fun
) || VECTORP (fun
))
352 return build_string ("Keyboard macro.");
354 else if (CONSP (fun
))
357 if (!SYMBOLP (funcar
))
358 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
359 else if (EQ (funcar
, Qkeymap
))
360 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
361 else if (EQ (funcar
, Qlambda
)
362 || EQ (funcar
, Qautoload
))
365 tem1
= Fcdr (Fcdr (fun
));
369 /* Handle a doc reference--but these never come last
370 in the function body, so reject them if they are last. */
371 else if ((NATNUMP (tem
) || CONSP (tem
))
372 && ! NILP (XCDR (tem1
)))
373 doc
= get_doc_string (tem
, 0, 0);
377 else if (EQ (funcar
, Qmocklisp
))
379 else if (EQ (funcar
, Qmacro
))
380 return Fdocumentation (Fcdr (fun
), raw
);
387 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
391 doc
= Fsubstitute_command_keys (doc
);
395 DEFUN ("documentation-property", Fdocumentation_property
,
396 Sdocumentation_property
, 2, 3, 0,
397 "Return the documentation string that is SYMBOL's PROP property.\n\
398 Third argument RAW omitted or nil means pass the result through\n\
399 `substitute-command-keys' if it is a string.\n\
401 This is differs from `get' in that it can refer to strings stored in the\n\
402 `etc/DOC' file; and that it evaluates documentation properties that\n\
405 Lisp_Object symbol
, prop
, raw
;
409 tem
= Fget (symbol
, prop
);
411 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
412 else if (CONSP (tem
) && INTEGERP (XCDR (tem
)))
413 tem
= get_doc_string (tem
, 0, 0);
414 else if (!STRINGP (tem
))
415 /* Feval protects its argument. */
418 if (NILP (raw
) && STRINGP (tem
))
419 tem
= Fsubstitute_command_keys (tem
);
423 /* Scanning the DOC files and placing docstring offsets into functions. */
426 store_function_docstring (fun
, offset
)
428 /* Use EMACS_INT because we get this from pointer subtraction. */
431 fun
= indirect_function (fun
);
433 /* The type determines where the docstring is stored. */
435 /* Lisp_Subrs have a slot for it. */
437 XSUBR (fun
)->doc
= (char *) - offset
;
439 /* If it's a lisp form, stick it in the form. */
440 else if (CONSP (fun
))
445 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
447 tem
= Fcdr (Fcdr (fun
));
448 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
449 XSETFASTINT (XCAR (tem
), offset
);
451 else if (EQ (tem
, Qmacro
))
452 store_function_docstring (XCDR (fun
), offset
);
455 /* Bytecode objects sometimes have slots for it. */
456 else if (COMPILEDP (fun
))
458 /* This bytecode object must have a slot for the
459 docstring, since we've found a docstring for it. */
460 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
461 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
466 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
468 "Used during Emacs initialization, before dumping runnable Emacs,\n\
469 to find pointers to doc strings stored in `etc/DOC...' and\n\
470 record them in function definitions.\n\
471 One arg, FILENAME, a string which does not include a directory.\n\
472 The file is found in `../etc' now; found in the `data-directory'\n\
473 when doc strings are referred to later in the dumped Emacs.")
475 Lisp_Object filename
;
481 register char *p
, *end
;
482 Lisp_Object sym
, fun
, tem
;
486 if (NILP (Vpurify_flag
))
487 error ("Snarf-documentation can only be called in an undumped Emacs");
490 CHECK_STRING (filename
, 0);
493 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
494 strcpy (name
, "../etc/");
495 #else /* CANNOT_DUMP */
496 CHECK_STRING (Vdoc_directory
, 0);
497 name
= (char *) alloca (XSTRING (filename
)->size
+
498 XSTRING (Vdoc_directory
)->size
+ 1);
499 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
500 #endif /* CANNOT_DUMP */
501 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
504 /* For VMS versions with limited file name syntax,
505 convert the name to something VMS will allow. */
513 #endif /* not VMS4_4 */
515 strcpy (name
, sys_translate_unix (name
));
519 fd
= emacs_open (name
, O_RDONLY
, 0);
521 report_file_error ("Opening doc string file",
522 Fcons (build_string (name
), Qnil
));
523 Vdoc_file_name
= filename
;
529 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
535 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
536 while (p
!= end
&& *p
!= '\037') p
++;
537 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
540 end
= (char *) index (p
, '\n');
541 sym
= oblookup (Vobarray
, p
+ 2,
542 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
546 /* Attach a docstring to a variable? */
549 /* Install file-position as variable-documentation property
550 and make it negative for a user-variable
551 (doc starts with a `*'). */
552 Fput (sym
, Qvariable_documentation
,
553 make_number ((pos
+ end
+ 1 - buf
)
554 * (end
[1] == '*' ? -1 : 1)));
557 /* Attach a docstring to a function? */
558 else if (p
[1] == 'F')
559 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
562 error ("DOC file invalid at position %d", pos
);
567 bcopy (end
, buf
, filled
);
573 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
574 Ssubstitute_command_keys
, 1, 1, 0,
575 "Substitute key descriptions for command names in STRING.\n\
576 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
577 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
578 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
579 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
580 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
581 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
582 as the keymap for future \\=\\[COMMAND] substrings.\n\
583 \\=\\= quotes the following character and is discarded;\n\
584 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
590 register unsigned char *strp
;
591 register unsigned char *bufp
;
597 unsigned char *start
;
598 int length
, length_byte
;
600 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
607 CHECK_STRING (string
, 0);
611 GCPRO4 (string
, tem
, keymap
, name
);
613 multibyte
= STRING_MULTIBYTE (string
);
616 /* KEYMAP is either nil (which means search all the active keymaps)
617 or a specified local map (which means search just that and the
618 global map). If non-nil, it might come from Voverriding_local_map,
619 or from a \\<mapname> construct in STRING itself.. */
620 keymap
= current_kboard
->Voverriding_terminal_local_map
;
622 keymap
= Voverriding_local_map
;
624 bsize
= STRING_BYTES (XSTRING (string
));
625 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
627 strp
= (unsigned char *) XSTRING (string
)->data
;
628 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
630 if (strp
[0] == '\\' && strp
[1] == '=')
632 /* \= quotes the next character;
633 thus, to put in \[ without its special meaning, use \=\[. */
639 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
641 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
645 bcopy (strp
, bufp
, len
);
651 *bufp
++ = *strp
++, nchars
++;
653 else if (strp
[0] == '\\' && strp
[1] == '[')
655 Lisp_Object firstkey
;
659 strp
+= 2; /* skip \[ */
661 start_idx
= start
- XSTRING (string
)->data
;
663 while ((strp
- (unsigned char *) XSTRING (string
)->data
664 < STRING_BYTES (XSTRING (string
)))
667 length_byte
= strp
- start
;
671 /* Save STRP in IDX. */
672 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
673 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
675 /* Note the Fwhere_is_internal can GC, so we have to take
676 relocation of string contents into account. */
677 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
678 strp
= XSTRING (string
)->data
+ idx
;
679 start
= XSTRING (string
)->data
+ start_idx
;
681 /* Disregard menu bar bindings; it is positively annoying to
682 mention them when there's no menu bar, and it isn't terribly
683 useful even when there is a menu bar. */
686 firstkey
= Faref (tem
, make_number (0));
687 if (EQ (firstkey
, Qmenu_bar
))
691 if (NILP (tem
)) /* but not on any keys */
693 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
696 bcopy ("M-x ", bufp
, 4);
700 length
= multibyte_chars_in_text (start
, length_byte
);
702 length
= length_byte
;
706 { /* function is on a key */
707 tem
= Fkey_description (tem
);
711 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
712 \<foo> just sets the keymap used for \[cmd]. */
713 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
715 struct buffer
*oldbuf
;
719 strp
+= 2; /* skip \{ or \< */
721 start_idx
= start
- XSTRING (string
)->data
;
723 while ((strp
- (unsigned char *) XSTRING (string
)->data
724 < XSTRING (string
)->size
)
725 && *strp
!= '}' && *strp
!= '>')
728 length_byte
= strp
- start
;
729 strp
++; /* skip } or > */
731 /* Save STRP in IDX. */
732 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
734 /* Get the value of the keymap in TEM, or nil if undefined.
735 Do this while still in the user's current buffer
736 in case it is a local variable. */
737 name
= Fintern (make_string (start
, length_byte
), Qnil
);
738 tem
= Fboundp (name
);
741 tem
= Fsymbol_value (name
);
744 tem
= get_keymap_1 (tem
, 0, 1);
745 /* Note that get_keymap_1 can GC. */
746 strp
= XSTRING (string
)->data
+ idx
;
747 start
= XSTRING (string
)->data
+ start_idx
;
751 /* Now switch to a temp buffer. */
752 oldbuf
= current_buffer
;
753 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
757 name
= Fsymbol_name (name
);
758 insert_string ("\nUses keymap \"");
759 insert_from_string (name
, 0, 0,
760 XSTRING (name
)->size
,
761 STRING_BYTES (XSTRING (name
)), 1);
762 insert_string ("\", which is not currently defined.\n");
763 if (start
[-1] == '<') keymap
= Qnil
;
765 else if (start
[-1] == '<')
768 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
769 tem
= Fbuffer_string ();
771 set_buffer_internal (oldbuf
);
774 start
= XSTRING (tem
)->data
;
775 length
= XSTRING (tem
)->size
;
776 length_byte
= STRING_BYTES (XSTRING (tem
));
778 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
781 bcopy (start
, bufp
, length_byte
);
784 /* Check STRING again in case gc relocated it. */
785 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
);