1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 86, 93, 94, 95, 97, 1998 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
;
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
)
88 read_bytecode_pointer
--;
91 return *read_bytecode_pointer
++;
94 /* Extract a doc string from a file. FILEPOS says where to get it.
95 If it is an integer, use that position in the standard DOC-... file.
96 If it is (FILE . INTEGER), use FILE as the file name
97 and INTEGER as the position in that file.
98 But if INTEGER is negative, make it positive.
99 (A negative integer is used for user variables, so we can distinguish
100 them without actually fetching the doc string.)
102 If UNIBYTE is nonzero, always make a unibyte string.
104 If DEFINITION is nonzero, assume this is for reading
105 a dynamic function definition; convert the bytestring
106 and the constants vector with appropriate byte handling,
107 and return a cons cell. */
110 get_doc_string (filepos
, unibyte
, definition
)
112 int unibyte
, definition
;
117 register char *p
, *p1
;
119 int offset
, position
;
120 Lisp_Object file
, tem
;
122 if (INTEGERP (filepos
))
124 file
= Vdoc_file_name
;
125 position
= XINT (filepos
);
127 else if (CONSP (filepos
))
129 file
= XCONS (filepos
)->car
;
130 position
= XINT (XCONS (filepos
)->cdr
);
132 position
= - position
;
137 if (!STRINGP (Vdoc_directory
))
143 /* Put the file name in NAME as a C string.
144 If it is relative, combine it with Vdoc_directory. */
146 tem
= Ffile_name_absolute_p (file
);
149 minsize
= XSTRING (Vdoc_directory
)->size
;
150 /* sizeof ("../etc/") == 8 */
153 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
154 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
155 strcat (name
, XSTRING (file
)->data
);
156 munge_doc_file_name (name
);
160 name
= (char *) XSTRING (file
)->data
;
163 fd
= open (name
, O_RDONLY
, 0);
167 if (!NILP (Vpurify_flag
))
169 /* Preparing to dump; DOC file is probably not installed.
170 So check in ../etc. */
171 strcpy (name
, "../etc/");
172 strcat (name
, XSTRING (file
)->data
);
173 munge_doc_file_name (name
);
175 fd
= open (name
, O_RDONLY
, 0);
179 error ("Cannot open doc string file \"%s\"", name
);
182 /* Seek only to beginning of disk block. */
183 offset
= position
% (8 * 1024);
184 if (0 > lseek (fd
, position
- offset
, 0))
187 error ("Position %ld out of range in doc string file \"%s\"",
191 /* Read the doc string into get_doc_string_buffer.
192 P points beyond the data just read. */
194 p
= get_doc_string_buffer
;
197 int space_left
= (get_doc_string_buffer_size
198 - (p
- get_doc_string_buffer
));
201 /* Allocate or grow the buffer if we need to. */
204 int in_buffer
= p
- get_doc_string_buffer
;
205 get_doc_string_buffer_size
+= 16 * 1024;
206 get_doc_string_buffer
207 = (char *) xrealloc (get_doc_string_buffer
,
208 get_doc_string_buffer_size
+ 1);
209 p
= get_doc_string_buffer
+ in_buffer
;
210 space_left
= (get_doc_string_buffer_size
211 - (p
- get_doc_string_buffer
));
214 /* Read a disk block at a time.
215 If we read the same block last time, maybe skip this? */
216 if (space_left
> 1024 * 8)
217 space_left
= 1024 * 8;
218 nread
= read (fd
, p
, space_left
);
222 error ("Read error on documentation file");
227 if (p
== get_doc_string_buffer
)
228 p1
= index (p
+ offset
, '\037');
230 p1
= index (p
, '\037');
241 /* Scan the text and perform quoting with ^A (char code 1).
242 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
243 from
= get_doc_string_buffer
+ offset
;
244 to
= get_doc_string_buffer
+ offset
;
260 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
266 /* If DEFINITION, read from this buffer
267 the same way we would read bytes from a file. */
270 read_bytecode_pointer
= get_doc_string_buffer
+ offset
;
271 return Fread (Qlambda
);
275 return make_unibyte_string (get_doc_string_buffer
+ offset
,
276 to
- (get_doc_string_buffer
+ offset
));
278 return make_string (get_doc_string_buffer
+ offset
,
279 to
- (get_doc_string_buffer
+ offset
));
282 /* Get a string from position FILEPOS and pass it through the Lisp reader.
283 We use this for fetching the bytecode string and constants vector
284 of a compiled function from the .elc file. */
287 read_doc_string (filepos
)
290 return get_doc_string (filepos
, 0, 1);
293 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
294 "Return the documentation string of FUNCTION.\n\
295 Unless a non-nil second argument RAW is given, the\n\
296 string is passed through `substitute-command-keys'.")
298 Lisp_Object function
, raw
;
302 Lisp_Object tem
, doc
;
304 fun
= Findirect_function (function
);
308 if (XSUBR (fun
)->doc
== 0) return Qnil
;
309 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
310 doc
= build_string (XSUBR (fun
)->doc
);
312 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
),
315 else if (COMPILEDP (fun
))
317 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
319 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
322 else if (NATNUMP (tem
) || CONSP (tem
))
323 doc
= get_doc_string (tem
, 0, 0);
327 else if (STRINGP (fun
) || VECTORP (fun
))
329 return build_string ("Keyboard macro.");
331 else if (CONSP (fun
))
334 if (!SYMBOLP (funcar
))
335 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
336 else if (EQ (funcar
, Qkeymap
))
337 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
339 else if (EQ (funcar
, Qlambda
)
340 || EQ (funcar
, Qautoload
))
343 tem1
= Fcdr (Fcdr (fun
));
347 /* Handle a doc reference--but these never come last
348 in the function body, so reject them if they are last. */
349 else if ((NATNUMP (tem
) || CONSP (tem
))
350 && ! NILP (XCONS (tem1
)->cdr
))
351 doc
= get_doc_string (tem
, 0, 0);
355 else if (EQ (funcar
, Qmocklisp
))
357 else if (EQ (funcar
, Qmacro
))
358 return Fdocumentation (Fcdr (fun
), raw
);
365 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
373 doc
= Fsubstitute_command_keys (doc
);
379 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
380 "Return the documentation string that is SYMBOL's PROP property.\n\
381 This is like `get', but it can refer to strings stored in the\n\
382 `etc/DOC' file; and if the value is a string, it is passed through\n\
383 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
386 Lisp_Object symbol
, prop
, raw
;
388 register Lisp_Object tem
;
390 tem
= Fget (symbol
, prop
);
392 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
393 else if (CONSP (tem
))
394 tem
= get_doc_string (tem
, 0, 0);
395 if (NILP (raw
) && STRINGP (tem
))
396 return Fsubstitute_command_keys (tem
);
400 /* Scanning the DOC files and placing docstring offsets into functions. */
403 store_function_docstring (fun
, offset
)
405 /* Use EMACS_INT because we get this from pointer subtraction. */
408 fun
= indirect_function (fun
);
410 /* The type determines where the docstring is stored. */
412 /* Lisp_Subrs have a slot for it. */
414 XSUBR (fun
)->doc
= (char *) - offset
;
416 /* If it's a lisp form, stick it in the form. */
417 else if (CONSP (fun
))
421 tem
= XCONS (fun
)->car
;
422 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
424 tem
= Fcdr (Fcdr (fun
));
425 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
426 XSETFASTINT (XCONS (tem
)->car
, offset
);
428 else if (EQ (tem
, Qmacro
))
429 store_function_docstring (XCONS (fun
)->cdr
, offset
);
432 /* Bytecode objects sometimes have slots for it. */
433 else if (COMPILEDP (fun
))
435 /* This bytecode object must have a slot for the
436 docstring, since we've found a docstring for it. */
437 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
438 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
443 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
445 "Used during Emacs initialization, before dumping runnable Emacs,\n\
446 to find pointers to doc strings stored in `etc/DOC...' and\n\
447 record them in function definitions.\n\
448 One arg, FILENAME, a string which does not include a directory.\n\
449 The file is found in `../etc' now; found in the `data-directory'\n\
450 when doc strings are referred to later in the dumped Emacs.")
452 Lisp_Object filename
;
458 register char *p
, *end
;
459 Lisp_Object sym
, fun
, tem
;
461 extern char *index ();
464 if (NILP (Vpurify_flag
))
465 error ("Snarf-documentation can only be called in an undumped Emacs");
468 CHECK_STRING (filename
, 0);
471 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
472 strcpy (name
, "../etc/");
473 #else /* CANNOT_DUMP */
474 CHECK_STRING (Vdoc_directory
, 0);
475 name
= (char *) alloca (XSTRING (filename
)->size
+
476 XSTRING (Vdoc_directory
)->size
+ 1);
477 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
478 #endif /* CANNOT_DUMP */
479 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
482 /* For VMS versions with limited file name syntax,
483 convert the name to something VMS will allow. */
491 #endif /* not VMS4_4 */
493 strcpy (name
, sys_translate_unix (name
));
497 fd
= open (name
, O_RDONLY
, 0);
499 report_file_error ("Opening doc string file",
500 Fcons (build_string (name
), Qnil
));
501 Vdoc_file_name
= filename
;
507 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
513 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
514 while (p
!= end
&& *p
!= '\037') p
++;
515 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
518 end
= index (p
, '\n');
519 sym
= oblookup (Vobarray
, p
+ 2,
520 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
524 /* Attach a docstring to a variable? */
527 /* Install file-position as variable-documentation property
528 and make it negative for a user-variable
529 (doc starts with a `*'). */
530 Fput (sym
, Qvariable_documentation
,
531 make_number ((pos
+ end
+ 1 - buf
)
532 * (end
[1] == '*' ? -1 : 1)));
535 /* Attach a docstring to a function? */
536 else if (p
[1] == 'F')
537 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
540 error ("DOC file invalid at position %d", pos
);
545 bcopy (end
, buf
, filled
);
551 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
552 Ssubstitute_command_keys
, 1, 1, 0,
553 "Substitute key descriptions for command names in STRING.\n\
554 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
555 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
556 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
557 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
558 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
559 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
560 as the keymap for future \\=\\[COMMAND] substrings.\n\
561 \\=\\= quotes the following character and is discarded;\n\
562 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
568 register unsigned char *strp
;
569 register unsigned char *bufp
;
575 unsigned char *start
;
576 int length
, length_byte
;
578 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
585 CHECK_STRING (string
, 0);
589 GCPRO4 (string
, tem
, keymap
, name
);
591 multibyte
= STRING_MULTIBYTE (string
);
594 /* KEYMAP is either nil (which means search all the active keymaps)
595 or a specified local map (which means search just that and the
596 global map). If non-nil, it might come from Voverriding_local_map,
597 or from a \\<mapname> construct in STRING itself.. */
598 keymap
= current_kboard
->Voverriding_terminal_local_map
;
600 keymap
= Voverriding_local_map
;
602 bsize
= STRING_BYTES (XSTRING (string
));
603 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
605 strp
= (unsigned char *) XSTRING (string
)->data
;
606 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
608 if (strp
[0] == '\\' && strp
[1] == '=')
610 /* \= quotes the next character;
611 thus, to put in \[ without its special meaning, use \=\[. */
617 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
619 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
623 bcopy (strp
, bufp
, len
);
629 *bufp
++ = *strp
++, nchars
++;
631 else if (strp
[0] == '\\' && strp
[1] == '[')
633 Lisp_Object firstkey
;
636 strp
+= 2; /* skip \[ */
639 while ((strp
- (unsigned char *) XSTRING (string
)->data
640 < STRING_BYTES (XSTRING (string
)))
643 length_byte
= strp
- start
;
647 /* Save STRP in IDX. */
648 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
649 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
650 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
652 /* Disregard menu bar bindings; it is positively annoying to
653 mention them when there's no menu bar, and it isn't terribly
654 useful even when there is a menu bar. */
657 firstkey
= Faref (tem
, make_number (0));
658 if (EQ (firstkey
, Qmenu_bar
))
662 if (NILP (tem
)) /* but not on any keys */
664 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
667 bcopy ("M-x ", bufp
, 4);
671 length
= multibyte_chars_in_text (start
, length_byte
);
673 length
= length_byte
;
677 { /* function is on a key */
678 tem
= Fkey_description (tem
);
682 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
683 \<foo> just sets the keymap used for \[cmd]. */
684 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
686 struct buffer
*oldbuf
;
689 strp
+= 2; /* skip \{ or \< */
692 while ((strp
- (unsigned char *) XSTRING (string
)->data
693 < XSTRING (string
)->size
)
694 && *strp
!= '}' && *strp
!= '>')
697 length_byte
= strp
- start
;
698 strp
++; /* skip } or > */
700 /* Save STRP in IDX. */
701 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
703 /* Get the value of the keymap in TEM, or nil if undefined.
704 Do this while still in the user's current buffer
705 in case it is a local variable. */
706 name
= Fintern (make_string (start
, length_byte
), Qnil
);
707 tem
= Fboundp (name
);
710 tem
= Fsymbol_value (name
);
712 tem
= get_keymap_1 (tem
, 0, 1);
715 /* Now switch to a temp buffer. */
716 oldbuf
= current_buffer
;
717 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
721 name
= Fsymbol_name (name
);
722 insert_string ("\nUses keymap \"");
723 insert_from_string (name
, 0, 0,
724 XSTRING (name
)->size
,
725 STRING_BYTES (XSTRING (name
)), 1);
726 insert_string ("\", which is not currently defined.\n");
727 if (start
[-1] == '<') keymap
= Qnil
;
729 else if (start
[-1] == '<')
732 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
733 tem
= Fbuffer_string ();
735 set_buffer_internal (oldbuf
);
738 start
= XSTRING (tem
)->data
;
739 length
= XSTRING (tem
)->size
;
740 length_byte
= STRING_BYTES (XSTRING (tem
));
742 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
745 bcopy (start
, bufp
, length_byte
);
748 /* Check STRING again in case gc relocated it. */
749 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
751 else if (! multibyte
) /* just copy other chars */
752 *bufp
++ = *strp
++, nchars
++;
756 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
758 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
762 bcopy (strp
, bufp
, len
);
769 if (changed
) /* don't bother if nothing substituted */
770 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
774 RETURN_UNGCPRO (tem
);
780 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
781 "Name of file containing documentation strings of built-in symbols.");
782 Vdoc_file_name
= Qnil
;
784 defsubr (&Sdocumentation
);
785 defsubr (&Sdocumentation_property
);
786 defsubr (&Ssnarf_documentation
);
787 defsubr (&Ssubstitute_command_keys
);