[PATCH] Support for builtins with find-function, find-variable

Our friends at the FSF have had this since April last year--cross-references to the C source from describe-variable and everything--and it’s a really convenient feature to have. The below implementation isn’t as nice as I’d like it to be, but I’m posting it to xemacs-beta now because I realise it’s unlikely that I can finish it today or tomorrow--it needs to support ellcc, and besides knowing very little about ellcc, I get this error when I try to load it: Dll error: Opening dynamic module, "/usr/local/lib/xemacs-21.5-b24/i386-unknown-netbsdelf2.0/modules/eldap.ell: Undefined PLT symbol \"alloc_lrecord\" (symnum = 51)" If anyone else has more knowledge or more luck with modules, shout, and we’ll see can we finish this. lib-src/ChangeLog addition: 2006-01-01 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): Add a function to output the source file name for variables and functions, use it before outputting documentation for each and every symbol. lisp/ChangeLog addition: 2006-01-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * dumped-lisp.el (preloaded-file-list): Move "loadhist" before "help" so the latter can call `symbol-file'. * help.el (describe-symbol-find-file): Removed. Use `symbol-file' from loadhist.el instead. * help.el (describe-function): Cross reference to the source code using find-function. * help.el (describe-variable): Cross reference to the source code using find-variable. * help.el (help-find-source-or-scroll-up): New. * help.el (help-mouse-find-source-or-track): New. Implement the cross referencing on mouse2 and enter. * loadhist.el (symbol-file): Support built-in-symbol-file for looking up the source files for built-in functions and variables. src/ChangeLog addition: 2006-01-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * doc.c: Add the possibility to get a built-in variable or function's original file name. * doc.c (extract_object_file_name): New. Given an offset in DOC, return the closest file name preceding that byte position. * doc.c (get_object_file_name): New. Figure out where the DOC file is, call extract_object_file_name * doc.c (Fbuilt_in_symbol_file): New. Given a built-in variable or function, return the path of the file it was defined in. * doc.c (syms_of_doc): Add built-in-symbol-file. * symbols.c: * symbols.c (Fsubr_name): New. Copied from our friends in the FSF. Necessary to work out, given a function object, what the canonical name for that function is. * symbols.c (syms_of_symbols): Add subr-name. * sysfile.h: Add DOC_MAX_FILENAME_LENGTH (the maximum file name length allowed in DOC--there's an assertion failure if a file name is longer than this), allow make-docfile to call IS_DIRECTORY_SEP by moving down the #ifdef emacs clause. XEmacs Trunk source patch: Diff command: cvs -q diff -u Files affected: src/sysfile.h src/symbols.c 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/01/01 16:50:01 ＠＠ -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,13 ＠＠ if (defunflag || defvarflag || c == '"') { /* XEmacs change: the original code is in the "else" clause */ +#warning "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 +991,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 +1388,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.57 diff -u -u -r1.57 dumped-lisp.el --- lisp/dumped-lisp.el 2005/11/26 11:45:53 1.57 +++ lisp/dumped-lisp.el 2006/01/01 16:50:01 ＠＠ -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/01/01 16:50:01 ＠＠ -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). ＠＠ -1421,10 +1425,20 ＠＠ (if autoload-file (princ (format " -- autoloads from \"%s\"\n" autoload-file))) (or file-name - (setq file-name (describe-symbol-find-file function))) + (setq file-name (symbol-file function))) (if file-name - (princ (format " -- loaded from \"%s\"\n" file-name))) -;; (terpri) + (princ " -- loaded from \"") + (if (not (bufferp standard-output)) + (princ file-name) + (let ((opoint (point standard-output)) + e) + (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 ＠＠ -1590,11 +1604,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 +1803,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)) + (view-scroll-lines-up 1))))) ;;; 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/01/01 16:50:01 ＠＠ -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/01/01 16:50:02 ＠＠ -39,11 +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--or the DOC file is + corrupt. */ + 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 +403,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 +679,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 +1260,7 ＠＠ void syms_of_doc (void) { + DEFSUBR (Fbuilt_in_symbol_file); DEFSUBR (Fdocumentation); DEFSUBR (Fdocumentation_property); DEFSUBR (Fsnarf_documentation); Index: src/symbols.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/symbols.c,v retrieving revision 1.54 diff -u -u -r1.54 symbols.c --- src/symbols.c 2005/10/25 08:32:49 1.54 +++ src/symbols.c 2006/01/01 16:50:04 ＠＠ -719,6 +719,19 ＠＠ 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 +3719,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); Index: src/sysfile.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/sysfile.h,v retrieving revision 1.21 diff -u -u -r1.21 sysfile.h --- src/sysfile.h 2005/10/25 11:16:28 1.21 +++ src/sysfile.h 2006/01/01 16:50:04 ＠＠ -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 ＠＠ -518,6 +516,12 ＠＠ #define IS_ANY_SEP(c) IS_DIRECTORY_SEP (c) #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) \ xemacs-packages/xemacs-devel/ChangeLog addition: 2006-01-01 Aidan Kehoe <kehoea(a)parhasard.net&gt; * find-func.el: Sync to GNU Emacs 22.0.50, add support for finding built-in functions. XEmacs Packages source patch: Diff command: cvs -q diff -u Files affected: xemacs-packages/xemacs-devel/find-func.el Index: xemacs-packages/xemacs-devel/find-func.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/xemacs-devel/find-func.el,v retrieving revision 1.8 diff -u -u -r1.8 find-func.el --- xemacs-packages/xemacs-devel/find-func.el 2004/06/29 17:44:28 1.8 +++ xemacs-packages/xemacs-devel/find-func.el 2006/01/01 16:45:39 ＠＠ -1,6 +1,7 ＠＠ ;;; find-func.el --- find the definition of the Emacs Lisp function near point -;; Copyright (C) 1997, 1999, 2001, 2004 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1999, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Jens Petersen <petersen(a)kurims.kyoto-u.ac.jp&gt; ;; Maintainer: petersen(a)kurims.kyoto-u.ac.jp ＠＠ -21,10 +22,10 ＠＠ ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. -;;; Synched up with: FSF 21.3. +;;; Synched up with: FSF 22.0.50 ;;; Commentary: ;; ＠＠ -43,9 +44,14 ＠＠ ;; although it is unusual it can happen that say a variable and function ;; of the same name are defined in different files, which may lead to ;; incorrect results.) Unfortunately in Emacs, only symbols loaded from -;; startup can be found. It would be nice if the location of primitive -;; functions in the C code was also recorded! +;; startup can be found. +;; The file names of primitive functions in C is available in recent GNU and +;; XEmacs beta versions; GNU since some point in 2004, XEmacs since early +;; 2005. XEmacs returns the file name from `symbol-file' in loadhist.el, as +;; with any other symbol. GNU has a function `help-C-file-name' in +;; help-fns.el that they call instead. + ;; The code started out from `describe-function', `describe-key' ;; ("help.el") and `fff-find-loaded-emacs-lisp-function' (Noah Friedman's ;; "fff.el"). ＠＠ -75,30 +81,55 ＠＠ ;; (define-derived-mode foo ...), (define-minor-mode foo) (concat "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\ -ine-function\\|ine-obsolete-function-alias\\|ine-compatible-function-alias\\|\ -\[^cgv\W]\\w+\\*?\\)\\|define-minor-mode\ -\\|easy-mmode-define-global-mode\\)" find-function-space-re +ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\ +foo\\|[^cfgv]\\w+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\ +menu-bar-make-toggle\\)" + find-function-space-re "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)") "The regexp used by `find-function' to search for a function definition. Note it must contain a `%s' at the place where `format' should insert the function name. The default value avoids `defconst', -`defgroup', `defvar'. +`defgroup', `defvar', `defface'. Please send improvements and fixes to the maintainer." :type 'regexp :group 'find-function) (defcustom find-variable-regexp - (concat "^\\s-*(\\(def[^umag\W]\\(\\w\\|\\s_\\)+\\*?\\|define-obsolete-variable-alias\\|define-compatible-variable-alias\\)" - find-function-space-re "%s\\(\\s-\\|$\\)") + (concat + "^\\s-*(\\(def[^fumag]\\(\\w\\|\\s_\\)+\\*?\\|\ +easy-mmode-def\\(map\\|syntax\\)\\|easy-menu-define\\)" + find-function-space-re + "%s\\(\\s-\\|$\\)") "The regexp used by `find-variable' to search for a variable definition. -It should match right up to the variable name. The default value -avoids `defun', `defmacro', `defalias', `defadvice', `defgroup'. +Note it must contain a `%s' at the place where `format' +should insert the variable name. The default value +avoids `defun', `defmacro', `defalias', `defadvice', `defgroup', `defface'. Please send improvements and fixes to the maintainer." :type 'regexp :group 'find-function) +(defcustom find-face-regexp + (concat"^\\s-*(defface" find-function-space-re "%s\\(\\s-\\|$\\)") + "The regexp used by `find-face' to search for a face definition. +Note it must contain a `%s' at the place where `format' +should insert the face name. + +Please send improvements and fixes to the maintainer." +:type 'regexp +:group 'find-function +:version "22.1") + +(defvar find-function-regexp-alist + '((nil . find-function-regexp) + (defvar . find-variable-regexp) + (defface . find-face-regexp)) + "Alist mapping definition types into regexp variables. +Each regexp variable's value should actually be a format string +to be used to substitute the desired symbol name into the regexp.") +(put 'find-function-regexp-alist 'risky-local-variable t) + (defcustom find-function-source-path nil "The default list of directories where `find-function' searches. ＠＠ -124,51 +155,99 ＠＠ ;;; Functions: -;; XEmacs omission: Emacs has find-library and supporting friends here. -;; We have the equivalent in lib-complete.el in core. +;; XEmacs omission: Emacs has find-library and supporting friends here. We +;; have the equivalent in lib-complete.el in core. -;;;###autoload -(defun find-function-search-for-symbol (symbol variable-p library) - "Search for SYMBOL in LIBRARY. -If VARIABLE-P is nil, `find-function-regexp' is used, otherwise -`find-variable-regexp' is used." +;; However, we don't have support for looking up C in core; that comes from +;; GNU and is here. + +(defvar find-function-C-source-directory + ;; XEmacs change ; source-directory -> build-root + (let ((dir (expand-file-name "src" build-root))) + (when (and (file-directory-p dir) (file-readable-p dir)) + dir)) + "Directory where the C source files of XEmacs can be found. +If nil, do not try to find the source code of functions and variables +defined in C.") + +(defun find-function-C-source (fun-or-var file type) + "Find the source location where SUBR-OR-VAR is defined in FILE. +TYPE should be nil to find a function, or `defvar' to find a variable." + (unless find-function-C-source-directory + (setq find-function-C-source-directory + (read-directory-name "XEmacs C source dir: " nil nil t))) + (setq file (expand-file-name file find-function-C-source-directory)) + (unless (file-readable-p file) + (error "The C source file %s is not available" + (file-name-nondirectory file))) + (unless type + (setq fun-or-var (indirect-function fun-or-var))) + ;; Versions of XEmacs without `subr-name' shouldn't return C filenames + ;; from `symbol-file'. + (assert (fboundp 'subr-name) + t + "This code needs `subr-name', and shouldn't be called without it.") + (with-current-buffer (find-file-noselect file) + (goto-char (point-min)) + (unless (re-search-forward + (if type + (concat "DEFVAR[A-Z_]*[ \t\n]*([ \t\n]*\"" + (regexp-quote (symbol-name fun-or-var)) + "\"") + (concat "DEFUN[ \t\n]*([ \t\n]*\"" + (regexp-quote (subr-name fun-or-var)) + "\"")) + nil t) + (error "Can't find source for %s" fun-or-var)) + (cons (current-buffer) (match-beginning 0)))) + +;;;###autoload +(defun find-function-search-for-symbol (symbol type library) + "Search for SYMBOL's definition of type TYPE in LIBRARY. +If TYPE is nil, look for a function definition. +Otherwise, TYPE specifies the kind of definition, +and it is interpreted via `find-function-regexp-alist'. +The search is done in the source for library LIBRARY." (if (null library) (error "Don't know where `%s' is defined" symbol)) ;; We deviate significantly from Emacs here, due to our distinct ;; find-library implementations. - (if (string-match "\\.el\\(c\\)\\'" library) - (setq library (substring library 0 (match-beginning 1)))) - (let* ((path find-function-source-path) - (filename (if (file-exists-p library) - library - ;; use `file-name-sans-extension' here? (if it gets fixed) - (if (string-match "\\(\\.el\\)\\'" library) - (setq library (substring library 0 - (match-beginning 1)))) - (or (locate-library (concat library ".el") t path) - (locate-library library t path))))) - (if (not filename) - (error "The library \"%s\" is not in the path." library)) - (with-current-buffer (find-file-noselect filename) - (save-match-data - (let ((regexp (format (if variable-p - find-variable-regexp - find-function-regexp) - (regexp-quote (symbol-name symbol)))) - (case-fold-search)) - (with-syntax-table emacs-lisp-mode-syntax-table - (goto-char (point-min)) - (if (or (re-search-forward regexp nil t) - (re-search-forward - (concat "^([^ ]+" find-function-space-re "['(]" - (regexp-quote (symbol-name symbol)) - "\\>") - nil t)) - (progn - (beginning-of-line) - (cons (current-buffer) (point))) - (error "Cannot find definition of `%s' in library `%s'" - symbol library)))))))) + (if (string-match "^\\(.*\\.c\\)$" library) + (find-function-C-source symbol (match-string 1 library) type) + (if (string-match "\\.el\\(c\\)\\'" library) + (setq library (substring library 0 (match-beginning 1)))) + (let* ((path find-function-source-path) + (filename (if (file-exists-p library) + library + ;; use `file-name-sans-extension' here? (if it gets + ;; fixed) + (if (string-match "\\(\\.el\\)\\'" library) + (setq library (substring library 0 + (match-beginning 1)))) + (or (locate-library (concat library ".el") t path) + (locate-library library t path))))) + (if (not filename) + (error "The library \"%s\" is not in the path." library)) + (with-current-buffer (find-file-noselect filename) + (save-match-data + (let ((regexp (format (if type + find-variable-regexp + find-function-regexp) + (regexp-quote (symbol-name symbol)))) + (case-fold-search)) + (with-syntax-table emacs-lisp-mode-syntax-table + (goto-char (point-min)) + (if (or (re-search-forward regexp nil t) + (re-search-forward + (concat "^([^ ]+" find-function-space-re "['(]" + (regexp-quote (symbol-name symbol)) + "\\_>") + nil t)) + (progn + (beginning-of-line) + (cons (current-buffer) (point))) + (error "Cannot find definition of `%s' in library `%s'" + symbol library))))))))) ;;;###autoload (defun find-function-noselect (function) ＠＠ -195,13 +274,8 ＠＠ function (symbol-name def))))) (setq function (symbol-function function) def (symbol-function function))) - ;; XEmacs difference: check for primitive functions a bit differently - (and (subrp (symbol-function function)) - (if aliases - (error "%s which is a primitive function" aliases) - (error "%s is a primitive function" function))) (if aliases - (message aliases)) + (message "%s" aliases)) (let ((library (cond ((eq (car-safe def) 'autoload) (nth 1 def)) ＠＠ -215,57 +289,62 ＠＠ (and (compiled-function-p (cdr def)) (file-name-sans-extension (compiled-function-annotation (cdr def)))))))))) + ;; XEmacs difference: check for primitive functions a bit differently + ;; XEmacs; move this after the symbol-file check, which can now return + ;; the place in C where the function is. + (and (null library) (subrp (symbol-function function)) + (if aliases + (error "%s which is a primitive function" aliases) + (error "%s is a primitive function" function))) (find-function-search-for-symbol function nil library)))) ;; XEmacs change: these functions are defined in help.el ;(defalias 'function-at-point 'function-called-at-point) -(defun find-function-read (&optional variable-p) +(defun find-function-read (&optional type) "Read and return an interned symbol, defaulting to the one near point. -If the optional VARIABLE-P is nil, then a function is gotten -defaulting to the value of the function `function-at-point', otherwise -a variable is asked for, with the default coming from -`variable-at-point'." - (let ((symb (funcall (if variable-p +If TYPE is nil, insist on a symbol with a function definition. +Otherwise TYPE should be `defvar' or `defface'. +If TYPE is nil, defaults using `function-at-point', +otherwise uses `variable-at-point'." + (let ((symb (funcall (if type 'variable-at-point 'function-at-point))) + (predicate (cdr (assq type '((nil . fboundp) (defvar . boundp) + (defface . facep))))) + (prompt (cdr (assq type '((nil . "function") (defvar . "variable") + (defface . "face"))))) (enable-recursive-minibuffers t) val) (if (equal symb 0) (setq symb nil)) - (setq val (if variable-p - (completing-read - (concat "Find variable" - (if symb - (format " (default %s)" symb)) - ": ") - obarray 'boundp t nil 'variable-history) - (completing-read - (concat "Find function" - (if symb - (format " (default %s)" symb)) - ": ") - obarray 'fboundp t nil 'function-history))) + (setq val (completing-read + (concat "Find " + prompt + (if symb + (format " (default %s)" symb)) + ": ") + obarray predicate t nil)) (list (if (equal val "") symb (intern val))))) -(defun find-function-do-it (symbol variable-p switch-fn) - "Find Emacs Lisp SYMBOL in a buffer and display it with SWITCH-FN. -If VARIABLE-P is nil, a function definition is searched for, otherwise -a variable definition is searched for. The start of a definition is -centered according to the variable `find-function-recenter-line'. +(defun find-function-do-it (symbol type switch-fn) + "Find Emacs Lisp SYMBOL in a buffer and display it. +TYPE is nil to search for a function definition, +or else `defvar' or `defface'. + +The variable `find-function-recenter-line' controls how +to recenter the display. SWITCH-FN is the function to call +to display and select the buffer. See also `find-function-after-hook'. -Point is saved in the buffer if it is one of the current buffers." +Set mark before moving, if the buffer already existed." (let* ((orig-point (point)) (orig-buffers (buffer-list)) (buffer-point (save-excursion - (funcall (if variable-p - 'find-variable-noselect - 'find-function-noselect) - symbol))) + (find-definition-noselect symbol type))) (new-buf (car buffer-point)) (new-point (cdr buffer-point))) (when buffer-point ＠＠ -278,7 +357,7 ＠＠ ;;;###autoload (defun find-function (function) - "Find the definition of the function near point in the current window. + "Find the definition of the FUNCTION near point. Finds the Emacs Lisp library containing the definition of the function near point (selected by `function-at-point') in a buffer and ＠＠ -319,46 +398,82 ＠＠ `find-function-source-path', if non nil, otherwise in `load-path'." (if (not variable) (error "You didn't specify a variable")) - (and (built-in-variable-type variable) - (error "%s is a primitive variable" variable)) (let ((library (or file (symbol-file variable)))) + (unless (and (null library) (built-in-variable-type variable)) + (error "%s is a primitive variable" variable)) (find-function-search-for-symbol variable 'variable library))) ;;;###autoload (defun find-variable (variable) - "Find the definition of the variable near point in the current window. + "Find the definition of the VARIABLE near point. Finds the Emacs Lisp library containing the definition of the variable near point (selected by `variable-at-point') in a buffer and -places point before the definition. Point is saved in the buffer if -it is one of the current buffers. +places point before the definition. +Set mark before moving, if the buffer already existed. + The library where VARIABLE is defined is searched for in `find-function-source-path', if non nil, otherwise in `load-path'. See also `find-function-recenter-line' and `find-function-after-hook'." - (interactive (find-function-read 'variable)) - (find-function-do-it variable t 'switch-to-buffer)) + (interactive (find-function-read 'defvar)) + (find-function-do-it variable 'defvar 'switch-to-buffer)) ;;;###autoload (defun find-variable-other-window (variable) - "Find the definition of the variable near point in another window. + "Find, in another window, the definition of VARIABLE near point. See `find-variable' for more details." - (interactive (find-function-read 'variable)) - (find-function-do-it variable t 'switch-to-buffer-other-window)) + (interactive (find-function-read 'defvar)) + (find-function-do-it variable 'defvar 'switch-to-buffer-other-window)) ;;;###autoload (defun find-variable-other-frame (variable) - "Find the definition of the variable near point in another frame. + "Find, in annother frame, the definition of VARIABLE near point. See `find-variable' for more details." - (interactive (find-function-read 'variable)) - (find-function-do-it variable t 'switch-to-buffer-other-frame)) + (interactive (find-function-read 'defvar)) + (find-function-do-it variable 'defvar 'switch-to-buffer-other-frame)) + +;;;###autoload +(defun find-definition-noselect (symbol type &optional file) + "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL. +TYPE says what type of definition: nil for a function, +`defvar' or `defface' for a variable or face. This functoin +does not switch to the buffer or display it. + +The library where SYMBOL is defined is searched for in FILE or +`find-function-source-path', if non nil, otherwise in `load-path'." + (if (not symbol) + (error "You didn't specify a symbol")) + (if (null type) + (find-function-noselect symbol) + (let ((library (or file (symbol-file symbol)))) + (find-function-search-for-symbol symbol type library)))) + +;; RMS says: +;; For symmetry, this should be called find-face; but some programs +;; assume that, if that name is defined, it means something else. +;;;###autoload +(defun find-face-definition (face) + "Find the definition of FACE. FACE defaults to the name near point. + +Finds the Emacs Lisp library containing the definition of the face +near point (selected by `variable-at-point') in a buffer and +places point before the definition. + +Set mark before moving, if the buffer already existed. + +The library where FACE is defined is searched for in +`find-function-source-path', if non nil, otherwise in `load-path'. +See also `find-function-recenter-line' and `find-function-after-hook'." + (interactive (find-function-read 'defface)) + (find-function-do-it face 'defface 'switch-to-buffer)) ;;;###autoload (defun find-function-on-key (key) "Find the function that KEY invokes. KEY is a string. -Point is saved if FUNCTION is in the current buffer." +Set mark before moving, if the buffer already existed." (interactive "kFind function on key: ") ;; XEmacs change: Avoid the complex menu code with key-or-menu-binding (let ((defn (key-or-menu-binding key)) ＠＠ -399,5 +514,5 ＠＠ (provide 'find-func) -;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64 +;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64 ;;; find-func.el ends here -- I AM IN JAIL AND ALLOWED SEND ONLY ONE CABLE SINCE WAS ARRESTED WHILE MEASURING FIFTEEN FOOT WALL OUTSIDE PALACE AND HAVE JUST FINISHED COUNTING THIRTY EIGHT THOUSAND FIVE HUNDERED TWENTY TWO NAMES WHOS WHO IN MIDEAST.