annotate src/doc.c @ 1324:70841e88fbee

[xemacs-hg @ 2003-02-24 12:42:34 by michaels] 2003-02-20 Mike Sperber <mike@xemacs.org> * Makefile.in.in (update-elc-2): Sequentialize dependencies even more.
author michaels
date Mon, 24 Feb 2003 12:42:39 +0000
parents 804517e16990
children 4542b72c005e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Record indices of function doc strings stored in a file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Free Software Foundation, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4 Copyright (C) 2001, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* Synched up with: FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
25 /* This file has been Mule-ized. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 #include "bytecode.h"
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
32 #include "file-coding.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "insdel.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "keymap.h"
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
35 #include "lstream.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 #include "sysfile.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Lisp_Object Vinternal_doc_file_name;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 Lisp_Object QSsubstitute;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
42 /* Read and return doc string or instructions from open file descriptor FD
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
43 at position POSITION. Does not close the file. Returns string; or if
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
44 error, returns a cons holding the error data to pass to Fsignal.
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
45 NAME_NONRELOC and NAME_RELOC are only used for the error messages. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 unparesseuxify_doc_string (int fd, EMACS_INT position,
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
49 Ibyte *name_nonreloc, Lisp_Object name_reloc,
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
50 int standard_doc_file)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
52 Ibyte buf[512 * 32 + 1];
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
53 Ibyte *buffer = buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 int buffer_size = sizeof (buf);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
55 Ibyte *from, *to;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
56 REGISTER Ibyte *p = buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object return_me;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
58 Lisp_Object fdstream = Qnil, instream = Qnil;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
59 struct gcpro gcpro1, gcpro2;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
60
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
61 GCPRO2 (fdstream, instream);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 if (0 > lseek (fd, position, 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 if (name_nonreloc)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
66 name_reloc = build_intstring (name_nonreloc);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
67 return_me = list3 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ("Position out of range in doc string file"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 name_reloc, make_int (position));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
73 fdstream = make_filedesc_input_stream (fd, 0, -1, 0);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
74 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
75 instream =
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
76 make_coding_input_stream
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
77 /* Major trouble if we are too clever when reading byte-code
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
78 instructions!
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
79
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
80 #### We should have a way of handling escape-quoted elc files
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
81 (i.e. files with non-ASCII/Latin-1 chars in them). Currently this
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
82 is "solved" in bytecomp.el by never inserting lazy references in
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
83 such files. */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 814
diff changeset
84 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary,
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
85 CODING_DECODE, 0);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
86 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0);
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
87
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 /* Read the doc string into a buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 Use the fixed buffer BUF if it is big enough; otherwise allocate one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 int space_left = buffer_size - (p - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 int nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 /* Switch to a bigger buffer if we need one. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 if (space_left == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
100 Ibyte *old_buffer = buffer;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
101 if (buffer == buf)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
102 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
103 buffer = (Ibyte *) xmalloc (buffer_size *= 2);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
104 memcpy (buffer, old_buffer, p - old_buffer);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
105 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
106 else
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
107 buffer = (Ibyte *) xrealloc (buffer, buffer_size *= 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 p += buffer - old_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 space_left = buffer_size - (p - buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* Don't read too much at one go. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 if (space_left > 1024 * 8)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 space_left = 1024 * 8;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
115 nread = Lstream_read (XLSTREAM (instream), p, space_left);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 if (nread < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
118 return_me = list1 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 ("Read error on documentation file"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 p[nread] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 if (!nread)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
126 Ibyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
127 if (p1)
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
128 {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
129 *p1 = 0;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
130 p = p1;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
131 break;
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
132 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 p += nread;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 /* Scan the text and remove quoting with ^A (char code 1).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 from = to = buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 while (from < p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 if (*from != 1 /*^A*/)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 *to++ = *from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 int c = *(++from);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 from++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 switch (c)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 case 1: *to++ = c; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 case '0': *to++ = '\0'; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 case '_': *to++ = '\037'; break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 default:
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
155 return_me = list2 (build_msg_string
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ("Invalid data in documentation file -- ^A followed by weird code"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 make_int (c));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
163 return_me = make_string (buffer, to - buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 done:
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
166 if (!NILP (instream))
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
167 {
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
168 Lstream_delete (XLSTREAM (instream));
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
169 Lstream_delete (XLSTREAM (fdstream));
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
170 }
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
171 UNGCPRO;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 if (buffer != buf) /* We must have allocated buffer above */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 xfree (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 return return_me;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
177 #define string_join(dest, s1, s2) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
178 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
179 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
180 XSTRING_LENGTH (s2)); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 /* Extract a doc string from a file. FILEPOS says where to get it.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (This could actually be byte code instructions/constants instead
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 of a doc string.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 If it is an integer, use that position in the standard DOC file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 If it is (FILE . INTEGER), use FILE as the file name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 and INTEGER as the position in that file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 But if INTEGER is negative, make it positive.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (A negative integer is used for user variables, so we can distinguish
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 them without actually fetching the doc string.) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 get_doc_string (Lisp_Object filepos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 REGISTER int fd;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
197 REGISTER Ibyte *name_nonreloc = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 EMACS_INT position;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 Lisp_Object file, tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 Lisp_Object name_reloc = Qnil;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
201 int standard_doc_file = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 if (INTP (filepos))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 file = Vinternal_doc_file_name;
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
206 standard_doc_file = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 position = XINT (filepos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 else if (CONSP (filepos) && INTP (XCDR (filepos)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 file = XCAR (filepos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 position = XINT (XCDR (filepos));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 if (position < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 position = - position;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (!STRINGP (file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 /* Put the file name in NAME as a C string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 If it is relative, combine it with Vdoc_directory. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 tem = Ffile_name_absolute_p (file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 {
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 563
diff changeset
228 Bytecount minsize;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 /* XEmacs: Move this check here. OK if called during loadup to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 load byte code instructions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 if (!STRINGP (Vdoc_directory))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 minsize = XSTRING_LENGTH (Vdoc_directory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 /* sizeof ("../lib-src/") == 12 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 if (minsize < 12)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 minsize = 12;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
238 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 string_join (name_nonreloc, Vdoc_directory, file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 name_reloc = file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
244 fd = qxe_open (name_nonreloc ? name_nonreloc :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
245 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 if (fd < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 #ifndef CANNOT_DUMP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 /* sizeof ("../lib-src/") == 12 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
252 name_nonreloc = (Ibyte *) ALLOCA (12 + XSTRING_LENGTH (file) + 8);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 /* Preparing to dump; DOC file is probably not installed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 So check in ../lib-src. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
255 qxestrcpy (name_nonreloc, (Ibyte *) "../lib-src/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
256 qxestrcat (name_nonreloc, XSTRING_DATA (file));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
258 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 #endif /* CANNOT_DUMP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 if (fd < 0)
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
263 report_file_error ("Cannot open doc string file",
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
264 name_nonreloc ? build_intstring (name_nonreloc) :
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
265 name_reloc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
268 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc,
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
269 standard_doc_file);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
270 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 if (!STRINGP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
273 signal_error_1 (Qinvalid_byte_code, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 /* Get a string from position FILEPOS and pass it through the Lisp reader.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 We use this for fetching the bytecode string and constants vector
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 of a compiled function from the .elc file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 read_doc_string (Lisp_Object filepos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 Lisp_Object string = get_doc_string (filepos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 if (!STRINGP (string))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
288 invalid_state ("loading bytecode failed to return string", string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 return Fread (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 Return the documentation string of FUNCTION.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 Unless a non-nil second argument RAW is given, the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 string is passed through `substitute-command-keys'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 (function, raw))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 Lisp_Object fun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 Lisp_Object doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 fun = Findirect_function (function);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 if (XSUBR (fun)->doc == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 doc = build_string (XSUBR (fun)->doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 Lisp_Object tem;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
317 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 if (! (f->flags.documentationp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 tem = compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 doc = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 else if (NATNUMP (tem) || CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 doc = get_doc_string (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 else if (KEYMAPP (fun))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
329 return build_msg_string ("Prefix command (definition is a keymap of subcommands).");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 else if (STRINGP (fun) || VECTORP (fun))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
331 return build_msg_string ("Keyboard macro.");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 Lisp_Object funcar = Fcar (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 if (!SYMBOLP (funcar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 return Fsignal (Qinvalid_function, list1 (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 else if (EQ (funcar, Qlambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 || EQ (funcar, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 Lisp_Object tem, tem1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 tem1 = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 tem = Fcar (tem1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 doc = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 /* Handle a doc reference--but these never come last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 in the function body, so reject them if they are last. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 else if ((NATNUMP (tem) || CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 && ! NILP (XCDR (tem1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 doc = get_doc_string (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 else if (EQ (funcar, Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 return Fdocumentation (Fcdr (fun), raw);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 goto oops;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 oops:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 return Fsignal (Qinvalid_function, list1 (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 if (NILP (raw))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 Lisp_Object domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 if (NILP (domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 doc = Fgettext (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 doc = Fdgettext (domain, doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 GCPRO1 (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 doc = Fsubstitute_command_keys (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 return doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 Return the documentation string that is SYMBOL's PROP property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 This is like `get', but it can refer to strings stored in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 `doc-directory/DOC' file; and if the value is a string, it is passed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 through `substitute-command-keys'. A non-nil third argument avoids this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 translation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
392 (symbol, prop, raw))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 REGISTER Lisp_Object doc = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 REGISTER Lisp_Object domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 GCPRO1 (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
403 doc = Fget (symbol, prop, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 if (INTP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 else if (CONSP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 doc = get_doc_string (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 if (!NILP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
411 domain = Fget (symbol, Qvariable_domain, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 if (NILP (domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 doc = Fgettext (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 doc = Fdgettext (domain, doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 if (NILP (raw) && STRINGP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 doc = Fsubstitute_command_keys (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 return doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 static void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
425 weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
426 int pos)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 message ("Note: Strange doc (%s) for %s %s @ %d",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
430 weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 Used during Emacs initialization, before dumping runnable Emacs,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 to find pointers to doc strings stored in `.../lib-src/DOC' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 record them in function definitions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 One arg, FILENAME, a string which does not include a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 The file is written to `../lib-src', and later found in `exec-directory'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 when doc strings are referred to in the dumped Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 int fd;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
444 Ibyte buf[1024 + 1];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 REGISTER int filled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 REGISTER int pos;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
447 REGISTER Ibyte *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 Lisp_Object sym, fun, tem;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
449 Ibyte *name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
451 /* This function should not pass the data it's reading through a coding
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
452 stream. The reason is that the only purpose of this function is to
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
453 find the file offsets for the documentation of the various functions,
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
454 not do anything with the documentation itself. If we pass through a
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
455 coding stream, the pointers will get messed up when we start reading
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
456 ISO 2022 data because our pointers will reflect internal format, not
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
457 external format. */
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
458
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 #ifndef CANNOT_DUMP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 if (!purify_flag)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
461 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 #ifdef CANNOT_DUMP
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
467 if (!NILP (Vdoc_directory))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 CHECK_STRING (Vdoc_directory);
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
470 name = alloca_ibytes (XSTRING_LENGTH (filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 + XSTRING_LENGTH (Vdoc_directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 + 1);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
473 qxestrcpy (name, XSTRING_DATA (Vdoc_directory));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 #endif /* CANNOT_DUMP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
478 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14);
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
479 qxestrcpy (name, (Ibyte *) "../lib-src/");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
482 qxestrcat (name, XSTRING_DATA (filename));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
484 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 if (fd < 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
486 report_file_error ("Opening doc string file", build_intstring (name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 Vinternal_doc_file_name = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 filled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 if (filled < 512)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
493 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 if (!filled)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 buf[filled] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 p = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 end = buf + (filled < 512 ? filled : filled - 128);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 while (p != end && *p != '\037') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 if (p != end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
504 end = qxestrchr (p, '\n');
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
505 sym = oblookup (Vobarray, p + 2, end - p - 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 if (SYMBOLP (sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 Lisp_Object offset = make_int (pos + end + 1 - buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 /* Attach a docstring to a variable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 if (p[1] == 'V')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 /* Install file-position as variable-documentation property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 and make it negative for a user-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 (doc starts with a `*'). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 if (!ZEROP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 GETTEXT ("variable"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 /* In the case of duplicate doc file entries, always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 take the later one. But if the doc is not an int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (a string, say) leave it alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 Fput (sym, Qvariable_documentation,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 ((end[1] == '*')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 ? make_int (- XINT (offset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 : offset));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 /* Attach a docstring to a function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 The type determines where the docstring is stored. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 else if (p[1] == 'F')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 fun = indirect_function (sym,0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 fun = XCDR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 if (UNBOUNDP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
542 #if 0 /* There are lots of legitimate cases where this message will appear
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
543 (e.g. any function that's only defined when MULE is defined,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
544 provided that the function is used somewhere in a dumped Lisp
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
545 file, so that the symbol is interned in the dumped XEmacs), and
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
546 there's not a lot that can be done to eliminate the warning other
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
547 than kludges like moving the function to a Mule-only source file,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
548 which often results in ugly code. Furthermore, the only point of
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
549 this warning is to warn you when you have a DEFUN that you forget
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
550 to DEFSUBR, but the compiler will also warn you, because the DEFUN
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
551 declares a static object, and the object will be unused -- you'll
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
552 get something like
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
553
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
554 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
555
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
556 So I'm disabling this. --ben */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
557
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 /* May have been #if'ed out or something */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 weird_doc (sym, GETTEXT ("not fboundp"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 GETTEXT ("function"), pos);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
561 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 else if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 /* Lisp_Subrs have a slot for it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 if (XSUBR (fun)->doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 GETTEXT ("subr"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 XSUBR (fun)->doc = (char *) (- XINT (offset));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 /* If it's a lisp form, stick it in the form. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 tem = XCAR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 tem = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 if (CONSP (tem) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 INTP (XCAR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 Lisp_Object old = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 if (!ZEROP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (EQ (tem, Qlambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 ? GETTEXT ("lambda")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 : GETTEXT ("autoload")),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 /* In the case of duplicate doc file entries,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 always take the later one. But if the doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 is not an int (a string, say) leave it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 XCAR (tem) = offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 else if (!CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 weird_doc (sym, GETTEXT ("!CONSP(tem)"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 goto cont;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 /* DOC string is a string not integer 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 goto cont;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 weird_doc (sym, GETTEXT ("not lambda or autoload"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 goto cont;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 /* Compiled-Function objects sometimes have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 slots for it. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
629 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 /* This compiled-function object must have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 slot for the docstring, since we've found a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 docstring for it. Unless there were multiple
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 definitions of it, and the latter one didn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 have any doc, which is a legal if slightly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 bogus situation, so don't blow up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 if (! (f->flags.documentationp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 weird_doc (sym, GETTEXT ("no doc slot"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 GETTEXT ("bytecode"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 Lisp_Object old =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 if (!ZEROP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 GETTEXT ("bytecode"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 /* In the case of duplicate doc file entries,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 always take the later one. But if the doc is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 not an int (a string, say) leave it alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 set_compiled_function_documentation (f, offset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 /* Otherwise the function is undefined or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 otherwise weird. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 weird_doc (sym, GETTEXT ("weird function"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 /* lose: */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
673 signal_error (Qfile_error, "DOC file invalid at position",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
674 make_int (pos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 weird:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 /* goto lose */;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 cont:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 pos += end - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 filled -= end - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 memmove (buf, end, filled);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
685 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 #if 1 /* Don't warn about functions whose doc was lost because they were
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 wrapped by advice-freeze.el... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 kludgily_ignore_lost_doc_p (Lisp_Object sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 # define kludge_prefix "ad-Orig-"
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
695 Lisp_Object name = XSYMBOL (sym)->name;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
696 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) &&
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
697 !qxestrncmp_c (XSTRING_DATA (name), kludge_prefix,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
698 sizeof (kludge_prefix) - 1));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 # undef kludge_prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 # define kludgily_ignore_lost_doc_p(sym) 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 verify_doc_mapper (Lisp_Object sym, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
709 Lisp_Object closure = * (Lisp_Object *) arg;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 if (!NILP (Ffboundp (sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 int doc = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 Lisp_Object fun = XSYMBOL (sym)->function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 if (CONSP (fun) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 EQ (XCAR (fun), Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 fun = XCDR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 doc = (EMACS_INT) XSUBR (fun)->doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 else if (SYMBOLP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 else if (KEYMAPP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 Lisp_Object tem = XCAR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 tem = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 if (CONSP (tem) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 INTP (XCAR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 doc = XINT (XCAR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
739 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 if (! (f->flags.documentationp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 Lisp_Object tem = compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 doc = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 message ("Warning: doc lost for function %s.",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
753 XSTRING_DATA (XSYMBOL (sym)->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 XCDR (closure) = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 if (!NILP (Fboundp (sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 if (ZEROP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 message ("Warning: doc lost for variable %s.",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
763 XSTRING_DATA (XSYMBOL (sym)->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 XCDR (closure) = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 return 0; /* Never stop */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 Used to make sure everything went well with Snarf-documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 Writes to stderr if not.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 Lisp_Object closure = Fcons (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 GCPRO1 (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 map_obarray (Vobarray, verify_doc_mapper, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 if (!NILP (Fcdr (closure)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 message ("\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 "This is usually because some files were preloaded by loaddefs.el or\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 "site-load.el, but were not passed to make-docfile by Makefile.\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 return NILP (Fcdr (closure)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 Substitute key descriptions for command names in STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 Return a new string which is STRING with substrings of the form \\=\\[COMMAND]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 replaced by either: a keystroke sequence that will invoke COMMAND,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 or "M-x COMMAND" if COMMAND is not on any keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
795 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 as the keymap for future \\=\\[COMMAND] substrings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 \\=\\= quotes the following character and is discarded;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
801 (string))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
804 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 int changed = 0;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
806 REGISTER Ibyte *strdata;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
807 REGISTER Ibyte *bufp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 Bytecount strlength;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 Bytecount idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 Bytecount bsize;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
811 Ibyte *new;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
812 Lisp_Object tem = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
813 Lisp_Object keymap = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
814 Lisp_Object name = Qnil;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
815 Ibyte *start;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 Bytecount length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
819 if (NILP (string))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
822 CHECK_STRING (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
823 GCPRO4 (string, tem, keymap, name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 /* There is the possibility that the string is not destined for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 translating stream, and it could be argued that we should do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 same thing here as in Fformat(), but there are very few times
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 when this will be the case and many calls to this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 would have to have `gettext' calls added. (I18N3) */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
830 string = LISP_GETTEXT (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 /* KEYMAP is either nil (which means search all the active keymaps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 or a specified local map (which means search just that and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 global map). If non-nil, it might come from Voverriding_local_map,
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
835 or from a \\<mapname> construct in STRING itself.. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 /* This is really weird and garbagey. If keymap is nil and there's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 an overriding-local-map, `where-is-internal' will correctly note
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 this, so there's no reason to do it here. Maybe FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 `where-is-internal' is broken. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 keymap = current_kboard->Voverriding_terminal_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 if (NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 keymap = Voverriding_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 strlength = XSTRING_LENGTH (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 bsize = 1 + strlength;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
850 buf = (Ibyte *) xmalloc (bsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 bufp = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 /* Have to reset strdata every time GC might be called */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
854 strdata = XSTRING_DATA (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 for (idx = 0; idx < strlength; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
857 Ibyte *strp = strdata + idx;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 if (strp[0] != '\\')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 /* just copy other chars */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 /* As it happens, this will work with Mule even if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 character quoted is multi-byte; the remaining multi-byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 characters will just be copied by this loop. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 *bufp++ = *strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 else switch (strp[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 /* just copy unknown escape sequences */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 *bufp++ = *strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 case '=':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 /* \= quotes the next character;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 thus, to put in \[ without its special meaning, use \=\[. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 /* As it happens, this will work with Mule even if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 character quoted is multi-byte; the remaining multi-byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 characters will just be copied by this loop. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 *bufp++ = strp[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 idx += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 case '[':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 idx += 2; /* skip \[ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 strp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 start = strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 while ((idx < strlength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 && *strp != ']')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 strp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 length = strp - start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 idx++; /* skip ] */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 tem = Fintern (make_string (start, length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 #if 0 /* FSFmacs */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
909 /* Disregard menu bar bindings; it is positively annoying to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
910 mention them when there's no menu bar, and it isn't terribly
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
911 useful even when there is a menu bar. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
912 if (!NILP (tem))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
913 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
914 firstkey = Faref (tem, Qzero);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
915 if (EQ (firstkey, Qmenu_bar))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
916 tem = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
917 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 if (NILP (tem)) /* but not on any keys */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
922 new = (Ibyte *) xrealloc (buf, bsize += 4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 bufp += new - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 buf = new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 memcpy (bufp, "M-x ", 4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 bufp += 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 goto subst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 { /* function is on a key */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 tem = Fkey_description (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 goto subst_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 case '{':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 case '<':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
938 Lisp_Object buffer = Fget_buffer_create (QSsubstitute);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
939 struct buffer *buf_ = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 Fbuffer_disable_undo (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 Ferase_buffer (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 /* \{foo} is replaced with a summary of keymap (symbol-value foo).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 \<foo> just sets the keymap used for \[cmd]. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 idx += 2; /* skip \{ or \< */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 strp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 start = strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 while ((idx < strlength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 && *strp != '}' && *strp != '>')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 strp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 length = strp - start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 idx++; /* skip } or > */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 /* Get the value of the keymap in TEM, or nil if undefined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 Do this while still in the user's current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 in case it is a local variable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 name = Fintern (make_string (start, length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 tem = Fboundp (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 if (! NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 tem = Fsymbol_value (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 if (! NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 tem = get_keymap (tem, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
974 buffer_insert_c_string (buf_, "(uses keymap \"");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
975 buffer_insert_lisp_string (buf_, Fsymbol_name (name));
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
976 buffer_insert_c_string (buf_, "\", which is not currently defined) ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 if (start[-1] == '<') keymap = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 else if (start[-1] == '<')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 keymap = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 BUF_Z (buf_) - BUF_BEG (buf_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 Ferase_buffer (buffer);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
988 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
989 goto subst_string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
991 subst_string:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
992 start = XSTRING_DATA (tem);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
993 length = XSTRING_LENGTH (tem);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
994 subst:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
995 bsize += length;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
996 new = (Ibyte *) xrealloc (buf, bsize);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
997 bufp += new - buf;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
998 buf = new;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
999 memcpy (bufp, start, length);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1000 bufp += length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1002 /* Reset STRDATA in case gc relocated it. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1003 strdata = XSTRING_DATA (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1005 break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 if (changed) /* don't bother if nothing substituted */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 tem = make_string (buf, bufp - buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1012 tem = string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 xfree (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 /* initialization */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 syms_of_doc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 DEFSUBR (Fdocumentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 DEFSUBR (Fdocumentation_property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 DEFSUBR (Fsnarf_documentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 DEFSUBR (Fverify_documentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 DEFSUBR (Fsubstitute_command_keys);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 vars_of_doc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 Name of file containing documentation strings of built-in symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 Vinternal_doc_file_name = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 QSsubstitute = build_string (" *substitute*");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 staticpro (&QSsubstitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 }