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*/
44 Lisp_Object Vdoc_file_name
, Vhelp_manyarg_func_alist
;
46 extern char *index ();
48 extern Lisp_Object Voverriding_local_map
;
50 /* For VMS versions with limited file name syntax,
51 convert the name to something VMS will allow. */
53 munge_doc_file_name (name
)
58 /* For VMS versions with limited file name syntax,
59 convert the name to something VMS will allow. */
67 #endif /* not VMS4_4 */
69 strcpy (name
, sys_translate_unix (name
));
74 /* Buffer used for reading from documentation file. */
75 static char *get_doc_string_buffer
;
76 static int get_doc_string_buffer_size
;
78 static unsigned char *read_bytecode_pointer
;
80 /* readchar in lread.c calls back here to fetch the next byte.
81 If UNREADFLAG is 1, we unread a byte. */
84 read_bytecode_char (unreadflag
)
89 read_bytecode_pointer
--;
92 return *read_bytecode_pointer
++;
95 /* Extract a doc string from a file. FILEPOS says where to get it.
96 If it is an integer, use that position in the standard DOC-... file.
97 If it is (FILE . INTEGER), use FILE as the file name
98 and INTEGER as the position in that file.
99 But if INTEGER is negative, make it positive.
100 (A negative integer is used for user variables, so we can distinguish
101 them without actually fetching the doc string.)
103 If UNIBYTE is nonzero, always make a unibyte string.
105 If DEFINITION is nonzero, assume this is for reading
106 a dynamic function definition; convert the bytestring
107 and the constants vector with appropriate byte handling,
108 and return a cons cell. */
111 get_doc_string (filepos
, unibyte
, definition
)
113 int unibyte
, definition
;
118 register char *p
, *p1
;
120 int offset
, position
;
121 Lisp_Object file
, tem
;
123 if (INTEGERP (filepos
))
125 file
= Vdoc_file_name
;
126 position
= XINT (filepos
);
128 else if (CONSP (filepos
))
130 file
= XCAR (filepos
);
131 position
= XINT (XCDR (filepos
));
133 position
= - position
;
138 if (!STRINGP (Vdoc_directory
))
144 /* Put the file name in NAME as a C string.
145 If it is relative, combine it with Vdoc_directory. */
147 tem
= Ffile_name_absolute_p (file
);
150 minsize
= XSTRING (Vdoc_directory
)->size
;
151 /* sizeof ("../etc/") == 8 */
154 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
155 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
156 strcat (name
, XSTRING (file
)->data
);
157 munge_doc_file_name (name
);
161 name
= (char *) XSTRING (file
)->data
;
164 fd
= emacs_open (name
, O_RDONLY
, 0);
168 if (!NILP (Vpurify_flag
))
170 /* Preparing to dump; DOC file is probably not installed.
171 So check in ../etc. */
172 strcpy (name
, "../etc/");
173 strcat (name
, XSTRING (file
)->data
);
174 munge_doc_file_name (name
);
176 fd
= emacs_open (name
, O_RDONLY
, 0);
180 error ("Cannot open doc string file \"%s\"", name
);
183 /* Seek only to beginning of disk block. */
184 offset
= position
% (8 * 1024);
185 if (0 > lseek (fd
, position
- offset
, 0))
188 error ("Position %ld out of range in doc string file \"%s\"",
192 /* Read the doc string into get_doc_string_buffer.
193 P points beyond the data just read. */
195 p
= get_doc_string_buffer
;
198 int space_left
= (get_doc_string_buffer_size
199 - (p
- get_doc_string_buffer
));
202 /* Allocate or grow the buffer if we need to. */
205 int in_buffer
= p
- get_doc_string_buffer
;
206 get_doc_string_buffer_size
+= 16 * 1024;
207 get_doc_string_buffer
208 = (char *) xrealloc (get_doc_string_buffer
,
209 get_doc_string_buffer_size
+ 1);
210 p
= get_doc_string_buffer
+ in_buffer
;
211 space_left
= (get_doc_string_buffer_size
212 - (p
- get_doc_string_buffer
));
215 /* Read a disk block at a time.
216 If we read the same block last time, maybe skip this? */
217 if (space_left
> 1024 * 8)
218 space_left
= 1024 * 8;
219 nread
= emacs_read (fd
, p
, space_left
);
223 error ("Read error on documentation file");
228 if (p
== get_doc_string_buffer
)
229 p1
= index (p
+ offset
, '\037');
231 p1
= index (p
, '\037');
242 /* Scan the text and perform quoting with ^A (char code 1).
243 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
244 from
= get_doc_string_buffer
+ offset
;
245 to
= get_doc_string_buffer
+ offset
;
261 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
267 /* If DEFINITION, read from this buffer
268 the same way we would read bytes from a file. */
271 read_bytecode_pointer
= get_doc_string_buffer
+ offset
;
272 return Fread (Qlambda
);
276 return make_unibyte_string (get_doc_string_buffer
+ offset
,
277 to
- (get_doc_string_buffer
+ offset
));
280 /* Let the data determine whether the string is multibyte,
281 even if Emacs is running in --unibyte mode. */
282 int nchars
= multibyte_chars_in_text (get_doc_string_buffer
+ offset
,
283 to
- (get_doc_string_buffer
+ offset
));
284 return make_string_from_bytes (get_doc_string_buffer
+ offset
,
286 to
- (get_doc_string_buffer
+ offset
));
290 /* Get a string from position FILEPOS and pass it through the Lisp reader.
291 We use this for fetching the bytecode string and constants vector
292 of a compiled function from the .elc file. */
295 read_doc_string (filepos
)
298 return get_doc_string (filepos
, 0, 1);
301 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
302 "Return the documentation string of FUNCTION.\n\
303 Unless a non-nil second argument RAW is given, the\n\
304 string is passed through `substitute-command-keys'.")
306 Lisp_Object function
, raw
;
310 Lisp_Object tem
, doc
;
312 fun
= Findirect_function (function
);
316 if (XSUBR (fun
)->doc
== 0) return Qnil
;
317 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
318 doc
= build_string (XSUBR (fun
)->doc
);
320 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
),
322 if (! NILP (tem
= Fassq (function
, Vhelp_manyarg_func_alist
)))
323 doc
= concat3 (doc
, build_string ("\n"), Fcdr (tem
));
325 else if (COMPILEDP (fun
))
327 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
329 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
332 else if (NATNUMP (tem
) || CONSP (tem
))
333 doc
= get_doc_string (tem
, 0, 0);
337 else if (STRINGP (fun
) || VECTORP (fun
))
339 return build_string ("Keyboard macro.");
341 else if (CONSP (fun
))
344 if (!SYMBOLP (funcar
))
345 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
346 else if (EQ (funcar
, Qkeymap
))
347 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
348 else if (EQ (funcar
, Qlambda
)
349 || EQ (funcar
, Qautoload
))
352 tem1
= Fcdr (Fcdr (fun
));
356 /* Handle a doc reference--but these never come last
357 in the function body, so reject them if they are last. */
358 else if ((NATNUMP (tem
) || CONSP (tem
))
359 && ! NILP (XCDR (tem1
)))
360 doc
= get_doc_string (tem
, 0, 0);
364 else if (EQ (funcar
, Qmocklisp
))
366 else if (EQ (funcar
, Qmacro
))
367 return Fdocumentation (Fcdr (fun
), raw
);
374 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
378 doc
= Fsubstitute_command_keys (doc
);
382 DEFUN ("documentation-property", Fdocumentation_property
,
383 Sdocumentation_property
, 2, 3, 0,
384 "Return the documentation string that is SYMBOL's PROP property.\n\
385 Third argument RAW omitted or nil means pass the result through\n\
386 `substitute-command-keys' if it is a string.\n\
388 This is differs from `get' in that it can refer to strings stored in the\n\
389 `etc/DOC' file; and that it evaluates documentation properties that\n\
392 Lisp_Object symbol
, prop
, raw
;
396 tem
= Fget (symbol
, prop
);
398 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
399 else if (CONSP (tem
) && INTEGERP (XCDR (tem
)))
400 tem
= get_doc_string (tem
, 0, 0);
401 else if (!STRINGP (tem
))
402 /* Feval protects its argument. */
405 if (NILP (raw
) && STRINGP (tem
))
406 tem
= Fsubstitute_command_keys (tem
);
410 /* Scanning the DOC files and placing docstring offsets into functions. */
413 store_function_docstring (fun
, offset
)
415 /* Use EMACS_INT because we get this from pointer subtraction. */
418 fun
= indirect_function (fun
);
420 /* The type determines where the docstring is stored. */
422 /* Lisp_Subrs have a slot for it. */
424 XSUBR (fun
)->doc
= (char *) - offset
;
426 /* If it's a lisp form, stick it in the form. */
427 else if (CONSP (fun
))
432 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
434 tem
= Fcdr (Fcdr (fun
));
435 if (CONSP (tem
) && INTEGERP (XCAR (tem
)))
436 XSETFASTINT (XCAR (tem
), offset
);
438 else if (EQ (tem
, Qmacro
))
439 store_function_docstring (XCDR (fun
), offset
);
442 /* Bytecode objects sometimes have slots for it. */
443 else if (COMPILEDP (fun
))
445 /* This bytecode object must have a slot for the
446 docstring, since we've found a docstring for it. */
447 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
448 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
453 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
455 "Used during Emacs initialization, before dumping runnable Emacs,\n\
456 to find pointers to doc strings stored in `etc/DOC...' and\n\
457 record them in function definitions.\n\
458 One arg, FILENAME, a string which does not include a directory.\n\
459 The file is found in `../etc' now; found in the `data-directory'\n\
460 when doc strings are referred to later in the dumped Emacs.")
462 Lisp_Object filename
;
468 register char *p
, *end
;
469 Lisp_Object sym
, fun
, tem
;
471 extern char *index ();
474 if (NILP (Vpurify_flag
))
475 error ("Snarf-documentation can only be called in an undumped Emacs");
478 CHECK_STRING (filename
, 0);
481 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
482 strcpy (name
, "../etc/");
483 #else /* CANNOT_DUMP */
484 CHECK_STRING (Vdoc_directory
, 0);
485 name
= (char *) alloca (XSTRING (filename
)->size
+
486 XSTRING (Vdoc_directory
)->size
+ 1);
487 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
488 #endif /* CANNOT_DUMP */
489 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
492 /* For VMS versions with limited file name syntax,
493 convert the name to something VMS will allow. */
501 #endif /* not VMS4_4 */
503 strcpy (name
, sys_translate_unix (name
));
507 fd
= emacs_open (name
, O_RDONLY
, 0);
509 report_file_error ("Opening doc string file",
510 Fcons (build_string (name
), Qnil
));
511 Vdoc_file_name
= filename
;
517 filled
+= emacs_read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
523 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
524 while (p
!= end
&& *p
!= '\037') p
++;
525 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
528 end
= index (p
, '\n');
529 sym
= oblookup (Vobarray
, p
+ 2,
530 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
534 /* Attach a docstring to a variable? */
537 /* Install file-position as variable-documentation property
538 and make it negative for a user-variable
539 (doc starts with a `*'). */
540 Fput (sym
, Qvariable_documentation
,
541 make_number ((pos
+ end
+ 1 - buf
)
542 * (end
[1] == '*' ? -1 : 1)));
545 /* Attach a docstring to a function? */
546 else if (p
[1] == 'F')
547 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
550 error ("DOC file invalid at position %d", pos
);
555 bcopy (end
, buf
, filled
);
561 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
562 Ssubstitute_command_keys
, 1, 1, 0,
563 "Substitute key descriptions for command names in STRING.\n\
564 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
565 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
566 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
567 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
568 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
569 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
570 as the keymap for future \\=\\[COMMAND] substrings.\n\
571 \\=\\= quotes the following character and is discarded;\n\
572 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
578 register unsigned char *strp
;
579 register unsigned char *bufp
;
585 unsigned char *start
;
586 int length
, length_byte
;
588 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
595 CHECK_STRING (string
, 0);
599 GCPRO4 (string
, tem
, keymap
, name
);
601 multibyte
= STRING_MULTIBYTE (string
);
604 /* KEYMAP is either nil (which means search all the active keymaps)
605 or a specified local map (which means search just that and the
606 global map). If non-nil, it might come from Voverriding_local_map,
607 or from a \\<mapname> construct in STRING itself.. */
608 keymap
= current_kboard
->Voverriding_terminal_local_map
;
610 keymap
= Voverriding_local_map
;
612 bsize
= STRING_BYTES (XSTRING (string
));
613 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
615 strp
= (unsigned char *) XSTRING (string
)->data
;
616 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
618 if (strp
[0] == '\\' && strp
[1] == '=')
620 /* \= quotes the next character;
621 thus, to put in \[ without its special meaning, use \=\[. */
627 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
629 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
633 bcopy (strp
, bufp
, len
);
639 *bufp
++ = *strp
++, nchars
++;
641 else if (strp
[0] == '\\' && strp
[1] == '[')
643 Lisp_Object firstkey
;
646 strp
+= 2; /* skip \[ */
649 while ((strp
- (unsigned char *) XSTRING (string
)->data
650 < STRING_BYTES (XSTRING (string
)))
653 length_byte
= strp
- start
;
657 /* Save STRP in IDX. */
658 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
659 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
660 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
662 /* Disregard menu bar bindings; it is positively annoying to
663 mention them when there's no menu bar, and it isn't terribly
664 useful even when there is a menu bar. */
667 firstkey
= Faref (tem
, make_number (0));
668 if (EQ (firstkey
, Qmenu_bar
))
672 if (NILP (tem
)) /* but not on any keys */
674 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
677 bcopy ("M-x ", bufp
, 4);
681 length
= multibyte_chars_in_text (start
, length_byte
);
683 length
= length_byte
;
687 { /* function is on a key */
688 tem
= Fkey_description (tem
);
692 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
693 \<foo> just sets the keymap used for \[cmd]. */
694 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
696 struct buffer
*oldbuf
;
699 strp
+= 2; /* skip \{ or \< */
702 while ((strp
- (unsigned char *) XSTRING (string
)->data
703 < XSTRING (string
)->size
)
704 && *strp
!= '}' && *strp
!= '>')
707 length_byte
= strp
- start
;
708 strp
++; /* skip } or > */
710 /* Save STRP in IDX. */
711 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
713 /* Get the value of the keymap in TEM, or nil if undefined.
714 Do this while still in the user's current buffer
715 in case it is a local variable. */
716 name
= Fintern (make_string (start
, length_byte
), Qnil
);
717 tem
= Fboundp (name
);
720 tem
= Fsymbol_value (name
);
722 tem
= get_keymap_1 (tem
, 0, 1);
725 /* Now switch to a temp buffer. */
726 oldbuf
= current_buffer
;
727 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
731 name
= Fsymbol_name (name
);
732 insert_string ("\nUses keymap \"");
733 insert_from_string (name
, 0, 0,
734 XSTRING (name
)->size
,
735 STRING_BYTES (XSTRING (name
)), 1);
736 insert_string ("\", which is not currently defined.\n");
737 if (start
[-1] == '<') keymap
= Qnil
;
739 else if (start
[-1] == '<')
742 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
743 tem
= Fbuffer_string ();
745 set_buffer_internal (oldbuf
);
748 start
= XSTRING (tem
)->data
;
749 length
= XSTRING (tem
)->size
;
750 length_byte
= STRING_BYTES (XSTRING (tem
));
752 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
755 bcopy (start
, bufp
, length_byte
);
758 /* Check STRING again in case gc relocated it. */
759 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
761 else if (! multibyte
) /* just copy other chars */
762 *bufp
++ = *strp
++, nchars
++;
766 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
768 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
772 bcopy (strp
, bufp
, len
);
779 if (changed
) /* don't bother if nothing substituted */
780 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
784 RETURN_UNGCPRO (tem
);
790 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
791 "Name of file containing documentation strings of built-in symbols.");
792 Vdoc_file_name
= Qnil
;
793 DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist
,
794 "Alist of primitive functions and descriptions of their arg lists.\n\
795 All special forms and primitives which effectively have &rest args\n\
796 should have an entry here so that `documentation' can provide their\n\
798 Vhelp_manyarg_func_alist
= Qnil
;
800 defsubr (&Sdocumentation
);
801 defsubr (&Sdocumentation_property
);
802 defsubr (&Ssnarf_documentation
);
803 defsubr (&Ssubstitute_command_keys
);