1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include <sys/types.h>
24 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
42 Lisp_Object Vdoc_file_name
;
44 extern char *index ();
46 extern Lisp_Object Voverriding_local_map
;
48 /* For VMS versions with limited file name syntax,
49 convert the name to something VMS will allow. */
51 munge_doc_file_name (name
)
56 /* For VMS versions with limited file name syntax,
57 convert the name to something VMS will allow. */
65 #endif /* not VMS4_4 */
67 strcpy (name
, sys_translate_unix (name
));
72 /* Extract a doc string from a file. FILEPOS says where to get it.
73 If it is an integer, use that position in the standard DOC-... file.
74 If it is (FILE . INTEGER), use FILE as the file name
75 and INTEGER as the position in that file. */
78 get_doc_string (filepos
)
81 char buf
[512 * 32 + 1];
88 register char *p
, *p1
;
91 Lisp_Object file
, tem
;
93 if (INTEGERP (filepos
))
95 file
= Vdoc_file_name
;
96 position
= XINT (filepos
);
98 else if (CONSP (filepos
))
100 file
= XCONS (filepos
)->car
;
101 position
= XINT (XCONS (filepos
)->cdr
);
106 if (!STRINGP (Vdoc_directory
))
112 /* Put the file name in NAME as a C string.
113 If it is relative, combine it with Vdoc_directory. */
115 tem
= Ffile_name_absolute_p (file
);
118 minsize
= XSTRING (Vdoc_directory
)->size
;
119 /* sizeof ("../etc/") == 8 */
122 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
123 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
124 strcat (name
, XSTRING (file
)->data
);
125 munge_doc_file_name (name
);
129 name
= XSTRING (file
)->data
;
132 fd
= open (name
, O_RDONLY
, 0);
136 if (!NILP (Vpurify_flag
))
138 /* Preparing to dump; DOC file is probably not installed.
139 So check in ../etc. */
140 strcpy (name
, "../etc/");
141 strcat (name
, XSTRING (file
)->data
);
142 munge_doc_file_name (name
);
144 fd
= open (name
, O_RDONLY
, 0);
149 error ("Cannot open doc string file \"%s\"", name
);
152 if (0 > lseek (fd
, position
, 0))
155 error ("Position %ld out of range in doc string file \"%s\"",
159 /* Read the doc string into a buffer.
160 Use the fixed buffer BUF if it is big enough;
161 otherwise allocate one and set FREE_IT.
162 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
165 buffer_size
= sizeof buf
;
170 int space_left
= buffer_size
- (p
- buffer
);
173 /* Switch to a bigger buffer if we need one. */
178 int offset
= p
- buffer
;
179 buffer
= (char *) xrealloc (buffer
,
185 buffer
= (char *) xmalloc (buffer_size
*= 2);
186 bcopy (buf
, buffer
, p
- buf
);
187 p
= buffer
+ (p
- buf
);
190 space_left
= buffer_size
- (p
- buffer
);
193 /* Don't read too too much at one go. */
194 if (space_left
> 1024 * 8)
195 space_left
= 1024 * 8;
196 nread
= read (fd
, p
, space_left
);
200 error ("Read error on documentation file");
205 p1
= index (p
, '\037');
216 /* Scan the text and perform quoting with ^A (char code 1).
217 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
235 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
241 tem
= make_string (buffer
, to
- buffer
);
248 /* Get a string from position FILEPOS and pass it through the Lisp reader.
249 We use this for fetching the bytecode string and constants vector
250 of a compiled function from the .elc file. */
253 read_doc_string (filepos
)
256 return Fread (get_doc_string (filepos
));
259 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
260 "Return the documentation string of FUNCTION.\n\
261 Unless a non-nil second argument is given, the\n\
262 string is passed through `substitute-command-keys'.")
264 Lisp_Object function
, raw
;
268 Lisp_Object tem
, doc
;
270 fun
= Findirect_function (function
);
274 if (XSUBR (fun
)->doc
== 0) return Qnil
;
275 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
276 doc
= build_string (XSUBR (fun
)->doc
);
278 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
280 else if (COMPILEDP (fun
))
282 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
284 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
287 else if (NATNUMP (tem
) || CONSP (tem
))
288 doc
= get_doc_string (tem
);
292 else if (STRINGP (fun
) || VECTORP (fun
))
294 return build_string ("Keyboard macro.");
296 else if (CONSP (fun
))
299 if (!SYMBOLP (funcar
))
300 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
301 else if (EQ (funcar
, Qkeymap
))
302 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
304 else if (EQ (funcar
, Qlambda
)
305 || EQ (funcar
, Qautoload
))
307 tem
= Fcar (Fcdr (Fcdr (fun
)));
310 else if (NATNUMP (tem
) || CONSP (tem
))
311 doc
= get_doc_string (tem
);
315 else if (EQ (funcar
, Qmocklisp
))
317 else if (EQ (funcar
, Qmacro
))
318 return Fdocumentation (Fcdr (fun
), raw
);
325 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
333 doc
= Fsubstitute_command_keys (doc
);
339 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
340 "Return the documentation string that is SYMBOL's PROP property.\n\
341 This is like `get', but it can refer to strings stored in the\n\
342 `etc/DOC' file; and if the value is a string, it is passed through\n\
343 `substitute-command-keys'. A non-nil third argument avoids this\n\
346 Lisp_Object sym
, prop
, raw
;
348 register Lisp_Object tem
;
350 tem
= Fget (sym
, prop
);
352 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
353 else if (CONSP (tem
))
354 tem
= get_doc_string (tem
);
355 if (NILP (raw
) && STRINGP (tem
))
356 return Fsubstitute_command_keys (tem
);
360 /* Scanning the DOC files and placing docstring offsets into functions. */
363 store_function_docstring (fun
, offset
)
365 /* Use EMACS_INT because we get this from pointer subtraction. */
368 fun
= indirect_function (fun
);
370 /* The type determines where the docstring is stored. */
372 /* Lisp_Subrs have a slot for it. */
374 XSUBR (fun
)->doc
= (char *) - offset
;
376 /* If it's a lisp form, stick it in the form. */
377 else if (CONSP (fun
))
381 tem
= XCONS (fun
)->car
;
382 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
384 tem
= Fcdr (Fcdr (fun
));
385 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
386 XSETFASTINT (XCONS (tem
)->car
, offset
);
388 else if (EQ (tem
, Qmacro
))
389 store_function_docstring (XCONS (fun
)->cdr
, offset
);
392 /* Bytecode objects sometimes have slots for it. */
393 else if (COMPILEDP (fun
))
395 /* This bytecode object must have a slot for the
396 docstring, since we've found a docstring for it. */
397 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
398 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
403 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
405 "Used during Emacs initialization, before dumping runnable Emacs,\n\
406 to find pointers to doc strings stored in `etc/DOC...' and\n\
407 record them in function definitions.\n\
408 One arg, FILENAME, a string which does not include a directory.\n\
409 The file is found in `../etc' now; found in the `data-directory'\n\
410 when doc strings are referred to later in the dumped Emacs.")
412 Lisp_Object filename
;
418 register char *p
, *end
;
419 Lisp_Object sym
, fun
, tem
;
421 extern char *index ();
424 if (NILP (Vpurify_flag
))
425 error ("Snarf-documentation can only be called in an undumped Emacs");
428 CHECK_STRING (filename
, 0);
431 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
432 strcpy (name
, "../etc/");
433 #else /* CANNOT_DUMP */
434 CHECK_STRING (Vdoc_directory
, 0);
435 name
= (char *) alloca (XSTRING (filename
)->size
+
436 XSTRING (Vdoc_directory
)->size
+ 1);
437 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
438 #endif /* CANNOT_DUMP */
439 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
442 /* For VMS versions with limited file name syntax,
443 convert the name to something VMS will allow. */
451 #endif /* not VMS4_4 */
453 strcpy (name
, sys_translate_unix (name
));
457 fd
= open (name
, O_RDONLY
, 0);
459 report_file_error ("Opening doc string file",
460 Fcons (build_string (name
), Qnil
));
461 Vdoc_file_name
= filename
;
467 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
473 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
474 while (p
!= end
&& *p
!= '\037') p
++;
475 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
478 end
= index (p
, '\n');
479 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
482 /* Attach a docstring to a variable? */
485 /* Install file-position as variable-documentation property
486 and make it negative for a user-variable
487 (doc starts with a `*'). */
488 Fput (sym
, Qvariable_documentation
,
489 make_number ((pos
+ end
+ 1 - buf
)
490 * (end
[1] == '*' ? -1 : 1)));
493 /* Attach a docstring to a function? */
494 else if (p
[1] == 'F')
495 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
498 error ("DOC file invalid at position %d", pos
);
503 bcopy (end
, buf
, filled
);
509 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
510 Ssubstitute_command_keys
, 1, 1, 0,
511 "Substitute key descriptions for command names in STRING.\n\
512 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
513 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
514 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
515 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
516 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
517 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
518 as the keymap for future \\=\\[COMMAND] substrings.\n\
519 \\=\\= quotes the following character and is discarded;\n\
520 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
526 register unsigned char *strp
;
527 register unsigned char *bufp
;
533 unsigned char *start
;
536 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
541 CHECK_STRING (str
, 0);
545 GCPRO4 (str
, tem
, keymap
, name
);
547 /* KEYMAP is either nil (which means search all the active keymaps)
548 or a specified local map (which means search just that and the
549 global map). If non-nil, it might come from Voverriding_local_map,
550 or from a \\<mapname> construct in STR itself.. */
551 keymap
= Voverriding_local_map
;
553 bsize
= XSTRING (str
)->size
;
554 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
556 strp
= (unsigned char *) XSTRING (str
)->data
;
557 while (strp
< (unsigned char *) XSTRING (str
)->data
+ XSTRING (str
)->size
)
559 if (strp
[0] == '\\' && strp
[1] == '=')
561 /* \= quotes the next character;
562 thus, to put in \[ without its special meaning, use \=\[. */
567 else if (strp
[0] == '\\' && strp
[1] == '[')
569 Lisp_Object firstkey
;
572 strp
+= 2; /* skip \[ */
575 while ((strp
- (unsigned char *) XSTRING (str
)->data
576 < XSTRING (str
)->size
)
579 length
= strp
- start
;
582 /* Save STRP in IDX. */
583 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
584 tem
= Fintern (make_string (start
, length
), Qnil
);
585 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
587 /* Disregard menu bar bindings; it is positively annoying to
588 mention them when there's no menu bar, and it isn't terribly
589 useful even when there is a menu bar. */
592 firstkey
= Faref (tem
, make_number (0));
593 if (EQ (firstkey
, Qmenu_bar
))
597 if (NILP (tem
)) /* but not on any keys */
599 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
602 bcopy ("M-x ", bufp
, 4);
607 { /* function is on a key */
608 tem
= Fkey_description (tem
);
612 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
613 \<foo> just sets the keymap used for \[cmd]. */
614 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
616 struct buffer
*oldbuf
;
619 strp
+= 2; /* skip \{ or \< */
622 while ((strp
- (unsigned char *) XSTRING (str
)->data
623 < XSTRING (str
)->size
)
624 && *strp
!= '}' && *strp
!= '>')
626 length
= strp
- start
;
627 strp
++; /* skip } or > */
629 /* Save STRP in IDX. */
630 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
632 /* Get the value of the keymap in TEM, or nil if undefined.
633 Do this while still in the user's current buffer
634 in case it is a local variable. */
635 name
= Fintern (make_string (start
, length
), Qnil
);
636 tem
= Fboundp (name
);
639 tem
= Fsymbol_value (name
);
641 tem
= get_keymap_1 (tem
, 0, 1);
644 /* Now switch to a temp buffer. */
645 oldbuf
= current_buffer
;
646 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
650 name
= Fsymbol_name (name
);
651 insert_string ("\nUses keymap \"");
652 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
653 insert_string ("\", which is not currently defined.\n");
654 if (start
[-1] == '<') keymap
= Qnil
;
656 else if (start
[-1] == '<')
659 describe_map_tree (tem
, 1, Qnil
, Qnil
, 0, 1);
660 tem
= Fbuffer_string ();
662 set_buffer_internal (oldbuf
);
665 start
= XSTRING (tem
)->data
;
666 length
= XSTRING (tem
)->size
;
668 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
671 bcopy (start
, bufp
, length
);
673 /* Check STR again in case gc relocated it. */
674 strp
= (unsigned char *) XSTRING (str
)->data
+ idx
;
676 else /* just copy other chars */
680 if (changed
) /* don't bother if nothing substituted */
681 tem
= make_string (buf
, bufp
- buf
);
685 RETURN_UNGCPRO (tem
);
690 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
691 "Name of file containing documentation strings of built-in symbols.");
692 Vdoc_file_name
= Qnil
;
694 defsubr (&Sdocumentation
);
695 defsubr (&Sdocumentation_property
);
696 defsubr (&Ssnarf_documentation
);
697 defsubr (&Ssubstitute_command_keys
);