297
|
1 /* Record indices of function doc strings stored in a file.
|
64770
|
2 Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
|
75348
|
3 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
|
297
|
4
|
|
5 This file is part of GNU Emacs.
|
|
6
|
|
7 GNU Emacs is free software; you can redistribute it and/or modify
|
|
8 it under the terms of the GNU General Public License as published by
|
78260
|
9 the Free Software Foundation; either version 3, or (at your option)
|
297
|
10 any later version.
|
|
11
|
|
12 GNU Emacs is distributed in the hope that it will be useful,
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
15 GNU General Public License for more details.
|
|
16
|
|
17 You should have received a copy of the GNU General Public License
|
|
18 along with GNU Emacs; see the file COPYING. If not, write to
|
64084
|
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
20 Boston, MA 02110-1301, USA. */
|
297
|
21
|
|
22
|
4696
|
23 #include <config.h>
|
297
|
24
|
|
25 #include <sys/types.h>
|
|
26 #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
|
58087
|
27 #include <ctype.h>
|
297
|
28
|
51402
|
29 #ifdef HAVE_FCNTL_H
|
297
|
30 #include <fcntl.h>
|
|
31 #endif
|
|
32
|
6862
|
33 #ifdef HAVE_UNISTD_H
|
|
34 #include <unistd.h>
|
|
35 #endif
|
|
36
|
297
|
37 #ifndef O_RDONLY
|
|
38 #define O_RDONLY 0
|
|
39 #endif
|
|
40
|
|
41 #include "lisp.h"
|
|
42 #include "buffer.h"
|
1511
|
43 #include "keyboard.h"
|
20619
|
44 #include "charset.h"
|
39697
|
45 #include "keymap.h"
|
297
|
46
|
31336
|
47 #ifdef HAVE_INDEX
|
|
48 extern char *index P_ ((const char *, int));
|
31225
|
49 #endif
|
|
50
|
40139
|
51 Lisp_Object Vdoc_file_name;
|
297
|
52
|
28334
|
53 Lisp_Object Qfunction_documentation;
|
|
54
|
58068
|
55 /* A list of files used to build this Emacs binary. */
|
|
56 static Lisp_Object Vbuild_files;
|
|
57
|
5784
|
58 extern Lisp_Object Voverriding_local_map;
|
|
59
|
65391
|
60 extern Lisp_Object Qremap;
|
|
61
|
9087
|
62 /* For VMS versions with limited file name syntax,
|
60388
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
63 convert the name to something VMS will allow. */
|
9087
|
64 static void
|
|
65 munge_doc_file_name (name)
|
|
66 char *name;
|
297
|
67 {
|
|
68 #ifdef VMS
|
60388
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
69 #ifndef NO_HYPHENS_IN_FILENAMES
|
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
70 extern char * sys_translate_unix (char *ufile);
|
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
71 strcpy (name, sys_translate_unix (name));
|
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
72 #else /* NO_HYPHENS_IN_FILENAMES */
|
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
73 char *p = name;
|
297
|
74 while (*p)
|
|
75 {
|
|
76 if (*p == '-')
|
|
77 *p = '_';
|
|
78 p++;
|
|
79 }
|
60388
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
80 #endif /* NO_HYPHENS_IN_FILENAMES */
|
297
|
81 #endif /* VMS */
|
9087
|
82 }
|
|
83
|
14648
|
84 /* Buffer used for reading from documentation file. */
|
|
85 static char *get_doc_string_buffer;
|
|
86 static int get_doc_string_buffer_size;
|
|
87
|
22690
|
88 static unsigned char *read_bytecode_pointer;
|
41823
|
89 Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
|
22690
|
90
|
|
91 /* readchar in lread.c calls back here to fetch the next byte.
|
|
92 If UNREADFLAG is 1, we unread a byte. */
|
|
93
|
|
94 int
|
|
95 read_bytecode_char (unreadflag)
|
25758
|
96 int unreadflag;
|
22690
|
97 {
|
|
98 if (unreadflag)
|
|
99 {
|
|
100 read_bytecode_pointer--;
|
|
101 return 0;
|
|
102 }
|
|
103 return *read_bytecode_pointer++;
|
|
104 }
|
|
105
|
10202
|
106 /* Extract a doc string from a file. FILEPOS says where to get it.
|
|
107 If it is an integer, use that position in the standard DOC-... file.
|
|
108 If it is (FILE . INTEGER), use FILE as the file name
|
11252
|
109 and INTEGER as the position in that file.
|
|
110 But if INTEGER is negative, make it positive.
|
|
111 (A negative integer is used for user variables, so we can distinguish
|
22043
|
112 them without actually fetching the doc string.)
|
|
113
|
44324
|
114 If the location does not point to the beginning of a docstring
|
|
115 (e.g. because the file has been modified and the location is stale),
|
|
116 return nil.
|
|
117
|
22602
|
118 If UNIBYTE is nonzero, always make a unibyte string.
|
|
119
|
22562
|
120 If DEFINITION is nonzero, assume this is for reading
|
|
121 a dynamic function definition; convert the bytestring
|
|
122 and the constants vector with appropriate byte handling,
|
|
123 and return a cons cell. */
|
10202
|
124
|
22268
|
125 Lisp_Object
|
22602
|
126 get_doc_string (filepos, unibyte, definition)
|
10202
|
127 Lisp_Object filepos;
|
22602
|
128 int unibyte, definition;
|
9087
|
129 {
|
10202
|
130 char *from, *to;
|
9087
|
131 register int fd;
|
|
132 register char *name;
|
|
133 register char *p, *p1;
|
|
134 int minsize;
|
14552
|
135 int offset, position;
|
10202
|
136 Lisp_Object file, tem;
|
9087
|
137
|
10202
|
138 if (INTEGERP (filepos))
|
|
139 {
|
|
140 file = Vdoc_file_name;
|
|
141 position = XINT (filepos);
|
|
142 }
|
|
143 else if (CONSP (filepos))
|
|
144 {
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
145 file = XCAR (filepos);
|
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
146 position = XINT (XCDR (filepos));
|
10202
|
147 }
|
|
148 else
|
|
149 return Qnil;
|
|
150
|
41823
|
151 if (position < 0)
|
|
152 position = - position;
|
|
153
|
10202
|
154 if (!STRINGP (Vdoc_directory))
|
9087
|
155 return Qnil;
|
|
156
|
10202
|
157 if (!STRINGP (file))
|
|
158 return Qnil;
|
49600
|
159
|
10202
|
160 /* Put the file name in NAME as a C string.
|
|
161 If it is relative, combine it with Vdoc_directory. */
|
|
162
|
|
163 tem = Ffile_name_absolute_p (file);
|
|
164 if (NILP (tem))
|
|
165 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
166 minsize = SCHARS (Vdoc_directory);
|
10202
|
167 /* sizeof ("../etc/") == 8 */
|
|
168 if (minsize < 8)
|
|
169 minsize = 8;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
170 name = (char *) alloca (minsize + SCHARS (file) + 8);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
171 strcpy (name, SDATA (Vdoc_directory));
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
172 strcat (name, SDATA (file));
|
10202
|
173 munge_doc_file_name (name);
|
|
174 }
|
|
175 else
|
|
176 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
177 name = (char *) SDATA (file);
|
10202
|
178 }
|
297
|
179
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
180 fd = emacs_open (name, O_RDONLY, 0);
|
297
|
181 if (fd < 0)
|
9087
|
182 {
|
|
183 #ifndef CANNOT_DUMP
|
|
184 if (!NILP (Vpurify_flag))
|
|
185 {
|
|
186 /* Preparing to dump; DOC file is probably not installed.
|
|
187 So check in ../etc. */
|
|
188 strcpy (name, "../etc/");
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
189 strcat (name, SDATA (file));
|
9087
|
190 munge_doc_file_name (name);
|
|
191
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
192 fd = emacs_open (name, O_RDONLY, 0);
|
9087
|
193 }
|
|
194 #endif
|
|
195 if (fd < 0)
|
|
196 error ("Cannot open doc string file \"%s\"", name);
|
|
197 }
|
|
198
|
14552
|
199 /* Seek only to beginning of disk block. */
|
44324
|
200 /* Make sure we read at least 1024 bytes before `position'
|
|
201 so we can check the leading text for consistency. */
|
|
202 offset = min (position, max (1024, position % (8 * 1024)));
|
14552
|
203 if (0 > lseek (fd, position - offset, 0))
|
297
|
204 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
205 emacs_close (fd);
|
297
|
206 error ("Position %ld out of range in doc string file \"%s\"",
|
10202
|
207 position, name);
|
297
|
208 }
|
10202
|
209
|
14648
|
210 /* Read the doc string into get_doc_string_buffer.
|
|
211 P points beyond the data just read. */
|
10202
|
212
|
14648
|
213 p = get_doc_string_buffer;
|
10202
|
214 while (1)
|
297
|
215 {
|
14648
|
216 int space_left = (get_doc_string_buffer_size
|
|
217 - (p - get_doc_string_buffer));
|
10202
|
218 int nread;
|
|
219
|
14552
|
220 /* Allocate or grow the buffer if we need to. */
|
10202
|
221 if (space_left == 0)
|
|
222 {
|
14648
|
223 int in_buffer = p - get_doc_string_buffer;
|
|
224 get_doc_string_buffer_size += 16 * 1024;
|
|
225 get_doc_string_buffer
|
|
226 = (char *) xrealloc (get_doc_string_buffer,
|
|
227 get_doc_string_buffer_size + 1);
|
|
228 p = get_doc_string_buffer + in_buffer;
|
|
229 space_left = (get_doc_string_buffer_size
|
|
230 - (p - get_doc_string_buffer));
|
10202
|
231 }
|
|
232
|
14552
|
233 /* Read a disk block at a time.
|
|
234 If we read the same block last time, maybe skip this? */
|
10202
|
235 if (space_left > 1024 * 8)
|
|
236 space_left = 1024 * 8;
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
237 nread = emacs_read (fd, p, space_left);
|
10202
|
238 if (nread < 0)
|
|
239 {
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
240 emacs_close (fd);
|
10202
|
241 error ("Read error on documentation file");
|
|
242 }
|
|
243 p[nread] = 0;
|
|
244 if (!nread)
|
297
|
245 break;
|
14648
|
246 if (p == get_doc_string_buffer)
|
31225
|
247 p1 = (char *) index (p + offset, '\037');
|
14552
|
248 else
|
31225
|
249 p1 = (char *) index (p, '\037');
|
297
|
250 if (p1)
|
|
251 {
|
|
252 *p1 = 0;
|
|
253 p = p1;
|
|
254 break;
|
|
255 }
|
10202
|
256 p += nread;
|
297
|
257 }
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
258 emacs_close (fd);
|
10202
|
259
|
44324
|
260 /* Sanity checking. */
|
|
261 if (CONSP (filepos))
|
|
262 {
|
|
263 int test = 1;
|
|
264 if (get_doc_string_buffer[offset - test++] != ' ')
|
|
265 return Qnil;
|
|
266 while (get_doc_string_buffer[offset - test] >= '0'
|
|
267 && get_doc_string_buffer[offset - test] <= '9')
|
|
268 test++;
|
|
269 if (get_doc_string_buffer[offset - test++] != '@'
|
|
270 || get_doc_string_buffer[offset - test] != '#')
|
|
271 return Qnil;
|
|
272 }
|
|
273 else
|
|
274 {
|
|
275 int test = 1;
|
|
276 if (get_doc_string_buffer[offset - test++] != '\n')
|
|
277 return Qnil;
|
|
278 while (get_doc_string_buffer[offset - test] > ' ')
|
|
279 test++;
|
|
280 if (get_doc_string_buffer[offset - test] != '\037')
|
|
281 return Qnil;
|
|
282 }
|
|
283
|
10202
|
284 /* Scan the text and perform quoting with ^A (char code 1).
|
|
285 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
|
14648
|
286 from = get_doc_string_buffer + offset;
|
|
287 to = get_doc_string_buffer + offset;
|
10202
|
288 while (from != p)
|
|
289 {
|
|
290 if (*from == 1)
|
|
291 {
|
|
292 int c;
|
|
293
|
|
294 from++;
|
|
295 c = *from++;
|
|
296 if (c == 1)
|
|
297 *to++ = c;
|
|
298 else if (c == '0')
|
|
299 *to++ = 0;
|
|
300 else if (c == '_')
|
|
301 *to++ = 037;
|
|
302 else
|
|
303 error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
|
|
304 }
|
|
305 else
|
|
306 *to++ = *from++;
|
|
307 }
|
|
308
|
22690
|
309 /* If DEFINITION, read from this buffer
|
|
310 the same way we would read bytes from a file. */
|
22562
|
311 if (definition)
|
|
312 {
|
22690
|
313 read_bytecode_pointer = get_doc_string_buffer + offset;
|
|
314 return Fread (Qlambda);
|
22562
|
315 }
|
|
316
|
22602
|
317 if (unibyte)
|
|
318 return make_unibyte_string (get_doc_string_buffer + offset,
|
|
319 to - (get_doc_string_buffer + offset));
|
|
320 else
|
24573
|
321 {
|
|
322 /* Let the data determine whether the string is multibyte,
|
|
323 even if Emacs is running in --unibyte mode. */
|
|
324 int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
|
|
325 to - (get_doc_string_buffer + offset));
|
|
326 return make_string_from_bytes (get_doc_string_buffer + offset,
|
|
327 nchars,
|
|
328 to - (get_doc_string_buffer + offset));
|
|
329 }
|
10202
|
330 }
|
|
331
|
|
332 /* Get a string from position FILEPOS and pass it through the Lisp reader.
|
|
333 We use this for fetching the bytecode string and constants vector
|
|
334 of a compiled function from the .elc file. */
|
|
335
|
|
336 Lisp_Object
|
|
337 read_doc_string (filepos)
|
|
338 Lisp_Object filepos;
|
|
339 {
|
22602
|
340 return get_doc_string (filepos, 0, 1);
|
297
|
341 }
|
|
342
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
343 static int
|
44324
|
344 reread_doc_file (file)
|
44355
|
345 Lisp_Object file;
|
44324
|
346 {
|
45368
|
347 #if 0
|
44324
|
348 Lisp_Object reply, prompt[3];
|
|
349 struct gcpro gcpro1;
|
|
350 GCPRO1 (file);
|
|
351 prompt[0] = build_string ("File ");
|
|
352 prompt[1] = NILP (file) ? Vdoc_file_name : file;
|
45368
|
353 prompt[2] = build_string (" is out of sync. Reload? ");
|
44324
|
354 reply = Fy_or_n_p (Fconcat (3, prompt));
|
|
355 UNGCPRO;
|
|
356 if (NILP (reply))
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
357 return 0;
|
45368
|
358 #endif
|
44324
|
359
|
|
360 if (NILP (file))
|
|
361 Fsnarf_documentation (Vdoc_file_name);
|
|
362 else
|
|
363 Fload (file, Qt, Qt, Qt, Qnil);
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
364
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
365 return 1;
|
44324
|
366 }
|
|
367
|
570
|
368 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
|
41001
|
369 doc: /* Return the documentation string of FUNCTION.
|
|
370 Unless a non-nil second argument RAW is given, the
|
|
371 string is passed through `substitute-command-keys'. */)
|
|
372 (function, raw)
|
647
|
373 Lisp_Object function, raw;
|
297
|
374 {
|
|
375 Lisp_Object fun;
|
|
376 Lisp_Object funcar;
|
570
|
377 Lisp_Object tem, doc;
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
378 int try_reload = 1;
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
379
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
380 documentation:
|
297
|
381
|
34363
|
382 doc = Qnil;
|
49600
|
383
|
28334
|
384 if (SYMBOLP (function)
|
|
385 && (tem = Fget (function, Qfunction_documentation),
|
|
386 !NILP (tem)))
|
|
387 return Fdocumentation_property (function, Qfunction_documentation, raw);
|
49600
|
388
|
68758
|
389 fun = Findirect_function (function, Qnil);
|
10002
|
390 if (SUBRP (fun))
|
297
|
391 {
|
28334
|
392 if (XSUBR (fun)->doc == 0)
|
|
393 return Qnil;
|
|
394 else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
|
570
|
395 doc = build_string (XSUBR (fun)->doc);
|
297
|
396 else
|
41823
|
397 doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
|
10002
|
398 }
|
|
399 else if (COMPILEDP (fun))
|
|
400 {
|
41823
|
401 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
|
297
|
402 return Qnil;
|
41823
|
403 tem = AREF (fun, COMPILED_DOC_STRING);
|
9133
|
404 if (STRINGP (tem))
|
570
|
405 doc = tem;
|
10202
|
406 else if (NATNUMP (tem) || CONSP (tem))
|
41823
|
407 doc = tem;
|
570
|
408 else
|
|
409 return Qnil;
|
10002
|
410 }
|
|
411 else if (STRINGP (fun) || VECTORP (fun))
|
|
412 {
|
297
|
413 return build_string ("Keyboard macro.");
|
10002
|
414 }
|
|
415 else if (CONSP (fun))
|
|
416 {
|
297
|
417 funcar = Fcar (fun);
|
9133
|
418 if (!SYMBOLP (funcar))
|
71974
|
419 xsignal1 (Qinvalid_function, fun);
|
647
|
420 else if (EQ (funcar, Qkeymap))
|
23921
|
421 return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
|
647
|
422 else if (EQ (funcar, Qlambda)
|
|
423 || EQ (funcar, Qautoload))
|
297
|
424 {
|
13521
|
425 Lisp_Object tem1;
|
|
426 tem1 = Fcdr (Fcdr (fun));
|
|
427 tem = Fcar (tem1);
|
9133
|
428 if (STRINGP (tem))
|
570
|
429 doc = tem;
|
13521
|
430 /* Handle a doc reference--but these never come last
|
|
431 in the function body, so reject them if they are last. */
|
41823
|
432 else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
|
|
433 && !NILP (XCDR (tem1)))
|
|
434 doc = tem;
|
570
|
435 else
|
|
436 return Qnil;
|
297
|
437 }
|
647
|
438 else if (EQ (funcar, Qmacro))
|
570
|
439 return Fdocumentation (Fcdr (fun), raw);
|
10002
|
440 else
|
|
441 goto oops;
|
|
442 }
|
|
443 else
|
|
444 {
|
|
445 oops:
|
71974
|
446 xsignal1 (Qinvalid_function, fun);
|
297
|
447 }
|
570
|
448
|
85493
|
449 /* Check for an advised function. Its doc string
|
|
450 has an `ad-advice-info' text property. */
|
|
451 if (STRINGP (doc))
|
|
452 {
|
|
453 Lisp_Object innerfunc;
|
|
454 innerfunc = Fget_text_property (make_number (0),
|
|
455 intern ("ad-advice-info"),
|
|
456 doc);
|
|
457 if (! NILP (innerfunc))
|
|
458 doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
|
|
459 }
|
|
460
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
461 /* If DOC is 0, it's typically because of a dumped file missing
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
462 from the DOC file (bug in src/Makefile.in). */
|
44385
|
463 if (EQ (doc, make_number (0)))
|
|
464 doc = Qnil;
|
44381
15b5489c78d6
(Fdocumentation, Fdocumentation_property): When the doc
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
465 if (INTEGERP (doc) || CONSP (doc))
|
44324
|
466 {
|
|
467 Lisp_Object tem;
|
|
468 tem = get_doc_string (doc, 0, 0);
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
469 if (NILP (tem) && try_reload)
|
44324
|
470 {
|
|
471 /* The file is newer, we need to reset the pointers. */
|
|
472 struct gcpro gcpro1, gcpro2;
|
|
473 GCPRO2 (function, raw);
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
474 try_reload = reread_doc_file (Fcar_safe (doc));
|
44324
|
475 UNGCPRO;
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
476 if (try_reload)
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
477 {
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
478 try_reload = 0;
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
479 goto documentation;
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
480 }
|
44324
|
481 }
|
|
482 else
|
|
483 doc = tem;
|
|
484 }
|
41823
|
485
|
577
|
486 if (NILP (raw))
|
26471
|
487 doc = Fsubstitute_command_keys (doc);
|
570
|
488 return doc;
|
297
|
489 }
|
|
490
|
28036
|
491 DEFUN ("documentation-property", Fdocumentation_property,
|
|
492 Sdocumentation_property, 2, 3, 0,
|
41001
|
493 doc: /* Return the documentation string that is SYMBOL's PROP property.
|
|
494 Third argument RAW omitted or nil means pass the result through
|
|
495 `substitute-command-keys' if it is a string.
|
|
496
|
|
497 This differs from `get' in that it can refer to strings stored in the
|
|
498 `etc/DOC' file; and that it evaluates documentation properties that
|
|
499 aren't strings. */)
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
500 (symbol, prop, raw)
|
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
501 Lisp_Object symbol, prop, raw;
|
297
|
502 {
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
503 int try_reload = 1;
|
26076
|
504 Lisp_Object tem;
|
297
|
505
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
506 documentation_property:
|
49600
|
507
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
508 tem = Fget (symbol, prop);
|
44383
|
509 if (EQ (tem, make_number (0)))
|
44385
|
510 tem = Qnil;
|
44381
15b5489c78d6
(Fdocumentation, Fdocumentation_property): When the doc
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
511 if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
|
44324
|
512 {
|
|
513 Lisp_Object doc = tem;
|
|
514 tem = get_doc_string (tem, 0, 0);
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
515 if (NILP (tem) && try_reload)
|
44324
|
516 {
|
|
517 /* The file is newer, we need to reset the pointers. */
|
|
518 struct gcpro gcpro1, gcpro2, gcpro3;
|
|
519 GCPRO3 (symbol, prop, raw);
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
520 try_reload = reread_doc_file (Fcar_safe (doc));
|
44324
|
521 UNGCPRO;
|
44348
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
522 if (try_reload)
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
523 {
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
524 try_reload = 0;
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
525 goto documentation_property;
|
80c9e94bec17
(reread_doc_file): Return whether reload was attempted.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
526 }
|
44324
|
527 }
|
|
528 }
|
28036
|
529 else if (!STRINGP (tem))
|
|
530 /* Feval protects its argument. */
|
|
531 tem = Feval (tem);
|
49600
|
532
|
9133
|
533 if (NILP (raw) && STRINGP (tem))
|
26420
|
534 tem = Fsubstitute_command_keys (tem);
|
312
|
535 return tem;
|
297
|
536 }
|
|
537
|
1651
|
538 /* Scanning the DOC files and placing docstring offsets into functions. */
|
|
539
|
|
540 static void
|
|
541 store_function_docstring (fun, offset)
|
|
542 Lisp_Object fun;
|
10330
|
543 /* Use EMACS_INT because we get this from pointer subtraction. */
|
|
544 EMACS_INT offset;
|
1651
|
545 {
|
|
546 fun = indirect_function (fun);
|
|
547
|
|
548 /* The type determines where the docstring is stored. */
|
|
549
|
|
550 /* Lisp_Subrs have a slot for it. */
|
9133
|
551 if (SUBRP (fun))
|
1651
|
552 XSUBR (fun)->doc = (char *) - offset;
|
|
553
|
|
554 /* If it's a lisp form, stick it in the form. */
|
|
555 else if (CONSP (fun))
|
|
556 {
|
|
557 Lisp_Object tem;
|
|
558
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
559 tem = XCAR (fun);
|
1651
|
560 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
|
|
561 {
|
|
562 tem = Fcdr (Fcdr (fun));
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
563 if (CONSP (tem) && INTEGERP (XCAR (tem)))
|
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
564 XSETCARFASTINT (tem, offset);
|
1651
|
565 }
|
|
566 else if (EQ (tem, Qmacro))
|
25662
0a7261c1d487
Use XCAR, XCDR, and XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
567 store_function_docstring (XCDR (fun), offset);
|
1651
|
568 }
|
|
569
|
|
570 /* Bytecode objects sometimes have slots for it. */
|
9133
|
571 else if (COMPILEDP (fun))
|
1651
|
572 {
|
|
573 /* This bytecode object must have a slot for the
|
|
574 docstring, since we've found a docstring for it. */
|
41823
|
575 if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
|
|
576 XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
|
1651
|
577 }
|
|
578 }
|
|
579
|
|
580
|
297
|
581 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
|
41001
|
582 1, 1, 0,
|
41218
|
583 doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
|
|
584 This searches the `etc/DOC...' file for doc strings and
|
|
585 records them in function and variable definitions.
|
|
586 The function takes one argument, FILENAME, a string;
|
|
587 it specifies the file name (without a directory) of the DOC file.
|
|
588 That file is found in `../etc' now; later, when the dumped Emacs is run,
|
56216
|
589 the same file name is found in the `doc-directory'. */)
|
41001
|
590 (filename)
|
297
|
591 Lisp_Object filename;
|
|
592 {
|
|
593 int fd;
|
|
594 char buf[1024 + 1];
|
|
595 register int filled;
|
|
596 register int pos;
|
|
597 register char *p, *end;
|
34963
|
598 Lisp_Object sym;
|
297
|
599 char *name;
|
58068
|
600 int skip_file = 0;
|
297
|
601
|
40656
|
602 CHECK_STRING (filename);
|
297
|
603
|
44324
|
604 if
|
297
|
605 #ifndef CANNOT_DUMP
|
44324
|
606 (!NILP (Vpurify_flag))
|
297
|
607 #else /* CANNOT_DUMP */
|
44324
|
608 (0)
|
|
609 #endif /* CANNOT_DUMP */
|
|
610 {
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
611 name = (char *) alloca (SCHARS (filename) + 14);
|
44324
|
612 strcpy (name, "../etc/");
|
|
613 }
|
|
614 else
|
|
615 {
|
|
616 CHECK_STRING (Vdoc_directory);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
617 name = (char *) alloca (SCHARS (filename)
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
618 + SCHARS (Vdoc_directory) + 1);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
619 strcpy (name, SDATA (Vdoc_directory));
|
44324
|
620 }
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
621 strcat (name, SDATA (filename)); /*** Add this line ***/
|
60388
1f66922e7ad0
(munge_doc_file_name) [VMS]: Use NO_HYPHENS_IN_FILENAMES, not VMS4_4.
Thien-Thi Nguyen <ttn@gnuvola.org>
diff
changeset
|
622 munge_doc_file_name (name);
|
297
|
623
|
58068
|
624 /* Vbuild_files is nil when temacs is run, and non-nil after that. */
|
|
625 if (NILP (Vbuild_files))
|
|
626 {
|
|
627 size_t cp_size = 0;
|
|
628 size_t to_read;
|
|
629 int nr_read;
|
|
630 char *cp = NULL;
|
|
631 char *beg, *end;
|
|
632
|
|
633 fd = emacs_open ("buildobj.lst", O_RDONLY, 0);
|
|
634 if (fd < 0)
|
|
635 report_file_error ("Opening file buildobj.lst", Qnil);
|
|
636
|
|
637 filled = 0;
|
|
638 for (;;)
|
|
639 {
|
|
640 cp_size += 1024;
|
|
641 to_read = cp_size - 1 - filled;
|
|
642 cp = xrealloc (cp, cp_size);
|
|
643 nr_read = emacs_read (fd, &cp[filled], to_read);
|
|
644 filled += nr_read;
|
|
645 if (nr_read < to_read)
|
|
646 break;
|
|
647 }
|
|
648
|
|
649 emacs_close (fd);
|
|
650 cp[filled] = 0;
|
|
651
|
|
652 for (beg = cp; *beg; beg = end)
|
|
653 {
|
|
654 int len;
|
|
655
|
|
656 while (*beg && isspace (*beg)) ++beg;
|
|
657
|
|
658 for (end = beg; *end && ! isspace (*end); ++end)
|
|
659 if (*end == '/') beg = end+1; /* skip directory part */
|
|
660
|
|
661 len = end - beg;
|
|
662 if (len > 4 && end[-4] == '.' && end[-3] == 'o')
|
|
663 len -= 2; /* Just take .o if it ends in .obj */
|
|
664
|
|
665 if (len > 0)
|
|
666 Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
|
|
667 }
|
|
668
|
|
669 xfree (cp);
|
|
670 }
|
|
671
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
672 fd = emacs_open (name, O_RDONLY, 0);
|
297
|
673 if (fd < 0)
|
|
674 report_file_error ("Opening doc string file",
|
|
675 Fcons (build_string (name), Qnil));
|
|
676 Vdoc_file_name = filename;
|
|
677 filled = 0;
|
|
678 pos = 0;
|
|
679 while (1)
|
|
680 {
|
|
681 if (filled < 512)
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
682 filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
|
297
|
683 if (!filled)
|
|
684 break;
|
|
685
|
|
686 buf[filled] = 0;
|
|
687 p = buf;
|
|
688 end = buf + (filled < 512 ? filled : filled - 128);
|
|
689 while (p != end && *p != '\037') p++;
|
|
690 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
|
|
691 if (p != end)
|
|
692 {
|
31225
|
693 end = (char *) index (p, '\n');
|
58068
|
694
|
|
695 /* See if this is a file name, and if it is a file in build-files. */
|
|
696 if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
|
|
697 && (end[-1] == 'o' || end[-1] == 'c'))
|
|
698 {
|
|
699 int len = end - p - 2;
|
|
700 char *fromfile = alloca (len + 1);
|
|
701 strncpy (fromfile, &p[2], len);
|
|
702 fromfile[len] = 0;
|
|
703 if (fromfile[len-1] == 'c')
|
|
704 fromfile[len-1] = 'o';
|
|
705
|
85324
|
706 skip_file = NILP (Fmember (build_string (fromfile),
|
|
707 Vbuild_files));
|
58068
|
708 }
|
|
709
|
20619
|
710 sym = oblookup (Vobarray, p + 2,
|
|
711 multibyte_chars_in_text (p + 2, end - p - 2),
|
|
712 end - p - 2);
|
85324
|
713 /* Check skip_file so that when a function is defined several
|
|
714 times in different files (typically, once in xterm, once in
|
|
715 w32term, ...), we only pay attention to the one that
|
|
716 matters. */
|
58068
|
717 if (! skip_file && SYMBOLP (sym))
|
297
|
718 {
|
|
719 /* Attach a docstring to a variable? */
|
|
720 if (p[1] == 'V')
|
|
721 {
|
|
722 /* Install file-position as variable-documentation property
|
|
723 and make it negative for a user-variable
|
|
724 (doc starts with a `*'). */
|
|
725 Fput (sym, Qvariable_documentation,
|
|
726 make_number ((pos + end + 1 - buf)
|
|
727 * (end[1] == '*' ? -1 : 1)));
|
|
728 }
|
|
729
|
1651
|
730 /* Attach a docstring to a function? */
|
297
|
731 else if (p[1] == 'F')
|
1651
|
732 store_function_docstring (sym, pos + end + 1 - buf);
|
297
|
733
|
54745
|
734 else if (p[1] == 'S')
|
|
735 ; /* Just a source file name boundary marker. Ignore it. */
|
|
736
|
1651
|
737 else
|
|
738 error ("DOC file invalid at position %d", pos);
|
297
|
739 }
|
|
740 }
|
|
741 pos += end - buf;
|
|
742 filled -= end - buf;
|
|
743 bcopy (end, buf, filled);
|
|
744 }
|
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
diff
changeset
|
745 emacs_close (fd);
|
297
|
746 return Qnil;
|
|
747 }
|
|
748
|
|
749 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
|
41001
|
750 Ssubstitute_command_keys, 1, 1, 0,
|
|
751 doc: /* Substitute key descriptions for command names in STRING.
|
66815
|
752 Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
|
|
753 sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
|
|
754 on any keys.
|
41001
|
755 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
|
68784
|
756 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
|
41001
|
757 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
|
|
758 as the keymap for future \\=\\[COMMAND] substrings.
|
|
759 \\=\\= quotes the following character and is discarded;
|
66815
|
760 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
|
|
761
|
75968
|
762 Returns original STRING if no substitutions were made. Otherwise,
|
66815
|
763 a new string, without any text properties, is returned. */)
|
41001
|
764 (string)
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
765 Lisp_Object string;
|
297
|
766 {
|
|
767 unsigned char *buf;
|
|
768 int changed = 0;
|
|
769 register unsigned char *strp;
|
|
770 register unsigned char *bufp;
|
|
771 int idx;
|
|
772 int bsize;
|
1511
|
773 Lisp_Object tem;
|
297
|
774 Lisp_Object keymap;
|
|
775 unsigned char *start;
|
20802
|
776 int length, length_byte;
|
1511
|
777 Lisp_Object name;
|
|
778 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
|
20619
|
779 int multibyte;
|
|
780 int nchars;
|
297
|
781
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
782 if (NILP (string))
|
297
|
783 return Qnil;
|
|
784
|
40656
|
785 CHECK_STRING (string);
|
1511
|
786 tem = Qnil;
|
|
787 keymap = Qnil;
|
|
788 name = Qnil;
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
789 GCPRO4 (string, tem, keymap, name);
|
297
|
790
|
20619
|
791 multibyte = STRING_MULTIBYTE (string);
|
|
792 nchars = 0;
|
|
793
|
5784
|
794 /* KEYMAP is either nil (which means search all the active keymaps)
|
|
795 or a specified local map (which means search just that and the
|
|
796 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
|
797 or from a \\<mapname> construct in STRING itself.. */
|
12261
|
798 keymap = current_kboard->Voverriding_terminal_local_map;
|
|
799 if (NILP (keymap))
|
|
800 keymap = Voverriding_local_map;
|
297
|
801
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
802 bsize = SBYTES (string);
|
297
|
803 bufp = buf = (unsigned char *) xmalloc (bsize);
|
|
804
|
50629
|
805 strp = SDATA (string);
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
806 while (strp < SDATA (string) + SBYTES (string))
|
297
|
807 {
|
|
808 if (strp[0] == '\\' && strp[1] == '=')
|
|
809 {
|
|
810 /* \= quotes the next character;
|
|
811 thus, to put in \[ without its special meaning, use \=\[. */
|
|
812 changed = 1;
|
20619
|
813 strp += 2;
|
|
814 if (multibyte)
|
|
815 {
|
|
816 int len;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
817 int maxlen = SDATA (string) + SBYTES (string) - strp;
|
20619
|
818
|
|
819 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
|
|
820 if (len == 1)
|
|
821 *bufp = *strp;
|
|
822 else
|
|
823 bcopy (strp, bufp, len);
|
|
824 strp += len;
|
|
825 bufp += len;
|
|
826 nchars++;
|
|
827 }
|
|
828 else
|
|
829 *bufp++ = *strp++, nchars++;
|
297
|
830 }
|
|
831 else if (strp[0] == '\\' && strp[1] == '[')
|
|
832 {
|
30154
|
833 int start_idx;
|
65391
|
834 int follow_remap = 1;
|
5248
|
835
|
297
|
836 changed = 1;
|
|
837 strp += 2; /* skip \[ */
|
|
838 start = strp;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
839 start_idx = start - SDATA (string);
|
297
|
840
|
50629
|
841 while ((strp - SDATA (string)
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
842 < SBYTES (string))
|
297
|
843 && *strp != ']')
|
|
844 strp++;
|
20619
|
845 length_byte = strp - start;
|
|
846
|
297
|
847 strp++; /* skip ] */
|
|
848
|
|
849 /* Save STRP in IDX. */
|
50629
|
850 idx = strp - SDATA (string);
|
57497
|
851 name = Fintern (make_string (start, length_byte), Qnil);
|
30154
|
852
|
65391
|
853 do_remap:
|
57441
|
854 /* Ignore remappings unless there are no ordinary bindings. */
|
57497
|
855 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt);
|
57441
|
856 if (NILP (tem))
|
57497
|
857 tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
|
57441
|
858
|
65391
|
859 if (VECTORP (tem) && XVECTOR (tem)->size > 1
|
|
860 && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
|
|
861 && follow_remap)
|
|
862 {
|
|
863 name = AREF (tem, 1);
|
|
864 follow_remap = 0;
|
|
865 goto do_remap;
|
|
866 }
|
|
867
|
30154
|
868 /* Note the Fwhere_is_internal can GC, so we have to take
|
|
869 relocation of string contents into account. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
870 strp = SDATA (string) + idx;
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
871 start = SDATA (string) + start_idx;
|
297
|
872
|
485
|
873 if (NILP (tem)) /* but not on any keys */
|
297
|
874 {
|
34363
|
875 int offset = bufp - buf;
|
|
876 buf = (unsigned char *) xrealloc (buf, bsize += 4);
|
|
877 bufp = buf + offset;
|
297
|
878 bcopy ("M-x ", bufp, 4);
|
|
879 bufp += 4;
|
20619
|
880 nchars += 4;
|
|
881 if (multibyte)
|
|
882 length = multibyte_chars_in_text (start, length_byte);
|
|
883 else
|
|
884 length = length_byte;
|
297
|
885 goto subst;
|
|
886 }
|
|
887 else
|
|
888 { /* function is on a key */
|
54927
|
889 tem = Fkey_description (tem, Qnil);
|
297
|
890 goto subst_string;
|
|
891 }
|
|
892 }
|
|
893 /* \{foo} is replaced with a summary of the keymap (symbol-value foo).
|
|
894 \<foo> just sets the keymap used for \[cmd]. */
|
|
895 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
|
|
896 {
|
|
897 struct buffer *oldbuf;
|
30154
|
898 int start_idx;
|
60065
|
899 /* This is for computing the SHADOWS arg for describe_map_tree. */
|
81609
|
900 Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
|
60065
|
901 Lisp_Object earlier_maps;
|
297
|
902
|
|
903 changed = 1;
|
|
904 strp += 2; /* skip \{ or \< */
|
|
905 start = strp;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
906 start_idx = start - SDATA (string);
|
297
|
907
|
54234
|
908 while ((strp - SDATA (string) < SBYTES (string))
|
297
|
909 && *strp != '}' && *strp != '>')
|
|
910 strp++;
|
20619
|
911
|
|
912 length_byte = strp - start;
|
297
|
913 strp++; /* skip } or > */
|
|
914
|
|
915 /* Save STRP in IDX. */
|
50629
|
916 idx = strp - SDATA (string);
|
297
|
917
|
|
918 /* Get the value of the keymap in TEM, or nil if undefined.
|
|
919 Do this while still in the user's current buffer
|
|
920 in case it is a local variable. */
|
20619
|
921 name = Fintern (make_string (start, length_byte), Qnil);
|
297
|
922 tem = Fboundp (name);
|
485
|
923 if (! NILP (tem))
|
297
|
924 {
|
|
925 tem = Fsymbol_value (name);
|
485
|
926 if (! NILP (tem))
|
30154
|
927 {
|
32988
|
928 tem = get_keymap (tem, 0, 1);
|
|
929 /* Note that get_keymap can GC. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
930 strp = SDATA (string) + idx;
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
931 start = SDATA (string) + start_idx;
|
30154
|
932 }
|
297
|
933 }
|
|
934
|
|
935 /* Now switch to a temp buffer. */
|
|
936 oldbuf = current_buffer;
|
|
937 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer));
|
|
938
|
485
|
939 if (NILP (tem))
|
297
|
940 {
|
|
941 name = Fsymbol_name (name);
|
|
942 insert_string ("\nUses keymap \"");
|
20619
|
943 insert_from_string (name, 0, 0,
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
944 SCHARS (name),
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
945 SBYTES (name), 1);
|
297
|
946 insert_string ("\", which is not currently defined.\n");
|
|
947 if (start[-1] == '<') keymap = Qnil;
|
|
948 }
|
|
949 else if (start[-1] == '<')
|
|
950 keymap = tem;
|
|
951 else
|
60065
|
952 {
|
|
953 /* Get the list of active keymaps that precede this one.
|
|
954 If this one's not active, get nil. */
|
|
955 earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
|
|
956 describe_map_tree (tem, 1, Fnreverse (earlier_maps),
|
|
957 Qnil, (char *)0, 1, 0, 0, 1);
|
|
958 }
|
297
|
959 tem = Fbuffer_string ();
|
|
960 Ferase_buffer ();
|
|
961 set_buffer_internal (oldbuf);
|
|
962
|
|
963 subst_string:
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
964 start = SDATA (tem);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
965 length = SCHARS (tem);
|
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
966 length_byte = SBYTES (tem);
|
297
|
967 subst:
|
34363
|
968 {
|
|
969 int offset = bufp - buf;
|
|
970 buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
|
|
971 bufp = buf + offset;
|
|
972 bcopy (start, bufp, length_byte);
|
|
973 bufp += length_byte;
|
|
974 nchars += length;
|
|
975 /* Check STRING again in case gc relocated it. */
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
976 strp = (unsigned char *) SDATA (string) + idx;
|
34363
|
977 }
|
297
|
978 }
|
20619
|
979 else if (! multibyte) /* just copy other chars */
|
|
980 *bufp++ = *strp++, nchars++;
|
|
981 else
|
|
982 {
|
|
983 int len;
|
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
diff
changeset
|
984 int maxlen = SDATA (string) + SBYTES (string) - strp;
|
20619
|
985
|
|
986 STRING_CHAR_AND_LENGTH (strp, maxlen, len);
|
|
987 if (len == 1)
|
|
988 *bufp = *strp;
|
|
989 else
|
|
990 bcopy (strp, bufp, len);
|
|
991 strp += len;
|
|
992 bufp += len;
|
|
993 nchars++;
|
|
994 }
|
297
|
995 }
|
|
996
|
|
997 if (changed) /* don't bother if nothing substituted */
|
21252
|
998 tem = make_string_from_bytes (buf, nchars, bufp - buf);
|
297
|
999 else
|
14069
a45a97ebdf1c
(Fdocumentation, Fdocumentation_property, Fsubstitute_command_keys):
Erik Naggum <erik@naggum.no>
diff
changeset
|
1000 tem = string;
|
2439
|
1001 xfree (buf);
|
1511
|
1002 RETURN_UNGCPRO (tem);
|
297
|
1003 }
|
|
1004
|
21514
|
1005 void
|
297
|
1006 syms_of_doc ()
|
|
1007 {
|
28334
|
1008 Qfunction_documentation = intern ("function-documentation");
|
|
1009 staticpro (&Qfunction_documentation);
|
49600
|
1010
|
297
|
1011 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
|
41001
|
1012 doc: /* Name of file containing documentation strings of built-in symbols. */);
|
297
|
1013 Vdoc_file_name = Qnil;
|
|
1014
|
58068
|
1015 DEFVAR_LISP ("build-files", &Vbuild_files,
|
|
1016 doc: /* A list of files used to build this Emacs binary. */);
|
|
1017 Vbuild_files = Qnil;
|
|
1018
|
297
|
1019 defsubr (&Sdocumentation);
|
|
1020 defsubr (&Sdocumentation_property);
|
|
1021 defsubr (&Ssnarf_documentation);
|
|
1022 defsubr (&Ssubstitute_command_keys);
|
|
1023 }
|
52401
|
1024
|
|
1025 /* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
|
|
1026 (do not change this comment) */
|