Mercurial > emacs
annotate src/doc.c @ 4413:5a00cec8e9b0
(fill-region-as-paragraph): When we take one word
after the fill column, don't stop at period with just one space.
When checking whether at beginning of line, if no fill prefix,
ignore intervening whitespace.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Aug 1993 05:55:56 +0000 |
parents | 6ad80fc3c559 |
children | 1fc792473491 |
rev | line source |
---|---|
297 | 1 /* Record indices of function doc strings stored in a file. |
2961 | 2 Copyright (C) 1985, 1986, 1993 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 | |
8 the Free Software Foundation; either version 1, or (at your option) | |
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 | |
21 #include "config.h" | |
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 | |
30 #ifndef O_RDONLY | |
31 #define O_RDONLY 0 | |
32 #endif | |
33 | |
34 #include "lisp.h" | |
35 #include "buffer.h" | |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
36 #include "keyboard.h" |
297 | 37 |
961
8d2cbfd93066
* doc.c (Vdata_directory): Removed; this is declared in callproc.c.
Jim Blandy <jimb@redhat.com>
parents:
943
diff
changeset
|
38 Lisp_Object Vdoc_file_name; |
297 | 39 |
40 Lisp_Object | |
41 get_doc_string (filepos) | |
42 long filepos; | |
43 { | |
44 char buf[512 * 32 + 1]; | |
45 register int fd; | |
46 register char *name; | |
47 register char *p, *p1; | |
48 register int count; | |
49 extern char *index (); | |
50 | |
463 | 51 if (XTYPE (Vdata_directory) != Lisp_String |
297 | 52 || XTYPE (Vdoc_file_name) != Lisp_String) |
53 return Qnil; | |
54 | |
463 | 55 name = (char *) alloca (XSTRING (Vdata_directory)->size |
297 | 56 + XSTRING (Vdoc_file_name)->size + 8); |
463 | 57 strcpy (name, XSTRING (Vdata_directory)->data); |
297 | 58 strcat (name, XSTRING (Vdoc_file_name)->data); |
59 #ifdef VMS | |
60 #ifndef VMS4_4 | |
61 /* For VMS versions with limited file name syntax, | |
62 convert the name to something VMS will allow. */ | |
63 p = name; | |
64 while (*p) | |
65 { | |
66 if (*p == '-') | |
67 *p = '_'; | |
68 p++; | |
69 } | |
70 #endif /* not VMS4_4 */ | |
71 #ifdef VMS4_4 | |
72 strcpy (name, sys_translate_unix (name)); | |
73 #endif /* VMS4_4 */ | |
74 #endif /* VMS */ | |
75 | |
76 fd = open (name, O_RDONLY, 0); | |
77 if (fd < 0) | |
78 error ("Cannot open doc string file \"%s\"", name); | |
79 if (0 > lseek (fd, filepos, 0)) | |
80 { | |
81 close (fd); | |
82 error ("Position %ld out of range in doc string file \"%s\"", | |
83 filepos, name); | |
84 } | |
85 p = buf; | |
86 while (p != buf + sizeof buf - 1) | |
87 { | |
88 count = read (fd, p, 512); | |
89 p[count] = 0; | |
90 if (!count) | |
91 break; | |
92 p1 = index (p, '\037'); | |
93 if (p1) | |
94 { | |
95 *p1 = 0; | |
96 p = p1; | |
97 break; | |
98 } | |
99 p += count; | |
100 } | |
101 close (fd); | |
102 return make_string (buf, p - buf); | |
103 } | |
104 | |
570 | 105 DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0, |
604 | 106 "Return the documentation string of FUNCTION.\n\ |
107 Unless a non-nil second argument is given, the\n\ | |
570 | 108 string is passed through `substitute-command-keys'.") |
647 | 109 (function, raw) |
110 Lisp_Object function, raw; | |
297 | 111 { |
112 Lisp_Object fun; | |
113 Lisp_Object funcar; | |
570 | 114 Lisp_Object tem, doc; |
297 | 115 |
647 | 116 fun = Findirect_function (function); |
297 | 117 |
118 switch (XTYPE (fun)) | |
119 { | |
120 case Lisp_Subr: | |
121 if (XSUBR (fun)->doc == 0) return Qnil; | |
122 if ((int) XSUBR (fun)->doc >= 0) | |
570 | 123 doc = build_string (XSUBR (fun)->doc); |
297 | 124 else |
570 | 125 doc = get_doc_string (- (int) XSUBR (fun)->doc); |
126 break; | |
297 | 127 |
128 case Lisp_Compiled: | |
129 if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) | |
130 return Qnil; | |
131 tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING]; | |
132 if (XTYPE (tem) == Lisp_String) | |
570 | 133 doc = tem; |
134 else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) | |
135 doc = get_doc_string (XFASTINT (tem)); | |
136 else | |
137 return Qnil; | |
138 break; | |
297 | 139 |
140 case Lisp_String: | |
141 case Lisp_Vector: | |
142 return build_string ("Keyboard macro."); | |
143 | |
144 case Lisp_Cons: | |
145 funcar = Fcar (fun); | |
146 if (XTYPE (funcar) != Lisp_Symbol) | |
147 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | |
647 | 148 else if (EQ (funcar, Qkeymap)) |
297 | 149 return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\ |
150 subcommands.)"); | |
647 | 151 else if (EQ (funcar, Qlambda) |
152 || EQ (funcar, Qautoload)) | |
297 | 153 { |
154 tem = Fcar (Fcdr (Fcdr (fun))); | |
155 if (XTYPE (tem) == Lisp_String) | |
570 | 156 doc = tem; |
157 else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0) | |
158 doc = get_doc_string (XFASTINT (tem)); | |
159 else | |
160 return Qnil; | |
647 | 161 |
162 break; | |
297 | 163 } |
647 | 164 else if (EQ (funcar, Qmocklisp)) |
297 | 165 return Qnil; |
647 | 166 else if (EQ (funcar, Qmacro)) |
570 | 167 return Fdocumentation (Fcdr (fun), raw); |
297 | 168 |
169 /* Fall through to the default to report an error. */ | |
170 | |
171 default: | |
172 return Fsignal (Qinvalid_function, Fcons (fun, Qnil)); | |
173 } | |
570 | 174 |
577 | 175 if (NILP (raw)) |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
176 { |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
177 struct gcpro gcpro1; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
178 |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
179 GCPRO1 (doc); |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
180 doc = Fsubstitute_command_keys (doc); |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
181 UNGCPRO; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
182 } |
570 | 183 return doc; |
297 | 184 } |
185 | |
577 | 186 DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 2, 0, |
297 | 187 "Return the documentation string that is SYMBOL's PROP property.\n\ |
570 | 188 This is like `get', but it can refer to strings stored in the\n\ |
604 | 189 `etc/DOC' file; and if the value is a string, it is passed through\n\ |
577 | 190 `substitute-command-keys'. A non-nil third argument avoids this\n\ |
191 translation.") | |
570 | 192 (sym, prop, raw) |
193 Lisp_Object sym, prop, raw; | |
297 | 194 { |
195 register Lisp_Object tem; | |
196 | |
197 tem = Fget (sym, prop); | |
198 if (XTYPE (tem) == Lisp_Int) | |
199 tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem)); | |
577 | 200 if (NILP (raw) && XTYPE (tem) == Lisp_String) |
312
adba7439e87c
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
297
diff
changeset
|
201 return Fsubstitute_command_keys (tem); |
adba7439e87c
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
297
diff
changeset
|
202 return tem; |
297 | 203 } |
204 | |
1651
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
205 /* Scanning the DOC files and placing docstring offsets into functions. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
206 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
207 static void |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
208 store_function_docstring (fun, offset) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
209 Lisp_Object fun; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
210 int offset; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
211 { |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
212 fun = indirect_function (fun); |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
213 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
214 /* The type determines where the docstring is stored. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
215 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
216 /* Lisp_Subrs have a slot for it. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
217 if (XTYPE (fun) == Lisp_Subr) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
218 XSUBR (fun)->doc = (char *) - offset; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
219 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
220 /* If it's a lisp form, stick it in the form. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
221 else if (CONSP (fun)) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
222 { |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
223 Lisp_Object tem; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
224 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
225 tem = XCONS (fun)->car; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
226 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
227 { |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
228 tem = Fcdr (Fcdr (fun)); |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
229 if (CONSP (tem) && |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
230 XTYPE (XCONS (tem)->car) == Lisp_Int) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
231 XFASTINT (XCONS (tem)->car) = offset; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
232 } |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
233 else if (EQ (tem, Qmacro)) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
234 store_function_docstring (XCONS (fun)->cdr, offset); |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
235 } |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
236 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
237 /* Bytecode objects sometimes have slots for it. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
238 else if (XTYPE (fun) == Lisp_Compiled) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
239 { |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
240 /* This bytecode object must have a slot for the |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
241 docstring, since we've found a docstring for it. */ |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
242 if (XVECTOR (fun)->size <= COMPILED_DOC_STRING) |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
243 abort (); |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
244 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
245 XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING]) = offset; |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
246 } |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
247 } |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
248 |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
249 |
297 | 250 DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation, |
251 1, 1, 0, | |
252 "Used during Emacs initialization, before dumping runnable Emacs,\n\ | |
604 | 253 to find pointers to doc strings stored in `etc/DOC...' and\n\ |
297 | 254 record them in function definitions.\n\ |
255 One arg, FILENAME, a string which does not include a directory.\n\ | |
604 | 256 The file is found in `../etc' now; found in the `data-directory'\n\ |
297 | 257 when doc strings are referred to later in the dumped Emacs.") |
258 (filename) | |
259 Lisp_Object filename; | |
260 { | |
261 int fd; | |
262 char buf[1024 + 1]; | |
263 register int filled; | |
264 register int pos; | |
265 register char *p, *end; | |
266 Lisp_Object sym, fun, tem; | |
267 char *name; | |
268 extern char *index (); | |
269 | |
1116
6d0d442e2ada
* doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents:
961
diff
changeset
|
270 #ifndef CANNOT_DUMP |
6d0d442e2ada
* doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents:
961
diff
changeset
|
271 if (NILP (Vpurify_flag)) |
6d0d442e2ada
* doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents:
961
diff
changeset
|
272 error ("Snarf-documentation can only be called in an undumped Emacs"); |
6d0d442e2ada
* doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents:
961
diff
changeset
|
273 #endif |
6d0d442e2ada
* doc.c (Fsnarf_documentation): Signal an error if this is
Jim Blandy <jimb@redhat.com>
parents:
961
diff
changeset
|
274 |
297 | 275 CHECK_STRING (filename, 0); |
276 | |
277 #ifndef CANNOT_DUMP | |
463 | 278 name = (char *) alloca (XSTRING (filename)->size + 14); |
604 | 279 strcpy (name, "../etc/"); |
297 | 280 #else /* CANNOT_DUMP */ |
463 | 281 CHECK_STRING (Vdata_directory, 0); |
297 | 282 name = (char *) alloca (XSTRING (filename)->size + |
463 | 283 XSTRING (Vdata_directory)->size + 1); |
284 strcpy (name, XSTRING (Vdata_directory)->data); | |
297 | 285 #endif /* CANNOT_DUMP */ |
286 strcat (name, XSTRING (filename)->data); /*** Add this line ***/ | |
287 #ifdef VMS | |
288 #ifndef VMS4_4 | |
289 /* For VMS versions with limited file name syntax, | |
290 convert the name to something VMS will allow. */ | |
291 p = name; | |
292 while (*p) | |
293 { | |
294 if (*p == '-') | |
295 *p = '_'; | |
296 p++; | |
297 } | |
298 #endif /* not VMS4_4 */ | |
299 #ifdef VMS4_4 | |
300 strcpy (name, sys_translate_unix (name)); | |
301 #endif /* VMS4_4 */ | |
302 #endif /* VMS */ | |
303 | |
304 fd = open (name, O_RDONLY, 0); | |
305 if (fd < 0) | |
306 report_file_error ("Opening doc string file", | |
307 Fcons (build_string (name), Qnil)); | |
308 Vdoc_file_name = filename; | |
309 filled = 0; | |
310 pos = 0; | |
311 while (1) | |
312 { | |
313 if (filled < 512) | |
314 filled += read (fd, &buf[filled], sizeof buf - 1 - filled); | |
315 if (!filled) | |
316 break; | |
317 | |
318 buf[filled] = 0; | |
319 p = buf; | |
320 end = buf + (filled < 512 ? filled : filled - 128); | |
321 while (p != end && *p != '\037') p++; | |
322 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ | |
323 if (p != end) | |
324 { | |
325 end = index (p, '\n'); | |
326 sym = oblookup (Vobarray, p + 2, end - p - 2); | |
327 if (XTYPE (sym) == Lisp_Symbol) | |
328 { | |
329 /* Attach a docstring to a variable? */ | |
330 if (p[1] == 'V') | |
331 { | |
332 /* Install file-position as variable-documentation property | |
333 and make it negative for a user-variable | |
334 (doc starts with a `*'). */ | |
335 Fput (sym, Qvariable_documentation, | |
336 make_number ((pos + end + 1 - buf) | |
337 * (end[1] == '*' ? -1 : 1))); | |
338 } | |
339 | |
1651
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
340 /* Attach a docstring to a function? */ |
297 | 341 else if (p[1] == 'F') |
1651
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
342 store_function_docstring (sym, pos + end + 1 - buf); |
297 | 343 |
1651
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
344 else |
ef09501a0a9b
* doc.c (store_function_docstring): New function, made from part
Jim Blandy <jimb@redhat.com>
parents:
1511
diff
changeset
|
345 error ("DOC file invalid at position %d", pos); |
297 | 346 } |
347 } | |
348 pos += end - buf; | |
349 filled -= end - buf; | |
350 bcopy (end, buf, filled); | |
351 } | |
352 close (fd); | |
353 return Qnil; | |
354 } | |
355 | |
356 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, | |
357 Ssubstitute_command_keys, 1, 1, 0, | |
358 "Substitute key descriptions for command names in STRING.\n\ | |
359 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\ | |
360 replaced by either: a keystroke sequence that will invoke COMMAND,\n\ | |
361 or \"M-x COMMAND\" if COMMAND is not on any keys.\n\ | |
362 Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\ | |
363 \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\ | |
364 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\ | |
365 as the keymap for future \\=\\[COMMAND] substrings.\n\ | |
366 \\=\\= quotes the following character and is discarded;\n\ | |
367 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.") | |
368 (str) | |
369 Lisp_Object str; | |
370 { | |
371 unsigned char *buf; | |
372 int changed = 0; | |
373 register unsigned char *strp; | |
374 register unsigned char *bufp; | |
375 int idx; | |
376 int bsize; | |
377 unsigned char *new; | |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
378 Lisp_Object tem; |
297 | 379 Lisp_Object keymap; |
380 unsigned char *start; | |
381 int length; | |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
382 Lisp_Object name; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
383 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; |
297 | 384 |
485 | 385 if (NILP (str)) |
297 | 386 return Qnil; |
387 | |
388 CHECK_STRING (str, 0); | |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
389 tem = Qnil; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
390 keymap = Qnil; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
391 name = Qnil; |
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
392 GCPRO4 (str, tem, keymap, name); |
297 | 393 |
394 keymap = current_buffer->keymap; | |
395 | |
396 bsize = XSTRING (str)->size; | |
397 bufp = buf = (unsigned char *) xmalloc (bsize); | |
398 | |
399 strp = (unsigned char *) XSTRING (str)->data; | |
400 while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size) | |
401 { | |
402 if (strp[0] == '\\' && strp[1] == '=') | |
403 { | |
404 /* \= quotes the next character; | |
405 thus, to put in \[ without its special meaning, use \=\[. */ | |
406 changed = 1; | |
407 *bufp++ = strp[2]; | |
408 strp += 3; | |
409 } | |
410 else if (strp[0] == '\\' && strp[1] == '[') | |
411 { | |
412 changed = 1; | |
413 strp += 2; /* skip \[ */ | |
414 start = strp; | |
415 | |
416 while ((strp - (unsigned char *) XSTRING (str)->data | |
417 < XSTRING (str)->size) | |
418 && *strp != ']') | |
419 strp++; | |
420 length = strp - start; | |
421 strp++; /* skip ] */ | |
422 | |
423 /* Save STRP in IDX. */ | |
424 idx = strp - (unsigned char *) XSTRING (str)->data; | |
425 tem = Fintern (make_string (start, length), Qnil); | |
426 tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, Qnil); | |
427 | |
485 | 428 if (NILP (tem)) /* but not on any keys */ |
297 | 429 { |
430 new = (unsigned char *) xrealloc (buf, bsize += 4); | |
431 bufp += new - buf; | |
432 buf = new; | |
433 bcopy ("M-x ", bufp, 4); | |
434 bufp += 4; | |
435 goto subst; | |
436 } | |
437 else | |
438 { /* function is on a key */ | |
439 tem = Fkey_description (tem); | |
440 goto subst_string; | |
441 } | |
442 } | |
443 /* \{foo} is replaced with a summary of the keymap (symbol-value foo). | |
444 \<foo> just sets the keymap used for \[cmd]. */ | |
445 else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) | |
446 { | |
447 struct buffer *oldbuf; | |
448 | |
449 changed = 1; | |
450 strp += 2; /* skip \{ or \< */ | |
451 start = strp; | |
452 | |
453 while ((strp - (unsigned char *) XSTRING (str)->data | |
454 < XSTRING (str)->size) | |
455 && *strp != '}' && *strp != '>') | |
456 strp++; | |
457 length = strp - start; | |
458 strp++; /* skip } or > */ | |
459 | |
460 /* Save STRP in IDX. */ | |
461 idx = strp - (unsigned char *) XSTRING (str)->data; | |
462 | |
463 /* Get the value of the keymap in TEM, or nil if undefined. | |
464 Do this while still in the user's current buffer | |
465 in case it is a local variable. */ | |
466 name = Fintern (make_string (start, length), Qnil); | |
467 tem = Fboundp (name); | |
485 | 468 if (! NILP (tem)) |
297 | 469 { |
470 tem = Fsymbol_value (name); | |
485 | 471 if (! NILP (tem)) |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
472 tem = get_keymap_1 (tem, 0, 1); |
297 | 473 } |
474 | |
475 /* Now switch to a temp buffer. */ | |
476 oldbuf = current_buffer; | |
477 set_buffer_internal (XBUFFER (Vprin1_to_string_buffer)); | |
478 | |
485 | 479 if (NILP (tem)) |
297 | 480 { |
481 name = Fsymbol_name (name); | |
482 insert_string ("\nUses keymap \""); | |
483 insert_from_string (name, 0, XSTRING (name)->size); | |
484 insert_string ("\", which is not currently defined.\n"); | |
485 if (start[-1] == '<') keymap = Qnil; | |
486 } | |
487 else if (start[-1] == '<') | |
488 keymap = tem; | |
489 else | |
3999
6ad80fc3c559
* doc.c (Fsubstitute_command_keys): Pass all five arguments to
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
490 describe_map_tree (tem, 1, Qnil, Qnil, 0); |
297 | 491 tem = Fbuffer_string (); |
492 Ferase_buffer (); | |
493 set_buffer_internal (oldbuf); | |
494 | |
495 subst_string: | |
496 start = XSTRING (tem)->data; | |
497 length = XSTRING (tem)->size; | |
498 subst: | |
499 new = (unsigned char *) xrealloc (buf, bsize += length); | |
500 bufp += new - buf; | |
501 buf = new; | |
502 bcopy (start, bufp, length); | |
503 bufp += length; | |
504 /* Check STR again in case gc relocated it. */ | |
505 strp = (unsigned char *) XSTRING (str)->data + idx; | |
506 } | |
507 else /* just copy other chars */ | |
508 *bufp++ = *strp++; | |
509 } | |
510 | |
511 if (changed) /* don't bother if nothing substituted */ | |
512 tem = make_string (buf, bufp - buf); | |
513 else | |
514 tem = str; | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
1651
diff
changeset
|
515 xfree (buf); |
1511
ff88f962a982
* doc.c: #include keyboard.h.
Jim Blandy <jimb@redhat.com>
parents:
1116
diff
changeset
|
516 RETURN_UNGCPRO (tem); |
297 | 517 } |
518 | |
519 syms_of_doc () | |
520 { | |
521 DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name, | |
522 "Name of file containing documentation strings of built-in symbols."); | |
523 Vdoc_file_name = Qnil; | |
524 | |
525 defsubr (&Sdocumentation); | |
526 defsubr (&Sdocumentation_property); | |
527 defsubr (&Ssnarf_documentation); | |
528 defsubr (&Ssubstitute_command_keys); | |
529 } |