# HG changeset patch # User aidan # Date 1146327331 0 # Node ID 959746c534f67dfed01d6ed3c50088a3a9facfeb # Parent 84ee3ca77e7f7cb94a7c8da359fe7dca65a8d176 [xemacs-hg @ 2006-04-29 16:15:21 by aidan] Support builtin functions in find-function. diff -r 84ee3ca77e7f -r 959746c534f6 lib-src/ChangeLog --- a/lib-src/ChangeLog Sat Apr 29 14:36:57 2006 +0000 +++ b/lib-src/ChangeLog Sat Apr 29 16:15:31 2006 +0000 @@ -1,3 +1,12 @@ +2006-04-29 Aidan Kehoe + + * make-docfile.c: + * make-docfile.c (put_filename): + * make-docfile.c (scan_c_file): + * make-docfile.c (scan_lisp_file): + Record file name information for built-in symbols. Based on the + FSF's implementation of same. + 2006-03-31 Stephen J. Turnbull * XEmacs 21.5.26 "endive" is released. diff -r 84ee3ca77e7f -r 959746c534f6 lib-src/make-docfile.c --- a/lib-src/make-docfile.c Sat Apr 29 14:36:57 2006 +0000 +++ b/lib-src/make-docfile.c Sat Apr 29 16:15:31 2006 +0000 @@ -44,6 +44,7 @@ #include #include +#include #include #include #include @@ -58,6 +59,7 @@ ('0' <= c && c <= '9') || \ (c == '_')) +static void put_filename (const char *filename); static int scan_file (const char *filename); static int read_c_string (FILE *, int, int); static void write_c_args (FILE *out, const char *func, char *buf, int minargs, @@ -263,6 +265,30 @@ return err_count > 0; } +/* Add a source file name boundary in the output file. */ +static void +put_filename (const char *filename) +{ + const char *tmp; + + /* Why are we cutting this off? */ + for (tmp = filename; *tmp; tmp++) + { + if (IS_DIRECTORY_SEP(*tmp)) + filename = tmp + 1; + } + + /* <= because sizeof includes the nul byte at the end. Not quite right, + because it should include the length of the symbol + "\037[VF]" instead + of simply 10. */ + assert(sizeof("\037S\n") + strlen(filename) + 10 + <= DOC_MAX_FILENAME_LENGTH); + + putc (037, outfile); + putc ('S', outfile); + fprintf (outfile, "%s\n", filename); +} + /* Read file FILENAME and output its doc strings to outfile. */ /* Return 1 if file is not found, 0 if it is found. */ @@ -864,11 +890,14 @@ if (defunflag || defvarflag || c == '"') { /* XEmacs change: the original code is in the "else" clause */ + /* XXX Must modify the documentation file name code to handle + ELLCCs */ if (ellcc) fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", defvarflag ? "SYM" : "SUBR", globalbuf); else { + put_filename (filename); /* XEmacs addition */ putc (037, outfile); putc (defvarflag ? 'V' : 'F', outfile); fprintf (outfile, "%s\n", globalbuf); @@ -963,6 +992,10 @@ The NAME and DOCSTRING are output. NAME is preceded by `F' for a function or `V' for a variable. An entry is output only if DOCSTRING has \ newline just after the opening " + + Adds the filename a symbol or function was found in before its docstring; + there's no need for this with the load-history available, but we do it for + consistency with the C parsing code. */ static void @@ -1356,6 +1389,7 @@ In the latter case, the opening quote (and leading backslash-newline) have already been read. */ + put_filename (filename); /* XEmacs addition */ putc ('\n', outfile); /* XEmacs addition */ putc (037, outfile); putc (type, outfile); diff -r 84ee3ca77e7f -r 959746c534f6 lisp/ChangeLog --- a/lisp/ChangeLog Sat Apr 29 14:36:57 2006 +0000 +++ b/lisp/ChangeLog Sat Apr 29 16:15:31 2006 +0000 @@ -1,3 +1,22 @@ +2006-04-29 Aidan Kehoe + + * dumped-lisp.el (preloaded-file-list): + Move loadhist earlier in the preloaded-file list. + * help.el: + * help.el (help-mode-map): Add bindings to find the source code of + a function, notably when that function's in C. + * help.el (describe-function-find-file, describe-symbol-find-file): + Removed. Use symbol-file from loadhist.el instead. + * help.el (frob-help-extents): + * help.el (describe-function-1): + Allow built-in function file names to be hyperlinks. + * help.el (describe-variable): + * help.el (help-find-source-or-scroll-up): New. + * help.el (help-mouse-find-source-or-track): New. + Make describe-function a bit more mouse-friendly, basically. + * loadhist.el (symbol-file): + Support looking up builtin symbols using built-in-symbol-file. + 2006-04-23 Ville Skyttä * simple.el (goto-line): Add optional `buffer' argument, from diff -r 84ee3ca77e7f -r 959746c534f6 lisp/dumped-lisp.el --- a/lisp/dumped-lisp.el Sat Apr 29 14:36:57 2006 +0000 +++ b/lisp/dumped-lisp.el Sat Apr 29 16:15:31 2006 +0000 @@ -92,6 +92,8 @@ ; `emacs-user-extension-dir' "misc" ;; (pureload "profile") + "loadhist" ; Must be dumped before loaddefs is loaded + ; Used by help. "help" ;; (pureload "hyper-apropos") Soon... "files" @@ -308,7 +310,6 @@ ;; "sun-eos-debugger" ;; "sun-eos-debugger-extra" ;; "sun-eos-menubar")) - "loadhist" ; Must be dumped before loaddefs is loaded "loaddefs" ; <=== autoloads get loaded here )) diff -r 84ee3ca77e7f -r 959746c534f6 lisp/help.el --- a/lisp/help.el Sat Apr 29 14:36:57 2006 +0000 +++ b/lisp/help.el Sat Apr 29 16:15:31 2006 +0000 @@ -1,4 +1,4 @@ -;;; help.el --- help commands for XEmacs. +;; help.el --- help commands for XEmacs. ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc. ;; Copyright (C) 2001, 2002, 2003 Ben Wing. @@ -41,6 +41,8 @@ ;; or run interpreted, but not when the compiled code is loaded. (eval-when-compile (require 'help-macro)) +(require 'loadhist) ;; For symbol-file. + (defgroup help nil "Support for on-line help systems." :group 'emacs) @@ -153,6 +155,8 @@ (define-key help-mode-map "c" 'customize-variable) (define-key help-mode-map [tab] 'help-next-symbol) (define-key help-mode-map [(shift tab)] 'help-prev-symbol) +(define-key help-mode-map [return] 'help-find-source-or-scroll-up) +(define-key help-mode-map [button2] 'help-mouse-find-source-or-track) (define-key help-mode-map "n" 'help-next-section) (define-key help-mode-map "p" 'help-prev-section) @@ -1091,14 +1095,14 @@ :type 'boolean :group 'help-appearance) -(defun describe-symbol-find-file (symbol) - (loop for (file . load-data) in load-history - do (when (memq symbol load-data) - (return file)))) +(define-obsolete-function-alias + ;; Moved to using the version in loadhist.el + 'describe-function-find-symbol + 'symbol-file) (define-obsolete-function-alias 'describe-function-find-file - 'describe-symbol-find-file) + 'symbol-file) (defun describe-function (function) "Display the full documentation of FUNCTION (a symbol). @@ -1340,6 +1344,7 @@ (when (or var fun) (let ((ex (make-extent b e))) (require 'hyper-apropos) + (set-extent-property ex 'mouse-face 'highlight) (set-extent-property ex 'help-symbol sym) (set-extent-property ex 'face 'hyper-apropos-hyperlink) @@ -1421,10 +1426,21 @@ (if autoload-file (princ (format " -- autoloads from \"%s\"\n" autoload-file))) (or file-name - (setq file-name (describe-symbol-find-file function))) - (if file-name - (princ (format " -- loaded from \"%s\"\n" file-name))) -;; (terpri) + (setq file-name (symbol-file function))) + (when file-name + (princ " -- loaded from \"") + (if (not (bufferp standard-output)) + (princ file-name) + (let ((opoint (point standard-output)) + e) + (require 'hyper-apropos) + (princ file-name) + (setq e (make-extent opoint (point standard-output) + standard-output)) + (set-extent-property e 'face 'hyper-apropos-hyperlink) + (set-extent-property e 'mouse-face 'highlight) + (set-extent-property e 'find-function-symbol function))) + (princ "\"\n")) (if describe-function-show-arglist (let ((arglist (function-arglist function))) (when arglist @@ -1469,7 +1485,6 @@ (eq ?\n (aref doc (1- (length doc))))) (terpri))))))))) - ;;; [Obnoxious, whining people who complain very LOUDLY on Usenet ;;; are binding this to keys.] (defun describe-function-arglist (function) @@ -1590,11 +1605,22 @@ (princ (format "%s" aliases))) (princ (built-in-variable-doc variable)) (princ ".\n") - (let ((file-name (describe-symbol-find-file variable))) - (if file-name - (princ (format " -- loaded from \"%s\"\n" file-name)))) + (require 'hyper-apropos) + (let ((file-name (symbol-file variable)) + opoint e) + (when file-name + (princ " -- loaded from \"") + (if (not (bufferp standard-output)) + (princ file-name) + (setq opoint (point standard-output)) + (princ file-name) + (setq e (make-extent opoint (point standard-output) + standard-output)) + (set-extent-property e 'face 'hyper-apropos-hyperlink) + (set-extent-property e 'mouse-face 'highlight) + (set-extent-property e 'find-variable-symbol variable)) + (princ"\"\n"))) (princ "\nValue: ") - (require 'hyper-apropos) (if (not (boundp variable)) (Help-princ-face "void\n" 'hyper-apropos-documentation) (Help-prin1-face (symbol-value variable) @@ -1779,4 +1805,28 @@ (with-displaying-help-buffer (insert string))))) +(defun help-find-source-or-scroll-up (&optional pos) + "Follow any cross reference to source code; if none, scroll up. " + (interactive "d") + (let ((e (extent-at pos nil 'find-function-symbol))) + (if e + (find-function (extent-property e 'find-function-symbol)) + (setq e (extent-at pos nil 'find-variable-symbol)) + (if e + (find-variable (extent-property e 'find-variable-symbol)) + (view-scroll-lines-up 1))))) + +(defun help-mouse-find-source-or-track (event) + "Follow any cross reference to source code under the mouse; +if none, call mouse-track. " + (interactive "e") + (mouse-set-point event) + (let ((e (extent-at (point) nil 'find-function-symbol))) + (if e + (find-function (extent-property e 'find-function-symbol)) + (setq e (extent-at (point) nil 'find-variable-symbol)) + (if e + (find-variable (extent-property e 'find-variable-symbol)) + (mouse-track event))))) + ;;; help.el ends here diff -r 84ee3ca77e7f -r 959746c534f6 lisp/loadhist.el --- a/lisp/loadhist.el Sat Apr 29 14:36:57 2006 +0000 +++ b/lisp/loadhist.el Sat Apr 29 16:15:31 2006 +0000 @@ -41,9 +41,15 @@ "Return the input source from which SYM was loaded. This is a file name, or nil if the source was a buffer with no associated file." (interactive "SFind source file for symbol: ") ; XEmacs - (dolist (entry load-history) - (when (memq sym (cdr entry)) - (return (car entry))))) + (block look-up-symbol-file + (dolist (entry load-history) + (when (memq sym (cdr entry)) + (return-from look-up-symbol-file (car entry)))) + (when (or (and (boundp sym) (built-in-variable-type sym)) + (and (fboundp sym) (subrp (symbol-function sym)))) + (let ((built-in-file (built-in-symbol-file sym))) + (if built-in-file + (concat build-root "/src/" built-in-file)))))) (defun feature-symbols (feature) "Return the file and list of symbols associated with a given FEATURE." diff -r 84ee3ca77e7f -r 959746c534f6 src/ChangeLog --- a/src/ChangeLog Sat Apr 29 14:36:57 2006 +0000 +++ b/src/ChangeLog Sat Apr 29 16:15:31 2006 +0000 @@ -1,3 +1,12 @@ +2006-04-29 Aidan Kehoe + + * doc.c: + * doc.c (extract_object_file_name): + * doc.c (get_object_file_name): + * doc.c (Fbuilt_in_symbol_file): + Support saving and recovering the source file name of a built-in + symbol (that is, one created in C.) + 2006-04-29 Aidan Kehoe * lread.c: diff -r 84ee3ca77e7f -r 959746c534f6 src/doc.c --- a/src/doc.c Sat Apr 29 14:36:57 2006 +0000 +++ b/src/doc.c Sat Apr 29 16:15:31 2006 +0000 @@ -39,10 +39,127 @@ Lisp_Object QSsubstitute; -/* 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. */ +/* 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]; + Ibyte *buffer = buf; + int buffer_size = sizeof (buf), 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 > DOC_MAX_FILENAME_LENGTH ? + doc_pos - DOC_MAX_FILENAME_LENGTH : 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; + + 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, @@ -287,6 +404,150 @@ 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, 1, 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. +*/ + (symbol)) +{ + /* This function can GC */ + Lisp_Object fun; + Lisp_Object filename = Qnil; + + if (EQ(Ffboundp(symbol), Qt)) + { + fun = Findirect_function (symbol); + + if (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)); + } + } + else if (EQ(Fboundp(symbol), Qt)) + { + 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; +} + DEFUN ("documentation", Fdocumentation, 1, 2, 0, /* Return the documentation string of FUNCTION. Unless a non-nil second argument RAW is given, the @@ -419,14 +680,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, @@ -1008,6 +1261,7 @@ void syms_of_doc (void) { + DEFSUBR (Fbuilt_in_symbol_file); DEFSUBR (Fdocumentation); DEFSUBR (Fdocumentation_property); DEFSUBR (Fsnarf_documentation); diff -r 84ee3ca77e7f -r 959746c534f6 src/symbols.c --- a/src/symbols.c Sat Apr 29 14:36:57 2006 +0000 +++ b/src/symbols.c Sat Apr 29 16:15:31 2006 +0000 @@ -719,6 +719,18 @@ return newdef; } +DEFUN ("subr-name", Fsubr_name, 1, 1, 0, /* +Return name of function SUBR. +SUBR must be a built-in function. +*/ + (subr)) +{ + const char *name; + if (!SUBRP (subr)) + wrong_type_argument (Qsubrp, subr); + name = XSUBR (subr)->name; + return make_string (name, strlen (name)); +} DEFUN ("setplist", Fsetplist, 2, 2, 0, /* Set SYMBOL's property list to NEWPLIST, and return NEWPLIST. @@ -3706,6 +3718,7 @@ DEFSUBR (Ffset); DEFSUBR (Fdefine_function); Ffset (intern ("defalias"), intern ("define-function")); + DEFSUBR (Fsubr_name); DEFSUBR (Fsetplist); DEFSUBR (Fsymbol_value_in_buffer); DEFSUBR (Fsymbol_value_in_console); diff -r 84ee3ca77e7f -r 959746c534f6 src/sysfile.h --- a/src/sysfile.h Sat Apr 29 14:36:57 2006 +0000 +++ b/src/sysfile.h Sat Apr 29 16:15:31 2006 +0000 @@ -447,8 +447,6 @@ separator. */ -#ifdef emacs - /* We used to put some of this stuff in the s+m files for the various types of MS Windows, but that's disingenuous. The various definitions above were specifically created for MS Windows, and the "if not, then @@ -519,6 +517,12 @@ #endif /* WIN32_ANY */ +/* How long can a source filename be in DOC (including "\037S" at the start + and "\n" at the end) ? */ +#define DOC_MAX_FILENAME_LENGTH 2048 + +#ifdef emacs + #if defined (WIN32_NATIVE) #define PATHNAME_RESOLVE_LINKS(path, pathout) \ do \