Commits

aidan  committed 02d1baf

Support built-in functions in find-func.

  • Participants
  • Parent commits 4e8ba1c

Comments (0)

Files changed (2)

+2006-07-07  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* find-func.el:
+	Sync to GNU Emacs 22.0.50, add support for finding built-in
+	functions.
+
 2005-10-12  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.72 released.

File find-func.el

 ;;; 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,
+;;   2006 Free Software Foundation, Inc.
 
 ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
 ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
 
 ;; 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:
 ;;
 ;; 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
   ;;  (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.
 
 
 ;;; 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. 
+
+;; 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 -> source-root
+  (let ((dir (expand-file-name "src" source-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 variable-p library)
-  "Search for SYMBOL in LIBRARY.
-If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
-`find-variable-regexp' is used."
+(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)
 				  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))
 			 (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
 
 ;;;###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
 `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))
 
 (provide 'find-func)
 
-;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
+;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
 ;;; find-func.el ends here