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 /* Extract a doc string from a file. FILEPOS says where to get it.
79 If it is an integer, use that position in the standard DOC-... file.
80 If it is (FILE . INTEGER), use FILE as the file name
81 and INTEGER as the position in that file.
82 But if INTEGER is negative, make it positive.
83 (A negative integer is used for user variables, so we can distinguish
84 them without actually fetching the doc string.) */
87 get_doc_string (filepos
)
93 register char *p
, *p1
;
96 Lisp_Object file
, tem
;
98 if (INTEGERP (filepos
))
100 file
= Vdoc_file_name
;
101 position
= XINT (filepos
);
103 else if (CONSP (filepos
))
105 file
= XCONS (filepos
)->car
;
106 position
= XINT (XCONS (filepos
)->cdr
);
108 position
= - position
;
113 if (!STRINGP (Vdoc_directory
))
119 /* Put the file name in NAME as a C string.
120 If it is relative, combine it with Vdoc_directory. */
122 tem
= Ffile_name_absolute_p (file
);
125 minsize
= XSTRING (Vdoc_directory
)->size
;
126 /* sizeof ("../etc/") == 8 */
129 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
130 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
131 strcat (name
, XSTRING (file
)->data
);
132 munge_doc_file_name (name
);
136 name
= (char *) XSTRING (file
)->data
;
139 fd
= open (name
, O_RDONLY
, 0);
143 if (!NILP (Vpurify_flag
))
145 /* Preparing to dump; DOC file is probably not installed.
146 So check in ../etc. */
147 strcpy (name
, "../etc/");
148 strcat (name
, XSTRING (file
)->data
);
149 munge_doc_file_name (name
);
151 fd
= open (name
, O_RDONLY
, 0);
155 error ("Cannot open doc string file \"%s\"", name
);
158 /* Seek only to beginning of disk block. */
159 offset
= position
% (8 * 1024);
160 if (0 > lseek (fd
, position
- offset
, 0))
163 error ("Position %ld out of range in doc string file \"%s\"",
167 /* Read the doc string into get_doc_string_buffer.
168 P points beyond the data just read. */
170 p
= get_doc_string_buffer
;
173 int space_left
= (get_doc_string_buffer_size
174 - (p
- get_doc_string_buffer
));
177 /* Allocate or grow the buffer if we need to. */
180 int in_buffer
= p
- get_doc_string_buffer
;
181 get_doc_string_buffer_size
+= 16 * 1024;
182 get_doc_string_buffer
183 = (char *) xrealloc (get_doc_string_buffer
,
184 get_doc_string_buffer_size
+ 1);
185 p
= get_doc_string_buffer
+ in_buffer
;
186 space_left
= (get_doc_string_buffer_size
187 - (p
- get_doc_string_buffer
));
190 /* Read a disk block at a time.
191 If we read the same block last time, maybe skip this? */
192 if (space_left
> 1024 * 8)
193 space_left
= 1024 * 8;
194 nread
= read (fd
, p
, space_left
);
198 error ("Read error on documentation file");
203 if (p
== get_doc_string_buffer
)
204 p1
= index (p
+ offset
, '\037');
206 p1
= index (p
, '\037');
217 /* Scan the text and perform quoting with ^A (char code 1).
218 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
219 from
= get_doc_string_buffer
+ offset
;
220 to
= get_doc_string_buffer
+ offset
;
236 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
242 return make_string (get_doc_string_buffer
+ offset
,
243 to
- (get_doc_string_buffer
+ offset
));
246 /* Get a string from position FILEPOS and pass it through the Lisp reader.
247 We use this for fetching the bytecode string and constants vector
248 of a compiled function from the .elc file. */
251 read_doc_string (filepos
)
254 return Fread (get_doc_string (filepos
));
257 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
258 "Return the documentation string of FUNCTION.\n\
259 Unless a non-nil second argument RAW is given, the\n\
260 string is passed through `substitute-command-keys'.")
262 Lisp_Object function
, raw
;
266 Lisp_Object tem
, doc
;
268 fun
= Findirect_function (function
);
272 if (XSUBR (fun
)->doc
== 0) return Qnil
;
273 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
274 doc
= build_string (XSUBR (fun
)->doc
);
276 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
278 else if (COMPILEDP (fun
))
280 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
282 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
285 else if (NATNUMP (tem
) || CONSP (tem
))
286 doc
= get_doc_string (tem
);
290 else if (STRINGP (fun
) || VECTORP (fun
))
292 return build_string ("Keyboard macro.");
294 else if (CONSP (fun
))
297 if (!SYMBOLP (funcar
))
298 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
299 else if (EQ (funcar
, Qkeymap
))
300 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
302 else if (EQ (funcar
, Qlambda
)
303 || EQ (funcar
, Qautoload
))
306 tem1
= Fcdr (Fcdr (fun
));
310 /* Handle a doc reference--but these never come last
311 in the function body, so reject them if they are last. */
312 else if ((NATNUMP (tem
) || CONSP (tem
))
313 && ! NILP (XCONS (tem1
)->cdr
))
314 doc
= get_doc_string (tem
);
318 else if (EQ (funcar
, Qmocklisp
))
320 else if (EQ (funcar
, Qmacro
))
321 return Fdocumentation (Fcdr (fun
), raw
);
328 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
336 doc
= Fsubstitute_command_keys (doc
);
342 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
343 "Return the documentation string that is SYMBOL's PROP property.\n\
344 This is like `get', but it can refer to strings stored in the\n\
345 `etc/DOC' file; and if the value is a string, it is passed through\n\
346 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
349 Lisp_Object symbol
, prop
, raw
;
351 register Lisp_Object tem
;
353 tem
= Fget (symbol
, prop
);
355 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
356 else if (CONSP (tem
))
357 tem
= get_doc_string (tem
);
358 if (NILP (raw
) && STRINGP (tem
))
359 return Fsubstitute_command_keys (tem
);
363 /* Scanning the DOC files and placing docstring offsets into functions. */
366 store_function_docstring (fun
, offset
)
368 /* Use EMACS_INT because we get this from pointer subtraction. */
371 fun
= indirect_function (fun
);
373 /* The type determines where the docstring is stored. */
375 /* Lisp_Subrs have a slot for it. */
377 XSUBR (fun
)->doc
= (char *) - offset
;
379 /* If it's a lisp form, stick it in the form. */
380 else if (CONSP (fun
))
384 tem
= XCONS (fun
)->car
;
385 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
387 tem
= Fcdr (Fcdr (fun
));
388 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
389 XSETFASTINT (XCONS (tem
)->car
, offset
);
391 else if (EQ (tem
, Qmacro
))
392 store_function_docstring (XCONS (fun
)->cdr
, offset
);
395 /* Bytecode objects sometimes have slots for it. */
396 else if (COMPILEDP (fun
))
398 /* This bytecode object must have a slot for the
399 docstring, since we've found a docstring for it. */
400 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
401 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
406 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
408 "Used during Emacs initialization, before dumping runnable Emacs,\n\
409 to find pointers to doc strings stored in `etc/DOC...' and\n\
410 record them in function definitions.\n\
411 One arg, FILENAME, a string which does not include a directory.\n\
412 The file is found in `../etc' now; found in the `data-directory'\n\
413 when doc strings are referred to later in the dumped Emacs.")
415 Lisp_Object filename
;
421 register char *p
, *end
;
422 Lisp_Object sym
, fun
, tem
;
424 extern char *index ();
427 if (NILP (Vpurify_flag
))
428 error ("Snarf-documentation can only be called in an undumped Emacs");
431 CHECK_STRING (filename
, 0);
434 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
435 strcpy (name
, "../etc/");
436 #else /* CANNOT_DUMP */
437 CHECK_STRING (Vdoc_directory
, 0);
438 name
= (char *) alloca (XSTRING (filename
)->size
+
439 XSTRING (Vdoc_directory
)->size
+ 1);
440 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
441 #endif /* CANNOT_DUMP */
442 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
445 /* For VMS versions with limited file name syntax,
446 convert the name to something VMS will allow. */
454 #endif /* not VMS4_4 */
456 strcpy (name
, sys_translate_unix (name
));
460 fd
= open (name
, O_RDONLY
, 0);
462 report_file_error ("Opening doc string file",
463 Fcons (build_string (name
), Qnil
));
464 Vdoc_file_name
= filename
;
470 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
476 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
477 while (p
!= end
&& *p
!= '\037') p
++;
478 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
481 end
= index (p
, '\n');
482 sym
= oblookup (Vobarray
, p
+ 2,
483 multibyte_chars_in_text (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
;
539 int length
, length_byte
;
541 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
548 CHECK_STRING (string
, 0);
552 GCPRO4 (string
, tem
, keymap
, name
);
554 multibyte
= STRING_MULTIBYTE (string
);
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 STRING itself.. */
561 keymap
= current_kboard
->Voverriding_terminal_local_map
;
563 keymap
= Voverriding_local_map
;
565 bsize
= STRING_BYTES (XSTRING (string
));
566 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
568 strp
= (unsigned char *) XSTRING (string
)->data
;
569 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
571 if (strp
[0] == '\\' && strp
[1] == '=')
573 /* \= quotes the next character;
574 thus, to put in \[ without its special meaning, use \=\[. */
580 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
582 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
586 bcopy (strp
, bufp
, len
);
592 *bufp
++ = *strp
++, nchars
++;
594 else if (strp
[0] == '\\' && strp
[1] == '[')
596 Lisp_Object firstkey
;
599 strp
+= 2; /* skip \[ */
602 while ((strp
- (unsigned char *) XSTRING (string
)->data
603 < STRING_BYTES (XSTRING (string
)))
606 length_byte
= strp
- start
;
610 /* Save STRP in IDX. */
611 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
612 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
613 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
615 /* Disregard menu bar bindings; it is positively annoying to
616 mention them when there's no menu bar, and it isn't terribly
617 useful even when there is a menu bar. */
620 firstkey
= Faref (tem
, make_number (0));
621 if (EQ (firstkey
, Qmenu_bar
))
625 if (NILP (tem
)) /* but not on any keys */
627 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
630 bcopy ("M-x ", bufp
, 4);
634 length
= multibyte_chars_in_text (start
, length_byte
);
636 length
= length_byte
;
640 { /* function is on a key */
641 tem
= Fkey_description (tem
);
645 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
646 \<foo> just sets the keymap used for \[cmd]. */
647 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
649 struct buffer
*oldbuf
;
652 strp
+= 2; /* skip \{ or \< */
655 while ((strp
- (unsigned char *) XSTRING (string
)->data
656 < XSTRING (string
)->size
)
657 && *strp
!= '}' && *strp
!= '>')
660 length_byte
= strp
- start
;
661 strp
++; /* skip } or > */
663 /* Save STRP in IDX. */
664 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
666 /* Get the value of the keymap in TEM, or nil if undefined.
667 Do this while still in the user's current buffer
668 in case it is a local variable. */
669 name
= Fintern (make_string (start
, length_byte
), Qnil
);
670 tem
= Fboundp (name
);
673 tem
= Fsymbol_value (name
);
675 tem
= get_keymap_1 (tem
, 0, 1);
678 /* Now switch to a temp buffer. */
679 oldbuf
= current_buffer
;
680 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
684 name
= Fsymbol_name (name
);
685 insert_string ("\nUses keymap \"");
686 insert_from_string (name
, 0, 0,
687 XSTRING (name
)->size
,
688 STRING_BYTES (XSTRING (name
)), 1);
689 insert_string ("\", which is not currently defined.\n");
690 if (start
[-1] == '<') keymap
= Qnil
;
692 else if (start
[-1] == '<')
695 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
696 tem
= Fbuffer_string ();
698 set_buffer_internal (oldbuf
);
701 start
= XSTRING (tem
)->data
;
702 length
= XSTRING (tem
)->size
;
703 length_byte
= STRING_BYTES (XSTRING (tem
));
705 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
708 bcopy (start
, bufp
, length_byte
);
711 /* Check STRING again in case gc relocated it. */
712 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
714 else if (! multibyte
) /* just copy other chars */
715 *bufp
++ = *strp
++, nchars
++;
719 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
721 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
725 bcopy (strp
, bufp
, len
);
732 if (changed
) /* don't bother if nothing substituted */
733 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
737 RETURN_UNGCPRO (tem
);
742 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
743 "Name of file containing documentation strings of built-in symbols.");
744 Vdoc_file_name
= Qnil
;
746 defsubr (&Sdocumentation
);
747 defsubr (&Sdocumentation_property
);
748 defsubr (&Ssnarf_documentation
);
749 defsubr (&Ssubstitute_command_keys
);