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