1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 1986, 1993 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
23 #include <sys/types.h>
24 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
38 Lisp_Object Vdoc_file_name
;
40 extern Lisp_Object Voverriding_local_map
;
43 get_doc_string (filepos
)
46 char buf
[512 * 32 + 1];
49 register char *p
, *p1
;
51 extern char *index ();
53 if (XTYPE (Vdoc_directory
) != Lisp_String
54 || XTYPE (Vdoc_file_name
) != Lisp_String
)
57 name
= (char *) alloca (XSTRING (Vdoc_directory
)->size
58 + XSTRING (Vdoc_file_name
)->size
+ 8);
59 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
60 strcat (name
, XSTRING (Vdoc_file_name
)->data
);
63 /* For VMS versions with limited file name syntax,
64 convert the name to something VMS will allow. */
72 #endif /* not VMS4_4 */
74 strcpy (name
, sys_translate_unix (name
));
78 fd
= open (name
, O_RDONLY
, 0);
80 error ("Cannot open doc string file \"%s\"", name
);
81 if (0 > lseek (fd
, filepos
, 0))
84 error ("Position %ld out of range in doc string file \"%s\"",
88 while (p
!= buf
+ sizeof buf
- 1)
90 count
= read (fd
, p
, 512);
94 p1
= index (p
, '\037');
104 return make_string (buf
, p
- buf
);
107 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 2, 0,
108 "Return the documentation string of FUNCTION.\n\
109 Unless a non-nil second argument is given, the\n\
110 string is passed through `substitute-command-keys'.")
112 Lisp_Object function
, raw
;
116 Lisp_Object tem
, doc
;
118 fun
= Findirect_function (function
);
123 if (XSUBR (fun
)->doc
== 0) return Qnil
;
124 if ((int) XSUBR (fun
)->doc
>= 0)
125 doc
= build_string (XSUBR (fun
)->doc
);
127 doc
= get_doc_string (- (int) XSUBR (fun
)->doc
);
131 if (XVECTOR (fun
)->size
<= COMPILED_DOC_STRING
)
133 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
134 if (XTYPE (tem
) == Lisp_String
)
136 else if (XTYPE (tem
) == Lisp_Int
&& XINT (tem
) >= 0)
137 doc
= get_doc_string (XFASTINT (tem
));
144 return build_string ("Keyboard macro.");
148 if (XTYPE (funcar
) != Lisp_Symbol
)
149 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
150 else if (EQ (funcar
, Qkeymap
))
151 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
153 else if (EQ (funcar
, Qlambda
)
154 || EQ (funcar
, Qautoload
))
156 tem
= Fcar (Fcdr (Fcdr (fun
)));
157 if (XTYPE (tem
) == Lisp_String
)
159 else if (XTYPE (tem
) == Lisp_Int
&& XINT (tem
) >= 0)
160 doc
= get_doc_string (XFASTINT (tem
));
166 else if (EQ (funcar
, Qmocklisp
))
168 else if (EQ (funcar
, Qmacro
))
169 return Fdocumentation (Fcdr (fun
), raw
);
171 /* Fall through to the default to report an error. */
174 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
182 doc
= Fsubstitute_command_keys (doc
);
188 DEFUN ("documentation-property", Fdocumentation_property
, Sdocumentation_property
, 2, 3, 0,
189 "Return the documentation string that is SYMBOL's PROP property.\n\
190 This is like `get', but it can refer to strings stored in the\n\
191 `etc/DOC' file; and if the value is a string, it is passed through\n\
192 `substitute-command-keys'. A non-nil third argument avoids this\n\
195 Lisp_Object sym
, prop
, raw
;
197 register Lisp_Object tem
;
199 tem
= Fget (sym
, prop
);
200 if (XTYPE (tem
) == Lisp_Int
)
201 tem
= get_doc_string (XINT (tem
) > 0 ? XINT (tem
) : - XINT (tem
));
202 if (NILP (raw
) && XTYPE (tem
) == Lisp_String
)
203 return Fsubstitute_command_keys (tem
);
207 /* Scanning the DOC files and placing docstring offsets into functions. */
210 store_function_docstring (fun
, offset
)
214 fun
= indirect_function (fun
);
216 /* The type determines where the docstring is stored. */
218 /* Lisp_Subrs have a slot for it. */
219 if (XTYPE (fun
) == Lisp_Subr
)
220 XSUBR (fun
)->doc
= (char *) - offset
;
222 /* If it's a lisp form, stick it in the form. */
223 else if (CONSP (fun
))
227 tem
= XCONS (fun
)->car
;
228 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
230 tem
= Fcdr (Fcdr (fun
));
232 XTYPE (XCONS (tem
)->car
) == Lisp_Int
)
233 XFASTINT (XCONS (tem
)->car
) = offset
;
235 else if (EQ (tem
, Qmacro
))
236 store_function_docstring (XCONS (fun
)->cdr
, offset
);
239 /* Bytecode objects sometimes have slots for it. */
240 else if (XTYPE (fun
) == Lisp_Compiled
)
242 /* This bytecode object must have a slot for the
243 docstring, since we've found a docstring for it. */
244 if (XVECTOR (fun
)->size
<= COMPILED_DOC_STRING
)
247 XFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
]) = offset
;
252 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
254 "Used during Emacs initialization, before dumping runnable Emacs,\n\
255 to find pointers to doc strings stored in `etc/DOC...' and\n\
256 record them in function definitions.\n\
257 One arg, FILENAME, a string which does not include a directory.\n\
258 The file is found in `../etc' now; found in the `data-directory'\n\
259 when doc strings are referred to later in the dumped Emacs.")
261 Lisp_Object filename
;
267 register char *p
, *end
;
268 Lisp_Object sym
, fun
, tem
;
270 extern char *index ();
273 if (NILP (Vpurify_flag
))
274 error ("Snarf-documentation can only be called in an undumped Emacs");
277 CHECK_STRING (filename
, 0);
280 name
= (char *) alloca (XSTRING (filename
)->size
+ 14);
281 strcpy (name
, "../etc/");
282 #else /* CANNOT_DUMP */
283 CHECK_STRING (Vdoc_directory
, 0);
284 name
= (char *) alloca (XSTRING (filename
)->size
+
285 XSTRING (Vdoc_directory
)->size
+ 1);
286 strcpy (name
, XSTRING (Vdoc_directory
)->data
);
287 #endif /* CANNOT_DUMP */
288 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
291 /* For VMS versions with limited file name syntax,
292 convert the name to something VMS will allow. */
300 #endif /* not VMS4_4 */
302 strcpy (name
, sys_translate_unix (name
));
306 fd
= open (name
, O_RDONLY
, 0);
308 report_file_error ("Opening doc string file",
309 Fcons (build_string (name
), Qnil
));
310 Vdoc_file_name
= filename
;
316 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
322 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
323 while (p
!= end
&& *p
!= '\037') p
++;
324 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
327 end
= index (p
, '\n');
328 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
329 if (XTYPE (sym
) == Lisp_Symbol
)
331 /* Attach a docstring to a variable? */
334 /* Install file-position as variable-documentation property
335 and make it negative for a user-variable
336 (doc starts with a `*'). */
337 Fput (sym
, Qvariable_documentation
,
338 make_number ((pos
+ end
+ 1 - buf
)
339 * (end
[1] == '*' ? -1 : 1)));
342 /* Attach a docstring to a function? */
343 else if (p
[1] == 'F')
344 store_function_docstring (sym
, pos
+ end
+ 1 - buf
);
347 error ("DOC file invalid at position %d", pos
);
352 bcopy (end
, buf
, filled
);
358 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
359 Ssubstitute_command_keys
, 1, 1, 0,
360 "Substitute key descriptions for command names in STRING.\n\
361 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
362 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
363 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
364 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
365 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
366 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
367 as the keymap for future \\=\\[COMMAND] substrings.\n\
368 \\=\\= quotes the following character and is discarded;\n\
369 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
375 register unsigned char *strp
;
376 register unsigned char *bufp
;
382 unsigned char *start
;
385 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
390 CHECK_STRING (str
, 0);
394 GCPRO4 (str
, tem
, keymap
, name
);
396 /* KEYMAP is either nil (which means search all the active keymaps)
397 or a specified local map (which means search just that and the
398 global map). If non-nil, it might come from Voverriding_local_map,
399 or from a \\<mapname> construct in STR itself.. */
400 keymap
= Voverriding_local_map
;
402 bsize
= XSTRING (str
)->size
;
403 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
405 strp
= (unsigned char *) XSTRING (str
)->data
;
406 while (strp
< (unsigned char *) XSTRING (str
)->data
+ XSTRING (str
)->size
)
408 if (strp
[0] == '\\' && strp
[1] == '=')
410 /* \= quotes the next character;
411 thus, to put in \[ without its special meaning, use \=\[. */
416 else if (strp
[0] == '\\' && strp
[1] == '[')
418 Lisp_Object firstkey
;
421 strp
+= 2; /* skip \[ */
424 while ((strp
- (unsigned char *) XSTRING (str
)->data
425 < XSTRING (str
)->size
)
428 length
= strp
- start
;
431 /* Save STRP in IDX. */
432 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
433 tem
= Fintern (make_string (start
, length
), Qnil
);
434 tem
= Fwhere_is_internal (tem
, keymap
, Qt
, Qnil
);
436 /* Disregard menu bar bindings; it is positively annoying to
437 mention them when there's no menu bar, and it isn't terribly
438 useful even when there is a menu bar. */
441 firstkey
= Faref (tem
, make_number (0));
442 if (EQ (firstkey
, Qmenu_bar
))
446 if (NILP (tem
)) /* but not on any keys */
448 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
451 bcopy ("M-x ", bufp
, 4);
456 { /* function is on a key */
457 tem
= Fkey_description (tem
);
461 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
462 \<foo> just sets the keymap used for \[cmd]. */
463 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
465 struct buffer
*oldbuf
;
468 strp
+= 2; /* skip \{ or \< */
471 while ((strp
- (unsigned char *) XSTRING (str
)->data
472 < XSTRING (str
)->size
)
473 && *strp
!= '}' && *strp
!= '>')
475 length
= strp
- start
;
476 strp
++; /* skip } or > */
478 /* Save STRP in IDX. */
479 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
481 /* Get the value of the keymap in TEM, or nil if undefined.
482 Do this while still in the user's current buffer
483 in case it is a local variable. */
484 name
= Fintern (make_string (start
, length
), Qnil
);
485 tem
= Fboundp (name
);
488 tem
= Fsymbol_value (name
);
490 tem
= get_keymap_1 (tem
, 0, 1);
493 /* Now switch to a temp buffer. */
494 oldbuf
= current_buffer
;
495 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
499 name
= Fsymbol_name (name
);
500 insert_string ("\nUses keymap \"");
501 insert_from_string (name
, 0, XSTRING (name
)->size
, 1);
502 insert_string ("\", which is not currently defined.\n");
503 if (start
[-1] == '<') keymap
= Qnil
;
505 else if (start
[-1] == '<')
508 describe_map_tree (tem
, 1, Qnil
, Qnil
, 0, 1);
509 tem
= Fbuffer_string ();
511 set_buffer_internal (oldbuf
);
514 start
= XSTRING (tem
)->data
;
515 length
= XSTRING (tem
)->size
;
517 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
520 bcopy (start
, bufp
, length
);
522 /* Check STR again in case gc relocated it. */
523 strp
= (unsigned char *) XSTRING (str
)->data
+ idx
;
525 else /* just copy other chars */
529 if (changed
) /* don't bother if nothing substituted */
530 tem
= make_string (buf
, bufp
- buf
);
534 RETURN_UNGCPRO (tem
);
539 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
540 "Name of file containing documentation strings of built-in symbols.");
541 Vdoc_file_name
= Qnil
;
543 defsubr (&Sdocumentation
);
544 defsubr (&Sdocumentation_property
);
545 defsubr (&Ssnarf_documentation
);
546 defsubr (&Ssubstitute_command_keys
);