![[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] / 43BSD / contrib / emacs / src|
Return to doc.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* Record indices of function doc strings stored in a file.
2: Copyright (C) 1985 Richard M. Stallman.
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: #include "paths.h"
26:
27: #include <sys/types.h>
28: #include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
29:
30: #ifdef USG5
31: #include <fcntl.h>
32: #endif
33:
34: #ifndef O_RDONLY
35: #define O_RDONLY 0
36: #endif
37:
38: Lisp_Object Vdoc_file_name;
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:
51: if (XTYPE (Vexec_directory) != Lisp_String
52: || XTYPE (Vdoc_file_name) != Lisp_String)
53: return Qnil;
54:
55: name = (char *) alloca (XSTRING (Vexec_directory)->size
56: + XSTRING (Vdoc_file_name)->size + 2);
57: strcpy (name, XSTRING (Vexec_directory)->data);
58: strcat (name, XSTRING (Vdoc_file_name)->data);
59:
60: fd = open (name, O_RDONLY, 0);
61: if (fd < 0)
62: error ("Cannot open doc string file \"%s\"", name);
63: if (0 > lseek (fd, filepos, 0))
64: {
65: close (fd);
66: error ("Position %ld out of range in doc string file \"%s\"",
67: filepos, name);
68: }
69: p = buf;
70: while (p != buf + sizeof buf - 1)
71: {
72: count = read (fd, p, 512);
73: p[count] = 0;
74: if (!count)
75: break;
76: p1 = index (p, '\037');
77: if (p1)
78: {
79: *p1 = 0;
80: p = p1;
81: break;
82: }
83: p += count;
84: }
85: close (fd);
86: return make_string (buf, p - buf);
87: }
88:
89: DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 1, 0,
90: "Return the documentation string of FUNCTION.")
91: (fun1)
92: Lisp_Object fun1;
93: {
94: Lisp_Object fun;
95: Lisp_Object funcar;
96: Lisp_Object tem;
97:
98: fun = fun1;
99: while (XTYPE (fun) == Lisp_Symbol)
100: fun = Fsymbol_function (fun);
101: if (XTYPE (fun) == Lisp_Subr)
102: {
103: if (XSUBR (fun)->doc == 0) return Qnil;
104: if ((int) XSUBR (fun)->doc >= 0)
105: return Fsubstitute_command_keys (build_string (XSUBR (fun)->doc));
106: return Fsubstitute_command_keys (get_doc_string (- (int) XSUBR (fun)->doc));
107: }
108: if (XTYPE (fun) == Lisp_Vector)
109: return build_string ("Prefix command (definition is a Lisp vector of subcommands).");
110: if (XTYPE (fun) == Lisp_String)
111: return build_string ("Keyboard macro.");
112: if (!LISTP(fun))
113: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
114: funcar = Fcar (fun);
115: if (XTYPE (funcar) != Lisp_Symbol)
116: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
117: if (XSYMBOL (funcar) == XSYMBOL (Qkeymap))
118: return build_string ("Prefix command (definition is a list whose cdr is an alist of subcommands.)");
119: if (XSYMBOL (funcar) == XSYMBOL (Qlambda)
120: || XSYMBOL (funcar) == XSYMBOL (Qautoload))
121: {
122: tem = Fcar (Fcdr (Fcdr (fun)));
123: if (XTYPE (tem) == Lisp_String)
124: return Fsubstitute_command_keys (tem);
125: if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
126: return Fsubstitute_command_keys (get_doc_string (XFASTINT (tem)));
127: return Qnil;
128: }
129: if (XSYMBOL (funcar) == XSYMBOL (Qmocklisp))
130: return Qnil;
131: if (XSYMBOL (funcar) == XSYMBOL (Qmacro))
132: return Fdocumentation (Fcdr (fun));
133: else
134: return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
135: }
136:
137: DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
138: 1, 1, 0,
139: "Used during Emacs initialization, before dumping runnable Emacs,\n\
140: to find pointers to doc strings stored in etc/DOC... and\n\
141: record them in function definitions.\n\
142: One arg, FILENAME, a string which does not include a directory.\n\
143: The file is found in ../etc now; found in the exec-directory\n\
144: when doc strings are referred to later in the dumped Emacs.")
145: (filename)
146: Lisp_Object filename;
147: {
148: int fd;
149: char buf[1024 + 1];
150: register int filled;
151: register int pos;
152: register char *p, *end;
153: Lisp_Object sym, fun, tem;
154: char *name;
155: extern char *index ();
156:
157: CHECK_STRING (filename, 0);
158:
159: #ifndef CANNOT_DUMP
160: name = (char *) alloca (XSTRING (filename)->size + 8);
161: strcpy (name, "../etc/");
162: #else /* CANNOT_DUMP */
163: name = (char *) alloca (XSTRING (filename)->size + sizeof(PATH_EXEC)+1);
164: strcpy (name, PATH_EXEC);
165: strcat (name, "/");
166: #endif /* CANNOT_DUMP */
167: strcat (name, XSTRING (filename)->data); /*** Add this line ***/
168:
169: fd = open (name, O_RDONLY, 0);
170: if (fd < 0)
171: report_file_error ("Opening doc string file", Fcons (filename, Qnil));
172: Vdoc_file_name = filename;
173: filled = 0;
174: pos = 0;
175: while (1)
176: {
177: if (filled < 512)
178: filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
179: if (!filled)
180: break;
181:
182: buf[filled] = 0;
183: p = buf;
184: end = buf + (filled < 512 ? filled : filled - 128);
185: while (p != end && *p != '\037') p++;
186: if (p != end)
187: {
188: end = index (p, '\n');
189: sym = oblookup (Vobarray, p + 1, end - p - 1);
190: if (XTYPE (sym) == Lisp_Symbol)
191: {
192: fun = XSYMBOL (sym)->function;
193: if (XTYPE (fun) == Lisp_Subr)
194: XSUBR (fun)->doc = (char *) - (pos + end + 1 - buf);
195: else if (LISTP (fun))
196: {
197: tem = XCONS (fun)->car;
198: if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
199: {
200: tem = Fcdr (Fcdr (fun));
201: if (LISTP (tem) && XTYPE (XCONS (tem)->car) == Lisp_Int)
202: XFASTINT (XCONS (tem)->car) = (pos + end + 1 - buf);
203: }
204: }
205: }
206: }
207: pos += end - buf;
208: filled -= end - buf;
209: bcopy (end, buf, filled);
210: }
211: close (fd);
212: return Qnil;
213: }
214:
215: extern Lisp_Object where_is_in_buffer ();
216:
217: DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
218: Ssubstitute_command_keys, 1, 1, 0,
219: "Return the STRING with substrings of the form \\=\\[COMMAND]\n\
220: replaced by either: a keystroke sequence that will invoke COMMAND,\n\
221: or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
222: Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
223: \(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
224: \\=\\= quotes the following character and is discarded;\n\
225: thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
226: (str)
227: Lisp_Object str;
228: {
229: unsigned char *buf;
230: int didone = 0;
231: register unsigned char *strp;
232: register unsigned char *bufp;
233: register unsigned char *send;
234: int bsize;
235: unsigned char *new;
236: Lisp_Object key, tem;
237: unsigned char *funp;
238: int func;
239: struct buffer *oldbuf;
240:
241: if (NULL (str))
242: return Qnil;
243:
244: CHECK_STRING (str, 0);
245: strp = (unsigned char *) XSTRING (str)->data;
246: send = strp + XSTRING (str)->size;
247:
248: bsize = XSTRING (str)->size;
249: bufp = buf = (unsigned char *) xmalloc (bsize);
250:
251: while (strp < send)
252: {
253: if (strp[0] == '\\' && strp[1] == '=')
254: {
255: /* \= quotes the next character;
256: thus, to put in \[ without its special meaning, use \=\[. */
257: didone = 1;
258: *bufp++ = strp[2];
259: strp += 3;
260: }
261: else if (strp[0] == '\\' && strp[1] == '[')
262: {
263: didone = 1;
264: strp += 2; /* skip \[ */
265: funp = strp;
266:
267: while (strp < send && *strp != ']')
268: strp++;
269: func = strp - funp;
270:
271: key = Fintern (make_string (funp, func), Qnil);
272: key = where_is_in_buffer (key, bf_cur, 1);
273: strp++; /* skip ] */
274:
275: if (NULL (key)) /* but not on any keys */
276: {
277: new = (unsigned char *) xrealloc (buf, bsize += 4);
278: bufp += new - buf;
279: buf = new;
280: strcpy (bufp, "M-x ");
281: bufp += 4;
282: }
283: else
284: { /* function is on a key */
285: key = Fkey_description (key);
286: funp = XSTRING (key)->data;
287: func = XSTRING (key)->size;
288: }
289:
290: subst:
291: new = (unsigned char *) xrealloc (buf, bsize += func);
292: bufp += new - buf;
293: buf = new;
294: bcopy (funp, bufp, func);
295: bufp += func;
296: }
297: else if (strp[0] == '\\' && strp[1] == '{')
298: {
299: didone = 1;
300: strp += 2; /* skip \( */
301: funp = strp;
302:
303: while (strp < send && *strp != '}')
304: strp++;
305: func = strp - funp;
306: strp++; /* skip } */
307:
308: oldbuf = bf_cur;
309: SetBfp (XBUFFER (Vprin1_to_string_buffer));
310: key = Fintern (make_string (funp, func), Qnil);
311: if ((tem = (Fboundp (key)), NULL (tem)) ||
312: (tem = (Fsymbol_value (key)), NULL (tem)))
313: {
314: key = Fsymbol_name (key);
315: InsStr ("\nUses keymap \"");
316: InsCStr (XSTRING (key)->data, XSTRING (key)->size);
317: InsStr ("\", which is not currently defined.\n");
318: }
319: else
320: {
321: key = Fsymbol_value (key);
322: describe_map_tree (key, 1);
323: }
324: key = Fbuffer_string ();
325: Ferase_buffer ();
326: SetBfp (oldbuf);
327: funp = XSTRING (key)->data;
328: func = XSTRING (key)->size;
329: goto subst;
330: }
331: else /* just copy other chars */
332: *bufp++ = *strp++;
333: }
334:
335: if (didone) /* don't bother if nothing substituted */
336: key = make_string (buf, bufp - buf);
337: else
338: key = str;
339: free (buf);
340: return key;
341: }
342:
343: syms_of_doc ()
344: {
345: staticpro (&Vdoc_file_name);
346: Vdoc_file_name = Qnil;
347:
348: defsubr (&Sdocumentation);
349: defsubr (&Ssnarf_documentation);
350: defsubr (&Ssubstitute_command_keys);
351: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.