SUPERSEDES 17336.3580.904405.497258(a)parhasard.net Doesn’t work for ELL modules yet, but I’m not waiting for that to commit, because I have a feeling if I ever get to it, it’ll be a long time in the future, and the code is plenty useful as it is. NOTE: This patch has been committed. lib-src/ChangeLog addition: 2006-04-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. lisp/ChangeLog addition: 2006-04-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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. src/ChangeLog addition: 2006-04-29 Aidan Kehoe <kehoea(a)parhasard.net&gt; * 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.) XEmacs Trunk source patch: Diff command: cvs -q diff -u Files affected: src/doc.c lisp/loadhist.el lisp/help.el lisp/dumped-lisp.el lib-src/make-docfile.c Index: lib-src/make-docfile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lib-src/make-docfile.c,v retrieving revision 1.17 diff -u -u -r1.17 make-docfile.c --- lib-src/make-docfile.c 2005/02/22 08:05:58 1.17 +++ lib-src/make-docfile.c 2006/04/29 16:02:37 ＠＠ -44,6 +44,7 ＠＠ #include <config.h> #include <sysfile.h> +#include <assert.h> #include <stdio.h> #include <stdlib.h> #include <string.h> ＠＠ -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); Index: lisp/dumped-lisp.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/dumped-lisp.el,v retrieving revision 1.58 diff -u -u -r1.58 dumped-lisp.el --- lisp/dumped-lisp.el 2006/04/23 16:11:22 1.58 +++ lisp/dumped-lisp.el 2006/04/29 16:02:39 ＠＠ -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 )) Index: lisp/help.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/help.el,v retrieving revision 1.47 diff -u -u -r1.47 help.el --- lisp/help.el 2005/11/16 12:13:02 1.47 +++ lisp/help.el 2006/04/29 16:02:39 ＠＠ -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)))) - (princ "\nValue: ") (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: ") (if (not (boundp variable)) (Help-princ-face "void\n" 'hyper-apropos-documentation) (Help-prin1-face (symbol-value variable) ＠＠ -1778,5 +1804,29 ＠＠ (if (stringp string) (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 Index: lisp/loadhist.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/loadhist.el,v retrieving revision 1.6 diff -u -u -r1.6 loadhist.el --- lisp/loadhist.el 2002/11/18 06:52:28 1.6 +++ lisp/loadhist.el 2006/04/29 16:02:39 ＠＠ -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." Index: src/doc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/doc.c,v retrieving revision 1.35 diff -u -u -r1.35 doc.c --- src/doc.c 2005/10/25 11:16:22 1.35 +++ src/doc.c 2006/04/29 16:02:40 ＠＠ -39,11 +39,128 ＠＠ 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, Ibyte *name_nonreloc, Lisp_Object name_reloc, ＠＠ -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; + } + el + +#ifdef emacs #if defined (WIN32_NATIVE) #define PATHNAME_RESOLVE_LINKS(path, pathout) \ -- In the beginning God created the heavens and the earth. And God was a bug-eyed, hexagonal smurf with a head of electrified hair; and God said: “Si, mi chiamano Mimi...”