5:20 p.m.
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>
* 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>
* 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>
* 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...”