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.)
86 If UNIBYTE is nonzero, always return the result as a unibyte string. */
89 get_doc_string (filepos
, unibyte
)
96 register char *p
, *p1
;
99 Lisp_Object file
, tem
;
101 if (INTEGERP (filepos
))
103 file
= Vdoc_file_name
;
104 position
= XINT (filepos
);
106 else if (CONSP (filepos
))
108 file
= XCONS (filepos
)->car
;
109 position
= XINT (XCONS (filepos
)->cdr
);
111 position
= - position
;
116 if (!STRINGP (Vdoc_directory
))
122 /* Put the file name in NAME as a C string.
123 If it is relative, combine it with Vdoc_directory. */
125 tem
= Ffile_name_absolute_p (file
);
128 minsize
= XSTRING (Vdoc_directory
)->size
;
129 /* sizeof ("../etc/") == 8 */
132 name
= (char *) alloca (minsize
+ XSTRING (file
)->size
+ 8);
133 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
134 strcat (name
, XSTRING (file
)->data
);
135 munge_doc_file_name (name
);
139 name
= (char *) XSTRING (file
)->data
;
142 fd
= open (name
, O_RDONLY
, 0);
146 if (!NILP (Vpurify_flag
))
148 /* Preparing to dump; DOC file is probably not installed.
149 So check in ../etc. */
150 strcpy (name
, "../etc/");
151 strcat (name
, XSTRING (file
)->data
);
152 munge_doc_file_name (name
);
154 fd
= open (name
, O_RDONLY
, 0);
158 error ("Cannot open doc string file \"%s\"", name
);
161 /* Seek only to beginning of disk block. */
162 offset
= position
% (8 * 1024);
163 if (0 > lseek (fd
, position
- offset
, 0))
166 error ("Position %ld out of range in doc string file \"%s\"",
170 /* Read the doc string into get_doc_string_buffer.
171 P points beyond the data just read. */
173 p
= get_doc_string_buffer
;
176 int space_left
= (get_doc_string_buffer_size
177 - (p
- get_doc_string_buffer
));
180 /* Allocate or grow the buffer if we need to. */
183 int in_buffer
= p
- get_doc_string_buffer
;
184 get_doc_string_buffer_size
+= 16 * 1024;
185 get_doc_string_buffer
186 = (char *) xrealloc (get_doc_string_buffer
,
187 get_doc_string_buffer_size
+ 1);
188 p
= get_doc_string_buffer
+ in_buffer
;
189 space_left
= (get_doc_string_buffer_size
190 - (p
- get_doc_string_buffer
));
193 /* Read a disk block at a time.
194 If we read the same block last time, maybe skip this? */
195 if (space_left
> 1024 * 8)
196 space_left
= 1024 * 8;
197 nread
= read (fd
, p
, space_left
);
201 error ("Read error on documentation file");
206 if (p
== get_doc_string_buffer
)
207 p1
= index (p
+ offset
, '\037');
209 p1
= index (p
, '\037');
220 /* Scan the text and perform quoting with ^A (char code 1).
221 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
222 from
= get_doc_string_buffer
+ offset
;
223 to
= get_doc_string_buffer
+ offset
;
239 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
246 return make_unibyte_string (get_doc_string_buffer
+ offset
,
247 to
- (get_doc_string_buffer
+ offset
));
249 return make_string (get_doc_string_buffer
+ offset
,
250 to
- (get_doc_string_buffer
+ offset
));
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
, 1));
264 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
265 "Return the documentation string of FUNCTION.\n\
266 Unless a non-nil second argument RAW 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
), 0);
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
, 1);
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
, 1);
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 RAW avoids this\n\
356 Lisp_Object symbol
, prop
, raw
;
358 register Lisp_Object tem
;
360 tem
= Fget (symbol
, prop
);
362 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)), 0);
363 else if (CONSP (tem
))
364 tem
= get_doc_string (tem
, 0);
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,
490 multibyte_chars_in_text (p
+ 2, end
- p
- 2),
494 /* Attach a docstring to a variable? */
497 /* Install file-position as variable-documentation property
498 and make it negative for a user-variable
499 (doc starts with a `*'). */
500 Fput (sym
, Qvariable_documentation
,
501 make_number ((pos
+ end
+ 1 - buf
)
502 * (end
[1] == '*' ? -1 : 1)));
505 /* Attach a docstring to a function? */
506 else if (p
[1] == 'F')
507 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
510 error ("DOC file invalid at position %d", pos
);
515 bcopy (end
, buf
, filled
);
521 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
522 Ssubstitute_command_keys
, 1, 1, 0,
523 "Substitute key descriptions for command names in STRING.\n\
524 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
525 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
526 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
527 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
528 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
529 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
530 as the keymap for future \\=\\[COMMAND] substrings.\n\
531 \\=\\= quotes the following character and is discarded;\n\
532 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
538 register unsigned char *strp
;
539 register unsigned char *bufp
;
545 unsigned char *start
;
546 int length
, length_byte
;
548 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
555 CHECK_STRING (string
, 0);
559 GCPRO4 (string
, tem
, keymap
, name
);
561 multibyte
= STRING_MULTIBYTE (string
);
564 /* KEYMAP is either nil (which means search all the active keymaps)
565 or a specified local map (which means search just that and the
566 global map). If non-nil, it might come from Voverriding_local_map,
567 or from a \\<mapname> construct in STRING itself.. */
568 keymap
= current_kboard
->Voverriding_terminal_local_map
;
570 keymap
= Voverriding_local_map
;
572 bsize
= STRING_BYTES (XSTRING (string
));
573 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
575 strp
= (unsigned char *) XSTRING (string
)->data
;
576 while (strp
< XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)))
578 if (strp
[0] == '\\' && strp
[1] == '=')
580 /* \= quotes the next character;
581 thus, to put in \[ without its special meaning, use \=\[. */
587 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
589 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
593 bcopy (strp
, bufp
, len
);
599 *bufp
++ = *strp
++, nchars
++;
601 else if (strp
[0] == '\\' && strp
[1] == '[')
603 Lisp_Object firstkey
;
606 strp
+= 2; /* skip \[ */
609 while ((strp
- (unsigned char *) XSTRING (string
)->data
610 < STRING_BYTES (XSTRING (string
)))
613 length_byte
= strp
- start
;
617 /* Save STRP in IDX. */
618 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
619 tem
= Fintern (make_string (start
, length_byte
), Qnil
);
620 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
622 /* Disregard menu bar bindings; it is positively annoying to
623 mention them when there's no menu bar, and it isn't terribly
624 useful even when there is a menu bar. */
627 firstkey
= Faref (tem
, make_number (0));
628 if (EQ (firstkey
, Qmenu_bar
))
632 if (NILP (tem
)) /* but not on any keys */
634 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
637 bcopy ("M-x ", bufp
, 4);
641 length
= multibyte_chars_in_text (start
, length_byte
);
643 length
= length_byte
;
647 { /* function is on a key */
648 tem
= Fkey_description (tem
);
652 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
653 \<foo> just sets the keymap used for \[cmd]. */
654 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
656 struct buffer
*oldbuf
;
659 strp
+= 2; /* skip \{ or \< */
662 while ((strp
- (unsigned char *) XSTRING (string
)->data
663 < XSTRING (string
)->size
)
664 && *strp
!= '}' && *strp
!= '>')
667 length_byte
= strp
- start
;
668 strp
++; /* skip } or > */
670 /* Save STRP in IDX. */
671 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
673 /* Get the value of the keymap in TEM, or nil if undefined.
674 Do this while still in the user's current buffer
675 in case it is a local variable. */
676 name
= Fintern (make_string (start
, length_byte
), Qnil
);
677 tem
= Fboundp (name
);
680 tem
= Fsymbol_value (name
);
682 tem
= get_keymap_1 (tem
, 0, 1);
685 /* Now switch to a temp buffer. */
686 oldbuf
= current_buffer
;
687 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
691 name
= Fsymbol_name (name
);
692 insert_string ("\nUses keymap \"");
693 insert_from_string (name
, 0, 0,
694 XSTRING (name
)->size
,
695 STRING_BYTES (XSTRING (name
)), 1);
696 insert_string ("\", which is not currently defined.\n");
697 if (start
[-1] == '<') keymap
= Qnil
;
699 else if (start
[-1] == '<')
702 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0, 0);
703 tem
= Fbuffer_string ();
705 set_buffer_internal (oldbuf
);
708 start
= XSTRING (tem
)->data
;
709 length
= XSTRING (tem
)->size
;
710 length_byte
= STRING_BYTES (XSTRING (tem
));
712 new = (unsigned char *) xrealloc (buf
, bsize
+= length_byte
);
715 bcopy (start
, bufp
, length_byte
);
718 /* Check STRING again in case gc relocated it. */
719 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
721 else if (! multibyte
) /* just copy other chars */
722 *bufp
++ = *strp
++, nchars
++;
726 int maxlen
= XSTRING (string
)->data
+ STRING_BYTES (XSTRING (string
)) - strp
;
728 STRING_CHAR_AND_LENGTH (strp
, maxlen
, len
);
732 bcopy (strp
, bufp
, len
);
739 if (changed
) /* don't bother if nothing substituted */
740 tem
= make_string_from_bytes (buf
, nchars
, bufp
- buf
);
744 RETURN_UNGCPRO (tem
);
750 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
751 "Name of file containing documentation strings of built-in symbols.");
752 Vdoc_file_name
= Qnil
;
754 defsubr (&Sdocumentation
);
755 defsubr (&Sdocumentation_property
);
756 defsubr (&Ssnarf_documentation
);
757 defsubr (&Ssubstitute_command_keys
);