|
297
|
1 /* Record indices of function doc strings stored in a file.
|
10344
a6e8525a1a9d
(store_function_docstring, Fdocumentation): Use & PSEUDOVECTOR_SIZE_MASK on
Roland McGrath <roland@gnu.org>
diff
changeset
|
2 Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
|
|
297
|
3
|
|
|
4 This file is part of GNU Emacs.
|
|
|
5
|
|
|
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
|
10344
a6e8525a1a9d
(store_function_docstring, Fdocumentation): Use & PSEUDOVECTOR_SIZE_MASK on
Roland McGrath <roland@gnu.org>
diff
changeset
|
8 the Free Software Foundation; either version 2, or (at your option)
|
|
297
|
9 any later version.
|
|
|
10
|
|
|
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.
|
|
|
15
|
|
|
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
|
|
14186
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
19 Boston, MA 02111-1307, USA. */
|
|
297
|
20
|
|
|
21
|
|
4696
|
22 #include <config.h>
|
|
297
|
23
|
|
|
24 #include <sys/types.h>
|
|
|
25 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
|
|
|
26
|
|
|
27 #ifdef USG5
|
|
|
28 #include <fcntl.h>
|
|
|
29 #endif
|
|
|
30
|
|
6862
|
31 #ifdef HAVE_UNISTD_H
|
|
|
32 #include <unistd.h>
|
|
|
33 #endif
|
|
|
34
|
|
297
|
35 #ifndef O_RDONLY
|
|
|
36 #define O_RDONLY 0
|
|
|
37 #endif
|
|
|
38
|
|
|
39 #include "lisp.h"
|
|
|
40 #include "buffer.h"
|
|
1511
|
41 #include "keyboard.h"
|
|
297
|
42
|
|
961
|
43 Lisp_Object Vdoc_file_name;
|
|
297
|
44
|
|
10202
|
45 extern char *index ();
|
|
|
46
|
|
5784
|
47 extern Lisp_Object Voverriding_local_map;
|
|
|
48
|
|
9087
|
49 /* For VMS versions with limited file name syntax,
|
|
|
50 convert the name to something VMS will allow. */
|
|
|
51 static void
|
|
|
52 munge_doc_file_name (name)
|
|
|
53 char *name;
|
|
297
|
54 {
|
|
|
55 #ifdef VMS
|
|
|
56 #ifndef VMS4_4
|
|
|
57 /* For VMS versions with limited file name syntax,
|
|
|
58 convert the name to something VMS will allow. */
|
|
|
59 p = name;
|
|
|
60 while (*p)
|
|
|
61 {
|
|
|
62 if (*p == '-')
|
|
|
63 *p = '_';
|
|
|
64 p++;
|
|
|
65 }
|
|
|
66 #endif /* not VMS4_4 */
|
|
|
67 #ifdef VMS4_4
|
|
|
68 strcpy (name, sys_translate_unix (name));
|
|
|
69 #endif /* VMS4_4 */
|
|
|
70 #endif /* VMS */
|
|
9087
|
71 }
|
|
|
72
|
|
14648
|
73 /* Buffer used for reading from documentation file. */
|
|
|
74 static char *get_doc_string_buffer;
|
|
|
75 static int get_doc_string_buffer_size;
|
|
|
76
|
|
10202
|
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
|
|
11252
|
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.) */
|
|
10202
|
84
|
|
|
85 static Lisp_Object
|
|
9087
|
86 get_doc_string (filepos)
|
|
10202
|
87 Lisp_Object filepos;
|
|
9087
|
88 {
|
|
10202
|
89 char *from, *to;
|
|
9087
|
90 register int fd;
|
|
|
91 register char *name;
|
|
|
92 register char *p, *p1;
|
|
|
93 int minsize;
|
|
14552
|
94 int offset, position;
|
|
10202
|
95 Lisp_Object file, tem;
|
|
9087
|
96
|
|
10202
|
97 if (INTEGERP (filepos))
|
|
|
98 {
|
|
|
99 file = Vdoc_file_name;
|
|
|
100 position = XINT (filepos);
|
|
|
101 }
|
|
|
102 else if (CONSP (filepos))
|
|
|
103 {
|
|
|
104 file = XCONS (filepos)->car;
|
|
|
105 position = XINT (XCONS (filepos)->cdr);
|
|
11252
|
106 if (position < 0)
|
|
|
107 position = - position;
|
|
10202
|
108 }
|
|
|
109 else
|
|
|
110 return Qnil;
|
|
|
111
|
|
|
112 if (!STRINGP (Vdoc_directory))
|
|
9087
|
113 return Qnil;
|
|
|
114
|
|
10202
|
115 if (!STRINGP (file))
|
|
|
116 return Qnil;
|
|
|
117
|
|
|
118 /* Put the file name in NAME as a C string.
|
|
|
119 If it is relative, combine it with Vdoc_directory. */
|
|
|
120
|
|
|
121 tem = Ffile_name_absolute_p (file);
|
|
|
122 if (NILP (tem))
|
|
|
123 {
|
|
|
124 minsize = XSTRING (Vdoc_directory)->size;
|
|
|
125 /* sizeof ("../etc/") == 8 */
|
|
|
126 if (minsize < 8)
|
|
|
127 minsize = 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);
|
|
|
132 }
|
|
|
133 else
|
|
|
134 {
|
|
11446
|
135 name = (char *) XSTRING (file)->data;
|
|
10202
|
136 }
|
|
297
|
137
|
|
|
138 fd = open (name, O_RDONLY, 0);
|
|
|
139 if (fd < 0)
|
|
9087
|
140 {
|
|
|
141 #ifndef CANNOT_DUMP
|
|
|
142 if (!NILP (Vpurify_flag))
|
|
|
143 {
|
|
|
144 /* Preparing to dump; DOC file is probably not installed.
|
|
|
145 So check in ../etc. */
|
|
|
146 strcpy (name, "../etc/");
|
|
10202
|
147 strcat (name, XSTRING (file)->data);
|
|
9087
|
148 munge_doc_file_name (name);
|
|
|
149
|
|
|
150 fd = open (name, O_RDONLY, 0);
|
|
|
151 }
|
|
|
152 #endif
|
|
|
153 if (fd < 0)
|
|
|
154 error ("Cannot open doc string file \"%s\"", name);
|
|
|
155 }
|
|
|
156
|
|
14552
|
157 /* Seek only to beginning of disk block. */
|
|
|
158 offset = position % (8 * 1024);
|
|
|
159 if (0 > lseek (fd, position - offset, 0))
|
|
297
|
160 {
|
|
|
161 close (fd);
|
|
|
162 error ("Position %ld out of range in doc string file \"%s\"",
|
|
10202
|
163 position, name);
|
|
297
|
164 }
|
|
10202
|
165
|
|
14648
|
166 /* Read the doc string into get_doc_string_buffer.
|
|
|
167 P points beyond the data just read. */
|
|
10202
|
168
|
|
14648
|
169 p = get_doc_string_buffer;
|
|
10202
|
170 while (1)
|
|
297
|
171 {
|
|
14648
|
172 int space_left = (get_doc_string_buffer_size
|
|
|
173 - (p - get_doc_string_buffer));
|
|
10202
|
174 int nread;
|
|
|
175
|
|
14552
|
176 /* Allocate or grow the buffer if we need to. */
|
|
10202
|
177 if (space_left == 0)
|
|
|
178 {
|
|
14648
|
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));
|
|
10202
|
187 }
|
|
|
188
|
|
14552
|
189 /* Read a disk block at a time.
|
|
|
190 If we read the same block last time, maybe skip this? */
|
|
10202
|
191 if (space_left > 1024 * 8)
|
|
|
192 space_left = 1024 * 8;
|
|
|
193 nread = read (fd, p, space_left);
|
|
|
194 if (nread < 0)
|
|
|
195 {
|
|
|
196 close (fd);
|
|
|
197 error ("Read error on documentation file");
|
|
|
198 }
|
|
|
199 p[nread] = 0;
|
|
|
200 if (!nread)
|
|
297
|
201 break;
|
|
14648
|
202 if (p == get_doc_string_buffer)
|
|
14552
|
203 p1 = index (p + offset, '\037');
|
|
|
204 else
|
|
|
205 p1 = index (p, '\037');
|
|
297
|
206 if (p1)
|
|
|
207 {
|
|
|
208 *p1 = 0;
|
|
|
209 p = p1;
|
|
|
210 break;
|
|
|
211 }
|
|
10202
|
212 p += nread;
|
|
297
|
213 }
|
|
|
214 close (fd);
|
|
10202
|
215
|
|
|
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 ^_. */
|
|
14648
|
218 from = get_doc_string_buffer + offset;
|
|
|
219 to = get_doc_string_buffer + offset;
|
|
10202
|
220 while (from != p)
|
|
|
221 {
|
|
|
222 if (*from == 1)
|
|
|
223 {
|
|
|
224 int c;
|
|
|
225
|
|
|
226 from++;
|
|
|
227 c = *from++;
|
|
|
228 if (c == 1)
|
|
|
229 *to++ = c;
|
|
|
230 else if (c == '0')
|
|
|
231 *to++ = 0;
|
|
|
232 else if (c == '_')
|
|
|
233 *to++ = 037;
|
|
|
234 else
|
|
|
235 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
|
|
|
236 }
|
|
|
237 else
|
|
|
238 *to++ = *from++;
|
|
|
239 }
|
|
|
240
|
|
14648
|
241 return make_string (get_doc_string_buffer + offset,
|
|
|
242 to - (get_doc_string_buffer + offset));
|
|
10202
|
243 }
|
|
|
244
|
|
|
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. */
|
|
|
248
|
|
|
249 Lisp_Object
|
|
|
250 read_doc_string (filepos)
|
|
|
251 Lisp_Object filepos;
|
|
|
252 {
|
|
|
253 return Fread (get_doc_string (filepos));
|
|
297
|
254 }
|
|
|
255
|
|
570
|
256 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
|
|
604
|
257 "Return the documentation string of FUNCTION.\n\
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
258 Unless a non-nil second argument RAW is given, the\n\
|
|
570
|
259 string is passed through `substitute-command-keys'.")
|
|
647
|
260 (function, raw)
|
|
|
261 Lisp_Object function, raw;
|
|
297
|
262 {
|
|
|
263 Lisp_Object fun;
|
|
|
264 Lisp_Object funcar;
|
|
570
|
265 Lisp_Object tem, doc;
|
|
297
|
266
|
|
647
|
267 fun = Findirect_function (function);
|
|
297
|
268
|
|
10002
|
269 if (SUBRP (fun))
|
|
297
|
270 {
|
|
|
271 if (XSUBR (fun)->doc == 0) return Qnil;
|
|
8823
|
272 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
|
|
570
|
273 doc = build_string (XSUBR (fun)->doc);
|
|
297
|
274 else
|
|
10202
|
275 doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc));
|
|
10002
|
276 }
|
|
|
277 else if (COMPILEDP (fun))
|
|
|
278 {
|
|
10345
|
279 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
|
|
297
|
280 return Qnil;
|
|
|
281 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
|
|
9133
|
282 if (STRINGP (tem))
|
|
570
|
283 doc = tem;
|
|
10202
|
284 else if (NATNUMP (tem) || CONSP (tem))
|
|
|
285 doc = get_doc_string (tem);
|
|
570
|
286 else
|
|
|
287 return Qnil;
|
|
10002
|
288 }
|
|
|
289 else if (STRINGP (fun) || VECTORP (fun))
|
|
|
290 {
|
|
297
|
291 return build_string ("Keyboard macro.");
|
|
10002
|
292 }
|
|
|
293 else if (CONSP (fun))
|
|
|
294 {
|
|
297
|
295 funcar = Fcar (fun);
|
|
9133
|
296 if (!SYMBOLP (funcar))
|
|
297
|
297 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
|
|
647
|
298 else if (EQ (funcar, Qkeymap))
|
|
297
|
299 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
|
|
|
300 subcommands.)");
|
|
647
|
301 else if (EQ (funcar, Qlambda)
|
|
|
302 || EQ (funcar, Qautoload))
|
|
297
|
303 {
|
|
13521
|
304 Lisp_Object tem1;
|
|
|
305 tem1 = Fcdr (Fcdr (fun));
|
|
|
306 tem = Fcar (tem1);
|
|
9133
|
307 if (STRINGP (tem))
|
|
570
|
308 doc = tem;
|
|
13521
|
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))
|
|
10202
|
313 doc = get_doc_string (tem);
|
|
570
|
314 else
|
|
|
315 return Qnil;
|
|
297
|
316 }
|
|
647
|
317 else if (EQ (funcar, Qmocklisp))
|
|
297
|
318 return Qnil;
|
|
647
|
319 else if (EQ (funcar, Qmacro))
|
|
570
|
320 return Fdocumentation (Fcdr (fun), raw);
|
|
10002
|
321 else
|
|
|
322 goto oops;
|
|
|
323 }
|
|
|
324 else
|
|
|
325 {
|
|
|
326 oops:
|
|
|
327 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
|
|
297
|
328 }
|
|
570
|
329
|
|
577
|
330 if (NILP (raw))
|
|
1511
|
331 {
|
|
|
332 struct gcpro gcpro1;
|
|
|
333
|
|
|
334 GCPRO1 (doc);
|
|
|
335 doc = Fsubstitute_command_keys (doc);
|
|
|
336 UNGCPRO;
|
|
|
337 }
|
|
570
|
338 return doc;
|
|
297
|
339 }
|
|
|
340
|
|
5248
|
341 DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0,
|
|
297
|
342 "Return the documentation string that is SYMBOL's PROP property.\n\
|
|
570
|
343 This is like `get', but it can refer to strings stored in the\n\
|
|
604
|
344 `etc/DOC' file; and if the value is a string, it is passed through\n\
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
345 `substitute-command-keys'. A non-nil third argument RAW avoids this\n\
|
|
577
|
346 translation.")
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
347 (symbol, prop, raw)
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
348 Lisp_Object symbol, prop, raw;
|
|
297
|
349 {
|
|
|
350 register Lisp_Object tem;
|
|
|
351
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
352 tem = Fget (symbol, prop);
|
|
9133
|
353 if (INTEGERP (tem))
|
|
10202
|
354 tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)));
|
|
|
355 else if (CONSP (tem))
|
|
|
356 tem = get_doc_string (tem);
|
|
9133
|
357 if (NILP (raw) && STRINGP (tem))
|
|
312
|
358 return Fsubstitute_command_keys (tem);
|
|
|
359 return tem;
|
|
297
|
360 }
|
|
|
361
|
|
1651
|
362 /* Scanning the DOC files and placing docstring offsets into functions. */
|
|
|
363
|
|
|
364 static void
|
|
|
365 store_function_docstring (fun, offset)
|
|
|
366 Lisp_Object fun;
|
|
10330
|
367 /* Use EMACS_INT because we get this from pointer subtraction. */
|
|
|
368 EMACS_INT offset;
|
|
1651
|
369 {
|
|
|
370 fun = indirect_function (fun);
|
|
|
371
|
|
|
372 /* The type determines where the docstring is stored. */
|
|
|
373
|
|
|
374 /* Lisp_Subrs have a slot for it. */
|
|
9133
|
375 if (SUBRP (fun))
|
|
1651
|
376 XSUBR (fun)->doc = (char *) - offset;
|
|
|
377
|
|
|
378 /* If it's a lisp form, stick it in the form. */
|
|
|
379 else if (CONSP (fun))
|
|
|
380 {
|
|
|
381 Lisp_Object tem;
|
|
|
382
|
|
|
383 tem = XCONS (fun)->car;
|
|
|
384 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
|
|
|
385 {
|
|
|
386 tem = Fcdr (Fcdr (fun));
|
|
9133
|
387 if (CONSP (tem) && INTEGERP (XCONS (tem)->car))
|
|
9304
|
388 XSETFASTINT (XCONS (tem)->car, offset);
|
|
1651
|
389 }
|
|
|
390 else if (EQ (tem, Qmacro))
|
|
|
391 store_function_docstring (XCONS (fun)->cdr, offset);
|
|
|
392 }
|
|
|
393
|
|
|
394 /* Bytecode objects sometimes have slots for it. */
|
|
9133
|
395 else if (COMPILEDP (fun))
|
|
1651
|
396 {
|
|
|
397 /* This bytecode object must have a slot for the
|
|
|
398 docstring, since we've found a docstring for it. */
|
|
10345
|
399 if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
|
|
9304
|
400 XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
|
|
1651
|
401 }
|
|
|
402 }
|
|
|
403
|
|
|
404
|
|
297
|
405 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
|
|
|
406 1, 1, 0,
|
|
|
407 "Used during Emacs initialization, before dumping runnable Emacs,\n\
|
|
604
|
408 to find pointers to doc strings stored in `etc/DOC...' and\n\
|
|
297
|
409 record them in function definitions.\n\
|
|
|
410 One arg, FILENAME, a string which does not include a directory.\n\
|
|
604
|
411 The file is found in `../etc' now; found in the `data-directory'\n\
|
|
297
|
412 when doc strings are referred to later in the dumped Emacs.")
|
|
|
413 (filename)
|
|
|
414 Lisp_Object filename;
|
|
|
415 {
|
|
|
416 int fd;
|
|
|
417 char buf[1024 + 1];
|
|
|
418 register int filled;
|
|
|
419 register int pos;
|
|
|
420 register char *p, *end;
|
|
|
421 Lisp_Object sym, fun, tem;
|
|
|
422 char *name;
|
|
|
423 extern char *index ();
|
|
|
424
|
|
1116
|
425 #ifndef CANNOT_DUMP
|
|
|
426 if (NILP (Vpurify_flag))
|
|
|
427 error ("Snarf-documentation can only be called in an undumped Emacs");
|
|
|
428 #endif
|
|
|
429
|
|
297
|
430 CHECK_STRING (filename, 0);
|
|
|
431
|
|
|
432 #ifndef CANNOT_DUMP
|
|
463
|
433 name = (char *) alloca (XSTRING (filename)->size + 14);
|
|
604
|
434 strcpy (name, "../etc/");
|
|
297
|
435 #else /* CANNOT_DUMP */
|
|
6030
|
436 CHECK_STRING (Vdoc_directory, 0);
|
|
297
|
437 name = (char *) alloca (XSTRING (filename)->size +
|
|
6030
|
438 XSTRING (Vdoc_directory)->size + 1);
|
|
|
439 strcpy (name, XSTRING (Vdoc_directory)->data);
|
|
297
|
440 #endif /* CANNOT_DUMP */
|
|
|
441 strcat (name, XSTRING (filename)->data); /*** Add this line ***/
|
|
|
442 #ifdef VMS
|
|
|
443 #ifndef VMS4_4
|
|
|
444 /* For VMS versions with limited file name syntax,
|
|
|
445 convert the name to something VMS will allow. */
|
|
|
446 p = name;
|
|
|
447 while (*p)
|
|
|
448 {
|
|
|
449 if (*p == '-')
|
|
|
450 *p = '_';
|
|
|
451 p++;
|
|
|
452 }
|
|
|
453 #endif /* not VMS4_4 */
|
|
|
454 #ifdef VMS4_4
|
|
|
455 strcpy (name, sys_translate_unix (name));
|
|
|
456 #endif /* VMS4_4 */
|
|
|
457 #endif /* VMS */
|
|
|
458
|
|
|
459 fd = open (name, O_RDONLY, 0);
|
|
|
460 if (fd < 0)
|
|
|
461 report_file_error ("Opening doc string file",
|
|
|
462 Fcons (build_string (name), Qnil));
|
|
|
463 Vdoc_file_name = filename;
|
|
|
464 filled = 0;
|
|
|
465 pos = 0;
|
|
|
466 while (1)
|
|
|
467 {
|
|
|
468 if (filled < 512)
|
|
|
469 filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
|
|
|
470 if (!filled)
|
|
|
471 break;
|
|
|
472
|
|
|
473 buf[filled] = 0;
|
|
|
474 p = buf;
|
|
|
475 end = buf + (filled < 512 ? filled : filled - 128);
|
|
|
476 while (p != end && *p != '\037') p++;
|
|
|
477 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
|
|
|
478 if (p != end)
|
|
|
479 {
|
|
|
480 end = index (p, '\n');
|
|
|
481 sym = oblookup (Vobarray, p + 2, end - p - 2);
|
|
9133
|
482 if (SYMBOLP (sym))
|
|
297
|
483 {
|
|
|
484 /* Attach a docstring to a variable? */
|
|
|
485 if (p[1] == 'V')
|
|
|
486 {
|
|
|
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)));
|
|
|
493 }
|
|
|
494
|
|
1651
|
495 /* Attach a docstring to a function? */
|
|
297
|
496 else if (p[1] == 'F')
|
|
1651
|
497 store_function_docstring (sym, pos + end + 1 - buf);
|
|
297
|
498
|
|
1651
|
499 else
|
|
|
500 error ("DOC file invalid at position %d", pos);
|
|
297
|
501 }
|
|
|
502 }
|
|
|
503 pos += end - buf;
|
|
|
504 filled -= end - buf;
|
|
|
505 bcopy (end, buf, filled);
|
|
|
506 }
|
|
|
507 close (fd);
|
|
|
508 return Qnil;
|
|
|
509 }
|
|
|
510
|
|
|
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.")
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
523 (string)
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
524 Lisp_Object string;
|
|
297
|
525 {
|
|
|
526 unsigned char *buf;
|
|
|
527 int changed = 0;
|
|
|
528 register unsigned char *strp;
|
|
|
529 register unsigned char *bufp;
|
|
|
530 int idx;
|
|
|
531 int bsize;
|
|
|
532 unsigned char *new;
|
|
1511
|
533 Lisp_Object tem;
|
|
297
|
534 Lisp_Object keymap;
|
|
|
535 unsigned char *start;
|
|
|
536 int length;
|
|
1511
|
537 Lisp_Object name;
|
|
|
538 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
|
297
|
539
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
540 if (NILP (string))
|
|
297
|
541 return Qnil;
|
|
|
542
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
543 CHECK_STRING (string, 0);
|
|
1511
|
544 tem = Qnil;
|
|
|
545 keymap = Qnil;
|
|
|
546 name = Qnil;
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
547 GCPRO4 (string, tem, keymap, name);
|
|
297
|
548
|
|
5784
|
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,
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
552 or from a \\<mapname> construct in STRING itself.. */
|
|
12261
|
553 keymap = current_kboard->Voverriding_terminal_local_map;
|
|
|
554 if (NILP (keymap))
|
|
|
555 keymap = Voverriding_local_map;
|
|
297
|
556
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
557 bsize = XSTRING (string)->size;
|
|
297
|
558 bufp = buf = (unsigned char *) xmalloc (bsize);
|
|
|
559
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
560 strp = (unsigned char *) XSTRING (string)->data;
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
561 while (strp < (unsigned char *) XSTRING (string)->data + XSTRING (string)->size)
|
|
297
|
562 {
|
|
|
563 if (strp[0] == '\\' && strp[1] == '=')
|
|
|
564 {
|
|
|
565 /* \= quotes the next character;
|
|
|
566 thus, to put in \[ without its special meaning, use \=\[. */
|
|
|
567 changed = 1;
|
|
|
568 *bufp++ = strp[2];
|
|
|
569 strp += 3;
|
|
|
570 }
|
|
|
571 else if (strp[0] == '\\' && strp[1] == '[')
|
|
|
572 {
|
|
5248
|
573 Lisp_Object firstkey;
|
|
|
574
|
|
297
|
575 changed = 1;
|
|
|
576 strp += 2; /* skip \[ */
|
|
|
577 start = strp;
|
|
|
578
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
579 while ((strp - (unsigned char *) XSTRING (string)->data
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
580 < XSTRING (string)->size)
|
|
297
|
581 && *strp != ']')
|
|
|
582 strp++;
|
|
|
583 length = strp - start;
|
|
|
584 strp++; /* skip ] */
|
|
|
585
|
|
|
586 /* Save STRP in IDX. */
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
587 idx = strp - (unsigned char *) XSTRING (string)->data;
|
|
297
|
588 tem = Fintern (make_string (start, length), Qnil);
|
|
5784
|
589 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
|
|
297
|
590
|
|
5248
|
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. */
|
|
5377
|
594 if (!NILP (tem))
|
|
|
595 {
|
|
|
596 firstkey = Faref (tem, make_number (0));
|
|
|
597 if (EQ (firstkey, Qmenu_bar))
|
|
|
598 tem = Qnil;
|
|
|
599 }
|
|
5248
|
600
|
|
485
|
601 if (NILP (tem)) /* but not on any keys */
|
|
297
|
602 {
|
|
|
603 new = (unsigned char *) xrealloc (buf, bsize += 4);
|
|
|
604 bufp += new - buf;
|
|
|
605 buf = new;
|
|
|
606 bcopy ("M-x ", bufp, 4);
|
|
|
607 bufp += 4;
|
|
|
608 goto subst;
|
|
|
609 }
|
|
|
610 else
|
|
|
611 { /* function is on a key */
|
|
|
612 tem = Fkey_description (tem);
|
|
|
613 goto subst_string;
|
|
|
614 }
|
|
|
615 }
|
|
|
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] == '<'))
|
|
|
619 {
|
|
|
620 struct buffer *oldbuf;
|
|
|
621
|
|
|
622 changed = 1;
|
|
|
623 strp += 2; /* skip \{ or \< */
|
|
|
624 start = strp;
|
|
|
625
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
626 while ((strp - (unsigned char *) XSTRING (string)->data
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
627 < XSTRING (string)->size)
|
|
297
|
628 && *strp != '}' && *strp != '>')
|
|
|
629 strp++;
|
|
|
630 length = strp - start;
|
|
|
631 strp++; /* skip } or > */
|
|
|
632
|
|
|
633 /* Save STRP in IDX. */
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
634 idx = strp - (unsigned char *) XSTRING (string)->data;
|
|
297
|
635
|
|
|
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);
|
|
485
|
641 if (! NILP (tem))
|
|
297
|
642 {
|
|
|
643 tem = Fsymbol_value (name);
|
|
485
|
644 if (! NILP (tem))
|
|
1511
|
645 tem = get_keymap_1 (tem, 0, 1);
|
|
297
|
646 }
|
|
|
647
|
|
|
648 /* Now switch to a temp buffer. */
|
|
|
649 oldbuf = current_buffer;
|
|
|
650 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
|
|
|
651
|
|
485
|
652 if (NILP (tem))
|
|
297
|
653 {
|
|
|
654 name = Fsymbol_name (name);
|
|
|
655 insert_string ("\nUses keymap \"");
|
4716
4382ad05411e
(Fsubstitute_command_keys): Pass new arg to insert_from_string.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
656 insert_from_string (name, 0, XSTRING (name)->size, 1);
|
|
297
|
657 insert_string ("\", which is not currently defined.\n");
|
|
|
658 if (start[-1] == '<') keymap = Qnil;
|
|
|
659 }
|
|
|
660 else if (start[-1] == '<')
|
|
|
661 keymap = tem;
|
|
|
662 else
|
|
13244
|
663 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0);
|
|
297
|
664 tem = Fbuffer_string ();
|
|
|
665 Ferase_buffer ();
|
|
|
666 set_buffer_internal (oldbuf);
|
|
|
667
|
|
|
668 subst_string:
|
|
|
669 start = XSTRING (tem)->data;
|
|
|
670 length = XSTRING (tem)->size;
|
|
|
671 subst:
|
|
|
672 new = (unsigned char *) xrealloc (buf, bsize += length);
|
|
|
673 bufp += new - buf;
|
|
|
674 buf = new;
|
|
|
675 bcopy (start, bufp, length);
|
|
|
676 bufp += length;
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
677 /* Check STRING again in case gc relocated it. */
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
678 strp = (unsigned char *) XSTRING (string)->data + idx;
|
|
297
|
679 }
|
|
|
680 else /* just copy other chars */
|
|
|
681 *bufp++ = *strp++;
|
|
|
682 }
|
|
|
683
|
|
|
684 if (changed) /* don't bother if nothing substituted */
|
|
|
685 tem = make_string (buf, bufp - buf);
|
|
|
686 else
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
687 tem = string;
|
|
2439
|
688 xfree (buf);
|
|
1511
|
689 RETURN_UNGCPRO (tem);
|
|
297
|
690 }
|
|
|
691
|
|
|
692 syms_of_doc ()
|
|
|
693 {
|
|
|
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;
|
|
|
697
|
|
|
698 defsubr (&Sdocumentation);
|
|
|
699 defsubr (&Sdocumentation_property);
|
|
|
700 defsubr (&Ssnarf_documentation);
|
|
|
701 defsubr (&Ssubstitute_command_keys);
|
|
|
702 }
|
