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.
76 But if INTEGER is negative, make it positive.
77 (A negative integer is used for user variables, so we can distinguish
78 them without actually fetching the doc string.) */
81 get_doc_string (filepos
)
84 char buf
[512 * 32 + 1];
91 register char *p
, *p1
;
94 Lisp_Object file
, tem
;
96 if (INTEGERP (filepos
))
98 file
= Vdoc_file_name
;
99 position
= XINT (filepos
);
101 else if (CONSP (filepos
))
103 file
= XCONS (filepos
)->car
;
104 position
= XINT (XCONS (filepos
)->cdr
);
106 position
= - position
;
111 if (!STRINGP (Vdoc_directory
))
117 /* Put the file name in NAME as a C string.
118 If it is relative, combine it with Vdoc_directory. */
120 tem
= Ffile_name_absolute_p (file
);
123 minsize
= XSTRING (Vdoc_directory
)->size
;
124 /* sizeof ("../etc/") == 8 */
127 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
128 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
129 strcat (name
, XSTRING (file
)->data
);
130 munge_doc_file_name (name
);
134 name
= (char *) XSTRING (file
)->data
;
137 fd
= open (name
, O_RDONLY
, 0);
141 if (!NILP (Vpurify_flag
))
143 /* Preparing to dump; DOC file is probably not installed.
144 So check in ../etc. */
145 strcpy (name
, "../etc/");
146 strcat (name
, XSTRING (file
)->data
);
147 munge_doc_file_name (name
);
149 fd
= open (name
, O_RDONLY
, 0);
154 error ("Cannot open doc string file \"%s\"", name
);
157 if (0 > lseek (fd
, position
, 0))
160 error ("Position %ld out of range in doc string file \"%s\"",
164 /* Read the doc string into a buffer.
165 Use the fixed buffer BUF if it is big enough;
166 otherwise allocate one and set FREE_IT.
167 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
170 buffer_size
= sizeof buf
;
175 int space_left
= buffer_size
- (p
- buffer
);
178 /* Switch to a bigger buffer if we need one. */
183 int offset
= p
- buffer
;
184 buffer
= (char *) xrealloc (buffer
,
190 buffer
= (char *) xmalloc (buffer_size
*= 2);
191 bcopy (buf
, buffer
, p
- buf
);
192 p
= buffer
+ (p
- buf
);
195 space_left
= buffer_size
- (p
- buffer
);
198 /* Don't read too too much at one go. */
199 if (space_left
> 1024 * 8)
200 space_left
= 1024 * 8;
201 nread
= read (fd
, p
, space_left
);
205 error ("Read error on documentation file");
210 p1
= index (p
, '\037');
221 /* Scan the text and perform quoting with ^A (char code 1).
222 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
240 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
246 tem
= make_string (buffer
, to
- buffer
);
253 /* Get a string from position FILEPOS and pass it through the Lisp reader.
254 We use this for fetching the bytecode string and constants vector
255 of a compiled function from the .elc file. */
258 read_doc_string (filepos
)
261 return Fread (get_doc_string (filepos
));
264 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
265 "Return the documentation string of FUNCTION.\n\
266 Unless a non-nil second argument is given, the\n\
267 string is passed through `substitute-command-keys'.")
269 Lisp_Object function
, raw
;
273 Lisp_Object tem
, doc
;
275 fun
= Findirect_function (function
);
279 if (XSUBR (fun
)->doc
== 0) return Qnil
;
280 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
281 doc
= build_string (XSUBR (fun
)->doc
);
283 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
285 else if (COMPILEDP (fun
))
287 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
289 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
292 else if (NATNUMP (tem
) || CONSP (tem
))
293 doc
= get_doc_string (tem
);
297 else if (STRINGP (fun
) || VECTORP (fun
))
299 return build_string ("Keyboard macro.");
301 else if (CONSP (fun
))
304 if (!SYMBOLP (funcar
))
305 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
306 else if (EQ (funcar
, Qkeymap
))
307 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
309 else if (EQ (funcar
, Qlambda
)
310 || EQ (funcar
, Qautoload
))
313 tem1
= Fcdr (Fcdr (fun
));
317 /* Handle a doc reference--but these never come last
318 in the function body, so reject them if they are last. */
319 else if ((NATNUMP (tem
) || CONSP (tem
))
320 && ! NILP (XCONS (tem1
)->cdr
))
321 doc
= get_doc_string (tem
);
325 else if (EQ (funcar
, Qmocklisp
))
327 else if (EQ (funcar
, Qmacro
))
328 return Fdocumentation (Fcdr (fun
), raw
);
335 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
343 doc
= Fsubstitute_command_keys (doc
);
349 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
350 "Return the documentation string that is SYMBOL's PROP property.\n\
351 This is like `get', but it can refer to strings stored in the\n\
352 `etc/DOC' file; and if the value is a string, it is passed through\n\
353 `substitute-command-keys'. A non-nil third argument avoids this\n\
356 Lisp_Object sym
, prop
, raw
;
358 register Lisp_Object tem
;
360 tem
= Fget (sym
, prop
);
362 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
363 else if (CONSP (tem
))
364 tem
= get_doc_string (tem
);
365 if (NILP (raw
) && STRINGP (tem
))
366 return Fsubstitute_command_keys (tem
);
370 /* Scanning the DOC files and placing docstring offsets into functions. */
373 store_function_docstring (fun
, offset
)
375 /* Use EMACS_INT because we get this from pointer subtraction. */
378 fun
= indirect_function (fun
);
380 /* The type determines where the docstring is stored. */
382 /* Lisp_Subrs have a slot for it. */
384 XSUBR (fun
)->doc
= (char *) - offset
;
386 /* If it's a lisp form, stick it in the form. */
387 else if (CONSP (fun
))
391 tem
= XCONS (fun
)->car
;
392 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
394 tem
= Fcdr (Fcdr (fun
));
395 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
396 XSETFASTINT (XCONS (tem
)->car
, offset
);
398 else if (EQ (tem
, Qmacro
))
399 store_function_docstring (XCONS (fun
)->cdr
, offset
);
402 /* Bytecode objects sometimes have slots for it. */
403 else if (COMPILEDP (fun
))
405 /* This bytecode object must have a slot for the
406 docstring, since we've found a docstring for it. */
407 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
408 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
413 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
415 "Used during Emacs initialization, before dumping runnable Emacs,\n\
416 to find pointers to doc strings stored in `etc/DOC...' and\n\
417 record them in function definitions.\n\
418 One arg, FILENAME, a string which does not include a directory.\n\
419 The file is found in `../etc' now; found in the `data-directory'\n\
420 when doc strings are referred to later in the dumped Emacs.")
422 Lisp_Object filename
;
428 register char *p
, *end
;
429 Lisp_Object sym
, fun
, tem
;
431 extern char *index ();
434 if (NILP (Vpurify_flag
))
435 error ("Snarf-documentation can only be called in an undumped Emacs");
438 CHECK_STRING (filename
, 0);
441 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
442 strcpy (name
, "../etc/");
443 #else /* CANNOT_DUMP */
444 CHECK_STRING (Vdoc_directory
, 0);
445 name
= (char *) alloca (XSTRING (filename
)->size
+
446 XSTRING (Vdoc_directory
)->size
+ 1);
447 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
448 #endif /* CANNOT_DUMP */
449 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
452 /* For VMS versions with limited file name syntax,
453 convert the name to something VMS will allow. */
461 #endif /* not VMS4_4 */
463 strcpy (name
, sys_translate_unix (name
));
467 fd
= open (name
, O_RDONLY
, 0);
469 report_file_error ("Opening doc string file",
470 Fcons (build_string (name
), Qnil
));
471 Vdoc_file_name
= filename
;
477 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
483 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
484 while (p
!= end
&& *p
!= '\037') p
++;
485 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
488 end
= index (p
, '\n');
489 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
492 /* Attach a docstring to a variable? */
495 /* Install file-position as variable-documentation property
496 and make it negative for a user-variable
497 (doc starts with a `*'). */
498 Fput (sym
, Qvariable_documentation
,
499 make_number ((pos
+ end
+ 1 - buf
)
500 * (end
[1] == '*' ? -1 : 1)));
503 /* Attach a docstring to a function? */
504 else if (p
[1] == 'F')
505 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
508 error ("DOC file invalid at position %d", pos
);
513 bcopy (end
, buf
, filled
);
519 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
520 Ssubstitute_command_keys
, 1, 1, 0,
521 "Substitute key descriptions for command names in STRING.\n\
522 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
523 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
524 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
525 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
526 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
527 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
528 as the keymap for future \\=\\[COMMAND] substrings.\n\
529 \\=\\= quotes the following character and is discarded;\n\
530 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
536 register unsigned char *strp
;
537 register unsigned char *bufp
;
543 unsigned char *start
;
546 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
551 CHECK_STRING (str
, 0);
555 GCPRO4 (str
, tem
, keymap
, name
);
557 /* KEYMAP is either nil (which means search all the active keymaps)
558 or a specified local map (which means search just that and the
559 global map). If non-nil, it might come from Voverriding_local_map,
560 or from a \\<mapname> construct in STR itself.. */
561 keymap
= current_kboard
->Voverriding_terminal_local_map
;
563 keymap
= Voverriding_local_map
;
565 bsize
= XSTRING (str
)->size
;
566 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
568 strp
= (unsigned char *) XSTRING (str
)->data
;
569 while (strp
< (unsigned char *) XSTRING (str
)->data
+ XSTRING (str
)->size
)
571 if (strp
[0] == '\\' && strp
[1] == '=')
573 /* \= quotes the next character;
574 thus, to put in \[ without its special meaning, use \=\[. */
579 else if (strp
[0] == '\\' && strp
[1] == '[')
581 Lisp_Object firstkey
;
584 strp
+= 2; /* skip \[ */
587 while ((strp
- (unsigned char *) XSTRING (str
)->data
588 < XSTRING (str
)->size
)
591 length
= strp
- start
;
594 /* Save STRP in IDX. */
595 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
596 tem
= Fintern (make_string (start
, length
), Qnil
);
597 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
599 /* Disregard menu bar bindings; it is positively annoying to
600 mention them when there's no menu bar, and it isn't terribly
601 useful even when there is a menu bar. */
604 firstkey
= Faref (tem
, make_number (0));
605 if (EQ (firstkey
, Qmenu_bar
))
609 if (NILP (tem
)) /* but not on any keys */
611 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
614 bcopy ("M-x ", bufp
, 4);
619 { /* function is on a key */
620 tem
= Fkey_description (tem
);
624 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
625 \<foo> just sets the keymap used for \[cmd]. */
626 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
628 struct buffer
*oldbuf
;
631 strp
+= 2; /* skip \{ or \< */
634 while ((strp
- (unsigned char *) XSTRING (str
)->data
635 < XSTRING (str
)->size
)
636 && *strp
!= '}' && *strp
!= '>')
638 length
= strp
- start
;
639 strp
++; /* skip } or > */
641 /* Save STRP in IDX. */
642 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
644 /* Get the value of the keymap in TEM, or nil if undefined.
645 Do this while still in the user's current buffer
646 in case it is a local variable. */
647 name
= Fintern (make_string (start
, length
), Qnil
);
648 tem
= Fboundp (name
);
651 tem
= Fsymbol_value (name
);
653 tem
= get_keymap_1 (tem
, 0, 1);
656 /* Now switch to a temp buffer. */
657 oldbuf
= current_buffer
;
658 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
662 name
= Fsymbol_name (name
);
663 insert_string ("\nUses keymap \"");
664 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
665 insert_string ("\", which is not currently defined.\n");
666 if (start
[-1] == '<') keymap
= Qnil
;
668 else if (start
[-1] == '<')
671 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0);
672 tem
= Fbuffer_string ();
674 set_buffer_internal (oldbuf
);
677 start
= XSTRING (tem
)->data
;
678 length
= XSTRING (tem
)->size
;
680 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
683 bcopy (start
, bufp
, length
);
685 /* Check STR again in case gc relocated it. */
686 strp
= (unsigned char *) XSTRING (str
)->data
+ idx
;
688 else /* just copy other chars */
692 if (changed
) /* don't bother if nothing substituted */
693 tem
= make_string (buf
, bufp
- buf
);
697 RETURN_UNGCPRO (tem
);
702 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
703 "Name of file containing documentation strings of built-in symbols.");
704 Vdoc_file_name
= Qnil
;
706 defsubr (&Sdocumentation
);
707 defsubr (&Sdocumentation_property
);
708 defsubr (&Ssnarf_documentation
);
709 defsubr (&Ssubstitute_command_keys
);