(x_draw_vertical_border): Undo last change.
[bpt/emacs.git] / src / doc.c
CommitLineData
c6045832 1/* Record indices of function doc strings stored in a file.
a12a9bd6
SM
2 Copyright (C) 1985, 86,93,94,95,97,98,99,2000,04
3 Free Software Foundation, Inc.
c6045832
JB
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
610f41b7 9the Free Software Foundation; either version 2, or (at your option)
c6045832
JB
10any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Emacs; see the file COPYING. If not, write to
3b7ad313
EN
19the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20Boston, MA 02111-1307, USA. */
c6045832
JB
21
22
18160b98 23#include <config.h>
c6045832
JB
24
25#include <sys/types.h>
26#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
27
54a2cb12 28#ifdef HAVE_FCNTL_H
c6045832
JB
29#include <fcntl.h>
30#endif
31
29beb080
RS
32#ifdef HAVE_UNISTD_H
33#include <unistd.h>
34#endif
35
c6045832
JB
36#ifndef O_RDONLY
37#define O_RDONLY 0
38#endif
39
c6045832
JB
40#include "lisp.h"
41#include "buffer.h"
665d3046 42#include "keyboard.h"
141199d1 43#include "charset.h"
8feddab4 44#include "keymap.h"
c6045832 45
8892f40b
GM
46#ifdef HAVE_INDEX
47extern char *index P_ ((const char *, int));
a847af86
GM
48#endif
49
512ca171 50Lisp_Object Vdoc_file_name;
c6045832 51
9191c8ae
GM
52Lisp_Object Qfunction_documentation;
53
9a425dcb
RS
54extern Lisp_Object Voverriding_local_map;
55
778d47c7
RS
56/* For VMS versions with limited file name syntax,
57 convert the name to something VMS will allow. */
58static void
59munge_doc_file_name (name)
60 char *name;
c6045832 61{
c6045832
JB
62#ifdef VMS
63#ifndef VMS4_4
64 /* For VMS versions with limited file name syntax,
65 convert the name to something VMS will allow. */
66 p = name;
67 while (*p)
68 {
69 if (*p == '-')
70 *p = '_';
71 p++;
72 }
73#endif /* not VMS4_4 */
74#ifdef VMS4_4
75 strcpy (name, sys_translate_unix (name));
76#endif /* VMS4_4 */
77#endif /* VMS */
778d47c7
RS
78}
79
912e8480
RS
80/* Buffer used for reading from documentation file. */
81static char *get_doc_string_buffer;
82static int get_doc_string_buffer_size;
83
32caae30 84static unsigned char *read_bytecode_pointer;
87afdd65 85Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
32caae30
RS
86
87/* readchar in lread.c calls back here to fetch the next byte.
88 If UNREADFLAG is 1, we unread a byte. */
89
90int
91read_bytecode_char (unreadflag)
33711cc9 92 int unreadflag;
32caae30
RS
93{
94 if (unreadflag)
95 {
96 read_bytecode_pointer--;
97 return 0;
98 }
99 return *read_bytecode_pointer++;
100}
101
700ea809
RS
102/* Extract a doc string from a file. FILEPOS says where to get it.
103 If it is an integer, use that position in the standard DOC-... file.
104 If it is (FILE . INTEGER), use FILE as the file name
0c00bc70
RS
105 and INTEGER as the position in that file.
106 But if INTEGER is negative, make it positive.
107 (A negative integer is used for user variables, so we can distinguish
ba29c3c9
RS
108 them without actually fetching the doc string.)
109
a154a4ef
SM
110 If the location does not point to the beginning of a docstring
111 (e.g. because the file has been modified and the location is stale),
112 return nil.
113
e96179b3
RS
114 If UNIBYTE is nonzero, always make a unibyte string.
115
f1df0d67
RS
116 If DEFINITION is nonzero, assume this is for reading
117 a dynamic function definition; convert the bytestring
118 and the constants vector with appropriate byte handling,
119 and return a cons cell. */
700ea809 120
0c3debbc 121Lisp_Object
e96179b3 122get_doc_string (filepos, unibyte, definition)
700ea809 123 Lisp_Object filepos;
e96179b3 124 int unibyte, definition;
778d47c7 125{
700ea809 126 char *from, *to;
778d47c7
RS
127 register int fd;
128 register char *name;
129 register char *p, *p1;
778d47c7 130 int minsize;
0fded513 131 int offset, position;
700ea809 132 Lisp_Object file, tem;
778d47c7 133
700ea809
RS
134 if (INTEGERP (filepos))
135 {
136 file = Vdoc_file_name;
137 position = XINT (filepos);
138 }
139 else if (CONSP (filepos))
140 {
03699b14
KR
141 file = XCAR (filepos);
142 position = XINT (XCDR (filepos));
700ea809
RS
143 }
144 else
778d47c7
RS
145 return Qnil;
146
87afdd65
SM
147 if (position < 0)
148 position = - position;
149
700ea809
RS
150 if (!STRINGP (Vdoc_directory))
151 return Qnil;
152
153 if (!STRINGP (file))
154 return Qnil;
177c0ea7 155
700ea809
RS
156 /* Put the file name in NAME as a C string.
157 If it is relative, combine it with Vdoc_directory. */
158
159 tem = Ffile_name_absolute_p (file);
160 if (NILP (tem))
161 {
d5db4077 162 minsize = SCHARS (Vdoc_directory);
700ea809
RS
163 /* sizeof ("../etc/") == 8 */
164 if (minsize < 8)
165 minsize = 8;
d5db4077
KR
166 name = (char *) alloca (minsize + SCHARS (file) + 8);
167 strcpy (name, SDATA (Vdoc_directory));
168 strcat (name, SDATA (file));
700ea809
RS
169 munge_doc_file_name (name);
170 }
171 else
172 {
d5db4077 173 name = (char *) SDATA (file);
700ea809 174 }
c6045832 175
68c45bf0 176 fd = emacs_open (name, O_RDONLY, 0);
c6045832 177 if (fd < 0)
778d47c7
RS
178 {
179#ifndef CANNOT_DUMP
180 if (!NILP (Vpurify_flag))
181 {
182 /* Preparing to dump; DOC file is probably not installed.
183 So check in ../etc. */
184 strcpy (name, "../etc/");
d5db4077 185 strcat (name, SDATA (file));
778d47c7
RS
186 munge_doc_file_name (name);
187
68c45bf0 188 fd = emacs_open (name, O_RDONLY, 0);
778d47c7
RS
189 }
190#endif
778d47c7
RS
191 if (fd < 0)
192 error ("Cannot open doc string file \"%s\"", name);
193 }
194
0fded513 195 /* Seek only to beginning of disk block. */
a154a4ef
SM
196 /* Make sure we read at least 1024 bytes before `position'
197 so we can check the leading text for consistency. */
198 offset = min (position, max (1024, position % (8 * 1024)));
0fded513 199 if (0 > lseek (fd, position - offset, 0))
c6045832 200 {
68c45bf0 201 emacs_close (fd);
c6045832 202 error ("Position %ld out of range in doc string file \"%s\"",
700ea809 203 position, name);
c6045832 204 }
700ea809 205
912e8480
RS
206 /* Read the doc string into get_doc_string_buffer.
207 P points beyond the data just read. */
0fded513 208
912e8480 209 p = get_doc_string_buffer;
700ea809 210 while (1)
c6045832 211 {
912e8480
RS
212 int space_left = (get_doc_string_buffer_size
213 - (p - get_doc_string_buffer));
700ea809
RS
214 int nread;
215
0fded513 216 /* Allocate or grow the buffer if we need to. */
700ea809
RS
217 if (space_left == 0)
218 {
912e8480
RS
219 int in_buffer = p - get_doc_string_buffer;
220 get_doc_string_buffer_size += 16 * 1024;
221 get_doc_string_buffer
222 = (char *) xrealloc (get_doc_string_buffer,
223 get_doc_string_buffer_size + 1);
224 p = get_doc_string_buffer + in_buffer;
225 space_left = (get_doc_string_buffer_size
226 - (p - get_doc_string_buffer));
700ea809
RS
227 }
228
0fded513
RS
229 /* Read a disk block at a time.
230 If we read the same block last time, maybe skip this? */
700ea809
RS
231 if (space_left > 1024 * 8)
232 space_left = 1024 * 8;
68c45bf0 233 nread = emacs_read (fd, p, space_left);
700ea809
RS
234 if (nread < 0)
235 {
68c45bf0 236 emacs_close (fd);
700ea809
RS
237 error ("Read error on documentation file");
238 }
239 p[nread] = 0;
240 if (!nread)
c6045832 241 break;
912e8480 242 if (p == get_doc_string_buffer)
a847af86 243 p1 = (char *) index (p + offset, '\037');
0fded513 244 else
a847af86 245 p1 = (char *) index (p, '\037');
c6045832
JB
246 if (p1)
247 {
248 *p1 = 0;
249 p = p1;
250 break;
251 }
700ea809 252 p += nread;
c6045832 253 }
68c45bf0 254 emacs_close (fd);
700ea809 255
a154a4ef
SM
256 /* Sanity checking. */
257 if (CONSP (filepos))
258 {
259 int test = 1;
260 if (get_doc_string_buffer[offset - test++] != ' ')
261 return Qnil;
262 while (get_doc_string_buffer[offset - test] >= '0'
263 && get_doc_string_buffer[offset - test] <= '9')
264 test++;
265 if (get_doc_string_buffer[offset - test++] != '@'
266 || get_doc_string_buffer[offset - test] != '#')
267 return Qnil;
268 }
269 else
270 {
271 int test = 1;
272 if (get_doc_string_buffer[offset - test++] != '\n')
273 return Qnil;
274 while (get_doc_string_buffer[offset - test] > ' ')
275 test++;
276 if (get_doc_string_buffer[offset - test] != '\037')
277 return Qnil;
278 }
279
700ea809
RS
280 /* Scan the text and perform quoting with ^A (char code 1).
281 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
912e8480
RS
282 from = get_doc_string_buffer + offset;
283 to = get_doc_string_buffer + offset;
700ea809
RS
284 while (from != p)
285 {
286 if (*from == 1)
287 {
288 int c;
289
290 from++;
291 c = *from++;
292 if (c == 1)
293 *to++ = c;
294 else if (c == '0')
295 *to++ = 0;
296 else if (c == '_')
297 *to++ = 037;
298 else
299 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
300 }
301 else
302 *to++ = *from++;
303 }
304
32caae30
RS
305 /* If DEFINITION, read from this buffer
306 the same way we would read bytes from a file. */
f1df0d67
RS
307 if (definition)
308 {
32caae30
RS
309 read_bytecode_pointer = get_doc_string_buffer + offset;
310 return Fread (Qlambda);
f1df0d67
RS
311 }
312
e96179b3
RS
313 if (unibyte)
314 return make_unibyte_string (get_doc_string_buffer + offset,
315 to - (get_doc_string_buffer + offset));
316 else
fb2fdea7
RS
317 {
318 /* Let the data determine whether the string is multibyte,
319 even if Emacs is running in --unibyte mode. */
320 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
321 to - (get_doc_string_buffer + offset));
322 return make_string_from_bytes (get_doc_string_buffer + offset,
323 nchars,
324 to - (get_doc_string_buffer + offset));
325 }
700ea809
RS
326}
327
328/* Get a string from position FILEPOS and pass it through the Lisp reader.
329 We use this for fetching the bytecode string and constants vector
330 of a compiled function from the .elc file. */
331
332Lisp_Object
333read_doc_string (filepos)
334 Lisp_Object filepos;
335{
e96179b3 336 return get_doc_string (filepos, 0, 1);
c6045832
JB
337}
338
e5aa79fa 339static int
a154a4ef 340reread_doc_file (file)
04fb8283 341 Lisp_Object file;
a154a4ef 342{
13d7dc77 343#if 0
a154a4ef
SM
344 Lisp_Object reply, prompt[3];
345 struct gcpro gcpro1;
346 GCPRO1 (file);
347 prompt[0] = build_string ("File ");
348 prompt[1] = NILP (file) ? Vdoc_file_name : file;
13d7dc77 349 prompt[2] = build_string (" is out of sync. Reload? ");
a154a4ef
SM
350 reply = Fy_or_n_p (Fconcat (3, prompt));
351 UNGCPRO;
352 if (NILP (reply))
e5aa79fa 353 return 0;
13d7dc77 354#endif
a154a4ef
SM
355
356 if (NILP (file))
357 Fsnarf_documentation (Vdoc_file_name);
358 else
359 Fload (file, Qt, Qt, Qt, Qnil);
e5aa79fa
SM
360
361 return 1;
a154a4ef
SM
362}
363
ee04dc54 364DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
335c5470
PJ
365 doc: /* Return the documentation string of FUNCTION.
366Unless a non-nil second argument RAW is given, the
367string is passed through `substitute-command-keys'. */)
368 (function, raw)
502ddf23 369 Lisp_Object function, raw;
c6045832
JB
370{
371 Lisp_Object fun;
372 Lisp_Object funcar;
ee04dc54 373 Lisp_Object tem, doc;
e5aa79fa
SM
374 int try_reload = 1;
375
376 documentation:
c6045832 377
8d17fe0b 378 doc = Qnil;
177c0ea7 379
9191c8ae
GM
380 if (SYMBOLP (function)
381 && (tem = Fget (function, Qfunction_documentation),
382 !NILP (tem)))
383 return Fdocumentation_property (function, Qfunction_documentation, raw);
177c0ea7 384
502ddf23 385 fun = Findirect_function (function);
5b5f6883 386 if (SUBRP (fun))
c6045832 387 {
9191c8ae
GM
388 if (XSUBR (fun)->doc == 0)
389 return Qnil;
390 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
ee04dc54 391 doc = build_string (XSUBR (fun)->doc);
c6045832 392 else
87afdd65 393 doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
5b5f6883
KH
394 }
395 else if (COMPILEDP (fun))
396 {
87afdd65 397 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
c6045832 398 return Qnil;
87afdd65 399 tem = AREF (fun, COMPILED_DOC_STRING);
e6d12642 400 if (STRINGP (tem))
ee04dc54 401 doc = tem;
700ea809 402 else if (NATNUMP (tem) || CONSP (tem))
87afdd65 403 doc = tem;
ee04dc54
RM
404 else
405 return Qnil;
5b5f6883
KH
406 }
407 else if (STRINGP (fun) || VECTORP (fun))
408 {
c6045832 409 return build_string ("Keyboard macro.");
5b5f6883
KH
410 }
411 else if (CONSP (fun))
412 {
c6045832 413 funcar = Fcar (fun);
e6d12642 414 if (!SYMBOLP (funcar))
c6045832 415 return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
502ddf23 416 else if (EQ (funcar, Qkeymap))
a3cec380 417 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
502ddf23
JB
418 else if (EQ (funcar, Qlambda)
419 || EQ (funcar, Qautoload))
c6045832 420 {
ae44f7a4
RS
421 Lisp_Object tem1;
422 tem1 = Fcdr (Fcdr (fun));
423 tem = Fcar (tem1);
e6d12642 424 if (STRINGP (tem))
ee04dc54 425 doc = tem;
ae44f7a4
RS
426 /* Handle a doc reference--but these never come last
427 in the function body, so reject them if they are last. */
87afdd65
SM
428 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
429 && !NILP (XCDR (tem1)))
430 doc = tem;
ee04dc54
RM
431 else
432 return Qnil;
c6045832 433 }
502ddf23 434 else if (EQ (funcar, Qmacro))
ee04dc54 435 return Fdocumentation (Fcdr (fun), raw);
5b5f6883
KH
436 else
437 goto oops;
438 }
439 else
440 {
441 oops:
442 Fsignal (Qinvalid_function, Fcons (fun, Qnil));
c6045832 443 }
ee04dc54 444
e5aa79fa
SM
445 /* If DOC is 0, it's typically because of a dumped file missing
446 from the DOC file (bug in src/Makefile.in). */
71cdb109
SM
447 if (EQ (doc, make_number (0)))
448 doc = Qnil;
68d8a8e1 449 if (INTEGERP (doc) || CONSP (doc))
a154a4ef
SM
450 {
451 Lisp_Object tem;
452 tem = get_doc_string (doc, 0, 0);
e5aa79fa 453 if (NILP (tem) && try_reload)
a154a4ef
SM
454 {
455 /* The file is newer, we need to reset the pointers. */
456 struct gcpro gcpro1, gcpro2;
457 GCPRO2 (function, raw);
e5aa79fa 458 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 459 UNGCPRO;
e5aa79fa
SM
460 if (try_reload)
461 {
462 try_reload = 0;
463 goto documentation;
464 }
a154a4ef
SM
465 }
466 else
467 doc = tem;
468 }
87afdd65 469
956ace37 470 if (NILP (raw))
441d75e5 471 doc = Fsubstitute_command_keys (doc);
ee04dc54 472 return doc;
c6045832
JB
473}
474
f6ee1260
GM
475DEFUN ("documentation-property", Fdocumentation_property,
476 Sdocumentation_property, 2, 3, 0,
335c5470
PJ
477 doc: /* Return the documentation string that is SYMBOL's PROP property.
478Third argument RAW omitted or nil means pass the result through
479`substitute-command-keys' if it is a string.
480
481This differs from `get' in that it can refer to strings stored in the
482`etc/DOC' file; and that it evaluates documentation properties that
483aren't strings. */)
4acb738e
EN
484 (symbol, prop, raw)
485 Lisp_Object symbol, prop, raw;
c6045832 486{
e5aa79fa 487 int try_reload = 1;
2f0b74ea 488 Lisp_Object tem;
c6045832 489
e5aa79fa 490 documentation_property:
177c0ea7 491
4acb738e 492 tem = Fget (symbol, prop);
44766095 493 if (EQ (tem, make_number (0)))
71cdb109 494 tem = Qnil;
68d8a8e1 495 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
a154a4ef
SM
496 {
497 Lisp_Object doc = tem;
498 tem = get_doc_string (tem, 0, 0);
e5aa79fa 499 if (NILP (tem) && try_reload)
a154a4ef
SM
500 {
501 /* The file is newer, we need to reset the pointers. */
502 struct gcpro gcpro1, gcpro2, gcpro3;
503 GCPRO3 (symbol, prop, raw);
e5aa79fa 504 try_reload = reread_doc_file (Fcar_safe (doc));
a154a4ef 505 UNGCPRO;
e5aa79fa
SM
506 if (try_reload)
507 {
508 try_reload = 0;
509 goto documentation_property;
510 }
a154a4ef
SM
511 }
512 }
f6ee1260
GM
513 else if (!STRINGP (tem))
514 /* Feval protects its argument. */
515 tem = Feval (tem);
177c0ea7 516
e6d12642 517 if (NILP (raw) && STRINGP (tem))
bbd7d5d3 518 tem = Fsubstitute_command_keys (tem);
992d176e 519 return tem;
c6045832
JB
520}
521\f
283e1184
JB
522/* Scanning the DOC files and placing docstring offsets into functions. */
523
524static void
525store_function_docstring (fun, offset)
526 Lisp_Object fun;
e343d389
RS
527 /* Use EMACS_INT because we get this from pointer subtraction. */
528 EMACS_INT offset;
283e1184
JB
529{
530 fun = indirect_function (fun);
531
532 /* The type determines where the docstring is stored. */
533
534 /* Lisp_Subrs have a slot for it. */
e6d12642 535 if (SUBRP (fun))
283e1184
JB
536 XSUBR (fun)->doc = (char *) - offset;
537
538 /* If it's a lisp form, stick it in the form. */
539 else if (CONSP (fun))
540 {
541 Lisp_Object tem;
542
03699b14 543 tem = XCAR (fun);
283e1184
JB
544 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
545 {
546 tem = Fcdr (Fcdr (fun));
03699b14 547 if (CONSP (tem) && INTEGERP (XCAR (tem)))
f3fbd155 548 XSETCARFASTINT (tem, offset);
283e1184
JB
549 }
550 else if (EQ (tem, Qmacro))
03699b14 551 store_function_docstring (XCDR (fun), offset);
283e1184
JB
552 }
553
554 /* Bytecode objects sometimes have slots for it. */
e6d12642 555 else if (COMPILEDP (fun))
283e1184
JB
556 {
557 /* This bytecode object must have a slot for the
558 docstring, since we've found a docstring for it. */
87afdd65
SM
559 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
560 XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
283e1184
JB
561 }
562}
563
564
c6045832 565DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
335c5470 566 1, 1, 0,
f4e25f94
RS
567 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
568This searches the `etc/DOC...' file for doc strings and
569records them in function and variable definitions.
570The function takes one argument, FILENAME, a string;
571it specifies the file name (without a directory) of the DOC file.
572That file is found in `../etc' now; later, when the dumped Emacs is run,
98b6690a 573the same file name is found in the `doc-directory'. */)
335c5470 574 (filename)
c6045832
JB
575 Lisp_Object filename;
576{
577 int fd;
578 char buf[1024 + 1];
579 register int filled;
580 register int pos;
581 register char *p, *end;
24109c98 582 Lisp_Object sym;
c6045832 583 char *name;
c6045832 584
b7826503 585 CHECK_STRING (filename);
c6045832 586
a154a4ef 587 if
c6045832 588#ifndef CANNOT_DUMP
a154a4ef 589 (!NILP (Vpurify_flag))
c6045832 590#else /* CANNOT_DUMP */
a154a4ef 591 (0)
c6045832 592#endif /* CANNOT_DUMP */
a154a4ef 593 {
d5db4077 594 name = (char *) alloca (SCHARS (filename) + 14);
a154a4ef
SM
595 strcpy (name, "../etc/");
596 }
597 else
598 {
599 CHECK_STRING (Vdoc_directory);
d5db4077
KR
600 name = (char *) alloca (SCHARS (filename)
601 + SCHARS (Vdoc_directory) + 1);
602 strcpy (name, SDATA (Vdoc_directory));
a154a4ef 603 }
d5db4077 604 strcat (name, SDATA (filename)); /*** Add this line ***/
c6045832
JB
605#ifdef VMS
606#ifndef VMS4_4
607 /* For VMS versions with limited file name syntax,
608 convert the name to something VMS will allow. */
609 p = name;
610 while (*p)
611 {
612 if (*p == '-')
613 *p = '_';
614 p++;
615 }
a12a9bd6 616#else /* VMS4_4 */
c6045832
JB
617 strcpy (name, sys_translate_unix (name));
618#endif /* VMS4_4 */
619#endif /* VMS */
620
68c45bf0 621 fd = emacs_open (name, O_RDONLY, 0);
c6045832
JB
622 if (fd < 0)
623 report_file_error ("Opening doc string file",
624 Fcons (build_string (name), Qnil));
625 Vdoc_file_name = filename;
626 filled = 0;
627 pos = 0;
628 while (1)
629 {
630 if (filled < 512)
68c45bf0 631 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
c6045832
JB
632 if (!filled)
633 break;
634
635 buf[filled] = 0;
636 p = buf;
637 end = buf + (filled < 512 ? filled : filled - 128);
638 while (p != end && *p != '\037') p++;
639 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
640 if (p != end)
641 {
a847af86 642 end = (char *) index (p, '\n');
141199d1
RS
643 sym = oblookup (Vobarray, p + 2,
644 multibyte_chars_in_text (p + 2, end - p - 2),
645 end - p - 2);
e6d12642 646 if (SYMBOLP (sym))
c6045832
JB
647 {
648 /* Attach a docstring to a variable? */
649 if (p[1] == 'V')
650 {
651 /* Install file-position as variable-documentation property
652 and make it negative for a user-variable
653 (doc starts with a `*'). */
654 Fput (sym, Qvariable_documentation,
655 make_number ((pos + end + 1 - buf)
656 * (end[1] == '*' ? -1 : 1)));
657 }
658
283e1184 659 /* Attach a docstring to a function? */
c6045832 660 else if (p[1] == 'F')
283e1184
JB
661 store_function_docstring (sym, pos + end + 1 - buf);
662
a12a9bd6
SM
663 else if (p[1] == 'S')
664 ; /* Just a source file name boundary marker. Ignore it. */
665
283e1184
JB
666 else
667 error ("DOC file invalid at position %d", pos);
c6045832
JB
668 }
669 }
670 pos += end - buf;
671 filled -= end - buf;
672 bcopy (end, buf, filled);
673 }
68c45bf0 674 emacs_close (fd);
c6045832
JB
675 return Qnil;
676}
677\f
678DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
335c5470
PJ
679 Ssubstitute_command_keys, 1, 1, 0,
680 doc: /* Substitute key descriptions for command names in STRING.
681Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
682replaced by either: a keystroke sequence that will invoke COMMAND,
683or "M-x COMMAND" if COMMAND is not on any keys.
684Substrings of the form \\=\\{MAPVAR} are replaced by summaries
685\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.
686Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
687as the keymap for future \\=\\[COMMAND] substrings.
688\\=\\= quotes the following character and is discarded;
689thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. */)
690 (string)
4acb738e 691 Lisp_Object string;
c6045832
JB
692{
693 unsigned char *buf;
694 int changed = 0;
695 register unsigned char *strp;
696 register unsigned char *bufp;
697 int idx;
698 int bsize;
665d3046 699 Lisp_Object tem;
c6045832
JB
700 Lisp_Object keymap;
701 unsigned char *start;
2d0aa229 702 int length, length_byte;
665d3046
JB
703 Lisp_Object name;
704 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
141199d1
RS
705 int multibyte;
706 int nchars;
c6045832 707
4acb738e 708 if (NILP (string))
c6045832
JB
709 return Qnil;
710
b7826503 711 CHECK_STRING (string);
665d3046
JB
712 tem = Qnil;
713 keymap = Qnil;
714 name = Qnil;
4acb738e 715 GCPRO4 (string, tem, keymap, name);
c6045832 716
141199d1
RS
717 multibyte = STRING_MULTIBYTE (string);
718 nchars = 0;
719
9a425dcb
RS
720 /* KEYMAP is either nil (which means search all the active keymaps)
721 or a specified local map (which means search just that and the
722 global map). If non-nil, it might come from Voverriding_local_map,
4acb738e 723 or from a \\<mapname> construct in STRING itself.. */
f73d1163
KH
724 keymap = current_kboard->Voverriding_terminal_local_map;
725 if (NILP (keymap))
726 keymap = Voverriding_local_map;
c6045832 727
d5db4077 728 bsize = SBYTES (string);
c6045832
JB
729 bufp = buf = (unsigned char *) xmalloc (bsize);
730
8a7bde3e 731 strp = SDATA (string);
d5db4077 732 while (strp < SDATA (string) + SBYTES (string))
c6045832
JB
733 {
734 if (strp[0] == '\\' && strp[1] == '=')
735 {
736 /* \= quotes the next character;
737 thus, to put in \[ without its special meaning, use \=\[. */
738 changed = 1;
141199d1
RS
739 strp += 2;
740 if (multibyte)
741 {
742 int len;
d5db4077 743 int maxlen = SDATA (string) + SBYTES (string) - strp;
141199d1
RS
744
745 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
746 if (len == 1)
747 *bufp = *strp;
748 else
749 bcopy (strp, bufp, len);
750 strp += len;
751 bufp += len;
752 nchars++;
753 }
754 else
755 *bufp++ = *strp++, nchars++;
c6045832
JB
756 }
757 else if (strp[0] == '\\' && strp[1] == '[')
758 {
b6c53774 759 Lisp_Object firstkey;
11f9d6e1 760 int start_idx;
b6c53774 761
c6045832
JB
762 changed = 1;
763 strp += 2; /* skip \[ */
764 start = strp;
d5db4077 765 start_idx = start - SDATA (string);
c6045832 766
8a7bde3e 767 while ((strp - SDATA (string)
d5db4077 768 < SBYTES (string))
c6045832
JB
769 && *strp != ']')
770 strp++;
141199d1
RS
771 length_byte = strp - start;
772
c6045832
JB
773 strp++; /* skip ] */
774
775 /* Save STRP in IDX. */
8a7bde3e 776 idx = strp - SDATA (string);
141199d1 777 tem = Fintern (make_string (start, length_byte), Qnil);
11f9d6e1 778
332e51c1
KS
779 /* Ignore remappings unless there are no ordinary bindings. */
780 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qt);
781 if (NILP (tem))
782 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
783
11f9d6e1
GM
784 /* Note the Fwhere_is_internal can GC, so we have to take
785 relocation of string contents into account. */
d5db4077
KR
786 strp = SDATA (string) + idx;
787 start = SDATA (string) + start_idx;
c6045832 788
b6c53774
RS
789 /* Disregard menu bar bindings; it is positively annoying to
790 mention them when there's no menu bar, and it isn't terribly
791 useful even when there is a menu bar. */
ef586bbd
RS
792 if (!NILP (tem))
793 {
794 firstkey = Faref (tem, make_number (0));
795 if (EQ (firstkey, Qmenu_bar))
796 tem = Qnil;
797 }
b6c53774 798
265a9e55 799 if (NILP (tem)) /* but not on any keys */
c6045832 800 {
8d17fe0b
GM
801 int offset = bufp - buf;
802 buf = (unsigned char *) xrealloc (buf, bsize += 4);
803 bufp = buf + offset;
c6045832
JB
804 bcopy ("M-x ", bufp, 4);
805 bufp += 4;
141199d1
RS
806 nchars += 4;
807 if (multibyte)
808 length = multibyte_chars_in_text (start, length_byte);
809 else
810 length = length_byte;
c6045832
JB
811 goto subst;
812 }
813 else
814 { /* function is on a key */
a1bfe073 815 tem = Fkey_description (tem, Qnil);
c6045832
JB
816 goto subst_string;
817 }
818 }
819 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
820 \<foo> just sets the keymap used for \[cmd]. */
821 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
822 {
823 struct buffer *oldbuf;
11f9d6e1 824 int start_idx;
c6045832
JB
825
826 changed = 1;
827 strp += 2; /* skip \{ or \< */
828 start = strp;
d5db4077 829 start_idx = start - SDATA (string);
c6045832 830
409949b5 831 while ((strp - SDATA (string) < SBYTES (string))
c6045832
JB
832 && *strp != '}' && *strp != '>')
833 strp++;
141199d1
RS
834
835 length_byte = strp - start;
c6045832
JB
836 strp++; /* skip } or > */
837
838 /* Save STRP in IDX. */
8a7bde3e 839 idx = strp - SDATA (string);
c6045832
JB
840
841 /* Get the value of the keymap in TEM, or nil if undefined.
842 Do this while still in the user's current buffer
843 in case it is a local variable. */
141199d1 844 name = Fintern (make_string (start, length_byte), Qnil);
c6045832 845 tem = Fboundp (name);
265a9e55 846 if (! NILP (tem))
c6045832
JB
847 {
848 tem = Fsymbol_value (name);
265a9e55 849 if (! NILP (tem))
11f9d6e1 850 {
02067692
SM
851 tem = get_keymap (tem, 0, 1);
852 /* Note that get_keymap can GC. */
d5db4077
KR
853 strp = SDATA (string) + idx;
854 start = SDATA (string) + start_idx;
11f9d6e1 855 }
c6045832
JB
856 }
857
858 /* Now switch to a temp buffer. */
859 oldbuf = current_buffer;
860 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
861
265a9e55 862 if (NILP (tem))
c6045832
JB
863 {
864 name = Fsymbol_name (name);
865 insert_string ("\nUses keymap \"");
141199d1 866 insert_from_string (name, 0, 0,
d5db4077
KR
867 SCHARS (name),
868 SBYTES (name), 1);
c6045832
JB
869 insert_string ("\", which is not currently defined.\n");
870 if (start[-1] == '<') keymap = Qnil;
871 }
872 else if (start[-1] == '<')
873 keymap = tem;
874 else
7523d17c 875 describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
c6045832
JB
876 tem = Fbuffer_string ();
877 Ferase_buffer ();
878 set_buffer_internal (oldbuf);
879
880 subst_string:
d5db4077
KR
881 start = SDATA (tem);
882 length = SCHARS (tem);
883 length_byte = SBYTES (tem);
c6045832 884 subst:
8d17fe0b
GM
885 {
886 int offset = bufp - buf;
887 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
888 bufp = buf + offset;
889 bcopy (start, bufp, length_byte);
890 bufp += length_byte;
891 nchars += length;
892 /* Check STRING again in case gc relocated it. */
d5db4077 893 strp = (unsigned char *) SDATA (string) + idx;
8d17fe0b 894 }
c6045832 895 }
141199d1
RS
896 else if (! multibyte) /* just copy other chars */
897 *bufp++ = *strp++, nchars++;
898 else
899 {
900 int len;
d5db4077 901 int maxlen = SDATA (string) + SBYTES (string) - strp;
141199d1
RS
902
903 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
904 if (len == 1)
905 *bufp = *strp;
906 else
907 bcopy (strp, bufp, len);
908 strp += len;
909 bufp += len;
910 nchars++;
911 }
c6045832
JB
912 }
913
914 if (changed) /* don't bother if nothing substituted */
cc5bf9eb 915 tem = make_string_from_bytes (buf, nchars, bufp - buf);
c6045832 916 else
4acb738e 917 tem = string;
9ac0d9e0 918 xfree (buf);
665d3046 919 RETURN_UNGCPRO (tem);
c6045832
JB
920}
921\f
dfcf069d 922void
c6045832
JB
923syms_of_doc ()
924{
9191c8ae
GM
925 Qfunction_documentation = intern ("function-documentation");
926 staticpro (&Qfunction_documentation);
177c0ea7 927
c6045832 928 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
335c5470 929 doc: /* Name of file containing documentation strings of built-in symbols. */);
c6045832
JB
930 Vdoc_file_name = Qnil;
931
932 defsubr (&Sdocumentation);
933 defsubr (&Sdocumentation_property);
934 defsubr (&Ssnarf_documentation);
935 defsubr (&Ssubstitute_command_keys);
936}
ab5796a9
MB
937
938/* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
939 (do not change this comment) */