![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to doc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src|
Return to doc.c CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src |
1.1 root 1: /* Record indices of function doc strings stored in a file.
2: Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is distributed in the hope that it will be useful,
7: but WITHOUT ANY WARRANTY. No author or distributor
8: accepts responsibility to anyone for the consequences of using it
9: or for whether it serves any particular purpose or works at all,
10: unless he says so in writing. Refer to the GNU Emacs General Public
11: License for full details.
12:
13: Everyone is granted permission to copy, modify and redistribute
14: GNU Emacs, but only under the conditions described in the
15: GNU Emacs General Public License. A copy of this license is
16: supposed to have been given to you along with GNU Emacs so you
17: can know your rights and responsibilities. It should be in a
18: file named COPYING. Among other things, the copyright notice
19: and this notice must be preserved on all copies. */
20:
21:
22: #include "config.h"
23: #include "lisp.h"
24: #include "buffer.h"
25:
26: #include <sys/types.h>
27: #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
28:
29: #ifdef USG5
30: #include <fcntl.h>
31: #endif
32:
33: #ifndef O_RDONLY
34: #define O_RDONLY 0
35: #endif
36:
37: Lisp_Object Vdoc_file_name;
38:
39: Lisp_Object
40: get_doc_string (filepos)
41: long filepos;
42: {
43: char buf[512 * 32 + 1];
44: register int fd;
45: register char *name;
46: register char *p, *p1;
47: register int count;
48: extern char *index ();
49:
50: if (XTYPE (Vexec_directory) != Lisp_String
51: || XTYPE (Vdoc_file_name) != Lisp_String)
52: return Qnil;
53:
54: name = (char *) alloca (XSTRING (Vexec_directory)->size
55: + XSTRING (Vdoc_file_name)->size + 8);
56: strcpy (name, XSTRING (Vexec_directory)->data);
57: strcat (name, XSTRING (Vdoc_file_name)->data);
58: #ifdef VMS
59: #ifndef VMS4_4
60: /* For VMS versions with limited file name syntax,
61: convert the name to something VMS will allow. */
62: p = name;
63: while (*p)
64: {
65: if (*p == '-')
66: *p = '_';
67: p++;
68: }
69: #endif /* not VMS4_4 */
70: #ifdef VMS4_4
71: strcpy (name, sys_translate_unix (name));
72: #endif /* VMS4_4 */
73: #endif /* VMS */
74:
75: fd = open (name, O_RDONLY, 0);
76: if (fd < 0)
77: error ("Cannot open doc string file \"%s\"", name);
78: if (0 > lseek (fd, filepos, 0))
79: {
80: close (fd);
81: error ("Position %ld out of range in doc string file \"%s\"",
82: filepos, name);
83: }
84: p = buf;
85: while (p != buf + sizeof buf - 1)
86: {
87: count = read (fd, p, 512);
88: p[count] = 0;
89: if (!count)
90: break;
91: p1 = index (p, '\037');
92: if (p1)
93: {
94: *p1 = 0;
95: p = p1;
96: break;
97: }
98: p += count;
99: }
100: close (fd);
101: return make_string (buf, p - buf);
102: }
103:
104: DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0,
105: "Return the documentation string of FUNCTION.")
106: (fun1)
107: Lisp_Object fun1;
108: {
109: Lisp_Object fun;
110: Lisp_Object funcar;
111: Lisp_Object tem;
112:
113: fun = fun1;
114: while (XTYPE (fun) == Lisp_Symbol)
115: fun = Fsymbol_function (fun);
116: if (XTYPE (fun) == Lisp_Subr)
117: {
118: if (XSUBR (fun)->doc == 0) return Qnil;
119: if ((int) XSUBR (fun)->doc >= 0)
120: return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc));
121: return Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc));
122: }
123: if (XTYPE (fun) == Lisp_Vector)
124: return build_string ("Prefix command (definition is a Lisp vector of subcommands).");
125: if (XTYPE (fun) == Lisp_String)
126: return build_string ("Keyboard macro.");
127: if (!CONSP (fun))
128: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
129: funcar = Fcar (fun);
130: if (XTYPE (funcar) != Lisp_Symbol)
131: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
132: if (XSYMBOL (funcar) == XSYMBOL (Qkeymap))
133: return build_string ("Prefix command (definition is a list whose cdr is an alist of subcommands.)");
134: if (XSYMBOL (funcar) == XSYMBOL (Qlambda)
135: || XSYMBOL (funcar) == XSYMBOL (Qautoload))
136: {
137: tem = Fcar (Fcdr (Fcdr (fun)));
138: if (XTYPE (tem) == Lisp_String)
139: return Fsubstitute_command_keys (tem);
140: if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
141: return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem)));
142: return Qnil;
143: }
144: if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp))
145: return Qnil;
146: if (XSYMBOL (funcar) == XSYMBOL (Qmacro))
147: return Fdocumentation (Fcdr (fun));
148: else
149: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
150: }
151:
152: DEFUN ("documentation-property", Fdocumentation_property,
153: Sdocumentation_property, 2, 2, 0,
154: "Return the documentation string that is SYMBOL's PROP property.\n\
155: This differs from using `get' only in that it can refer to strings\n\
156: stored in the etc/DOC file.")
157: (sym, prop)
158: Lisp_Object sym, prop;
159: {
160: register Lisp_Object tem;
161:
162: tem = Fget (sym, prop);
163: if (XTYPE (tem) == Lisp_Int)
164: tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
165: return Fsubstitute_command_keys (tem);
166: }
167:
168: DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
169: 1, 1, 0,
170: "Used during Emacs initialization, before dumping runnable Emacs,\n\
171: to find pointers to doc strings stored in etc/DOC... and\n\
172: record them in function definitions.\n\
173: One arg, FILENAME, a string which does not include a directory.\n\
174: The file is found in ../etc now; found in the exec-directory\n\
175: when doc strings are referred to later in the dumped Emacs.")
176: (filename)
177: Lisp_Object filename;
178: {
179: int fd;
180: char buf[1024 + 1];
181: register int filled;
182: register int pos;
183: register char *p, *end;
184: Lisp_Object sym, fun, tem;
185: char *name;
186: extern char *index ();
187:
188: CHECK_STRING (filename, 0);
189:
190: #ifndef CANNOT_DUMP
191: name = (char *) alloca (XSTRING (filename)->size + 8);
192: strcpy (name, "../etc/");
193: #else /* CANNOT_DUMP */
194: CHECK_STRING (Vexec_directory, 0);
195: name = (char *) alloca (XSTRING (filename)->size +
196: XSTRING (Vexec_directory)->size + 1);
197: strcpy (name, XSTRING (Vexec_directory)->data);
198: #endif /* CANNOT_DUMP */
199: strcat (name, XSTRING (filename)->data); /*** Add this line ***/
200: #ifdef VMS
201: #ifndef VMS4_4
202: /* For VMS versions with limited file name syntax,
203: convert the name to something VMS will allow. */
204: p = name;
205: while (*p)
206: {
207: if (*p == '-')
208: *p = '_';
209: p++;
210: }
211: #endif /* not VMS4_4 */
212: #ifdef VMS4_4
213: strcpy (name, sys_translate_unix (name));
214: #endif /* VMS4_4 */
215: #endif /* VMS */
216:
217: fd = open (name, O_RDONLY, 0);
218: if (fd < 0)
219: report_file_error ("Opening doc string file",
220: Fcons (build_string (name), Qnil));
221: Vdoc_file_name = filename;
222: filled = 0;
223: pos = 0;
224: while (1)
225: {
226: if (filled < 512)
227: filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
228: if (!filled)
229: break;
230:
231: buf[filled] = 0;
232: p = buf;
233: end = buf + (filled < 512 ? filled : filled - 128);
234: while (p != end && *p != '\037') p++;
235: /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
236: if (p != end)
237: {
238: end = index (p, '\n');
239: sym = oblookup (Vobarray, p + 2, end - p - 2);
240: if (XTYPE (sym) == Lisp_Symbol)
241: {
242: if (p[1] == 'V')
243: {
244: /* Install file-position as variable-documentation property
245: and make it negative for a user-variable
246: (doc starts with a `*'). */
247: Fput (sym, Qvariable_documentation,
248: make_number ((pos + end + 1 - buf)
249: * (end[1] == '*' ? -1 : 1)));
250: }
251: else if (p[1] == 'F')
252: {
253: fun = XSYMBOL (sym)->function;
254: if (XTYPE (fun) == Lisp_Subr)
255: XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
256: else if (CONSP (fun))
257: {
258: tem = XCONS (fun)->car;
259: if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
260: {
261: tem = Fcdr (Fcdr (fun));
262: if (CONSP (tem) &&
263: XTYPE (XCONS (tem)->car) == Lisp_Int)
264: XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
265: }
266: }
267: }
268: else error ("DOC file invalid at position %d", pos);
269: }
270: }
271: pos += end - buf;
272: filled -= end - buf;
273: bcopy (end, buf, filled);
274: }
275: close (fd);
276: return Qnil;
277: }
278:
279: DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
280: Ssubstitute_command_keys, 1, 1, 0,
281: "Return the STRING with substrings of the form \\=\\[COMMAND]\n\
282: replaced by either: a keystroke sequence that will invoke COMMAND,\n\
283: or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
284: Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
285: \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
286: Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
287: as the keymap for future \\=\\[COMMAND] substrings.\n\
288: \\=\\= quotes the following character and is discarded;\n\
289: thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
290: (str)
291: Lisp_Object str;
292: {
293: unsigned char *buf;
294: int changed = 0;
295: register unsigned char *strp;
296: register unsigned char *bufp;
297: register unsigned char *send;
298: int bsize;
299: unsigned char *new;
300: register Lisp_Object tem;
301: Lisp_Object keymap;
302: unsigned char *start;
303: int length;
304:
305: if (NULL (str))
306: return Qnil;
307:
308: CHECK_STRING (str, 0);
309: strp = (unsigned char *) XSTRING (str)->data;
310: send = strp + XSTRING (str)->size;
311:
312: keymap = bf_cur->keymap;
313:
314: bsize = XSTRING (str)->size;
315: bufp = buf = (unsigned char *) xmalloc (bsize);
316:
317: while (strp < send)
318: {
319: if (strp[0] == '\\' && strp[1] == '=')
320: {
321: /* \= quotes the next character;
322: thus, to put in \[ without its special meaning, use \=\[. */
323: changed = 1;
324: *bufp++ = strp[2];
325: strp += 3;
326: }
327: else if (strp[0] == '\\' && strp[1] == '[')
328: {
329: changed = 1;
330: strp += 2; /* skip \[ */
331: start = strp;
332:
333: while (strp < send && *strp != ']')
334: strp++;
335: length = strp - start;
336: strp++; /* skip ] */
337:
338: tem = Fintern (make_string (start, length), Qnil);
339: tem = Fwhere_is_internal (tem, keymap, Qt);
340:
341: if (NULL (tem)) /* but not on any keys */
342: {
343: new = (unsigned char *) xrealloc (buf, bsize += 4);
344: bufp += new - buf;
345: buf = new;
346: bcopy ("M-x ", bufp, 4);
347: bufp += 4;
348: goto subst;
349: }
350: else
351: { /* function is on a key */
352: tem = Fkey_description (tem);
353: goto subst_string;
354: }
355: }
356: /* \{foo} is replaced with a summary of the keymap (symeval foo).
357: \<foo> just sets the keymap used for \[cmd]. */
358: else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
359: {
360: struct buffer *oldbuf;
361: Lisp_Object name;
362:
363: changed = 1;
364: strp += 2; /* skip \{ or \< */
365: start = strp;
366:
367: while (strp < send && *strp != '}' && *strp != '>')
368: strp++;
369: length = strp - start;
370: strp++; /* skip } or > */
371:
372: oldbuf = bf_cur;
373: SetBfp (XBUFFER (Vprin1_to_string_buffer));
374: name = Fintern (make_string (start, length), Qnil);
375: if ((tem = (Fboundp (name)), NULL (tem)) ||
376: (tem = (Fsymbol_value (name)), NULL (tem)) ||
377: (tem = (get_keymap_1 (tem, 0)), NULL (tem)))
378: {
379: name = Fsymbol_name (name);
380: InsStr ("\nUses keymap \"");
381: InsCStr (XSTRING (name)->data, XSTRING (name)->size);
382: InsStr ("\", which is not currently defined.\n");
383: if (start[-1] == '<') keymap = Qnil;
384: }
385: else if (start[-1] == '<')
386: keymap = tem;
387: else
388: describe_map_tree (tem, 1, Qnil);
389: tem = Fbuffer_string ();
390: Ferase_buffer ();
391: SetBfp (oldbuf);
392:
393: subst_string:
394: start = XSTRING (tem)->data;
395: length = XSTRING (tem)->size;
396: subst:
397: new = (unsigned char *) xrealloc (buf, bsize += length);
398: bufp += new - buf;
399: buf = new;
400: bcopy (start, bufp, length);
401: bufp += length;
402: }
403: else /* just copy other chars */
404: *bufp++ = *strp++;
405: }
406:
407: if (changed) /* don't bother if nothing substituted */
408: tem = make_string (buf, bufp - buf);
409: else
410: tem = str;
411: free (buf);
412: return tem;
413: }
414:
415: syms_of_doc ()
416: {
417: staticpro (&Vdoc_file_name);
418: Vdoc_file_name = Qnil;
419:
420: defsubr (&Sdocumentation);
421: defsubr (&Sdocumentation_property);
422: defsubr (&Ssnarf_documentation);
423: defsubr (&Ssubstitute_command_keys);
424: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.