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, 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*/
43 Lisp_Object Vdoc_file_name
;
45 extern char *index ();
47 extern Lisp_Object Voverriding_local_map
;
49 /* For VMS versions with limited file name syntax,
50 convert the name to something VMS will allow. */
52 munge_doc_file_name (name
)
57 /* For VMS versions with limited file name syntax,
58 convert the name to something VMS will allow. */
66 #endif /* not VMS4_4 */
68 strcpy (name
, sys_translate_unix (name
));
73 /* Extract a doc string from a file. FILEPOS says where to get it.
74 If it is an integer, use that position in the standard DOC-... file.
75 If it is (FILE . INTEGER), use FILE as the file name
76 and INTEGER as the position in that file.
77 But if INTEGER is negative, make it positive.
78 (A negative integer is used for user variables, so we can distinguish
79 them without actually fetching the doc string.) */
82 get_doc_string (filepos
)
85 char buf
[512 * 32 + 1];
92 register char *p
, *p1
;
95 Lisp_Object file
, tem
;
97 if (INTEGERP (filepos
))
99 file
= Vdoc_file_name
;
100 position
= XINT (filepos
);
102 else if (CONSP (filepos
))
104 file
= XCONS (filepos
)->car
;
105 position
= XINT (XCONS (filepos
)->cdr
);
107 position
= - position
;
112 if (!STRINGP (Vdoc_directory
))
118 /* Put the file name in NAME as a C string.
119 If it is relative, combine it with Vdoc_directory. */
121 tem
= Ffile_name_absolute_p (file
);
124 minsize
= XSTRING (Vdoc_directory
)->size
;
125 /* sizeof ("../etc/") == 8 */
128 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
129 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
130 strcat (name
, XSTRING (file
)->data
);
131 munge_doc_file_name (name
);
135 name
= (char *) XSTRING (file
)->data
;
138 fd
= open (name
, O_RDONLY
, 0);
142 if (!NILP (Vpurify_flag
))
144 /* Preparing to dump; DOC file is probably not installed.
145 So check in ../etc. */
146 strcpy (name
, "../etc/");
147 strcat (name
, XSTRING (file
)->data
);
148 munge_doc_file_name (name
);
150 fd
= open (name
, O_RDONLY
, 0);
155 error ("Cannot open doc string file \"%s\"", name
);
158 if (0 > lseek (fd
, position
, 0))
161 error ("Position %ld out of range in doc string file \"%s\"",
165 /* Read the doc string into a buffer.
166 Use the fixed buffer BUF if it is big enough;
167 otherwise allocate one and set FREE_IT.
168 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
171 buffer_size
= sizeof buf
;
176 int space_left
= buffer_size
- (p
- buffer
);
179 /* Switch to a bigger buffer if we need one. */
184 int offset
= p
- buffer
;
185 buffer
= (char *) xrealloc (buffer
,
191 buffer
= (char *) xmalloc (buffer_size
*= 2);
192 bcopy (buf
, buffer
, p
- buf
);
193 p
= buffer
+ (p
- buf
);
196 space_left
= buffer_size
- (p
- buffer
);
199 /* Don't read too too much at one go. */
200 if (space_left
> 1024 * 8)
201 space_left
= 1024 * 8;
202 nread
= read (fd
, p
, space_left
);
206 error ("Read error on documentation file");
211 p1
= index (p
, '\037');
222 /* Scan the text and perform quoting with ^A (char code 1).
223 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
241 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
247 tem
= make_string (buffer
, to
- buffer
);
254 /* Get a string from position FILEPOS and pass it through the Lisp reader.
255 We use this for fetching the bytecode string and constants vector
256 of a compiled function from the .elc file. */
259 read_doc_string (filepos
)
262 return Fread (get_doc_string (filepos
));
265 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
266 "Return the documentation string of FUNCTION.\n\
267 Unless a non-nil second argument RAW is given, the\n\
268 string is passed through `substitute-command-keys'.")
270 Lisp_Object function
, raw
;
274 Lisp_Object tem
, doc
;
276 fun
= Findirect_function (function
);
280 if (XSUBR (fun
)->doc
== 0) return Qnil
;
281 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
282 doc
= build_string (XSUBR (fun
)->doc
);
284 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
286 else if (COMPILEDP (fun
))
288 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
290 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
293 else if (NATNUMP (tem
) || CONSP (tem
))
294 doc
= get_doc_string (tem
);
298 else if (STRINGP (fun
) || VECTORP (fun
))
300 return build_string ("Keyboard macro.");
302 else if (CONSP (fun
))
305 if (!SYMBOLP (funcar
))
306 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
307 else if (EQ (funcar
, Qkeymap
))
308 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
310 else if (EQ (funcar
, Qlambda
)
311 || EQ (funcar
, Qautoload
))
314 tem1
= Fcdr (Fcdr (fun
));
318 /* Handle a doc reference--but these never come last
319 in the function body, so reject them if they are last. */
320 else if ((NATNUMP (tem
) || CONSP (tem
))
321 && ! NILP (XCONS (tem1
)->cdr
))
322 doc
= get_doc_string (tem
);
326 else if (EQ (funcar
, Qmocklisp
))
328 else if (EQ (funcar
, Qmacro
))
329 return Fdocumentation (Fcdr (fun
), raw
);
336 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
344 doc
= Fsubstitute_command_keys (doc
);
350 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
351 "Return the documentation string that is SYMBOL's PROP property.\n\
352 This is like `get', but it can refer to strings stored in the\n\
353 `etc/DOC' file; and if the value is a string, it is passed through\n\
354 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
357 Lisp_Object symbol
, prop
, raw
;
359 register Lisp_Object tem
;
361 tem
= Fget (symbol
, prop
);
363 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
364 else if (CONSP (tem
))
365 tem
= get_doc_string (tem
);
366 if (NILP (raw
) && STRINGP (tem
))
367 return Fsubstitute_command_keys (tem
);
371 /* Scanning the DOC files and placing docstring offsets into functions. */
374 store_function_docstring (fun
, offset
)
376 /* Use EMACS_INT because we get this from pointer subtraction. */
379 fun
= indirect_function (fun
);
381 /* The type determines where the docstring is stored. */
383 /* Lisp_Subrs have a slot for it. */
385 XSUBR (fun
)->doc
= (char *) - offset
;
387 /* If it's a lisp form, stick it in the form. */
388 else if (CONSP (fun
))
392 tem
= XCONS (fun
)->car
;
393 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
395 tem
= Fcdr (Fcdr (fun
));
396 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
397 XSETFASTINT (XCONS (tem
)->car
, offset
);
399 else if (EQ (tem
, Qmacro
))
400 store_function_docstring (XCONS (fun
)->cdr
, offset
);
403 /* Bytecode objects sometimes have slots for it. */
404 else if (COMPILEDP (fun
))
406 /* This bytecode object must have a slot for the
407 docstring, since we've found a docstring for it. */
408 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
409 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
414 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
416 "Used during Emacs initialization, before dumping runnable Emacs,\n\
417 to find pointers to doc strings stored in `etc/DOC...' and\n\
418 record them in function definitions.\n\
419 One arg, FILENAME, a string which does not include a directory.\n\
420 The file is found in `../etc' now; found in the `data-directory'\n\
421 when doc strings are referred to later in the dumped Emacs.")
423 Lisp_Object filename
;
429 register char *p
, *end
;
430 Lisp_Object sym
, fun
, tem
;
432 extern char *index ();
435 if (NILP (Vpurify_flag
))
436 error ("Snarf-documentation can only be called in an undumped Emacs");
439 CHECK_STRING (filename
, 0);
442 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
443 strcpy (name
, "../etc/");
444 #else /* CANNOT_DUMP */
445 CHECK_STRING (Vdoc_directory
, 0);
446 name
= (char *) alloca (XSTRING (filename
)->size
+
447 XSTRING (Vdoc_directory
)->size
+ 1);
448 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
449 #endif /* CANNOT_DUMP */
450 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
453 /* For VMS versions with limited file name syntax,
454 convert the name to something VMS will allow. */
462 #endif /* not VMS4_4 */
464 strcpy (name
, sys_translate_unix (name
));
468 fd
= open (name
, O_RDONLY
, 0);
470 report_file_error ("Opening doc string file",
471 Fcons (build_string (name
), Qnil
));
472 Vdoc_file_name
= filename
;
478 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
484 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
485 while (p
!= end
&& *p
!= '\037') p
++;
486 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
489 end
= index (p
, '\n');
490 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
493 /* Attach a docstring to a variable? */
496 /* Install file-position as variable-documentation property
497 and make it negative for a user-variable
498 (doc starts with a `*'). */
499 Fput (sym
, Qvariable_documentation
,
500 make_number ((pos
+ end
+ 1 - buf
)
501 * (end
[1] == '*' ? -1 : 1)));
504 /* Attach a docstring to a function? */
505 else if (p
[1] == 'F')
506 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
509 error ("DOC file invalid at position %d", pos
);
514 bcopy (end
, buf
, filled
);
520 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
521 Ssubstitute_command_keys
, 1, 1, 0,
522 "Substitute key descriptions for command names in STRING.\n\
523 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
524 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
525 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
526 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
527 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
528 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
529 as the keymap for future \\=\\[COMMAND] substrings.\n\
530 \\=\\= quotes the following character and is discarded;\n\
531 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
537 register unsigned char *strp
;
538 register unsigned char *bufp
;
544 unsigned char *start
;
547 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
552 CHECK_STRING (string
, 0);
556 GCPRO4 (string
, tem
, keymap
, name
);
558 /* KEYMAP is either nil (which means search all the active keymaps)
559 or a specified local map (which means search just that and the
560 global map). If non-nil, it might come from Voverriding_local_map,
561 or from a \\<mapname> construct in STRING itself.. */
562 keymap
= current_kboard
->Voverriding_terminal_local_map
;
564 keymap
= Voverriding_local_map
;
566 bsize
= XSTRING (string
)->size
;
567 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
569 strp
= (unsigned char *) XSTRING (string
)->data
;
570 while (strp
< (unsigned char *) XSTRING (string
)->data
+ XSTRING (string
)->size
)
572 if (strp
[0] == '\\' && strp
[1] == '=')
574 /* \= quotes the next character;
575 thus, to put in \[ without its special meaning, use \=\[. */
580 else if (strp
[0] == '\\' && strp
[1] == '[')
582 Lisp_Object firstkey
;
585 strp
+= 2; /* skip \[ */
588 while ((strp
- (unsigned char *) XSTRING (string
)->data
589 < XSTRING (string
)->size
)
592 length
= strp
- start
;
595 /* Save STRP in IDX. */
596 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
597 tem
= Fintern (make_string (start
, length
), Qnil
);
598 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
600 /* Disregard menu bar bindings; it is positively annoying to
601 mention them when there's no menu bar, and it isn't terribly
602 useful even when there is a menu bar. */
605 firstkey
= Faref (tem
, make_number (0));
606 if (EQ (firstkey
, Qmenu_bar
))
610 if (NILP (tem
)) /* but not on any keys */
612 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
615 bcopy ("M-x ", bufp
, 4);
620 { /* function is on a key */
621 tem
= Fkey_description (tem
);
625 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
626 \<foo> just sets the keymap used for \[cmd]. */
627 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
629 struct buffer
*oldbuf
;
632 strp
+= 2; /* skip \{ or \< */
635 while ((strp
- (unsigned char *) XSTRING (string
)->data
636 < XSTRING (string
)->size
)
637 && *strp
!= '}' && *strp
!= '>')
639 length
= strp
- start
;
640 strp
++; /* skip } or > */
642 /* Save STRP in IDX. */
643 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
645 /* Get the value of the keymap in TEM, or nil if undefined.
646 Do this while still in the user's current buffer
647 in case it is a local variable. */
648 name
= Fintern (make_string (start
, length
), Qnil
);
649 tem
= Fboundp (name
);
652 tem
= Fsymbol_value (name
);
654 tem
= get_keymap_1 (tem
, 0, 1);
657 /* Now switch to a temp buffer. */
658 oldbuf
= current_buffer
;
659 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
663 name
= Fsymbol_name (name
);
664 insert_string ("\nUses keymap \"");
665 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
666 insert_string ("\", which is not currently defined.\n");
667 if (start
[-1] == '<') keymap
= Qnil
;
669 else if (start
[-1] == '<')
672 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0);
673 tem
= Fbuffer_string ();
675 set_buffer_internal (oldbuf
);
678 start
= XSTRING (tem
)->data
;
679 length
= XSTRING (tem
)->size
;
681 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
684 bcopy (start
, bufp
, length
);
686 /* Check STRING again in case gc relocated it. */
687 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
689 else /* just copy other chars */
693 if (changed
) /* don't bother if nothing substituted */
694 tem
= make_string (buf
, bufp
- buf
);
698 RETURN_UNGCPRO (tem
);
703 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
704 "Name of file containing documentation strings of built-in symbols.");
705 Vdoc_file_name
= Qnil
;
707 defsubr (&Sdocumentation
);
708 defsubr (&Sdocumentation_property
);
709 defsubr (&Ssnarf_documentation
);
710 defsubr (&Ssubstitute_command_keys
);