annotate src/doc.c @ 2210:9361a78f86a0

[xemacs-hg @ 2004-08-11 02:04:03 by james] Mark really_abort() as a function that does not return.
author james
date Wed, 11 Aug 2004 02:04:12 +0000
parents 21549d437f09
children ecf1ebac70d8
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 */
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1330
diff changeset
173 xfree (buffer, Ibyte *);
428
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 if (purify_flag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 /* sizeof ("../lib-src/") == 12 */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
251 name_nonreloc = (Ibyte *) ALLOCA (12 + XSTRING_LENGTH (file) + 8);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 /* Preparing to dump; DOC file is probably not installed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 So check in ../lib-src. */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
254 qxestrcpy (name_nonreloc, (Ibyte *) "../lib-src/");
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
255 qxestrcat (name_nonreloc, XSTRING_DATA (file));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
257 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 }
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 if (fd < 0)
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
261 report_file_error ("Cannot open doc string file",
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
262 name_nonreloc ? build_intstring (name_nonreloc) :
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
263 name_reloc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
266 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
267 standard_doc_file);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
268 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 if (!STRINGP (tem))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
271 signal_error_1 (Qinvalid_byte_code, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 return tem;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 /* 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
277 We use this for fetching the bytecode string and constants vector
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 of a compiled function from the .elc file. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 read_doc_string (Lisp_Object filepos)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 Lisp_Object string = get_doc_string (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 if (!STRINGP (string))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
286 invalid_state ("loading bytecode failed to return string", string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 return Fread (string);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 Return the documentation string of FUNCTION.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
292 Unless a non-nil second argument RAW is given, the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 string is passed through `substitute-command-keys'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (function, raw))
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 Lisp_Object fun;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 Lisp_Object doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 fun = Findirect_function (function);
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 if (SUBRP (fun))
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 (XSUBR (fun)->doc == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 if ((EMACS_INT) XSUBR (fun)->doc >= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 doc = build_string (XSUBR (fun)->doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 doc = get_doc_string (make_int (- (EMACS_INT) XSUBR (fun)->doc));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 else if (COMPILED_FUNCTIONP (fun))
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 Lisp_Object tem;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
315 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 if (! (f->flags.documentationp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 tem = compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 doc = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 else if (NATNUMP (tem) || CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 doc = get_doc_string (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 else if (KEYMAPP (fun))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
327 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
328 else if (STRINGP (fun) || VECTORP (fun))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
329 return build_msg_string ("Keyboard macro.");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 Lisp_Object funcar = Fcar (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 if (!SYMBOLP (funcar))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 return Fsignal (Qinvalid_function, list1 (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 else if (EQ (funcar, Qlambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 || EQ (funcar, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 Lisp_Object tem, tem1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 tem1 = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 tem = Fcar (tem1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 if (STRINGP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 doc = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 /* Handle a doc reference--but these never come last
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 in the function body, so reject them if they are last. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 else if ((NATNUMP (tem) || CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 && ! NILP (XCDR (tem1)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 doc = get_doc_string (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 else if (EQ (funcar, Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 return Fdocumentation (Fcdr (fun), raw);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 goto oops;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 else
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 oops:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 return Fsignal (Qinvalid_function, list1 (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 if (NILP (raw))
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 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 Lisp_Object domain = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 if (NILP (domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 doc = Fgettext (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 doc = Fdgettext (domain, doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 GCPRO1 (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 doc = Fsubstitute_command_keys (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 return doc;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 Return the documentation string that is SYMBOL's PROP property.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 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
386 `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
387 through `substitute-command-keys'. A non-nil third argument avoids this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 translation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
390 (symbol, prop, raw))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* This function can GC */
1849
21549d437f09 [xemacs-hg @ 2004-01-03 21:54:41 by james]
james
parents: 1726
diff changeset
393 Lisp_Object doc = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 REGISTER Lisp_Object domain;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 GCPRO1 (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
401 doc = Fget (symbol, prop, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 if (INTP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 doc = get_doc_string (XINT (doc) > 0 ? doc : make_int (- XINT (doc)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 else if (CONSP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 doc = get_doc_string (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 #ifdef I18N3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 if (!NILP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
409 domain = Fget (symbol, Qvariable_domain, Qnil);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (NILP (domain))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 doc = Fgettext (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 doc = Fdgettext (domain, doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 if (NILP (raw) && STRINGP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 doc = Fsubstitute_command_keys (doc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 return doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 static void
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
423 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
424 int pos)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 if (!strcmp (weirdness, GETTEXT ("duplicate"))) return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 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
428 weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 Used during Emacs initialization, before dumping runnable Emacs,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 to find pointers to doc strings stored in `.../lib-src/DOC' and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 record them in function definitions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 One arg, FILENAME, a string which does not include a directory.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 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
437 when doc strings are referred to in the dumped Emacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (filename))
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 int fd;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
442 Ibyte buf[1024 + 1];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 REGISTER int filled;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 REGISTER int pos;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
445 REGISTER Ibyte *p, *end;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 Lisp_Object sym, fun, tem;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
447 Ibyte *name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
814
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
449 /* 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
450 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
451 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
452 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
453 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
454 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
455 external format. */
a634e3b7acc8 [xemacs-hg @ 2002-04-14 12:41:59 by ben]
ben
parents: 793
diff changeset
456
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 if (!purify_flag)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
458 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
459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 CHECK_STRING (filename);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
1330
4542b72c005e [xemacs-hg @ 2003-03-01 07:25:26 by ben]
ben
parents: 867
diff changeset
462 {
4542b72c005e [xemacs-hg @ 2003-03-01 07:25:26 by ben]
ben
parents: 867
diff changeset
463 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14);
4542b72c005e [xemacs-hg @ 2003-03-01 07:25:26 by ben]
ben
parents: 867
diff changeset
464 qxestrcpy (name, (Ibyte *) "../lib-src/");
4542b72c005e [xemacs-hg @ 2003-03-01 07:25:26 by ben]
ben
parents: 867
diff changeset
465 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
467 qxestrcat (name, XSTRING_DATA (filename));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
469 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 if (fd < 0)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
471 report_file_error ("Opening doc string file", build_intstring (name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 Vinternal_doc_file_name = filename;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 filled = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 pos = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 if (filled < 512)
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
478 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 if (!filled)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 buf[filled] = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 p = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 end = buf + (filled < 512 ? filled : filled - 128);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 while (p != end && *p != '\037') p++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 if (p != end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
489 end = qxestrchr (p, '\n');
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
490 sym = oblookup (Vobarray, p + 2, end - p - 2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 if (SYMBOLP (sym))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 Lisp_Object offset = make_int (pos + end + 1 - buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 /* Attach a docstring to a variable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 if (p[1] == 'V')
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 /* Install file-position as variable-documentation property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 and make it negative for a user-variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (doc starts with a `*'). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 if (!ZEROP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 GETTEXT ("variable"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 /* In the case of duplicate doc file entries, always
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 take the later one. But if the doc is not an int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (a string, say) leave it alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 Fput (sym, Qvariable_documentation,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 ((end[1] == '*')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 ? make_int (- XINT (offset))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 : offset));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 /* Attach a docstring to a function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 The type determines where the docstring is stored. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 else if (p[1] == 'F')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 fun = indirect_function (sym,0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 fun = XCDR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 if (UNBOUNDP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
527 #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
528 (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
529 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
530 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
531 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
532 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
533 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
534 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
535 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
536 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
537 get something like
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
538
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
539 /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
540
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
541 So I'm disabling this. --ben */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
542
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 /* May have been #if'ed out or something */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 weird_doc (sym, GETTEXT ("not fboundp"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 GETTEXT ("function"), pos);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
546 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 else if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 /* Lisp_Subrs have a slot for it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 if (XSUBR (fun)->doc)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 GETTEXT ("subr"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 XSUBR (fun)->doc = (char *) (- XINT (offset));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 /* If it's a lisp form, stick it in the form. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 tem = XCAR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
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 tem = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 if (CONSP (tem) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 INTP (XCAR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 Lisp_Object old = XCAR (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 if (!ZEROP (old))
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 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (EQ (tem, Qlambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 ? GETTEXT ("lambda")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 : GETTEXT ("autoload")),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 /* In the case of duplicate doc file entries,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 always take the later one. But if the doc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 is not an int (a string, say) leave it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 goto weird;
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 XCAR (tem) = offset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 else if (!CONSP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 weird_doc (sym, GETTEXT ("!CONSP(tem)"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 goto cont;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 /* DOC string is a string not integer 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 weird_doc (sym, GETTEXT ("!INTP(XCAR(tem))"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 goto cont;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 weird_doc (sym, GETTEXT ("not lambda or autoload"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 goto cont;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 }
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 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 /* Compiled-Function objects sometimes have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 slots for it. */
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
614 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 /* This compiled-function object must have a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 slot for the docstring, since we've found a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 docstring for it. Unless there were multiple
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 definitions of it, and the latter one didn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 have any doc, which is a legal if slightly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 bogus situation, so don't blow up. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 if (! (f->flags.documentationp))
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 weird_doc (sym, GETTEXT ("no doc slot"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 GETTEXT ("bytecode"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 else
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 Lisp_Object old =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 if (!ZEROP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 weird_doc (sym, GETTEXT ("duplicate"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 GETTEXT ("bytecode"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 /* In the case of duplicate doc file entries,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 always take the later one. But if the doc is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 not an int (a string, say) leave it alone. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 if (!INTP (old))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 set_compiled_function_documentation (f, offset);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 }
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 /* Otherwise the function is undefined or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 otherwise weird. Ignore it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 weird_doc (sym, GETTEXT ("weird function"),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 GETTEXT ("function"), pos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 goto weird;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 /* lose: */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
658 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
659 make_int (pos));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 weird:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 /* goto lose */;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 cont:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 pos += end - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 filled -= end - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 memmove (buf, end, filled);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 }
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
670 retry_close (fd);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 #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
675 wrapped by advice-freeze.el... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 kludgily_ignore_lost_doc_p (Lisp_Object sym)
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 # define kludge_prefix "ad-Orig-"
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
680 Lisp_Object name = XSYMBOL (sym)->name;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
681 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) &&
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
682 !qxestrncmp_c (XSTRING_DATA (name), kludge_prefix,
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
683 sizeof (kludge_prefix) - 1));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 # undef kludge_prefix
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 # define kludgily_ignore_lost_doc_p(sym) 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
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 verify_doc_mapper (Lisp_Object sym, void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 {
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
694 Lisp_Object closure = * (Lisp_Object *) arg;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 if (!NILP (Ffboundp (sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 int doc = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 Lisp_Object fun = XSYMBOL (sym)->function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 if (CONSP (fun) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 EQ (XCAR (fun), Qmacro))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 fun = XCDR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 if (SUBRP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 doc = (EMACS_INT) XSUBR (fun)->doc;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 else if (SYMBOLP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 else if (KEYMAPP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 else if (CONSP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Lisp_Object tem = XCAR (fun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 tem = Fcdr (Fcdr (fun));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 if (CONSP (tem) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 INTP (XCAR (tem)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 doc = XINT (XCAR (tem));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 else if (COMPILED_FUNCTIONP (fun))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
724 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 if (! (f->flags.documentationp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 doc = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 Lisp_Object tem = compiled_function_documentation (f);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 if (INTP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 doc = XINT (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym))
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 message ("Warning: doc lost for function %s.",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
738 XSTRING_DATA (XSYMBOL (sym)->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 XCDR (closure) = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 if (!NILP (Fboundp (sym)))
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 doc = Fget (sym, Qvariable_documentation, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 if (ZEROP (doc))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 message ("Warning: doc lost for variable %s.",
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
748 XSTRING_DATA (XSYMBOL (sym)->name));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 XCDR (closure) = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 }
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 return 0; /* Never stop */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 Used to make sure everything went well with Snarf-documentation.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 Writes to stderr if not.
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 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 Lisp_Object closure = Fcons (Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 GCPRO1 (closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 map_obarray (Vobarray, verify_doc_mapper, &closure);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 if (!NILP (Fcdr (closure)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 message ("\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 "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
768 "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
769 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 return NILP (Fcdr (closure)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
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 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 Substitute key descriptions for command names in STRING.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 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
777 replaced by either: a keystroke sequence that will invoke COMMAND,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 or "M-x COMMAND" if COMMAND is not on any keys.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 Substrings of the form \\=\\{MAPVAR} are replaced by summaries
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
780 \(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
781 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 as the keymap for future \\=\\[COMMAND] substrings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 \\=\\= quotes the following character and is discarded;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
786 (string))
428
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 /* This function can GC */
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
789 Ibyte *buf;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 int changed = 0;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
791 REGISTER Ibyte *strdata;
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
792 REGISTER Ibyte *bufp;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 Bytecount strlength;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 Bytecount idx;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 Bytecount bsize;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
796 Ibyte *new;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
797 Lisp_Object tem = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
798 Lisp_Object keymap = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
799 Lisp_Object name = Qnil;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
800 Ibyte *start;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 Bytecount length;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
804 if (NILP (string))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
807 CHECK_STRING (string);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
808 GCPRO4 (string, tem, keymap, name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 /* There is the possibility that the string is not destined for a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 translating stream, and it could be argued that we should do the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 same thing here as in Fformat(), but there are very few times
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 when this will be the case and many calls to this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 would have to have `gettext' calls added. (I18N3) */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
815 string = LISP_GETTEXT (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 /* KEYMAP is either nil (which means search all the active keymaps)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 or a specified local map (which means search just that and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 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
820 or from a \\<mapname> construct in STRING itself.. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 #if 0 /* FSFmacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 /* 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
823 an overriding-local-map, `where-is-internal' will correctly note
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 this, so there's no reason to do it here. Maybe FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 `where-is-internal' is broken. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 keymap = current_kboard->Voverriding_terminal_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 if (NILP (keymap))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 keymap = Voverriding_local_map;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
833 strlength = XSTRING_LENGTH (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 bsize = 1 + strlength;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
835 buf = (Ibyte *) xmalloc (bsize);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 bufp = buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 /* Have to reset strdata every time GC might be called */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
839 strdata = XSTRING_DATA (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 for (idx = 0; idx < strlength; )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
842 Ibyte *strp = strdata + idx;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 if (strp[0] != '\\')
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 /* just copy other chars */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 /* As it happens, this will work with Mule even if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 character quoted is multi-byte; the remaining multi-byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 characters will just be copied by this loop. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 *bufp++ = *strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 idx++;
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 else switch (strp[1])
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 /* just copy unknown escape sequences */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 *bufp++ = *strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 case '=':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 /* \= quotes the next character;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 thus, to put in \[ without its special meaning, use \=\[. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 /* As it happens, this will work with Mule even if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 character quoted is multi-byte; the remaining multi-byte
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 characters will just be copied by this loop. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 *bufp++ = strp[2];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 idx += 3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 case '[':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 idx += 2; /* skip \[ */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 strp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 start = strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 while ((idx < strlength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 && *strp != ']')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 strp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 length = strp - start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 idx++; /* skip ] */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 tem = Fintern (make_string (start, length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 #if 0 /* FSFmacs */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
894 /* Disregard menu bar bindings; it is positively annoying to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 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
896 useful even when there is a menu bar. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 if (!NILP (tem))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
898 {
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
899 firstkey = Faref (tem, Qzero);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
900 if (EQ (firstkey, Qmenu_bar))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
901 tem = Qnil;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
902 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 #endif
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 if (NILP (tem)) /* but not on any keys */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 {
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
907 new = (Ibyte *) xrealloc (buf, bsize += 4);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 bufp += new - buf;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 buf = new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 memcpy (bufp, "M-x ", 4);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 bufp += 4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 goto subst;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 { /* function is on a key */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 tem = Fkey_description (tem);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 goto subst_string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 }
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 case '{':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 case '<':
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
923 Lisp_Object buffer = Fget_buffer_create (QSsubstitute);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
924 struct buffer *buf_ = XBUFFER (buffer);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 Fbuffer_disable_undo (buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 Ferase_buffer (buffer);
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 /* \{foo} is replaced with a summary of keymap (symbol-value foo).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 \<foo> just sets the keymap used for \[cmd]. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 changed = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 idx += 2; /* skip \{ or \< */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 strp += 2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 start = strp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 while ((idx < strlength)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 && *strp != '}' && *strp != '>')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 strp++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 idx++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 length = strp - start;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 idx++; /* skip } or > */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 /* Get the value of the keymap in TEM, or nil if undefined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 Do this while still in the user's current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 in case it is a local variable. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 name = Fintern (make_string (start, length), Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 tem = Fboundp (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 if (! NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 tem = Fsymbol_value (name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 if (! NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 tem = get_keymap (tem, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 }
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 if (NILP (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
959 buffer_insert_c_string (buf_, "(uses keymap \"");
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
960 buffer_insert_lisp_string (buf_, Fsymbol_name (name));
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
961 buffer_insert_c_string (buf_, "\", which is not currently defined) ");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 if (start[-1] == '<') keymap = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 else if (start[-1] == '<')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 keymap = tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 tem = make_string_from_buffer (buf_, BUF_BEG (buf_),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 BUF_Z (buf_) - BUF_BEG (buf_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 Ferase_buffer (buffer);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
973 }
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
974 goto subst_string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
976 subst_string:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
977 start = XSTRING_DATA (tem);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
978 length = XSTRING_LENGTH (tem);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
979 subst:
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
980 bsize += length;
867
804517e16990 [xemacs-hg @ 2002-06-05 09:54:39 by ben]
ben
parents: 851
diff changeset
981 new = (Ibyte *) xrealloc (buf, bsize);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
982 bufp += new - buf;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
983 buf = new;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
984 memcpy (bufp, start, length);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
985 bufp += length;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
987 /* Reset STRDATA in case gc relocated it. */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
988 strdata = XSTRING_DATA (string);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
990 break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 if (changed) /* don't bother if nothing substituted */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 tem = make_string (buf, bufp - buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
997 tem = string;
1726
a8d8f419b459 [xemacs-hg @ 2003-09-30 15:26:34 by james]
james
parents: 1330
diff changeset
998 xfree (buf, Ibyte *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 return tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 /* initialization */
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 syms_of_doc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 DEFSUBR (Fdocumentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 DEFSUBR (Fdocumentation_property);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 DEFSUBR (Fsnarf_documentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 DEFSUBR (Fverify_documentation);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 DEFSUBR (Fsubstitute_command_keys);
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 vars_of_doc (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 Name of file containing documentation strings of built-in symbols.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 Vinternal_doc_file_name = Qnil;
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 QSsubstitute = build_string (" *substitute*");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 staticpro (&QSsubstitute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 }