1 /* Record indices of function doc strings stored in a file.
2 Copyright (C) 1985, 1986 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
;
41 get_doc_string (filepos
)
44 char buf
[512 * 32 + 1];
47 register char *p
, *p1
;
49 extern char *index ();
51 if (XTYPE (Vexec_directory
) != Lisp_String
52 || XTYPE (Vdoc_file_name
) != Lisp_String
)
55 name
= (char *) alloca (XSTRING (Vexec_directory
)->size
56 + XSTRING (Vdoc_file_name
)->size
+ 8);
57 strcpy (name
, XSTRING (Vexec_directory
)->data
);
58 strcat (name
, XSTRING (Vdoc_file_name
)->data
);
61 /* For VMS versions with limited file name syntax,
62 convert the name to something VMS will allow. */
70 #endif /* not VMS4_4 */
72 strcpy (name
, sys_translate_unix (name
));
76 fd
= open (name
, O_RDONLY
, 0);
78 error ("Cannot open doc string file \"%s\"", name
);
79 if (0 > lseek (fd
, filepos
, 0))
82 error ("Position %ld out of range in doc string file \"%s\"",
86 while (p
!= buf
+ sizeof buf
- 1)
88 count
= read (fd
, p
, 512);
92 p1
= index (p
, '\037');
102 return make_string (buf
, p
- buf
);
105 DEFUN ("documentation", Fdocumentation
, Sdocumentation
, 1, 1, 0,
106 "Return the documentation string of FUNCTION.")
115 while (XTYPE (fun
) == Lisp_Symbol
)
118 fun
= Fsymbol_function (fun
);
124 if (XSUBR (fun
)->doc
== 0) return Qnil
;
125 if ((int) XSUBR (fun
)->doc
>= 0)
126 return Fsubstitute_command_keys (build_string (XSUBR (fun
)->doc
));
129 Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun
)->doc
));
132 if (XVECTOR (fun
)->size
<= COMPILED_DOC_STRING
)
134 tem
= XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
];
135 if (XTYPE (tem
) == Lisp_String
)
136 return Fsubstitute_command_keys (tem
);
137 if (XTYPE (tem
) == Lisp_Int
&& XINT (tem
) >= 0)
138 return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem
)));
143 return build_string ("Keyboard macro.");
147 if (XTYPE (funcar
) != Lisp_Symbol
)
148 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
149 if (XSYMBOL (funcar
) == XSYMBOL (Qkeymap
))
150 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
152 if (XSYMBOL (funcar
) == XSYMBOL (Qlambda
)
153 || XSYMBOL (funcar
) == XSYMBOL (Qautoload
))
155 tem
= Fcar (Fcdr (Fcdr (fun
)));
156 if (XTYPE (tem
) == Lisp_String
)
157 return Fsubstitute_command_keys (tem
);
158 if (XTYPE (tem
) == Lisp_Int
&& XINT (tem
) >= 0)
159 return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem
)));
162 if (XSYMBOL (funcar
) == XSYMBOL (Qmocklisp
))
164 if (XSYMBOL (funcar
) == XSYMBOL (Qmacro
))
165 return Fdocumentation (Fcdr (fun
));
167 /* Fall through to the default to report an error. */
170 return Fsignal (Qinvalid_function
, Fcons (fun
, Qnil
));
174 DEFUN ("documentation-property", Fdocumentation_property
,
175 Sdocumentation_property
, 2, 2, 0,
176 "Return the documentation string that is SYMBOL's PROP property.\n\
177 This differs from using `get' only in that it can refer to strings\n\
178 stored in the `etc/DOC' file.")
180 Lisp_Object sym
, prop
;
182 register Lisp_Object tem
;
184 tem
= Fget (sym
, prop
);
185 if (XTYPE (tem
) == Lisp_Int
)
186 tem
= get_doc_string (XINT (tem
) > 0 ? XINT (tem
) : - XINT (tem
));
187 if (XTYPE (tem
) == Lisp_String
)
188 return Fsubstitute_command_keys (tem
);
192 DEFUN ("Snarf-documentation", Fsnarf_documentation
, Ssnarf_documentation
,
194 "Used during Emacs initialization, before dumping runnable Emacs,\n\
195 to find pointers to doc strings stored in `etc/DOC...' and\n\
196 record them in function definitions.\n\
197 One arg, FILENAME, a string which does not include a directory.\n\
198 The file is found in `../etc' now; found in the `exec-directory'\n\
199 when doc strings are referred to later in the dumped Emacs.")
201 Lisp_Object filename
;
207 register char *p
, *end
;
208 Lisp_Object sym
, fun
, tem
;
210 extern char *index ();
212 CHECK_STRING (filename
, 0);
215 name
= (char *) alloca (XSTRING (filename
)->size
+ 8);
216 strcpy (name
, "../etc/");
217 #else /* CANNOT_DUMP */
218 CHECK_STRING (Vexec_directory
, 0);
219 name
= (char *) alloca (XSTRING (filename
)->size
+
220 XSTRING (Vexec_directory
)->size
+ 1);
221 strcpy (name
, XSTRING (Vexec_directory
)->data
);
222 #endif /* CANNOT_DUMP */
223 strcat (name
, XSTRING (filename
)->data
); /*** Add this line ***/
226 /* For VMS versions with limited file name syntax,
227 convert the name to something VMS will allow. */
235 #endif /* not VMS4_4 */
237 strcpy (name
, sys_translate_unix (name
));
241 fd
= open (name
, O_RDONLY
, 0);
243 report_file_error ("Opening doc string file",
244 Fcons (build_string (name
), Qnil
));
245 Vdoc_file_name
= filename
;
251 filled
+= read (fd
, &buf
[filled
], sizeof buf
- 1 - filled
);
257 end
= buf
+ (filled
< 512 ? filled
: filled
- 128);
258 while (p
!= end
&& *p
!= '\037') p
++;
259 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
262 end
= index (p
, '\n');
263 sym
= oblookup (Vobarray
, p
+ 2, end
- p
- 2);
264 if (XTYPE (sym
) == Lisp_Symbol
)
266 /* Attach a docstring to a variable? */
269 /* Install file-position as variable-documentation property
270 and make it negative for a user-variable
271 (doc starts with a `*'). */
272 Fput (sym
, Qvariable_documentation
,
273 make_number ((pos
+ end
+ 1 - buf
)
274 * (end
[1] == '*' ? -1 : 1)));
277 /* Attach a docstring to a function? The type determines where
278 the docstring is stored. */
279 else if (p
[1] == 'F')
281 fun
= XSYMBOL (sym
)->function
;
283 /* Lisp_Subrs have a slot for it. */
284 if (XTYPE (fun
) == Lisp_Subr
)
285 XSUBR (fun
)->doc
= (char *) - (pos
+ end
+ 1 - buf
);
287 /* If it's a lisp form, stick it in the form. */
288 else if (CONSP (fun
))
290 tem
= XCONS (fun
)->car
;
291 if (EQ (tem
, Qlambda
) || EQ (tem
, Qautoload
))
293 tem
= Fcdr (Fcdr (fun
));
295 XTYPE (XCONS (tem
)->car
) == Lisp_Int
)
296 XFASTINT (XCONS (tem
)->car
) = (pos
+ end
+ 1 - buf
);
300 /* Bytecode objects sometimes have slots for it. */
301 else if (XTYPE (fun
) == Lisp_Compiled
)
303 /* This bytecode object must have a slot for the
304 docstring, since we've found a docstring for it. */
305 if (XVECTOR (fun
)->size
<= COMPILED_DOC_STRING
)
308 XFASTINT (XVECTOR (fun
)->contents
[COMPILED_DOC_STRING
])
309 = pos
+ end
+ 1 - buf
;
312 else error ("DOC file invalid at position %d", pos
);
317 bcopy (end
, buf
, filled
);
323 DEFUN ("substitute-command-keys", Fsubstitute_command_keys
,
324 Ssubstitute_command_keys
, 1, 1, 0,
325 "Substitute key descriptions for command names in STRING.\n\
326 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
327 replaced by either: a keystroke sequence that will invoke COMMAND,\n\
328 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
329 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
330 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
331 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
332 as the keymap for future \\=\\[COMMAND] substrings.\n\
333 \\=\\= quotes the following character and is discarded;\n\
334 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
340 register unsigned char *strp
;
341 register unsigned char *bufp
;
345 register Lisp_Object tem
;
347 unsigned char *start
;
354 CHECK_STRING (str
, 0);
357 keymap
= current_buffer
->keymap
;
359 bsize
= XSTRING (str
)->size
;
360 bufp
= buf
= (unsigned char *) xmalloc (bsize
);
362 strp
= (unsigned char *) XSTRING (str
)->data
;
363 while (strp
< (unsigned char *) XSTRING (str
)->data
+ XSTRING (str
)->size
)
365 if (strp
[0] == '\\' && strp
[1] == '=')
367 /* \= quotes the next character;
368 thus, to put in \[ without its special meaning, use \=\[. */
373 else if (strp
[0] == '\\' && strp
[1] == '[')
376 strp
+= 2; /* skip \[ */
379 while ((strp
- (unsigned char *) XSTRING (str
)->data
380 < XSTRING (str
)->size
)
383 length
= strp
- start
;
386 /* Save STRP in IDX. */
387 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
388 tem
= Fintern (make_string (start
, length
), Qnil
);
389 tem
= Fwhere_is_internal (tem
, keymap
, Qnil
, Qt
, Qnil
);
391 if (NULL (tem
)) /* but not on any keys */
393 new = (unsigned char *) xrealloc (buf
, bsize
+= 4);
396 bcopy ("M-x ", bufp
, 4);
401 { /* function is on a key */
402 tem
= Fkey_description (tem
);
406 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
407 \<foo> just sets the keymap used for \[cmd]. */
408 else if (strp
[0] == '\\' && (strp
[1] == '{' || strp
[1] == '<'))
410 struct buffer
*oldbuf
;
414 strp
+= 2; /* skip \{ or \< */
417 while ((strp
- (unsigned char *) XSTRING (str
)->data
418 < XSTRING (str
)->size
)
419 && *strp
!= '}' && *strp
!= '>')
421 length
= strp
- start
;
422 strp
++; /* skip } or > */
424 /* Save STRP in IDX. */
425 idx
= strp
- (unsigned char *) XSTRING (str
)->data
;
427 /* Get the value of the keymap in TEM, or nil if undefined.
428 Do this while still in the user's current buffer
429 in case it is a local variable. */
430 name
= Fintern (make_string (start
, length
), Qnil
);
431 tem
= Fboundp (name
);
434 tem
= Fsymbol_value (name
);
436 tem
= get_keymap_1 (tem
, 0);
439 /* Now switch to a temp buffer. */
440 oldbuf
= current_buffer
;
441 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer
));
445 name
= Fsymbol_name (name
);
446 insert_string ("\nUses keymap \"");
447 insert_from_string (name
, 0, XSTRING (name
)->size
);
448 insert_string ("\", which is not currently defined.\n");
449 if (start
[-1] == '<') keymap
= Qnil
;
451 else if (start
[-1] == '<')
454 describe_map_tree (tem
, 1, Qnil
);
455 tem
= Fbuffer_string ();
457 set_buffer_internal (oldbuf
);
460 start
= XSTRING (tem
)->data
;
461 length
= XSTRING (tem
)->size
;
463 new = (unsigned char *) xrealloc (buf
, bsize
+= length
);
466 bcopy (start
, bufp
, length
);
468 /* Check STR again in case gc relocated it. */
469 strp
= (unsigned char *) XSTRING (str
)->data
+ idx
;
471 else /* just copy other chars */
475 if (changed
) /* don't bother if nothing substituted */
476 tem
= make_string (buf
, bufp
- buf
);
486 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name
,
487 "Name of file containing documentation strings of built-in symbols.");
488 Vdoc_file_name
= Qnil
;
490 defsubr (&Sdocumentation
);
491 defsubr (&Sdocumentation_property
);
492 defsubr (&Ssnarf_documentation
);
493 defsubr (&Ssubstitute_command_keys
);