Mercurial > hg > xemacs-beta
diff src/doc.c @ 5118:e0db3c197671 ben-lisp-object
merge up to latest default branch, doesn't compile yet
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 21:18:49 -0600 |
parents | 061e030e3270 |
children | 755ae5b97edb 19a72041c5ed |
line wrap: on
line diff
--- a/src/doc.c Sat Dec 26 00:20:27 2009 -0600 +++ b/src/doc.c Sat Dec 26 21:18:49 2009 -0600 @@ -37,12 +37,129 @@ Lisp_Object Vinternal_doc_file_name; -Lisp_Object QSsubstitute; +Lisp_Object QSsubstitute, Qdefvar; + +/* Work out what source file a function or variable came from, taking the + information from the documentation file. */ + +static Lisp_Object +extract_object_file_name (int fd, EMACS_INT doc_pos, + Ibyte *name_nonreloc, Lisp_Object name_reloc, + int standard_doc_file) +{ + Ibyte buf[DOC_MAX_FILENAME_LENGTH+1]; + Ibyte *buffer = buf; + int buffer_size = sizeof (buf) - 1, space_left; + Ibyte *from, *to; + REGISTER Ibyte *p = buffer; + Lisp_Object return_me; + Lisp_Object fdstream = Qnil, instream = Qnil; + struct gcpro gcpro1, gcpro2; + EMACS_INT position, seenS = 0; + + GCPRO2 (fdstream, instream); + + position = doc_pos > buffer_size ? + doc_pos - buffer_size : 0; + + if (0 > lseek (fd, position, 0)) + { + if (name_nonreloc) + name_reloc = build_intstring (name_nonreloc); + return_me = list3 (build_msg_string + ("Position out of range in doc string file"), + name_reloc, make_int (position)); + goto done; + } + + fdstream = make_filedesc_input_stream (fd, 0, -1, 0); + Lstream_set_buffering (XLSTREAM (fdstream), LSTREAM_UNBUFFERED, 0); + instream = + make_coding_input_stream + (XLSTREAM (fdstream), standard_doc_file ? Qescape_quoted : Qbinary, + CODING_DECODE, 0); + Lstream_set_buffering (XLSTREAM (instream), LSTREAM_UNBUFFERED, 0); + + space_left = buffer_size - (p - buffer); + while (space_left > 0) + { + int nread; + + nread = Lstream_read (XLSTREAM (instream), p, space_left); + if (nread < 0) + { + return_me = list1 (build_msg_string + ("Read error on documentation file")); + goto done; + } + + p[nread] = 0; + + if (!nread) + break; -/* Read and return doc string or instructions from open file descriptor FD - at position POSITION. Does not close the file. Returns string; or if - error, returns a cons holding the error data to pass to Fsignal. - NAME_NONRELOC and NAME_RELOC are only used for the error messages. */ + p += nread; + space_left = buffer_size - (p - buffer); + } + + /* First, search backward for the "\037S" that marks the beginning of the + file name, then search forward from that to the newline or to the end + of the buffer. */ + from = p; + + while (from > buf) + { + --from; + if (seenS) + { + if ('\037' == *from) + { + /* Got a file name; adjust `from' to point to it, break out of + the loop. */ + from += 2; + break; + } + } + /* Is *from 'S' ? */ + seenS = ('S' == *from); + } + + if (buf == from) + { + /* We've scanned back to the beginning of the buffer without hitting + the file name. Either the file name plus the symbol name is longer + than DOC_MAX_FILENAME_LENGTH--which shouldn't happen, because it'll + trigger an assertion failure in make-docfile, the DOC file is + corrupt, or it was produced by a version of make-docfile that + doesn't store the file name with the symbol name and docstring. */ + return_me = list1 (build_msg_string + ("Object file name not stored in doc file")); + goto done; + } + + to = from; + /* Search for the end of the file name. */ + while (++to < p) + { + if ('\n' == *to || '\037' == *to) + { + break; + } + } + + /* Don't require the file name to end in a newline. */ + return_me = make_string (from, to - from); + + done: + if (!NILP (instream)) + { + Lstream_delete (XLSTREAM (instream)); + Lstream_delete (XLSTREAM (fdstream)); + } + + UNGCPRO; + return return_me; +} Lisp_Object unparesseuxify_doc_string (int fd, EMACS_INT position, @@ -51,7 +168,7 @@ { Ibyte buf[512 * 32 + 1]; Ibyte *buffer = buf; - int buffer_size = sizeof (buf); + int buffer_size = sizeof (buf) - 1; Ibyte *from, *to; REGISTER Ibyte *p = buffer; Lisp_Object return_me; @@ -98,13 +215,15 @@ if (space_left == 0) { Ibyte *old_buffer = buffer; + buffer_size *= 2; + if (buffer == buf) { - buffer = xnew_ibytes (buffer_size *= 2); + buffer = xnew_ibytes (buffer_size + 1); memcpy (buffer, old_buffer, p - old_buffer); } else - XREALLOC_ARRAY (buffer, Ibyte, buffer_size *= 2); + XREALLOC_ARRAY (buffer, Ibyte, buffer_size + 1); p += buffer - old_buffer; space_left = buffer_size - (p - buffer); } @@ -287,6 +406,180 @@ return Fread (string); } +static Lisp_Object +get_object_file_name (Lisp_Object filepos) +{ + REGISTER int fd; + REGISTER Ibyte *name_nonreloc = 0; + EMACS_INT position; + Lisp_Object file, tem; + Lisp_Object name_reloc = Qnil; + int standard_doc_file = 0; + + if (INTP (filepos)) + { + file = Vinternal_doc_file_name; + standard_doc_file = 1; + position = XINT (filepos); + } + else if (CONSP (filepos) && INTP (XCDR (filepos))) + { + file = XCAR (filepos); + position = XINT (XCDR (filepos)); + if (position < 0) + position = - position; + } + else + return Qnil; + + if (!STRINGP (file)) + return Qnil; + + /* Put the file name in NAME as a C string. + If it is relative, combine it with Vdoc_directory. */ + + tem = Ffile_name_absolute_p (file); + if (NILP (tem)) + { + Bytecount minsize; + /* XEmacs: Move this check here. OK if called during loadup to + load byte code instructions. */ + if (!STRINGP (Vdoc_directory)) + return Qnil; + + minsize = XSTRING_LENGTH (Vdoc_directory); + /* sizeof ("../lib-src/") == 12 */ + if (minsize < 12) + minsize = 12; + name_nonreloc = alloca_ibytes (minsize + XSTRING_LENGTH (file) + 8); + string_join (name_nonreloc, Vdoc_directory, file); + } + else + name_reloc = file; + + fd = qxe_open (name_nonreloc ? name_nonreloc : + XSTRING_DATA (name_reloc), O_RDONLY | OPEN_BINARY, 0); + if (fd < 0) + { + if (purify_flag) + { + /* sizeof ("../lib-src/") == 12 */ + name_nonreloc = alloca_ibytes (12 + XSTRING_LENGTH (file) + 8); + /* Preparing to dump; DOC file is probably not installed. + So check in ../lib-src. */ + qxestrcpy_ascii (name_nonreloc, "../lib-src/"); + qxestrcat (name_nonreloc, XSTRING_DATA (file)); + + fd = qxe_open (name_nonreloc, O_RDONLY | OPEN_BINARY, 0); + } + + if (fd < 0) + report_file_error ("Cannot open doc string file", + name_nonreloc ? build_intstring (name_nonreloc) : + name_reloc); + } + + tem = extract_object_file_name (fd, position, name_nonreloc, name_reloc, + standard_doc_file); + retry_close (fd); + + if (!STRINGP (tem)) + signal_error_1 (Qinvalid_byte_code, tem); + + return tem; +} + + +static void +weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type, + int pos) +{ + if (!strcmp (weirdness, GETTEXT ("duplicate"))) return; + message ("Note: Strange doc (%s) for %s %s @ %d", + weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos); +} + +DEFUN ("built-in-symbol-file", Fbuilt_in_symbol_file, 1, 2, 0, /* +Return the C source file built-in symbol SYM comes from. +Don't use this. Use the more general `symbol-file' (q.v.) instead. + +If TYPE is nil or omitted, any kind of definition is acceptable. +If TYPE is `defun', then function, subr, special form or macro definitions +are acceptable. +If TYPE is `defvar', then variable definitions are acceptable. +*/ + (symbol, type)) +{ + /* This function can GC */ + Lisp_Object fun; + Lisp_Object filename = Qnil; + + if (EQ(Ffboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefun))) + { + fun = Findirect_function (symbol); + + if (SUBRP (fun) || (CONSP(fun) && (EQ (Qmacro, Fcar_safe (fun))) + && (fun = Fcdr_safe (fun), SUBRP (fun)))) + { + if (XSUBR (fun)->doc == 0) + return Qnil; + + if ((EMACS_INT) XSUBR (fun)->doc >= 0) + { + weird_doc (symbol, "No file info available for function", + GETTEXT("function"), 0); + return Qnil; + } + else + { + filename = get_object_file_name + (make_int (- (EMACS_INT) XSUBR (fun)->doc)); + return filename; + } + } + + if (COMPILED_FUNCTIONP (fun) || (CONSP(fun) && + (EQ (Qmacro, Fcar_safe (fun))) + && (fun = Fcdr_safe (fun), + COMPILED_FUNCTIONP (fun)))) + { + Lisp_Object tem; + Lisp_Compiled_Function *f = XCOMPILED_FUNCTION (fun); + + if (! (f->flags.documentationp)) + return Qnil; + tem = compiled_function_documentation (f); + if (NATNUMP (tem) || CONSP (tem)) + { + filename = get_object_file_name (tem); + return filename; + } + } + } + + if (EQ(Fboundp(symbol), Qt) && (EQ(type, Qnil) || EQ(type, Qdefvar))) + { + Lisp_Object doc_offset = Fget (symbol, Qvariable_documentation, Qnil); + + if (!NILP(doc_offset)) + { + if (INTP(doc_offset)) + { + filename = get_object_file_name + (XINT (doc_offset) > 0 ? doc_offset + : make_int (- XINT (doc_offset))); + } + else if (CONSP(doc_offset)) + { + filename = get_object_file_name(doc_offset); + } + return filename; + } + } + + return Qnil; +} + DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the @@ -419,14 +712,6 @@ return doc; } -static void -weird_doc (Lisp_Object sym, const CIbyte *weirdness, const CIbyte *type, - int pos) -{ - if (!strcmp (weirdness, GETTEXT ("duplicate"))) return; - message ("Note: Strange doc (%s) for %s %s @ %d", - weirdness, type, XSTRING_DATA (XSYMBOL (sym)->name), pos); -} DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /* Used during Emacs initialization, before dumping runnable Emacs, @@ -487,6 +772,10 @@ if (p != end) { end = qxestrchr (p, '\n'); + /* If you trigger a failure with this assertion, you probably + configured with --quick-build and need to rebuild your DOC + file. */ + assert((end - p - 2) > -1); sym = oblookup (Vobarray, p + 2, end - p - 2); if (SYMBOLP (sym)) { @@ -1008,11 +1297,14 @@ void syms_of_doc (void) { + DEFSUBR (Fbuilt_in_symbol_file); DEFSUBR (Fdocumentation); DEFSUBR (Fdocumentation_property); DEFSUBR (Fsnarf_documentation); DEFSUBR (Fverify_documentation); DEFSUBR (Fsubstitute_command_keys); + + DEFSYMBOL (Qdefvar); } void