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