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 commands).");
338 else if (EQ (funcar
, Qlambda
)
339 || EQ (funcar
, Qautoload
))
342 tem1
= Fcdr (Fcdr (fun
));
346 /* Handle a doc reference--but these never come last
347 in the function body, so reject them if they are last. */
348 else if ((NATNUMP (tem
) || CONSP (tem
))
349 && ! NILP (XCONS (tem1
)->cdr
))
350 doc
= get_doc_string (tem
, 0, 0);
354 else if (EQ (funcar
, Qmocklisp
))
356 else if (EQ (funcar
, Qmacro
))
357 return Fdocumentation (Fcdr (fun
), raw
);
364 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
372 doc
= Fsubstitute_command_keys (doc
);
378 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
379 "Return the documentation string that is SYMBOL's PROP property.\n\
380 This is like `get', but it can refer to strings stored in the\n\
381 `etc/DOC' file; and if the value is a string, it is passed through\n\
382 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
385 Lisp_Object symbol
, prop
, raw
;
387 register Lisp_Object tem
;
389 tem
= Fget (symbol
, prop
);
391 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0, 0);
392 else if (CONSP (tem
))
393 tem
= get_doc_string (tem
, 0, 0);
394 if (NILP (raw
) && STRINGP (tem
))
395 return Fsubstitute_command_keys (tem
);
399 /* Scanning the DOC files and placing docstring offsets into functions. */
402 store_function_docstring (fun
, offset
)
404 /* Use EMACS_INT because we get this from pointer subtraction. */
407 fun
= indirect_function (fun
);
409 /* The type determines where the docstring is stored. */
411 /* Lisp_Subrs have a slot for it. */
413 XSUBR (fun
)->doc
= (char *) - offset
;
415 /* If it's a lisp form, stick it in the form. */
416 else if (CONSP (fun
))
420 tem
= XCONS (fun
)->car
;
421 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
423 tem
= Fcdr (Fcdr (fun
));
424 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
425 XSETFASTINT (XCONS (tem
)->car
, offset
);
427 else if (EQ (tem
, Qmacro
))
428 store_function_docstring (XCONS (fun
)->cdr
, offset
);
431 /* Bytecode objects sometimes have slots for it. */
432 else if (COMPILEDP (fun
))
434 /* This bytecode object must have a slot for the
435 docstring, since we've found a docstring for it. */
436 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
437 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
442 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
444 "Used during Emacs initialization, before dumping runnable Emacs,\n\
445 to find pointers to doc strings stored in `etc/DOC...' and\n\
446 record them in function definitions.\n\
447 One arg, FILENAME, a string which does not include a directory.\n\
448 The file is found in `../etc' now; found in the `data-directory'\n\
449 when doc strings are referred to later in the dumped Emacs.")
451 Lisp_Object filename
;
457 register char *p
, *end
;
458 Lisp_Object sym
, fun
, tem
;
460 extern char *index ();
463 if (NILP (Vpurify_flag
))
464 error ("Snarf-documentation can only be called in an undumped Emacs");
467 CHECK_STRING (filename
, 0);
470 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
471 strcpy (name
, "../etc/");
472 #else /* CANNOT_DUMP */
473 CHECK_STRING (Vdoc_directory
, 0);
474 name
= (char *) alloca (XSTRING (filename
)->size
+
475 XSTRING (Vdoc_directory
)->size
+ 1);
476 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
477 #endif /* CANNOT_DUMP */
478 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
481 /* For VMS versions with limited file name syntax,
482 convert the name to something VMS will allow. */
490 #endif /* not VMS4_4 */
492 strcpy (name
, sys_translate_unix (name
));
496 fd
= open (name
, O_RDONLY
, 0);
498 report_file_error ("Opening doc string file",
499 Fcons (build_string (name
), Qnil
));
500 Vdoc_file_name
= filename
;
506 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
512 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
513 while (p
!= end
&& *p
!= '\037') p
++;
514 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
517 end
= index (p
, '\n');
518 sym
= oblookup (Vobarray
, p
+ 2,
519 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
523 /* Attach a docstring to a variable? */
526 /* Install file-position as variable-documentation property
527 and make it negative for a user-variable
528 (doc starts with a `*'). */
529 Fput (sym
, Qvariable_documentation
,
530 make_number ((pos
+ end
+ 1 - buf
)
531 * (end
[1] == '*' ? -1 : 1)));
534 /* Attach a docstring to a function? */
535 else if (p
[1] == 'F')
536 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
539 error ("DOC file invalid at position %d", pos
);
544 bcopy (end
, buf
, filled
);
550 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
551 Ssubstitute_command_keys
, 1, 1, 0,
552 "Substitute key descriptions for command names in STRING.\n\
553 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
554 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
555 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
556 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
557 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
558 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
559 as the keymap for future \\=\\[COMMAND] substrings.\n\
560 \\=\\= quotes the following character and is discarded;\n\
561 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
567 register unsigned char *strp
;
568 register unsigned char *bufp
;
574 unsigned char *start
;
575 int length
, length_byte
;
577 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
584 CHECK_STRING (string
, 0);
588 GCPRO4 (string
, tem
, keymap
, name
);
590 multibyte
= STRING_MULTIBYTE (string
);
593 /* KEYMAP is either nil (which means search all the active keymaps)
594 or a specified local map (which means search just that and the
595 global map). If non-nil, it might come from Voverriding_local_map,
596 or from a \\<mapname> construct in STRING itself.. */
597 keymap
= current_kboard
->Voverriding_terminal_local_map
;
599 keymap
= Voverriding_local_map
;
601 bsize
= STRING_BYTES (XSTRING (string
));
602 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
604 strp
= (unsigned char *) XSTRING (string
)->data
;
605 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
607 if (strp
[0] == '\\' && strp
[1] == '=')
609 /* \= quotes the next character;
610 thus, to put in \[ without its special meaning, use \=\[. */
616 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
618 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
622 bcopy (strp
, bufp
, len
);
628 *bufp
++ = *strp
++, nchars
++;
630 else if (strp
[0] == '\\' && strp
[1] == '[')
632 Lisp_Object firstkey
;
635 strp
+= 2; /* skip \[ */
638 while ((strp
- (unsigned char *) XSTRING (string
)->data
639 < STRING_BYTES (XSTRING (string
)))
642 length_byte
= strp
- start
;
646 /* Save STRP in IDX. */
647 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
648 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
649 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
651 /* Disregard menu bar bindings; it is positively annoying to
652 mention them when there's no menu bar, and it isn't terribly
653 useful even when there is a menu bar. */
656 firstkey
= Faref (tem
, make_number (0));
657 if (EQ (firstkey
, Qmenu_bar
))
661 if (NILP (tem
)) /* but not on any keys */
663 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
666 bcopy ("M-x ", bufp
, 4);
670 length
= multibyte_chars_in_text (start
, length_byte
);
672 length
= length_byte
;
676 { /* function is on a key */
677 tem
= Fkey_description (tem
);
681 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
682 \<foo> just sets the keymap used for \[cmd]. */
683 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
685 struct buffer
*oldbuf
;
688 strp
+= 2; /* skip \{ or \< */
691 while ((strp
- (unsigned char *) XSTRING (string
)->data
692 < XSTRING (string
)->size
)
693 && *strp
!= '}' && *strp
!= '>')
696 length_byte
= strp
- start
;
697 strp
++; /* skip } or > */
699 /* Save STRP in IDX. */
700 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
702 /* Get the value of the keymap in TEM, or nil if undefined.
703 Do this while still in the user's current buffer
704 in case it is a local variable. */
705 name
= Fintern (make_string (start
, length_byte
), Qnil
);
706 tem
= Fboundp (name
);
709 tem
= Fsymbol_value (name
);
711 tem
= get_keymap_1 (tem
, 0, 1);
714 /* Now switch to a temp buffer. */
715 oldbuf
= current_buffer
;
716 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
720 name
= Fsymbol_name (name
);
721 insert_string ("\nUses keymap \"");
722 insert_from_string (name
, 0, 0,
723 XSTRING (name
)->size
,
724 STRING_BYTES (XSTRING (name
)), 1);
725 insert_string ("\", which is not currently defined.\n");
726 if (start
[-1] == '<') keymap
= Qnil
;
728 else if (start
[-1] == '<')
731 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
732 tem
= Fbuffer_string ();
734 set_buffer_internal (oldbuf
);
737 start
= XSTRING (tem
)->data
;
738 length
= XSTRING (tem
)->size
;
739 length_byte
= STRING_BYTES (XSTRING (tem
));
741 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
744 bcopy (start
, bufp
, length_byte
);
747 /* Check STRING again in case gc relocated it. */
748 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
750 else if (! multibyte
) /* just copy other chars */
751 *bufp
++ = *strp
++, nchars
++;
755 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
757 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
761 bcopy (strp
, bufp
, len
);
768 if (changed
) /* don't bother if nothing substituted */
769 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
773 RETURN_UNGCPRO (tem
);
779 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
780 "Name of file containing documentation strings of built-in symbols.");
781 Vdoc_file_name
= Qnil
;
783 defsubr (&Sdocumentation
);
784 defsubr (&Sdocumentation_property
);
785 defsubr (&Ssnarf_documentation
);
786 defsubr (&Ssubstitute_command_keys
);