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 /* Buffer used for reading from documentation file. */
74 static char *get_doc_string_buffer
;
75 static int get_doc_string_buffer_size
;
77 /* Extract a doc string from a file. FILEPOS says where to get it.
78 If it is an integer, use that position in the standard DOC-... file.
79 If it is (FILE . INTEGER), use FILE as the file name
80 and INTEGER as the position in that file.
81 But if INTEGER is negative, make it positive.
82 (A negative integer is used for user variables, so we can distinguish
83 them without actually fetching the doc string.) */
86 get_doc_string (filepos
)
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);
154 error ("Cannot open doc string file \"%s\"", name
);
157 /* Seek only to beginning of disk block. */
158 offset
= position
% (8 * 1024);
159 if (0 > lseek (fd
, position
- offset
, 0))
162 error ("Position %ld out of range in doc string file \"%s\"",
166 /* Read the doc string into get_doc_string_buffer.
167 P points beyond the data just read. */
169 p
= get_doc_string_buffer
;
172 int space_left
= (get_doc_string_buffer_size
173 - (p
- get_doc_string_buffer
));
176 /* Allocate or grow the buffer if we need to. */
179 int in_buffer
= p
- get_doc_string_buffer
;
180 get_doc_string_buffer_size
+= 16 * 1024;
181 get_doc_string_buffer
182 = (char *) xrealloc (get_doc_string_buffer
,
183 get_doc_string_buffer_size
+ 1);
184 p
= get_doc_string_buffer
+ in_buffer
;
185 space_left
= (get_doc_string_buffer_size
186 - (p
- get_doc_string_buffer
));
189 /* Read a disk block at a time.
190 If we read the same block last time, maybe skip this? */
191 if (space_left
> 1024 * 8)
192 space_left
= 1024 * 8;
193 nread
= read (fd
, p
, space_left
);
197 error ("Read error on documentation file");
202 if (p
== get_doc_string_buffer
)
203 p1
= index (p
+ offset
, '\037');
205 p1
= index (p
, '\037');
216 /* Scan the text and perform quoting with ^A (char code 1).
217 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
218 from
= get_doc_string_buffer
+ offset
;
219 to
= get_doc_string_buffer
+ offset
;
235 error ("Invalid data in documentation file -- ^A followed by code 0%o", c
);
241 return make_string (get_doc_string_buffer
+ offset
,
242 to
- (get_doc_string_buffer
+ offset
));
245 /* Get a string from position FILEPOS and pass it through the Lisp reader.
246 We use this for fetching the bytecode string and constants vector
247 of a compiled function from the .elc file. */
250 read_doc_string (filepos
)
253 return Fread (get_doc_string (filepos
));
256 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
257 "Return the documentation string of FUNCTION.\n\
258 Unless a non-nil second argument RAW is given, the\n\
259 string is passed through `substitute-command-keys'.")
261 Lisp_Object function
, raw
;
265 Lisp_Object tem
, doc
;
267 fun
= Findirect_function (function
);
271 if (XSUBR (fun
)->doc
== 0) return Qnil
;
272 if ((EMACS_INT
) XSUBR (fun
)->doc
>= 0)
273 doc
= build_string (XSUBR (fun
)->doc
);
275 doc
= get_doc_string (make_number (- (EMACS_INT
) XSUBR (fun
)->doc
));
277 else if (COMPILEDP (fun
))
279 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) <= COMPILED_DOC_STRING
)
281 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
284 else if (NATNUMP (tem
) || CONSP (tem
))
285 doc
= get_doc_string (tem
);
289 else if (STRINGP (fun
) || VECTORP (fun
))
291 return build_string ("Keyboard macro.");
293 else if (CONSP (fun
))
296 if (!SYMBOLP (funcar
))
297 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
298 else if (EQ (funcar
, Qkeymap
))
299 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
301 else if (EQ (funcar
, Qlambda
)
302 || EQ (funcar
, Qautoload
))
305 tem1
= Fcdr (Fcdr (fun
));
309 /* Handle a doc reference--but these never come last
310 in the function body, so reject them if they are last. */
311 else if ((NATNUMP (tem
) || CONSP (tem
))
312 && ! NILP (XCONS (tem1
)->cdr
))
313 doc
= get_doc_string (tem
);
317 else if (EQ (funcar
, Qmocklisp
))
319 else if (EQ (funcar
, Qmacro
))
320 return Fdocumentation (Fcdr (fun
), raw
);
327 Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
335 doc
= Fsubstitute_command_keys (doc
);
341 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
342 "Return the documentation string that is SYMBOL's PROP property.\n\
343 This is like `get', but it can refer to strings stored in the\n\
344 `etc/DOC' file; and if the value is a string, it is passed through\n\
345 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
348 Lisp_Object symbol
, prop
, raw
;
350 register Lisp_Object tem
;
352 tem
= Fget (symbol
, prop
);
354 tem
= get_doc_string (XINT (tem
) > 0 ? tem
: make_number (- XINT (tem
)));
355 else if (CONSP (tem
))
356 tem
= get_doc_string (tem
);
357 if (NILP (raw
) && STRINGP (tem
))
358 return Fsubstitute_command_keys (tem
);
362 /* Scanning the DOC files and placing docstring offsets into functions. */
365 store_function_docstring (fun
, offset
)
367 /* Use EMACS_INT because we get this from pointer subtraction. */
370 fun
= indirect_function (fun
);
372 /* The type determines where the docstring is stored. */
374 /* Lisp_Subrs have a slot for it. */
376 XSUBR (fun
)->doc
= (char *) - offset
;
378 /* If it's a lisp form, stick it in the form. */
379 else if (CONSP (fun
))
383 tem
= XCONS (fun
)->car
;
384 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
386 tem
= Fcdr (Fcdr (fun
));
387 if (CONSP (tem
) && INTEGERP (XCONS (tem
)->car
))
388 XSETFASTINT (XCONS (tem
)->car
, offset
);
390 else if (EQ (tem
, Qmacro
))
391 store_function_docstring (XCONS (fun
)->cdr
, offset
);
394 /* Bytecode objects sometimes have slots for it. */
395 else if (COMPILEDP (fun
))
397 /* This bytecode object must have a slot for the
398 docstring, since we've found a docstring for it. */
399 if ((XVECTOR (fun
)->size
& PSEUDOVECTOR_SIZE_MASK
) > COMPILED_DOC_STRING
)
400 XSETFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
], offset
);
405 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
407 "Used during Emacs initialization, before dumping runnable Emacs,\n\
408 to find pointers to doc strings stored in `etc/DOC...' and\n\
409 record them in function definitions.\n\
410 One arg, FILENAME, a string which does not include a directory.\n\
411 The file is found in `../etc' now; found in the `data-directory'\n\
412 when doc strings are referred to later in the dumped Emacs.")
414 Lisp_Object filename
;
420 register char *p
, *end
;
421 Lisp_Object sym
, fun
, tem
;
423 extern char *index ();
426 if (NILP (Vpurify_flag
))
427 error ("Snarf-documentation can only be called in an undumped Emacs");
430 CHECK_STRING (filename
, 0);
433 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
434 strcpy (name
, "../etc/");
435 #else /* CANNOT_DUMP */
436 CHECK_STRING (Vdoc_directory
, 0);
437 name
= (char *) alloca (XSTRING (filename
)->size
+
438 XSTRING (Vdoc_directory
)->size
+ 1);
439 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
440 #endif /* CANNOT_DUMP */
441 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
444 /* For VMS versions with limited file name syntax,
445 convert the name to something VMS will allow. */
453 #endif /* not VMS4_4 */
455 strcpy (name
, sys_translate_unix (name
));
459 fd
= open (name
, O_RDONLY
, 0);
461 report_file_error ("Opening doc string file",
462 Fcons (build_string (name
), Qnil
));
463 Vdoc_file_name
= filename
;
469 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
475 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
476 while (p
!= end
&& *p
!= '\037') p
++;
477 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
480 end
= index (p
, '\n');
481 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
484 /* Attach a docstring to a variable? */
487 /* Install file-position as variable-documentation property
488 and make it negative for a user-variable
489 (doc starts with a `*'). */
490 Fput (sym
, Qvariable_documentation
,
491 make_number ((pos
+ end
+ 1 - buf
)
492 * (end
[1] == '*' ? -1 : 1)));
495 /* Attach a docstring to a function? */
496 else if (p
[1] == 'F')
497 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
500 error ("DOC file invalid at position %d", pos
);
505 bcopy (end
, buf
, filled
);
511 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
512 Ssubstitute_command_keys
, 1, 1, 0,
513 "Substitute key descriptions for command names in STRING.\n\
514 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
515 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
516 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
517 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
518 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
519 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
520 as the keymap for future \\=\\[COMMAND] substrings.\n\
521 \\=\\= quotes the following character and is discarded;\n\
522 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
528 register unsigned char *strp
;
529 register unsigned char *bufp
;
535 unsigned char *start
;
538 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
543 CHECK_STRING (string
, 0);
547 GCPRO4 (string
, tem
, keymap
, name
);
549 /* KEYMAP is either nil (which means search all the active keymaps)
550 or a specified local map (which means search just that and the
551 global map). If non-nil, it might come from Voverriding_local_map,
552 or from a \\<mapname> construct in STRING itself.. */
553 keymap
= current_kboard
->Voverriding_terminal_local_map
;
555 keymap
= Voverriding_local_map
;
557 bsize
= XSTRING (string
)->size
;
558 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
560 strp
= (unsigned char *) XSTRING (string
)->data
;
561 while (strp
< (unsigned char *) XSTRING (string
)->data
+ XSTRING (string
)->size
)
563 if (strp
[0] == '\\' && strp
[1] == '=')
565 /* \= quotes the next character;
566 thus, to put in \[ without its special meaning, use \=\[. */
571 else if (strp
[0] == '\\' && strp
[1] == '[')
573 Lisp_Object firstkey
;
576 strp
+= 2; /* skip \[ */
579 while ((strp
- (unsigned char *) XSTRING (string
)->data
580 < XSTRING (string
)->size
)
583 length
= strp
- start
;
586 /* Save STRP in IDX. */
587 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
588 tem
= Fintern (make_string (start
, length
), Qnil
);
589 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
591 /* Disregard menu bar bindings; it is positively annoying to
592 mention them when there's no menu bar, and it isn't terribly
593 useful even when there is a menu bar. */
596 firstkey
= Faref (tem
, make_number (0));
597 if (EQ (firstkey
, Qmenu_bar
))
601 if (NILP (tem
)) /* but not on any keys */
603 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
606 bcopy ("M-x ", bufp
, 4);
611 { /* function is on a key */
612 tem
= Fkey_description (tem
);
616 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
617 \<foo> just sets the keymap used for \[cmd]. */
618 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
620 struct buffer
*oldbuf
;
623 strp
+= 2; /* skip \{ or \< */
626 while ((strp
- (unsigned char *) XSTRING (string
)->data
627 < XSTRING (string
)->size
)
628 && *strp
!= '}' && *strp
!= '>')
630 length
= strp
- start
;
631 strp
++; /* skip } or > */
633 /* Save STRP in IDX. */
634 idx
= strp
- (unsigned char *) XSTRING (string
)->data
;
636 /* Get the value of the keymap in TEM, or nil if undefined.
637 Do this while still in the user's current buffer
638 in case it is a local variable. */
639 name
= Fintern (make_string (start
, length
), Qnil
);
640 tem
= Fboundp (name
);
643 tem
= Fsymbol_value (name
);
645 tem
= get_keymap_1 (tem
, 0, 1);
648 /* Now switch to a temp buffer. */
649 oldbuf
= current_buffer
;
650 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
654 name
= Fsymbol_name (name
);
655 insert_string ("\nUses keymap \"");
656 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
657 insert_string ("\", which is not currently defined.\n");
658 if (start
[-1] == '<') keymap
= Qnil
;
660 else if (start
[-1] == '<')
663 describe_map_tree (tem
, 1, Qnil
, Qnil
, (char *)0, 1, 0);
664 tem
= Fbuffer_string ();
666 set_buffer_internal (oldbuf
);
669 start
= XSTRING (tem
)->data
;
670 length
= XSTRING (tem
)->size
;
672 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
675 bcopy (start
, bufp
, length
);
677 /* Check STRING again in case gc relocated it. */
678 strp
= (unsigned char *) XSTRING (string
)->data
+ idx
;
680 else /* just copy other chars */
684 if (changed
) /* don't bother if nothing substituted */
685 tem
= make_string (buf
, bufp
- buf
);
689 RETURN_UNGCPRO (tem
);
694 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
695 "Name of file containing documentation strings of built-in symbols.");
696 Vdoc_file_name
= Qnil
;
698 defsubr (&Sdocumentation
);
699 defsubr (&Sdocumentation_property
);
700 defsubr (&Ssnarf_documentation
);
701 defsubr (&Ssubstitute_command_keys
);