Mercurial > hg > xemacs-beta
annotate src/doc.c @ 5607:1a507c4c6c42
Refactor out sequence-oriented builtins from fns.c to the new sequence.c.
src/ChangeLog addition:
2011-12-04 Aidan Kehoe <kehoea@parhasard.net>
* Makefile.in.in (objs):
* depend:
Add sequence.o to the list of objects and dependencies.
* alloc.c:
* alloc.c (mark_bit_vector):
* alloc.c (print_bit_vector):
* alloc.c (bit_vector_equal):
* alloc.c (internal_bit_vector_equalp_hash):
* alloc.c (bit_vector_hash):
* alloc.c (init_alloc_once_early):
Move the implementation of the bit vector type here from fns.c.
* emacs.c (main_1):
Call syms_of_sequence() here, now sequence.c is included.
* fns.c (Fold_rassq):
Move this together with the rest of the Fold_* functions.
* fns.c:
* fns.c (syms_of_fns):
Move most functions dealing with sequences generally, and
especially those taking key arguments, to a separate file,
sequence.c.
* general-slots.h:
Qyes_or_no_p belong here, not fns.c.
* lisp.h:
Make Flist_length available here, it's used by sequence.c
* sequence.c:
* sequence.c (check_sequence_range):
* sequence.c (Flength):
* sequence.c (check_other_nokey):
* sequence.c (check_other_key):
* sequence.c (check_if_key):
* sequence.c (check_match_eq_key):
* sequence.c (check_match_eql_key):
* sequence.c (check_match_equal_key):
* sequence.c (check_match_equalp_key):
* sequence.c (check_match_other_key):
* sequence.c (check_lss_key):
* sequence.c (check_lss_key_car):
* sequence.c (check_string_lessp_key):
* sequence.c (check_string_lessp_key_car):
* sequence.c (get_check_match_function_1):
* sequence.c (get_merge_predicate):
* sequence.c (count_with_tail):
* sequence.c (list_count_from_end):
* sequence.c (string_count_from_end):
* sequence.c (Fcount):
* sequence.c (Fsubseq):
* sequence.c (list_position_cons_before):
* sequence.c (FmemberX):
* sequence.c (Fadjoin):
* sequence.c (FassocX):
* sequence.c (FrassocX):
* sequence.c (position):
* sequence.c (Fposition):
* sequence.c (Ffind):
* sequence.c (delq_no_quit_and_free_cons):
* sequence.c (FdeleteX):
* sequence.c (FremoveX):
* sequence.c (list_delete_duplicates_from_end):
* sequence.c (Fdelete_duplicates):
* sequence.c (Fremove_duplicates):
* sequence.c (Fnreverse):
* sequence.c (Freverse):
* sequence.c (list_merge):
* sequence.c (array_merge):
* sequence.c (list_array_merge_into_list):
* sequence.c (list_list_merge_into_array):
* sequence.c (list_array_merge_into_array):
* sequence.c (Fmerge):
* sequence.c (list_sort):
* sequence.c (array_sort):
* sequence.c (FsortX):
* sequence.c (Ffill):
* sequence.c (mapcarX):
* sequence.c (shortest_length_among_sequences):
* sequence.c (Fmapconcat):
* sequence.c (FmapcarX):
* sequence.c (Fmapvector):
* sequence.c (Fmapcan):
* sequence.c (Fmap):
* sequence.c (Fmap_into):
* sequence.c (Fsome):
* sequence.c (Fevery):
* sequence.c (Freduce):
* sequence.c (replace_string_range_1):
* sequence.c (Freplace):
* sequence.c (Fnsubstitute):
* sequence.c (Fsubstitute):
* sequence.c (subst):
* sequence.c (sublis):
* sequence.c (Fsublis):
* sequence.c (nsublis):
* sequence.c (Fnsublis):
* sequence.c (Fsubst):
* sequence.c (Fnsubst):
* sequence.c (tree_equal):
* sequence.c (Ftree_equal):
* sequence.c (mismatch_from_end):
* sequence.c (mismatch_list_list):
* sequence.c (mismatch_list_string):
* sequence.c (mismatch_list_array):
* sequence.c (mismatch_string_array):
* sequence.c (mismatch_string_string):
* sequence.c (mismatch_array_array):
* sequence.c (get_mismatch_func):
* sequence.c (Fmismatch):
* sequence.c (Fsearch):
* sequence.c (venn):
* sequence.c (nvenn):
* sequence.c (Funion):
* sequence.c (Fset_exclusive_or):
* sequence.c (Fnset_exclusive_or):
* sequence.c (syms_of_sequence):
Add this file, containing those general functions that dealt with
sequences that were in fns.c.
* symsinit.h:
Make syms_of_sequence() available here.
man/ChangeLog addition:
2011-12-04 Aidan Kehoe <kehoea@parhasard.net>
* internals/internals.texi (Basic Lisp Modules):
Document sequence.c here too.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 04 Dec 2011 18:42:50 +0000 |
| parents | 3b1d4fa716a4 |
| children | 2014ff433daf |
| rev | line source |
|---|---|
| 428 | 1 /* Record indices of function doc strings stored in a file. |
| 2 Copyright (C) 1985, 1986, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
| 2367 | 4 Copyright (C) 2001, 2002, 2004 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
11 option) any later version. |
| 428 | 12 |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5206
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: FSF 19.30. */ | |
| 22 | |
| 814 | 23 /* This file has been Mule-ized. */ |
| 428 | 24 |
| 25 #include <config.h> | |
| 26 #include "lisp.h" | |
| 27 | |
| 28 #include "buffer.h" | |
| 29 #include "bytecode.h" | |
| 814 | 30 #include "file-coding.h" |
| 428 | 31 #include "insdel.h" |
| 32 #include "keymap.h" | |
| 814 | 33 #include "lstream.h" |
| 428 | 34 #include "sysfile.h" |
| 35 | |
| 36 Lisp_Object Vinternal_doc_file_name; | |
| 37 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
38 Lisp_Object QSsubstitute, Qdefvar; |
| 428 | 39 |
| 3368 | 40 /* Work out what source file a function or variable came from, taking the |
| 41 information from the documentation file. */ | |
| 42 | |
| 43 static Lisp_Object | |
| 44 extract_object_file_name (int fd, EMACS_INT doc_pos, | |
| 45 Ibyte *name_nonreloc, Lisp_Object name_reloc, | |
| 46 int standard_doc_file) | |
| 47 { | |
| 3383 | 48 Ibyte buf[DOC_MAX_FILENAME_LENGTH+1]; |
| 3368 | 49 Ibyte *buffer = buf; |
| 3411 | 50 int buffer_size = sizeof (buf) - 1, space_left; |
| 3368 | 51 Ibyte *from, *to; |
| 52 REGISTER Ibyte *p = buffer; | |
| 53 Lisp_Object return_me; | |
| 54 Lisp_Object fdstream = Qnil, instream = Qnil; | |
| 55 struct gcpro gcpro1, gcpro2; | |
| 56 EMACS_INT position, seenS = 0; | |
| 57 | |
| 58 GCPRO2 (fdstream, instream); | |
| 59 | |
| 3411 | 60 position = doc_pos > buffer_size ? |
| 61 doc_pos - buffer_size : 0; | |
| 3368 | 62 |
| 63 if (0 > lseek (fd, position, 0)) | |
| 64 { | |
| 65 if (name_nonreloc) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
66 name_reloc = build_istring (name_nonreloc); |
| 3368 | 67 return_me = list3 (build_msg_string |
| 68 ("Position out of range in doc string file"), | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
69 name_reloc, make_fixnum (position)); |
| 3368 | 70 goto done; |
| 71 } | |
| 72 | |
| 73 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); | |
| 74 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
| 75 instream = | |
| 76 make_coding_input_stream | |
| 77 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, | |
| 78 CODING_DECODE, 0); | |
| 79 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
| 80 | |
| 81 space_left = buffer_size - (p - buffer); | |
| 82 while (space_left > 0) | |
| 83 { | |
| 84 int nread; | |
| 85 | |
| 86 nread = Lstream_read (XLSTREAM (instream), p, space_left); | |
| 87 if (nread < 0) | |
| 88 { | |
| 89 return_me = list1 (build_msg_string | |
| 90 ("Read error on documentation file")); | |
| 91 goto done; | |
| 92 } | |
| 93 | |
| 94 p[nread] = 0; | |
| 95 | |
| 96 if (!nread) | |
| 97 break; | |
| 98 | |
| 99 p += nread; | |
| 100 space_left = buffer_size - (p - buffer); | |
| 101 } | |
| 102 | |
| 103 /* First, search backward for the "\037S" that marks the beginning of the | |
| 104 file name, then search forward from that to the newline or to the end | |
| 105 of the buffer. */ | |
| 106 from = p; | |
| 107 | |
| 108 while (from > buf) | |
| 109 { | |
| 110 --from; | |
| 111 if (seenS) | |
| 112 { | |
| 113 if ('\037' == *from) | |
| 114 { | |
| 115 /* Got a file name; adjust `from' to point to it, break out of | |
| 116 the loop. */ | |
| 117 from += 2; | |
| 118 break; | |
| 119 } | |
| 120 } | |
| 121 /* Is *from 'S' ? */ | |
| 122 seenS = ('S' == *from); | |
| 123 } | |
| 124 | |
| 125 if (buf == from) | |
| 126 { | |
| 127 /* We've scanned back to the beginning of the buffer without hitting | |
| 128 the file name. Either the file name plus the symbol name is longer | |
| 129 than DOC_MAX_FILENAME_LENGTH--which shouldn't happen, because it'll | |
| 130 trigger an assertion failure in make-docfile, the DOC file is | |
| 131 corrupt, or it was produced by a version of make-docfile that | |
| 132 doesn't store the file name with the symbol name and docstring. */ | |
| 133 return_me = list1 (build_msg_string | |
| 134 ("Object file name not stored in doc file")); | |
| 135 goto done; | |
| 136 } | |
| 137 | |
| 138 to = from; | |
| 139 /* Search for the end of the file name. */ | |
| 140 while (++to < p) | |
| 141 { | |
| 142 if ('\n' == *to || '\037' == *to) | |
| 143 { | |
| 144 break; | |
| 145 } | |
| 146 } | |
| 147 | |
| 148 /* Don't require the file name to end in a newline. */ | |
| 149 return_me = make_string (from, to - from); | |
| 150 | |
| 151 done: | |
| 152 if (!NILP (instream)) | |
| 153 { | |
| 154 Lstream_delete (XLSTREAM (instream)); | |
| 155 Lstream_delete (XLSTREAM (fdstream)); | |
| 156 } | |
| 157 | |
| 158 UNGCPRO; | |
| 159 return return_me; | |
| 160 } | |
| 428 | 161 |
| 162 Lisp_Object | |
| 163 unparesseuxify_doc_string (int fd, EMACS_INT position, | |
| 867 | 164 Ibyte *name_nonreloc, Lisp_Object name_reloc, |
| 814 | 165 int standard_doc_file) |
| 428 | 166 { |
| 867 | 167 Ibyte buf[512 * 32 + 1]; |
| 168 Ibyte *buffer = buf; | |
| 3411 | 169 int buffer_size = sizeof (buf) - 1; |
| 867 | 170 Ibyte *from, *to; |
| 171 REGISTER Ibyte *p = buffer; | |
| 428 | 172 Lisp_Object return_me; |
| 814 | 173 Lisp_Object fdstream = Qnil, instream = Qnil; |
| 174 struct gcpro gcpro1, gcpro2; | |
| 175 | |
| 176 GCPRO2 (fdstream, instream); | |
| 428 | 177 |
| 178 if (0 > lseek (fd, position, 0)) | |
| 179 { | |
| 180 if (name_nonreloc) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
181 name_reloc = build_istring (name_nonreloc); |
| 771 | 182 return_me = list3 (build_msg_string |
| 428 | 183 ("Position out of range in doc string file"), |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
184 name_reloc, make_fixnum (position)); |
| 428 | 185 goto done; |
| 186 } | |
| 187 | |
| 814 | 188 fdstream = make_filedesc_input_stream (fd, 0, -1, 0); |
| 189 Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); | |
| 190 instream = | |
| 191 make_coding_input_stream | |
| 192 /* Major trouble if we are too clever when reading byte-code | |
| 193 instructions! | |
| 194 | |
| 195 #### We should have a way of handling escape-quoted elc files | |
| 196 (i.e. files with non-ASCII/Latin-1 chars in them). Currently this | |
| 197 is "solved" in bytecomp.el by never inserting lazy references in | |
| 198 such files. */ | |
| 826 | 199 (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, |
| 814 | 200 CODING_DECODE, 0); |
| 201 Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); | |
| 202 | |
| 428 | 203 /* Read the doc string into a buffer. |
| 204 Use the fixed buffer BUF if it is big enough; otherwise allocate one. | |
| 205 We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */ | |
| 206 | |
| 207 while (1) | |
| 208 { | |
| 209 int space_left = buffer_size - (p - buffer); | |
| 210 int nread; | |
| 211 | |
| 212 /* Switch to a bigger buffer if we need one. */ | |
| 213 if (space_left == 0) | |
| 214 { | |
| 867 | 215 Ibyte *old_buffer = buffer; |
| 3411 | 216 buffer_size *= 2; |
| 217 | |
| 771 | 218 if (buffer == buf) |
| 219 { | |
| 3411 | 220 buffer = xnew_ibytes (buffer_size + 1); |
| 771 | 221 memcpy (buffer, old_buffer, p - old_buffer); |
| 222 } | |
| 223 else | |
| 3411 | 224 XREALLOC_ARRAY (buffer, Ibyte, buffer_size + 1); |
| 428 | 225 p += buffer - old_buffer; |
| 226 space_left = buffer_size - (p - buffer); | |
| 227 } | |
| 228 | |
| 229 /* Don't read too much at one go. */ | |
| 230 if (space_left > 1024 * 8) | |
| 231 space_left = 1024 * 8; | |
| 814 | 232 nread = Lstream_read (XLSTREAM (instream), p, space_left); |
| 428 | 233 if (nread < 0) |
| 234 { | |
| 771 | 235 return_me = list1 (build_msg_string |
| 428 | 236 ("Read error on documentation file")); |
| 237 goto done; | |
| 238 } | |
| 239 p[nread] = 0; | |
| 240 if (!nread) | |
| 241 break; | |
| 242 { | |
| 867 | 243 Ibyte *p1 = qxestrchr (p, '\037'); /* End of doc string marker */ |
| 814 | 244 if (p1) |
| 245 { | |
| 246 *p1 = 0; | |
| 247 p = p1; | |
| 248 break; | |
| 249 } | |
| 428 | 250 } |
| 251 p += nread; | |
| 252 } | |
| 253 | |
| 254 /* Scan the text and remove quoting with ^A (char code 1). | |
| 255 ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */ | |
| 256 from = to = buffer; | |
| 257 while (from < p) | |
| 258 { | |
| 259 if (*from != 1 /*^A*/) | |
| 260 *to++ = *from++; | |
| 261 else | |
| 262 { | |
| 263 int c = *(++from); | |
| 264 | |
| 265 from++; | |
| 266 switch (c) | |
| 267 { | |
| 268 case 1: *to++ = c; break; | |
| 269 case '0': *to++ = '\0'; break; | |
| 270 case '_': *to++ = '\037'; break; | |
| 271 default: | |
| 771 | 272 return_me = list2 (build_msg_string |
| 428 | 273 ("Invalid data in documentation file -- ^A followed by weird code"), |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
274 make_fixnum (c)); |
| 428 | 275 goto done; |
| 276 } | |
| 277 } | |
| 278 } | |
| 279 | |
| 814 | 280 return_me = make_string (buffer, to - buffer); |
| 428 | 281 |
| 282 done: | |
| 814 | 283 if (!NILP (instream)) |
| 284 { | |
| 285 Lstream_delete (XLSTREAM (instream)); | |
| 286 Lstream_delete (XLSTREAM (fdstream)); | |
| 287 } | |
| 288 UNGCPRO; | |
| 428 | 289 if (buffer != buf) /* We must have allocated buffer above */ |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
290 xfree (buffer); |
| 428 | 291 return return_me; |
| 292 } | |
| 293 | |
| 771 | 294 #define string_join(dest, s1, s2) \ |
| 295 memcpy (dest, XSTRING_DATA (s1), XSTRING_LENGTH (s1)); \ | |
| 296 memcpy (dest + XSTRING_LENGTH (s1), XSTRING_DATA (s2), \ | |
| 297 XSTRING_LENGTH (s2)); \ | |
| 428 | 298 dest[XSTRING_LENGTH (s1) + XSTRING_LENGTH (s2)] = '\0' |
| 299 | |
| 300 /* Extract a doc string from a file. FILEPOS says where to get it. | |
| 301 (This could actually be byte code instructions/constants instead | |
| 302 of a doc string.) | |
| 303 If it is an integer, use that position in the standard DOC file. | |
| 304 If it is (FILE . INTEGER), use FILE as the file name | |
| 305 and INTEGER as the position in that file. | |
| 306 But if INTEGER is negative, make it positive. | |
| 307 (A negative integer is used for user variables, so we can distinguish | |
| 308 them without actually fetching the doc string.) */ | |
| 309 | |
| 310 static Lisp_Object | |
| 311 get_doc_string (Lisp_Object filepos) | |
| 312 { | |
| 313 REGISTER int fd; | |
| 867 | 314 REGISTER Ibyte *name_nonreloc = 0; |
| 428 | 315 EMACS_INT position; |
| 316 Lisp_Object file, tem; | |
| 317 Lisp_Object name_reloc = Qnil; | |
| 814 | 318 int standard_doc_file = 0; |
| 428 | 319 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
320 if (FIXNUMP (filepos)) |
| 428 | 321 { |
| 322 file = Vinternal_doc_file_name; | |
| 814 | 323 standard_doc_file = 1; |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
324 position = XFIXNUM (filepos); |
| 428 | 325 } |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
326 else if (CONSP (filepos) && FIXNUMP (XCDR (filepos))) |
| 428 | 327 { |
| 328 file = XCAR (filepos); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
329 position = XFIXNUM (XCDR (filepos)); |
| 428 | 330 if (position < 0) |
| 331 position = - position; | |
| 332 } | |
| 333 else | |
| 334 return Qnil; | |
| 335 | |
| 336 if (!STRINGP (file)) | |
| 337 return Qnil; | |
| 338 | |
| 339 /* Put the file name in NAME as a C string. | |
| 340 If it is relative, combine it with Vdoc_directory. */ | |
| 341 | |
| 342 tem = Ffile_name_absolute_p (file); | |
| 343 if (NILP (tem)) | |
| 344 { | |
| 647 | 345 Bytecount minsize; |
| 428 | 346 /* XEmacs: Move this check here. OK if called during loadup to |
| 347 load byte code instructions. */ | |
| 348 if (!STRINGP (Vdoc_directory)) | |
| 349 return Qnil; | |
| 350 | |
| 351 minsize = XSTRING_LENGTH (Vdoc_directory); | |
| 352 /* sizeof ("../lib-src/") == 12 */ | |
| 353 if (minsize < 12) | |
| 354 minsize = 12; | |
| 867 | 355 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); |
| 428 | 356 string_join (name_nonreloc, Vdoc_directory, file); |
| 357 } | |
| 358 else | |
| 359 name_reloc = file; | |
| 360 | |
| 771 | 361 fd = qxe_open (name_nonreloc ? name_nonreloc : |
| 362 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
| 428 | 363 if (fd < 0) |
| 364 { | |
| 365 if (purify_flag) | |
| 366 { | |
| 367 /* sizeof ("../lib-src/") == 12 */ | |
| 2367 | 368 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); |
| 428 | 369 /* Preparing to dump; DOC file is probably not installed. |
| 370 So check in ../lib-src. */ | |
| 2367 | 371 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); |
| 771 | 372 qxestrcat (name_nonreloc, XSTRING_DATA (file)); |
| 428 | 373 |
| 771 | 374 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); |
| 428 | 375 } |
| 376 | |
| 377 if (fd < 0) | |
| 814 | 378 report_file_error ("Cannot open doc string file", |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
379 name_nonreloc ? build_istring (name_nonreloc) : |
| 814 | 380 name_reloc); |
| 428 | 381 } |
| 382 | |
| 814 | 383 tem = unparesseuxify_doc_string (fd, position, name_nonreloc, name_reloc, |
| 384 standard_doc_file); | |
| 771 | 385 retry_close (fd); |
| 428 | 386 |
| 387 if (!STRINGP (tem)) | |
| 563 | 388 signal_error_1 (Qinvalid_byte_code, tem); |
| 428 | 389 |
| 390 return tem; | |
| 391 } | |
| 392 | |
| 393 /* Get a string from position FILEPOS and pass it through the Lisp reader. | |
| 394 We use this for fetching the bytecode string and constants vector | |
| 395 of a compiled function from the .elc file. */ | |
| 396 | |
| 397 Lisp_Object | |
| 398 read_doc_string (Lisp_Object filepos) | |
| 399 { | |
| 400 Lisp_Object string = get_doc_string (filepos); | |
| 401 | |
| 402 if (!STRINGP (string)) | |
| 563 | 403 invalid_state ("loading bytecode failed to return string", string); |
| 428 | 404 return Fread (string); |
| 405 } | |
| 406 | |
| 3368 | 407 static Lisp_Object |
| 408 get_object_file_name (Lisp_Object filepos) | |
| 409 { | |
| 410 REGISTER int fd; | |
| 411 REGISTER Ibyte *name_nonreloc = 0; | |
| 412 EMACS_INT position; | |
| 413 Lisp_Object file, tem; | |
| 414 Lisp_Object name_reloc = Qnil; | |
| 415 int standard_doc_file = 0; | |
| 416 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
417 if (FIXNUMP (filepos)) |
| 3368 | 418 { |
| 419 file = Vinternal_doc_file_name; | |
| 420 standard_doc_file = 1; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
421 position = XFIXNUM (filepos); |
| 3368 | 422 } |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
423 else if (CONSP (filepos) && FIXNUMP (XCDR (filepos))) |
| 3368 | 424 { |
| 425 file = XCAR (filepos); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
426 position = XFIXNUM (XCDR (filepos)); |
| 3368 | 427 if (position < 0) |
| 428 position = - position; | |
| 429 } | |
| 430 else | |
| 431 return Qnil; | |
| 432 | |
| 433 if (!STRINGP (file)) | |
| 434 return Qnil; | |
| 435 | |
| 436 /* Put the file name in NAME as a C string. | |
| 437 If it is relative, combine it with Vdoc_directory. */ | |
| 438 | |
| 439 tem = Ffile_name_absolute_p (file); | |
| 440 if (NILP (tem)) | |
| 441 { | |
| 442 Bytecount minsize; | |
| 443 /* XEmacs: Move this check here. OK if called during loadup to | |
| 444 load byte code instructions. */ | |
| 445 if (!STRINGP (Vdoc_directory)) | |
| 446 return Qnil; | |
| 447 | |
| 448 minsize = XSTRING_LENGTH (Vdoc_directory); | |
| 449 /* sizeof ("../lib-src/") == 12 */ | |
| 450 if (minsize < 12) | |
| 451 minsize = 12; | |
| 452 name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); | |
| 453 string_join (name_nonreloc, Vdoc_directory, file); | |
| 454 } | |
| 455 else | |
| 456 name_reloc = file; | |
| 457 | |
| 458 fd = qxe_open (name_nonreloc ? name_nonreloc : | |
| 459 XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); | |
| 460 if (fd < 0) | |
| 461 { | |
| 462 if (purify_flag) | |
| 463 { | |
| 464 /* sizeof ("../lib-src/") == 12 */ | |
| 465 name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); | |
| 466 /* Preparing to dump; DOC file is probably not installed. | |
| 467 So check in ../lib-src. */ | |
| 468 qxestrcpy_ascii (name_nonreloc, "../lib-src/"); | |
| 469 qxestrcat (name_nonreloc, XSTRING_DATA (file)); | |
| 470 | |
| 471 fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); | |
| 472 } | |
| 473 | |
| 474 if (fd < 0) | |
| 475 report_file_error ("Cannot open doc string file", | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
476 name_nonreloc ? build_istring (name_nonreloc) : |
| 3368 | 477 name_reloc); |
| 478 } | |
| 479 | |
| 480 tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc, | |
| 481 standard_doc_file); | |
| 482 retry_close (fd); | |
| 483 | |
| 484 if (!STRINGP (tem)) | |
| 485 signal_error_1 (Qinvalid_byte_code, tem); | |
| 486 | |
| 487 return tem; | |
| 488 } | |
| 489 | |
| 490 | |
| 491 static void | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
492 weird_doc (Lisp_Object sym, const Ascbyte *weirdness, const Ascbyte *type, |
| 3368 | 493 int pos) |
| 494 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
495 if (!strcmp (weirdness, "duplicate")) return; |
| 3368 | 496 message ("Note: Strange doc (%s) for %s %s @ %d", |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
497 GETTEXT (weirdness), GETTEXT (type), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
498 XSTRING_DATA (XSYMBOL (sym)->name), pos); |
| 3368 | 499 } |
| 500 | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
501 DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /* |
| 3368 | 502 Return the C source file built-in symbol SYM comes from. |
| 503 Don't use this. Use the more general `symbol-file' (q.v.) instead. | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
504 |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
505 If TYPE is nil or omitted, any kind of definition is acceptable. |
|
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4539
diff
changeset
|
506 If TYPE is `defun', then function, subr, special operator or macro definitions |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
507 are acceptable. |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
508 If TYPE is `defvar', then variable definitions are acceptable. |
| 3368 | 509 */ |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
510 (symbol, type)) |
| 3368 | 511 { |
| 512 /* This function can GC */ | |
| 513 Lisp_Object fun; | |
| 514 Lisp_Object filename = Qnil; | |
| 515 | |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
516 CHECK_SYMBOL (symbol); |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
517 |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
518 if (!UNBOUNDP (XSYMBOL_FUNCTION (symbol)) |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
519 && (NILP (type) || EQ (type, Qdefun))) |
| 3368 | 520 { |
| 521 fun = Findirect_function (symbol); | |
| 522 | |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
523 if (EQ (Qmacro, Fcar_safe (fun))) |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
524 { |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
525 fun = XCDR (fun); |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
526 } |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
527 |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
528 if (SUBRP (fun)) |
| 3368 | 529 { |
| 530 if (XSUBR (fun)->doc == 0) | |
| 531 return Qnil; | |
| 532 | |
| 533 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
| 534 { | |
| 535 weird_doc (symbol, "No file info available for function", | |
| 536 GETTEXT("function"), 0); | |
| 537 return Qnil; | |
| 538 } | |
| 539 else | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
540 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
541 filename = get_object_file_name |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
542 (make_fixnum (- (EMACS_INT) XSUBR (fun)->doc)); |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
543 return filename; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
544 } |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
545 } |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
546 |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
547 if (COMPILED_FUNCTIONP (fun)) |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
548 { |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
549 Lisp_Object tem; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
550 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
551 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
552 if (! (f->flags.documentationp)) |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
553 return Qnil; |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
554 tem = compiled_function_documentation (f); |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
555 if (NATNUMP (tem)) |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
556 { |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
557 return get_object_file_name (tem); |
|
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
558 } |
| 3368 | 559 } |
| 560 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
561 |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
562 if (!UNBOUNDP (XSYMBOL_VALUE (symbol)) && (NILP (type) || EQ (type, Qdefvar))) |
| 3368 | 563 { |
| 564 Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil); | |
| 565 | |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
566 if (!NILP (doc_offset)) |
| 3368 | 567 { |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
568 if (FIXNUMP (doc_offset)) |
| 3368 | 569 { |
|
5596
3b1d4fa716a4
Ignore lazy docstring info, #'built-in-symbol-file; nothing built-in uses it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
570 filename = get_object_file_name |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
571 (XFIXNUM (doc_offset) > 0 ? doc_offset |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
572 : make_fixnum (- XFIXNUM (doc_offset))); |
| 3368 | 573 } |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
574 return filename; |
| 3368 | 575 } |
| 576 } | |
|
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
577 |
|
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4381
diff
changeset
|
578 return Qnil; |
| 3368 | 579 } |
| 580 | |
| 428 | 581 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* |
| 582 Return the documentation string of FUNCTION. | |
| 444 | 583 Unless a non-nil second argument RAW is given, the |
| 428 | 584 string is passed through `substitute-command-keys'. |
| 585 */ | |
| 586 (function, raw)) | |
| 587 { | |
| 588 /* This function can GC */ | |
| 589 Lisp_Object fun; | |
| 590 Lisp_Object doc; | |
| 591 | |
| 592 fun = Findirect_function (function); | |
| 593 | |
| 594 if (SUBRP (fun)) | |
| 595 { | |
| 596 if (XSUBR (fun)->doc == 0) | |
| 597 return Qnil; | |
| 598 if ((EMACS_INT) XSUBR (fun)->doc >= 0) | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
599 doc = build_cistring (XSUBR (fun)->doc); |
| 428 | 600 else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
601 doc = get_doc_string (make_fixnum (- (EMACS_INT) XSUBR (fun)->doc)); |
| 428 | 602 } |
| 603 else if (COMPILED_FUNCTIONP (fun)) | |
| 604 { | |
| 605 Lisp_Object tem; | |
| 440 | 606 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 607 if (! (f->flags.documentationp)) |
| 608 return Qnil; | |
| 609 tem = compiled_function_documentation (f); | |
| 610 if (STRINGP (tem)) | |
| 611 doc = tem; | |
| 612 else if (NATNUMP (tem) || CONSP (tem)) | |
|
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
613 { |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
614 doc = get_doc_string (tem); |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
615 /* We may have zero length strings in the docfile for file |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
616 information. */ |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
617 if (STRINGP (doc) && 0 == XSTRING_LENGTH (doc)) |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
618 { |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
619 return Qnil; |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
620 } |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
621 } |
| 428 | 622 else |
| 623 return Qnil; | |
| 624 } | |
| 625 else if (KEYMAPP (fun)) | |
| 771 | 626 return build_msg_string ("Prefix command (definition is a keymap of subcommands)."); |
| 428 | 627 else if (STRINGP (fun) || VECTORP (fun)) |
| 771 | 628 return build_msg_string ("Keyboard macro."); |
| 428 | 629 else if (CONSP (fun)) |
| 630 { | |
| 631 Lisp_Object funcar = Fcar (fun); | |
| 632 | |
| 633 if (!SYMBOLP (funcar)) | |
| 634 return Fsignal (Qinvalid_function, list1 (fun)); | |
| 635 else if (EQ (funcar, Qlambda) | |
| 636 || EQ (funcar, Qautoload)) | |
| 637 { | |
| 638 Lisp_Object tem, tem1; | |
| 639 tem1 = Fcdr (Fcdr (fun)); | |
| 640 tem = Fcar (tem1); | |
| 641 if (STRINGP (tem)) | |
| 642 doc = tem; | |
| 643 /* Handle a doc reference--but these never come last | |
| 644 in the function body, so reject them if they are last. */ | |
| 645 else if ((NATNUMP (tem) || CONSP (tem)) | |
| 646 && ! NILP (XCDR (tem1))) | |
| 647 doc = get_doc_string (tem); | |
| 648 else | |
| 649 return Qnil; | |
| 650 } | |
| 651 else if (EQ (funcar, Qmacro)) | |
| 652 return Fdocumentation (Fcdr (fun), raw); | |
| 653 else | |
| 654 goto oops; | |
| 655 } | |
| 656 else | |
| 657 { | |
| 658 oops: | |
| 659 return Fsignal (Qinvalid_function, list1 (fun)); | |
| 660 } | |
| 661 | |
| 662 if (NILP (raw)) | |
| 663 { | |
| 664 struct gcpro gcpro1; | |
| 665 #ifdef I18N3 | |
| 666 Lisp_Object domain = Qnil; | |
| 667 if (COMPILED_FUNCTIONP (fun)) | |
| 668 domain = compiled_function_domain (XCOMPILED_FUNCTION (fun)); | |
| 669 if (NILP (domain)) | |
| 670 doc = Fgettext (doc); | |
| 671 else | |
| 672 doc = Fdgettext (domain, doc); | |
| 673 #endif | |
| 674 | |
| 675 GCPRO1 (doc); | |
| 676 doc = Fsubstitute_command_keys (doc); | |
| 677 UNGCPRO; | |
| 678 } | |
| 679 return doc; | |
| 680 } | |
| 681 | |
| 682 DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /* | |
| 683 Return the documentation string that is SYMBOL's PROP property. | |
| 684 This is like `get', but it can refer to strings stored in the | |
| 685 `doc-directory/DOC' file; and if the value is a string, it is passed | |
| 686 through `substitute-command-keys'. A non-nil third argument avoids this | |
| 687 translation. | |
| 688 */ | |
| 444 | 689 (symbol, prop, raw)) |
| 428 | 690 { |
| 691 /* This function can GC */ | |
| 1849 | 692 Lisp_Object doc = Qnil; |
| 428 | 693 #ifdef I18N3 |
| 694 REGISTER Lisp_Object domain; | |
| 695 #endif | |
| 696 struct gcpro gcpro1; | |
| 697 | |
| 698 GCPRO1 (doc); | |
| 699 | |
| 444 | 700 doc = Fget (symbol, prop, Qnil); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
701 if (FIXNUMP (doc)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
702 doc = get_doc_string (XFIXNUM (doc) > 0 ? doc : make_fixnum (- XFIXNUM (doc))); |
| 428 | 703 else if (CONSP (doc)) |
| 704 doc = get_doc_string (doc); | |
| 705 #ifdef I18N3 | |
| 706 if (!NILP (doc)) | |
| 707 { | |
| 444 | 708 domain = Fget (symbol, Qvariable_domain, Qnil); |
| 428 | 709 if (NILP (domain)) |
| 710 doc = Fgettext (doc); | |
| 711 else | |
| 712 doc = Fdgettext (domain, doc); | |
| 713 } | |
| 714 #endif | |
| 715 if (NILP (raw) && STRINGP (doc)) | |
| 716 doc = Fsubstitute_command_keys (doc); | |
| 717 UNGCPRO; | |
| 718 return doc; | |
| 719 } | |
| 720 | |
| 721 | |
| 722 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* | |
| 723 Used during Emacs initialization, before dumping runnable Emacs, | |
| 724 to find pointers to doc strings stored in `.../lib-src/DOC' and | |
| 725 record them in function definitions. | |
| 726 One arg, FILENAME, a string which does not include a directory. | |
| 727 The file is written to `../lib-src', and later found in `exec-directory' | |
| 728 when doc strings are referred to in the dumped Emacs. | |
| 729 */ | |
| 730 (filename)) | |
| 731 { | |
| 732 int fd; | |
| 867 | 733 Ibyte buf[1024 + 1]; |
| 428 | 734 REGISTER int filled; |
| 735 REGISTER int pos; | |
| 867 | 736 REGISTER Ibyte *p, *end; |
| 428 | 737 Lisp_Object sym, fun, tem; |
| 867 | 738 Ibyte *name; |
| 428 | 739 |
| 814 | 740 /* This function should not pass the data it's reading through a coding |
| 741 stream. The reason is that the only purpose of this function is to | |
| 742 find the file offsets for the documentation of the various functions, | |
| 743 not do anything with the documentation itself. If we pass through a | |
| 744 coding stream, the pointers will get messed up when we start reading | |
| 745 ISO 2022 data because our pointers will reflect internal format, not | |
| 746 external format. */ | |
| 747 | |
| 428 | 748 if (!purify_flag) |
| 563 | 749 invalid_operation ("Snarf-documentation can only be called in an undumped Emacs", Qunbound); |
| 428 | 750 |
| 751 CHECK_STRING (filename); | |
| 752 | |
| 1330 | 753 { |
| 754 name = alloca_ibytes (XSTRING_LENGTH (filename) + 14); | |
| 2367 | 755 qxestrcpy_ascii (name, "../lib-src/"); |
| 1330 | 756 } |
| 428 | 757 |
| 771 | 758 qxestrcat (name, XSTRING_DATA (filename)); |
| 428 | 759 |
| 771 | 760 fd = qxe_open (name, O_RDONLY | OPEN_BINARY, 0); |
| 428 | 761 if (fd < 0) |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
762 report_file_error ("Opening doc string file", build_istring (name)); |
| 428 | 763 Vinternal_doc_file_name = filename; |
| 764 filled = 0; | |
| 765 pos = 0; | |
| 766 while (1) | |
| 767 { | |
| 768 if (filled < 512) | |
| 771 | 769 filled += retry_read (fd, &buf[filled], sizeof (buf) - 1 - filled); |
| 428 | 770 if (!filled) |
| 771 break; | |
| 772 | |
| 773 buf[filled] = 0; | |
| 774 p = buf; | |
| 775 end = buf + (filled < 512 ? filled : filled - 128); | |
| 776 while (p != end && *p != '\037') p++; | |
| 777 /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ | |
| 778 if (p != end) | |
| 779 { | |
| 771 | 780 end = qxestrchr (p, '\n'); |
| 3548 | 781 /* If you trigger a failure with this assertion, you probably |
| 782 configured with --quick-build and need to rebuild your DOC | |
| 3545 | 783 file. */ |
| 784 assert((end - p - 2) > -1); | |
| 771 | 785 sym = oblookup (Vobarray, p + 2, end - p - 2); |
| 428 | 786 if (SYMBOLP (sym)) |
| 787 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
788 Lisp_Object offset = make_fixnum (pos + end + 1 - buf); |
| 428 | 789 /* Attach a docstring to a variable */ |
| 790 if (p[1] == 'V') | |
| 791 { | |
| 792 /* Install file-position as variable-documentation property | |
| 793 and make it negative for a user-variable | |
| 794 (doc starts with a `*'). */ | |
| 795 Lisp_Object old = Fget (sym, Qvariable_documentation, Qzero); | |
| 796 if (!ZEROP (old)) | |
| 797 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
798 weird_doc (sym, "duplicate", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
799 "variable", pos); |
| 428 | 800 /* In the case of duplicate doc file entries, always |
| 801 take the later one. But if the doc is not an int | |
| 802 (a string, say) leave it alone. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
803 if (!FIXNUMP (old)) |
| 428 | 804 goto weird; |
| 805 } | |
| 806 Fput (sym, Qvariable_documentation, | |
| 807 ((end[1] == '*') | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
808 ? make_fixnum (- XFIXNUM (offset)) |
| 428 | 809 : offset)); |
| 810 } | |
| 811 /* Attach a docstring to a function. | |
| 812 The type determines where the docstring is stored. */ | |
| 813 else if (p[1] == 'F') | |
| 814 { | |
| 815 fun = indirect_function (sym,0); | |
| 816 | |
| 817 if (CONSP (fun) && EQ (XCAR (fun), Qmacro)) | |
| 818 fun = XCDR (fun); | |
| 819 | |
| 820 if (UNBOUNDP (fun)) | |
| 821 { | |
| 771 | 822 #if 0 /* There are lots of legitimate cases where this message will appear |
| 823 (e.g. any function that's only defined when MULE is defined, | |
| 824 provided that the function is used somewhere in a dumped Lisp | |
| 825 file, so that the symbol is interned in the dumped XEmacs), and | |
| 826 there's not a lot that can be done to eliminate the warning other | |
| 827 than kludges like moving the function to a Mule-only source file, | |
| 828 which often results in ugly code. Furthermore, the only point of | |
| 829 this warning is to warn you when you have a DEFUN that you forget | |
| 830 to DEFSUBR, but the compiler will also warn you, because the DEFUN | |
| 831 declares a static object, and the object will be unused -- you'll | |
| 832 get something like | |
| 833 | |
| 834 /src/xemacs/mule/src/abbrev.c:269: warning: `SFexpand_abbrev' defined but not used | |
| 835 | |
| 836 So I'm disabling this. --ben */ | |
| 837 | |
| 428 | 838 /* May have been #if'ed out or something */ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
839 weird_doc (sym, "not fboundp", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
840 "function", pos); |
| 771 | 841 #endif |
| 428 | 842 goto weird; |
| 843 } | |
| 844 else if (SUBRP (fun)) | |
| 845 { | |
| 846 /* Lisp_Subrs have a slot for it. */ | |
| 847 if (XSUBR (fun)->doc) | |
| 848 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
849 weird_doc (sym, "duplicate", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
850 "subr", pos); |
| 428 | 851 goto weird; |
| 852 } | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
853 XSUBR (fun)->doc = (char *) (- XFIXNUM (offset)); |
| 428 | 854 } |
| 855 else if (CONSP (fun)) | |
| 856 { | |
| 857 /* If it's a lisp form, stick it in the form. */ | |
| 858 tem = XCAR (fun); | |
| 859 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
| 860 { | |
| 861 tem = Fcdr (Fcdr (fun)); | |
| 862 if (CONSP (tem) && | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
863 FIXNUMP (XCAR (tem))) |
| 428 | 864 { |
| 865 Lisp_Object old = XCAR (tem); | |
| 866 if (!ZEROP (old)) | |
| 867 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
868 if (EQ (tem, Qlambda)) |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
869 weird_doc (sym, "duplicate", "lambda", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
870 pos); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
871 else |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
872 weird_doc (sym, "duplicate", "autoload", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
873 pos); |
| 428 | 874 /* In the case of duplicate doc file entries, |
| 875 always take the later one. But if the doc | |
| 876 is not an int (a string, say) leave it | |
| 877 alone. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
878 if (!FIXNUMP (old)) |
| 428 | 879 goto weird; |
| 880 } | |
| 881 XCAR (tem) = offset; | |
| 882 } | |
| 883 else if (!CONSP (tem)) | |
| 884 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
885 weird_doc (sym, "!CONSP(tem)", "function", pos); |
| 428 | 886 goto cont; |
| 887 } | |
| 888 else | |
| 889 { | |
| 890 /* DOC string is a string not integer 0 */ | |
| 891 #if 0 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
892 weird_doc (sym, "!FIXNUMP(XCAR(tem))", |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
893 "function", pos); |
| 428 | 894 #endif |
| 895 goto cont; | |
| 896 } | |
| 897 } | |
| 898 else | |
| 899 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
900 weird_doc (sym, "not lambda or autoload", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
901 "function", pos); |
| 428 | 902 goto cont; |
| 903 } | |
| 904 } | |
| 905 else if (COMPILED_FUNCTIONP (fun)) | |
| 906 { | |
| 907 /* Compiled-Function objects sometimes have | |
| 908 slots for it. */ | |
| 440 | 909 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 910 |
|
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
911 /* If there were multiple definitions for this function, |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
912 and the latter one didn't |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
913 have any doc, warn and don't blow up. */ |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
914 Lisp_Object old = |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
915 compiled_function_documentation (f); |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
916 if (!ZEROP (old) && !NILP (old)) |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
917 { |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
918 weird_doc (sym, "duplicate", "bytecode", pos); |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
919 /* In the case of duplicate doc file entries, |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
920 always take the later one. But if the doc is |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
921 not an int (a string, say) leave it alone. */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
922 if (!FIXNUMP (old)) |
|
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
923 goto weird; |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
924 } |
| 428 | 925 |
|
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
926 /* This may be a function or variable where we want |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
927 to make the file name available. */ |
|
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4976
diff
changeset
|
928 set_compiled_function_documentation (f, offset); |
| 428 | 929 } |
| 930 else | |
| 931 { | |
| 932 /* Otherwise the function is undefined or | |
| 933 otherwise weird. Ignore it. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
934 weird_doc (sym, "weird function", "function", pos); |
| 428 | 935 goto weird; |
| 936 } | |
| 937 } | |
| 938 else | |
| 939 { | |
| 940 /* lose: */ | |
| 771 | 941 signal_error (Qfile_error, "DOC file invalid at position", |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
942 make_fixnum (pos)); |
| 428 | 943 weird: |
| 944 /* goto lose */; | |
| 945 } | |
| 946 } | |
| 947 } | |
| 948 cont: | |
| 949 pos += end - buf; | |
| 950 filled -= end - buf; | |
| 951 memmove (buf, end, filled); | |
| 952 } | |
| 771 | 953 retry_close (fd); |
| 428 | 954 return Qnil; |
| 955 } | |
| 956 | |
| 957 #if 1 /* Don't warn about functions whose doc was lost because they were | |
| 958 wrapped by advice-freeze.el... */ | |
| 959 static int | |
| 960 kludgily_ignore_lost_doc_p (Lisp_Object sym) | |
| 961 { | |
| 962 # define kludge_prefix "ad-Orig-" | |
| 793 | 963 Lisp_Object name = XSYMBOL (sym)->name; |
| 964 return (XSTRING_LENGTH (name) > (Bytecount) (sizeof (kludge_prefix)) && | |
| 2367 | 965 !qxestrncmp_ascii (XSTRING_DATA (name), kludge_prefix, |
| 793 | 966 sizeof (kludge_prefix) - 1)); |
| 428 | 967 # undef kludge_prefix |
| 968 } | |
| 969 #else | |
| 970 # define kludgily_ignore_lost_doc_p(sym) 0 | |
| 971 #endif | |
| 972 | |
| 973 | |
| 974 static int | |
| 975 verify_doc_mapper (Lisp_Object sym, void *arg) | |
| 976 { | |
| 793 | 977 Lisp_Object closure = * (Lisp_Object *) arg; |
| 428 | 978 |
| 979 if (!NILP (Ffboundp (sym))) | |
| 980 { | |
| 981 int doc = 0; | |
| 982 Lisp_Object fun = XSYMBOL (sym)->function; | |
| 983 if (CONSP (fun) && | |
| 984 EQ (XCAR (fun), Qmacro)) | |
| 985 fun = XCDR (fun); | |
| 986 | |
| 987 if (SUBRP (fun)) | |
| 988 doc = (EMACS_INT) XSUBR (fun)->doc; | |
| 989 else if (SYMBOLP (fun)) | |
| 990 doc = -1; | |
| 991 else if (KEYMAPP (fun)) | |
| 992 doc = -1; | |
| 993 else if (CONSP (fun)) | |
| 994 { | |
| 995 Lisp_Object tem = XCAR (fun); | |
| 996 if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) | |
| 997 { | |
| 998 doc = -1; | |
| 999 tem = Fcdr (Fcdr (fun)); | |
| 1000 if (CONSP (tem) && | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1001 FIXNUMP (XCAR (tem))) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1002 doc = XFIXNUM (XCAR (tem)); |
| 428 | 1003 } |
| 1004 } | |
| 1005 else if (COMPILED_FUNCTIONP (fun)) | |
| 1006 { | |
| 440 | 1007 Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); |
| 428 | 1008 if (! (f->flags.documentationp)) |
| 1009 doc = -1; | |
| 1010 else | |
| 1011 { | |
| 1012 Lisp_Object tem = compiled_function_documentation (f); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1013 if (FIXNUMP (tem)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1014 doc = XFIXNUM (tem); |
| 428 | 1015 } |
| 1016 } | |
| 1017 | |
| 1018 if (doc == 0 && !kludgily_ignore_lost_doc_p (sym)) | |
| 1019 { | |
| 1020 message ("Warning: doc lost for function %s.", | |
| 793 | 1021 XSTRING_DATA (XSYMBOL (sym)->name)); |
| 428 | 1022 XCDR (closure) = Qt; |
| 1023 } | |
| 1024 } | |
| 1025 if (!NILP (Fboundp (sym))) | |
| 1026 { | |
| 1027 Lisp_Object doc = Fget (sym, Qvariable_documentation, Qnil); | |
| 1028 if (ZEROP (doc)) | |
| 1029 { | |
| 1030 message ("Warning: doc lost for variable %s.", | |
| 793 | 1031 XSTRING_DATA (XSYMBOL (sym)->name)); |
| 428 | 1032 XCDR (closure) = Qt; |
| 1033 } | |
| 1034 } | |
| 1035 return 0; /* Never stop */ | |
| 1036 } | |
| 1037 | |
| 1038 DEFUN ("Verify-documentation", Fverify_documentation, 0, 0, 0, /* | |
| 1039 Used to make sure everything went well with Snarf-documentation. | |
| 1040 Writes to stderr if not. | |
| 1041 */ | |
| 1042 ()) | |
| 1043 { | |
| 1044 Lisp_Object closure = Fcons (Qnil, Qnil); | |
| 1045 struct gcpro gcpro1; | |
| 1046 GCPRO1 (closure); | |
| 1047 map_obarray (Vobarray, verify_doc_mapper, &closure); | |
| 1048 if (!NILP (Fcdr (closure))) | |
| 1049 message ("\n" | |
| 1050 "This is usually because some files were preloaded by loaddefs.el or\n" | |
| 1051 "site-load.el, but were not passed to make-docfile by Makefile.\n"); | |
| 1052 UNGCPRO; | |
| 1053 return NILP (Fcdr (closure)) ? Qt : Qnil; | |
| 1054 } | |
| 1055 | |
| 1056 | |
| 1057 DEFUN ("substitute-command-keys", Fsubstitute_command_keys, 1, 1, 0, /* | |
| 1058 Substitute key descriptions for command names in STRING. | |
| 1059 Return a new string which is STRING with substrings of the form \\=\\[COMMAND] | |
| 1060 replaced by either: a keystroke sequence that will invoke COMMAND, | |
| 1061 or "M-x COMMAND" if COMMAND is not on any keys. | |
| 1062 Substrings of the form \\=\\{MAPVAR} are replaced by summaries | |
| 444 | 1063 \(made by `describe-bindings') of the value of MAPVAR, taken as a keymap. |
| 428 | 1064 Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR |
| 1065 as the keymap for future \\=\\[COMMAND] substrings. | |
| 1066 \\=\\= quotes the following character and is discarded; | |
| 1067 thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. | |
| 1068 */ | |
| 444 | 1069 (string)) |
| 428 | 1070 { |
| 1071 /* This function can GC */ | |
| 867 | 1072 Ibyte *buf; |
| 428 | 1073 int changed = 0; |
| 867 | 1074 REGISTER Ibyte *strdata; |
| 1075 REGISTER Ibyte *bufp; | |
| 428 | 1076 Bytecount strlength; |
| 1077 Bytecount idx; | |
| 1078 Bytecount bsize; | |
| 3025 | 1079 Ibyte *new_; |
| 444 | 1080 Lisp_Object tem = Qnil; |
| 1081 Lisp_Object keymap = Qnil; | |
| 1082 Lisp_Object name = Qnil; | |
| 867 | 1083 Ibyte *start; |
| 428 | 1084 Bytecount length; |
| 1085 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 1086 | |
| 444 | 1087 if (NILP (string)) |
| 428 | 1088 return Qnil; |
| 1089 | |
| 444 | 1090 CHECK_STRING (string); |
| 1091 GCPRO4 (string, tem, keymap, name); | |
| 428 | 1092 |
| 1093 /* There is the possibility that the string is not destined for a | |
| 1094 translating stream, and it could be argued that we should do the | |
| 1095 same thing here as in Fformat(), but there are very few times | |
| 1096 when this will be the case and many calls to this function | |
| 1097 would have to have `gettext' calls added. (I18N3) */ | |
| 444 | 1098 string = LISP_GETTEXT (string); |
| 428 | 1099 |
| 1100 /* KEYMAP is either nil (which means search all the active keymaps) | |
| 1101 or a specified local map (which means search just that and the | |
| 1102 global map). If non-nil, it might come from Voverriding_local_map, | |
| 444 | 1103 or from a \\<mapname> construct in STRING itself.. */ |
| 428 | 1104 #if 0 /* FSFmacs */ |
| 1105 /* This is really weird and garbagey. If keymap is nil and there's | |
| 1106 an overriding-local-map, `where-is-internal' will correctly note | |
| 1107 this, so there's no reason to do it here. Maybe FSFmacs | |
| 1108 `where-is-internal' is broken. */ | |
| 1109 /* | |
| 1110 keymap = current_kboard->Voverriding_terminal_local_map; | |
| 1111 if (NILP (keymap)) | |
| 1112 keymap = Voverriding_local_map; | |
| 1113 */ | |
| 1114 #endif | |
| 1115 | |
| 444 | 1116 strlength = XSTRING_LENGTH (string); |
| 2367 | 1117 bsize = ITEXT_ZTERM_SIZE + strlength; |
| 1118 buf = xnew_ibytes (bsize); | |
| 428 | 1119 bufp = buf; |
| 1120 | |
| 1121 /* Have to reset strdata every time GC might be called */ | |
| 444 | 1122 strdata = XSTRING_DATA (string); |
| 428 | 1123 for (idx = 0; idx < strlength; ) |
| 1124 { | |
| 867 | 1125 Ibyte *strp = strdata + idx; |
| 428 | 1126 |
| 1127 if (strp[0] != '\\') | |
| 1128 { | |
| 1129 /* just copy other chars */ | |
| 1130 /* As it happens, this will work with Mule even if the | |
| 1131 character quoted is multi-byte; the remaining multi-byte | |
| 1132 characters will just be copied by this loop. */ | |
| 1133 *bufp++ = *strp; | |
| 1134 idx++; | |
| 1135 } | |
| 1136 else switch (strp[1]) | |
| 1137 { | |
| 1138 default: | |
| 1139 { | |
| 1140 /* just copy unknown escape sequences */ | |
| 1141 *bufp++ = *strp; | |
| 1142 idx++; | |
| 1143 break; | |
| 1144 } | |
| 1145 case '=': | |
| 1146 { | |
| 1147 /* \= quotes the next character; | |
| 1148 thus, to put in \[ without its special meaning, use \=\[. */ | |
| 1149 /* As it happens, this will work with Mule even if the | |
| 1150 character quoted is multi-byte; the remaining multi-byte | |
| 1151 characters will just be copied by this loop. */ | |
| 1152 changed = 1; | |
| 1153 *bufp++ = strp[2]; | |
| 1154 idx += 3; | |
| 1155 break; | |
| 1156 } | |
| 1157 case '[': | |
| 1158 { | |
| 1159 changed = 1; | |
| 1160 idx += 2; /* skip \[ */ | |
| 1161 strp += 2; | |
| 1162 start = strp; | |
| 1163 | |
| 1164 while ((idx < strlength) | |
| 1165 && *strp != ']') | |
| 1166 { | |
| 1167 strp++; | |
| 1168 idx++; | |
| 1169 } | |
| 1170 length = strp - start; | |
| 1171 idx++; /* skip ] */ | |
| 1172 | |
| 1173 tem = Fintern (make_string (start, length), Qnil); | |
| 1174 tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); | |
| 1175 | |
| 1176 #if 0 /* FSFmacs */ | |
| 444 | 1177 /* Disregard menu bar bindings; it is positively annoying to |
| 1178 mention them when there's no menu bar, and it isn't terribly | |
| 1179 useful even when there is a menu bar. */ | |
| 1180 if (!NILP (tem)) | |
| 1181 { | |
| 1182 firstkey = Faref (tem, Qzero); | |
| 1183 if (EQ (firstkey, Qmenu_bar)) | |
| 1184 tem = Qnil; | |
| 1185 } | |
| 428 | 1186 #endif |
| 1187 | |
| 1188 if (NILP (tem)) /* but not on any keys */ | |
| 1189 { | |
| 3025 | 1190 new_ = (Ibyte *) xrealloc (buf, bsize += 4); |
| 1191 bufp += new_ - buf; | |
| 1192 buf = new_; | |
| 428 | 1193 memcpy (bufp, "M-x ", 4); |
| 1194 bufp += 4; | |
| 1195 goto subst; | |
| 1196 } | |
| 1197 else | |
| 1198 { /* function is on a key */ | |
| 1199 tem = Fkey_description (tem); | |
| 1200 goto subst_string; | |
| 1201 } | |
| 1202 } | |
| 1203 case '{': | |
| 1204 case '<': | |
| 1205 { | |
| 444 | 1206 Lisp_Object buffer = Fget_buffer_create (QSsubstitute); |
| 1207 struct buffer *buf_ = XBUFFER (buffer); | |
| 428 | 1208 |
| 1209 Fbuffer_disable_undo (buffer); | |
| 1210 Ferase_buffer (buffer); | |
| 1211 | |
| 1212 /* \{foo} is replaced with a summary of keymap (symbol-value foo). | |
| 1213 \<foo> just sets the keymap used for \[cmd]. */ | |
| 1214 changed = 1; | |
| 1215 idx += 2; /* skip \{ or \< */ | |
| 1216 strp += 2; | |
| 1217 start = strp; | |
| 1218 | |
| 1219 while ((idx < strlength) | |
| 1220 && *strp != '}' && *strp != '>') | |
| 1221 { | |
| 1222 strp++; | |
| 1223 idx++; | |
| 1224 } | |
| 1225 length = strp - start; | |
| 1226 idx++; /* skip } or > */ | |
| 1227 | |
| 1228 /* Get the value of the keymap in TEM, or nil if undefined. | |
| 1229 Do this while still in the user's current buffer | |
| 1230 in case it is a local variable. */ | |
| 1231 name = Fintern (make_string (start, length), Qnil); | |
| 1232 tem = Fboundp (name); | |
| 1233 if (! NILP (tem)) | |
| 1234 { | |
| 1235 tem = Fsymbol_value (name); | |
| 1236 if (! NILP (tem)) | |
| 1237 tem = get_keymap (tem, 0, 1); | |
| 1238 } | |
| 1239 | |
| 1240 if (NILP (tem)) | |
| 1241 { | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1242 buffer_insert_ascstring (buf_, "(uses keymap \""); |
| 444 | 1243 buffer_insert_lisp_string (buf_, Fsymbol_name (name)); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1244 buffer_insert_ascstring (buf_, "\", which is not currently defined) "); |
| 428 | 1245 |
| 1246 if (start[-1] == '<') keymap = Qnil; | |
| 1247 } | |
| 1248 else if (start[-1] == '<') | |
| 1249 keymap = tem; | |
| 1250 else | |
| 1251 describe_map_tree (tem, 1, Qnil, Qnil, 0, buffer); | |
| 1252 | |
| 1253 tem = make_string_from_buffer (buf_, BUF_BEG (buf_), | |
| 1254 BUF_Z (buf_) - BUF_BEG (buf_)); | |
| 1255 Ferase_buffer (buffer); | |
| 444 | 1256 } |
| 1257 goto subst_string; | |
| 428 | 1258 |
| 444 | 1259 subst_string: |
| 1260 start = XSTRING_DATA (tem); | |
| 1261 length = XSTRING_LENGTH (tem); | |
| 1262 subst: | |
| 1263 bsize += length; | |
| 3025 | 1264 new_ = (Ibyte *) xrealloc (buf, bsize); |
| 1265 bufp += new_ - buf; | |
| 1266 buf = new_; | |
| 444 | 1267 memcpy (bufp, start, length); |
| 1268 bufp += length; | |
| 428 | 1269 |
| 444 | 1270 /* Reset STRDATA in case gc relocated it. */ |
| 1271 strdata = XSTRING_DATA (string); | |
| 428 | 1272 |
| 444 | 1273 break; |
| 428 | 1274 } |
| 1275 } | |
| 1276 | |
| 1277 if (changed) /* don't bother if nothing substituted */ | |
| 1278 tem = make_string (buf, bufp - buf); | |
| 1279 else | |
| 444 | 1280 tem = string; |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1281 xfree (buf); |
| 428 | 1282 UNGCPRO; |
| 1283 return tem; | |
| 1284 } | |
| 1285 | |
| 1286 | |
| 1287 /************************************************************************/ | |
| 1288 /* initialization */ | |
| 1289 /************************************************************************/ | |
| 1290 | |
| 1291 void | |
| 1292 syms_of_doc (void) | |
| 1293 { | |
| 3368 | 1294 DEFSUBR (Fbuilt_in_symbol_file); |
| 428 | 1295 DEFSUBR (Fdocumentation); |
| 1296 DEFSUBR (Fdocumentation_property); | |
| 1297 DEFSUBR (Fsnarf_documentation); | |
| 1298 DEFSUBR (Fverify_documentation); | |
| 1299 DEFSUBR (Fsubstitute_command_keys); | |
|
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1300 |
|
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3548
diff
changeset
|
1301 DEFSYMBOL (Qdefvar); |
| 428 | 1302 } |
| 1303 | |
| 1304 void | |
| 1305 vars_of_doc (void) | |
| 1306 { | |
| 1307 DEFVAR_LISP ("internal-doc-file-name", &Vinternal_doc_file_name /* | |
| 1308 Name of file containing documentation strings of built-in symbols. | |
| 1309 */ ); | |
| 1310 Vinternal_doc_file_name = Qnil; | |
| 1311 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4539
diff
changeset
|
1312 QSsubstitute = build_ascstring (" *substitute*"); |
| 428 | 1313 staticpro (&QSsubstitute); |
| 1314 } |