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
)
86 static int buffer_size
;
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);
153 error ("Cannot open doc string file \"%s\"", name
);
156 /* Seek only to beginning of disk block. */
157 offset
= position
% (8 * 1024);
158 if (0 > lseek (fd
, position
- offset
, 0))
161 error ("Position %ld out of range in doc string file \"%s\"",
165 /* Read the doc string into a buffer.
166 p points beyond the data just read. */
171 int space_left
= buffer_size
- (p
- buffer
);
174 /* Allocate or grow the buffer if we need to. */
177 int in_buffer
= p
- buffer
;
178 buffer_size
+= 16 * 1024;
179 buffer
= (char *) xrealloc (buffer
, buffer_size
+ 1);
180 p
= buffer
+ in_buffer
;
181 space_left
= buffer_size
- (p
- buffer
);
184 /* Read a disk block at a time.
185 If we read the same block last time, maybe skip this? */
186 if (space_left
> 1024 * 8)
187 space_left
= 1024 * 8;
188 nread
= read (fd
, p
, space_left
);
192 error ("Read error on documentation file");
198 p1
= index (p
+ offset
, '\037');
200 p1
= index (p
, '\037');
211 /* Scan the text and perform quoting with ^A (char code 1).
212 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
213 from
= buffer
+ offset
;
214 to
= buffer
+ offset
;
230 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
236 return make_string (buffer
+ offset
, to
- (buffer
+ offset
));
239 /* Get a string from position FILEPOS and pass it through the Lisp reader.
240 We use this for fetching the bytecode string and constants vector
241 of a compiled function from the .elc file. */
244 read_doc_string (filepos
)
247 return Fread (get_doc_string (filepos
));
250 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
251 "Return the documentation string of FUNCTION.\n\
252 Unless a non-nil second argument RAW is given, the\n\
253 string is passed through `substitute-command-keys'.")
255 Lisp_Object function
, raw
;
259 Lisp_Object tem
, doc
;
261 fun
= Findirect_function (function
);
265 if (XSUBR (fun
)->doc
== 0) return Qnil
;
266 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
267 doc
= build_string (XSUBR (fun
)->doc
);
269 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
271 else if (COMPILEDP (fun
))
273 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
275 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
278 else if (NATNUMP (tem
) || CONSP (tem
))
279 doc
= get_doc_string (tem
);
283 else if (STRINGP (fun
) || VECTORP (fun
))
285 return build_string ("Keyboard macro.");
287 else if (CONSP (fun
))
290 if (!SYMBOLP (funcar
))
291 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
292 else if (EQ (funcar
, Qkeymap
))
293 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
295 else if (EQ (funcar
, Qlambda
)
296 || EQ (funcar
, Qautoload
))
299 tem1
= Fcdr (Fcdr (fun
));
303 /* Handle a doc reference--but these never come last
304 in the function body, so reject them if they are last. */
305 else if ((NATNUMP (tem
) || CONSP (tem
))
306 && ! NILP (XCONS (tem1
)->cdr
))
307 doc
= get_doc_string (tem
);
311 else if (EQ (funcar
, Qmocklisp
))
313 else if (EQ (funcar
, Qmacro
))
314 return Fdocumentation (Fcdr (fun
), raw
);
321 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
329 doc
= Fsubstitute_command_keys (doc
);
335 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
336 "Return the documentation string that is SYMBOL's PROP property.\n\
337 This is like `get', but it can refer to strings stored in the\n\
338 `etc/DOC' file; and if the value is a string, it is passed through\n\
339 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
342 Lisp_Object symbol
, prop
, raw
;
344 register Lisp_Object tem
;
346 tem
= Fget (symbol
, prop
);
348 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
349 else if (CONSP (tem
))
350 tem
= get_doc_string (tem
);
351 if (NILP (raw
) && STRINGP (tem
))
352 return Fsubstitute_command_keys (tem
);
356 /* Scanning the DOC files and placing docstring offsets into functions. */
359 store_function_docstring (fun
, offset
)
361 /* Use EMACS_INT because we get this from pointer subtraction. */
364 fun
= indirect_function (fun
);
366 /* The type determines where the docstring is stored. */
368 /* Lisp_Subrs have a slot for it. */
370 XSUBR (fun
)->doc
= (char *) - offset
;
372 /* If it's a lisp form, stick it in the form. */
373 else if (CONSP (fun
))
377 tem
= XCONS (fun
)->car
;
378 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
380 tem
= Fcdr (Fcdr (fun
));
381 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
382 XSETFASTINT (XCONS (tem
)->car
, offset
);
384 else if (EQ (tem
, Qmacro
))
385 store_function_docstring (XCONS (fun
)->cdr
, offset
);
388 /* Bytecode objects sometimes have slots for it. */
389 else if (COMPILEDP (fun
))
391 /* This bytecode object must have a slot for the
392 docstring, since we've found a docstring for it. */
393 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
394 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
399 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
401 "Used during Emacs initialization, before dumping runnable Emacs,\n\
402 to find pointers to doc strings stored in `etc/DOC...' and\n\
403 record them in function definitions.\n\
404 One arg, FILENAME, a string which does not include a directory.\n\
405 The file is found in `../etc' now; found in the `data-directory'\n\
406 when doc strings are referred to later in the dumped Emacs.")
408 Lisp_Object filename
;
414 register char *p
, *end
;
415 Lisp_Object sym
, fun
, tem
;
417 extern char *index ();
420 if (NILP (Vpurify_flag
))
421 error ("Snarf-documentation can only be called in an undumped Emacs");
424 CHECK_STRING (filename
, 0);
427 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
428 strcpy (name
, "../etc/");
429 #else /* CANNOT_DUMP */
430 CHECK_STRING (Vdoc_directory
, 0);
431 name
= (char *) alloca (XSTRING (filename
)->size
+
432 XSTRING (Vdoc_directory
)->size
+ 1);
433 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
434 #endif /* CANNOT_DUMP */
435 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
438 /* For VMS versions with limited file name syntax,
439 convert the name to something VMS will allow. */
447 #endif /* not VMS4_4 */
449 strcpy (name
, sys_translate_unix (name
));
453 fd
= open (name
, O_RDONLY
, 0);
455 report_file_error ("Opening doc string file",
456 Fcons (build_string (name
), Qnil
));
457 Vdoc_file_name
= filename
;
463 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
469 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
470 while (p
!= end
&& *p
!= '\037') p
++;
471 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
474 end
= index (p
, '\n');
475 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
478 /* Attach a docstring to a variable? */
481 /* Install file-position as variable-documentation property
482 and make it negative for a user-variable
483 (doc starts with a `*'). */
484 Fput (sym
, Qvariable_documentation
,
485 make_number ((pos
+ end
+ 1 - buf
)
486 * (end
[1] == '*' ? -1 : 1)));
489 /* Attach a docstring to a function? */
490 else if (p
[1] == 'F')
491 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
494 error ("DOC file invalid at position %d", pos
);
499 bcopy (end
, buf
, filled
);
505 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
506 Ssubstitute_command_keys
, 1, 1, 0,
507 "Substitute key descriptions for command names in STRING.\n\
508 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
509 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
510 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
511 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
512 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
513 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
514 as the keymap for future \\=\\[COMMAND] substrings.\n\
515 \\=\\= quotes the following character and is discarded;\n\
516 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
522 register unsigned char *strp
;
523 register unsigned char *bufp
;
529 unsigned char *start
;
532 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
537 CHECK_STRING (string
, 0);
541 GCPRO4 (string
, tem
, keymap
, name
);
543 /* KEYMAP is either nil (which means search all the active keymaps)
544 or a specified local map (which means search just that and the
545 global map). If non-nil, it might come from Voverriding_local_map,
546 or from a \\<mapname> construct in STRING itself.. */
547 keymap
= current_kboard
->Voverriding_terminal_local_map
;
549 keymap
= Voverriding_local_map
;
551 bsize
= XSTRING (string
)->size
;
552 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
554 strp
= (unsigned char *) XSTRING (string
)->data
;
555 while (strp
< (unsigned char *) XSTRING (string
)->data
+ XSTRING (string
)->size
)
557 if (strp
[0] == '\\' && strp
[1] == '=')
559 /* \= quotes the next character;
560 thus, to put in \[ without its special meaning, use \=\[. */
565 else if (strp
[0] == '\\' && strp
[1] == '[')
567 Lisp_Object firstkey
;
570 strp
+= 2; /* skip \[ */
573 while ((strp
- (unsigned char *) XSTRING (string
)->data
574 < XSTRING (string
)->size
)
577 length
= strp
- start
;
580 /* Save STRP in IDX. */
581 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
582 tem
= Fintern (make_string (start
, length
), Qnil
);
583 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
585 /* Disregard menu bar bindings; it is positively annoying to
586 mention them when there's no menu bar, and it isn't terribly
587 useful even when there is a menu bar. */
590 firstkey
= Faref (tem
, make_number (0));
591 if (EQ (firstkey
, Qmenu_bar
))
595 if (NILP (tem
)) /* but not on any keys */
597 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
600 bcopy ("M-x ", bufp
, 4);
605 { /* function is on a key */
606 tem
= Fkey_description (tem
);
610 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
611 \<foo> just sets the keymap used for \[cmd]. */
612 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
614 struct buffer
*oldbuf
;
617 strp
+= 2; /* skip \{ or \< */
620 while ((strp
- (unsigned char *) XSTRING (string
)->data
621 < XSTRING (string
)->size
)
622 && *strp
!= '}' && *strp
!= '>')
624 length
= strp
- start
;
625 strp
++; /* skip } or > */
627 /* Save STRP in IDX. */
628 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
630 /* Get the value of the keymap in TEM, or nil if undefined.
631 Do this while still in the user's current buffer
632 in case it is a local variable. */
633 name
= Fintern (make_string (start
, length
), Qnil
);
634 tem
= Fboundp (name
);
637 tem
= Fsymbol_value (name
);
639 tem
= get_keymap_1 (tem
, 0, 1);
642 /* Now switch to a temp buffer. */
643 oldbuf
= current_buffer
;
644 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
648 name
= Fsymbol_name (name
);
649 insert_string ("\nUses keymap \"");
650 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
651 insert_string ("\", which is not currently defined.\n");
652 if (start
[-1] == '<') keymap
= Qnil
;
654 else if (start
[-1] == '<')
657 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0);
658 tem
= Fbuffer_string ();
660 set_buffer_internal (oldbuf
);
663 start
= XSTRING (tem
)->data
;
664 length
= XSTRING (tem
)->size
;
666 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
669 bcopy (start
, bufp
, length
);
671 /* Check STRING again in case gc relocated it. */
672 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
674 else /* just copy other chars */
678 if (changed
) /* don't bother if nothing substituted */
679 tem
= make_string (buf
, bufp
- buf
);
683 RETURN_UNGCPRO (tem
);
688 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
689 "Name of file containing documentation strings of built-in symbols.");
690 Vdoc_file_name
= Qnil
;
692 defsubr (&Sdocumentation
);
693 defsubr (&Sdocumentation_property
);
694 defsubr (&Ssnarf_documentation
);
695 defsubr (&Ssubstitute_command_keys
);