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
))
312 tem
= Fcar (Fcdr (Fcdr (fun
)));
315 else if (NATNUMP (tem
) || CONSP (tem
))
316 doc
= get_doc_string (tem
);
320 else if (EQ (funcar
, Qmocklisp
))
322 else if (EQ (funcar
, Qmacro
))
323 return Fdocumentation (Fcdr (fun
), raw
);
330 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
338 doc
= Fsubstitute_command_keys (doc
);
344 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
345 "Return the documentation string that is SYMBOL's PROP property.\n\
346 This is like `get', but it can refer to strings stored in the\n\
347 `etc/DOC' file; and if the value is a string, it is passed through\n\
348 `substitute-command-keys'. A non-nil third argument avoids this\n\
351 Lisp_Object sym
, prop
, raw
;
353 register Lisp_Object tem
;
355 tem
= Fget (sym
, prop
);
357 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
358 else if (CONSP (tem
))
359 tem
= get_doc_string (tem
);
360 if (NILP (raw
) && STRINGP (tem
))
361 return Fsubstitute_command_keys (tem
);
365 /* Scanning the DOC files and placing docstring offsets into functions. */
368 store_function_docstring (fun
, offset
)
370 /* Use EMACS_INT because we get this from pointer subtraction. */
373 fun
= indirect_function (fun
);
375 /* The type determines where the docstring is stored. */
377 /* Lisp_Subrs have a slot for it. */
379 XSUBR (fun
)->doc
= (char *) - offset
;
381 /* If it's a lisp form, stick it in the form. */
382 else if (CONSP (fun
))
386 tem
= XCONS (fun
)->car
;
387 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
389 tem
= Fcdr (Fcdr (fun
));
390 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
391 XSETFASTINT (XCONS (tem
)->car
, offset
);
393 else if (EQ (tem
, Qmacro
))
394 store_function_docstring (XCONS (fun
)->cdr
, offset
);
397 /* Bytecode objects sometimes have slots for it. */
398 else if (COMPILEDP (fun
))
400 /* This bytecode object must have a slot for the
401 docstring, since we've found a docstring for it. */
402 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
403 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
408 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
410 "Used during Emacs initialization, before dumping runnable Emacs,\n\
411 to find pointers to doc strings stored in `etc/DOC...' and\n\
412 record them in function definitions.\n\
413 One arg, FILENAME, a string which does not include a directory.\n\
414 The file is found in `../etc' now; found in the `data-directory'\n\
415 when doc strings are referred to later in the dumped Emacs.")
417 Lisp_Object filename
;
423 register char *p
, *end
;
424 Lisp_Object sym
, fun
, tem
;
426 extern char *index ();
429 if (NILP (Vpurify_flag
))
430 error ("Snarf-documentation can only be called in an undumped Emacs");
433 CHECK_STRING (filename
, 0);
436 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
437 strcpy (name
, "../etc/");
438 #else /* CANNOT_DUMP */
439 CHECK_STRING (Vdoc_directory
, 0);
440 name
= (char *) alloca (XSTRING (filename
)->size
+
441 XSTRING (Vdoc_directory
)->size
+ 1);
442 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
443 #endif /* CANNOT_DUMP */
444 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
447 /* For VMS versions with limited file name syntax,
448 convert the name to something VMS will allow. */
456 #endif /* not VMS4_4 */
458 strcpy (name
, sys_translate_unix (name
));
462 fd
= open (name
, O_RDONLY
, 0);
464 report_file_error ("Opening doc string file",
465 Fcons (build_string (name
), Qnil
));
466 Vdoc_file_name
= filename
;
472 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
478 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
479 while (p
!= end
&& *p
!= '\037') p
++;
480 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
483 end
= index (p
, '\n');
484 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
487 /* Attach a docstring to a variable? */
490 /* Install file-position as variable-documentation property
491 and make it negative for a user-variable
492 (doc starts with a `*'). */
493 Fput (sym
, Qvariable_documentation
,
494 make_number ((pos
+ end
+ 1 - buf
)
495 * (end
[1] == '*' ? -1 : 1)));
498 /* Attach a docstring to a function? */
499 else if (p
[1] == 'F')
500 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
503 error ("DOC file invalid at position %d", pos
);
508 bcopy (end
, buf
, filled
);
514 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
515 Ssubstitute_command_keys
, 1, 1, 0,
516 "Substitute key descriptions for command names in STRING.\n\
517 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
518 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
519 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
520 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
521 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
522 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
523 as the keymap for future \\=\\[COMMAND] substrings.\n\
524 \\=\\= quotes the following character and is discarded;\n\
525 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
531 register unsigned char *strp
;
532 register unsigned char *bufp
;
538 unsigned char *start
;
541 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
546 CHECK_STRING (str
, 0);
550 GCPRO4 (str
, tem
, keymap
, name
);
552 /* KEYMAP is either nil (which means search all the active keymaps)
553 or a specified local map (which means search just that and the
554 global map). If non-nil, it might come from Voverriding_local_map,
555 or from a \\<mapname> construct in STR itself.. */
556 keymap
= current_kboard
->Voverriding_terminal_local_map
;
558 keymap
= Voverriding_local_map
;
560 bsize
= XSTRING (str
)->size
;
561 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
563 strp
= (unsigned char *) XSTRING (str
)->data
;
564 while (strp
< (unsigned char *) XSTRING (str
)->data
+ XSTRING (str
)->size
)
566 if (strp
[0] == '\\' && strp
[1] == '=')
568 /* \= quotes the next character;
569 thus, to put in \[ without its special meaning, use \=\[. */
574 else if (strp
[0] == '\\' && strp
[1] == '[')
576 Lisp_Object firstkey
;
579 strp
+= 2; /* skip \[ */
582 while ((strp
- (unsigned char *) XSTRING (str
)->data
583 < XSTRING (str
)->size
)
586 length
= strp
- start
;
589 /* Save STRP in IDX. */
590 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
591 tem
= Fintern (make_string (start
, length
), Qnil
);
592 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
594 /* Disregard menu bar bindings; it is positively annoying to
595 mention them when there's no menu bar, and it isn't terribly
596 useful even when there is a menu bar. */
599 firstkey
= Faref (tem
, make_number (0));
600 if (EQ (firstkey
, Qmenu_bar
))
604 if (NILP (tem
)) /* but not on any keys */
606 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
609 bcopy ("M-x ", bufp
, 4);
614 { /* function is on a key */
615 tem
= Fkey_description (tem
);
619 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
620 \<foo> just sets the keymap used for \[cmd]. */
621 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
623 struct buffer
*oldbuf
;
626 strp
+= 2; /* skip \{ or \< */
629 while ((strp
- (unsigned char *) XSTRING (str
)->data
630 < XSTRING (str
)->size
)
631 && *strp
!= '}' && *strp
!= '>')
633 length
= strp
- start
;
634 strp
++; /* skip } or > */
636 /* Save STRP in IDX. */
637 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
639 /* Get the value of the keymap in TEM, or nil if undefined.
640 Do this while still in the user's current buffer
641 in case it is a local variable. */
642 name
= Fintern (make_string (start
, length
), Qnil
);
643 tem
= Fboundp (name
);
646 tem
= Fsymbol_value (name
);
648 tem
= get_keymap_1 (tem
, 0, 1);
651 /* Now switch to a temp buffer. */
652 oldbuf
= current_buffer
;
653 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
657 name
= Fsymbol_name (name
);
658 insert_string ("\nUses keymap \"");
659 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
660 insert_string ("\", which is not currently defined.\n");
661 if (start
[-1] == '<') keymap
= Qnil
;
663 else if (start
[-1] == '<')
666 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1);
667 tem
= Fbuffer_string ();
669 set_buffer_internal (oldbuf
);
672 start
= XSTRING (tem
)->data
;
673 length
= XSTRING (tem
)->size
;
675 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
678 bcopy (start
, bufp
, length
);
680 /* Check STR again in case gc relocated it. */
681 strp
= (unsigned char *) XSTRING (str
)->data
+ idx
;
683 else /* just copy other chars */
687 if (changed
) /* don't bother if nothing substituted */
688 tem
= make_string (buf
, bufp
- buf
);
692 RETURN_UNGCPRO (tem
);
697 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
698 "Name of file containing documentation strings of built-in symbols.");
699 Vdoc_file_name
= Qnil
;
701 defsubr (&Sdocumentation
);
702 defsubr (&Sdocumentation_property
);
703 defsubr (&Ssnarf_documentation
);
704 defsubr (&Ssubstitute_command_keys
);