X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/cb0fd101b90b4721a7498850235427bd890f8be7..a27235b3b5a9a6a31a8f33410186bd35328531e2:/lisp/emacs-lisp/find-func.el

diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 6e49140923..54efd14b35 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -1,6 +1,6 @@
 ;;; find-func.el --- find the definition of the Emacs Lisp function near point
 
-;; Copyright (C) 1997, 1999, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1997, 1999, 2001, 2004  Free Software Foundation, Inc.
 
 ;; Author: Jens Petersen <petersen@kurims.kyoto-u.ac.jp>
 ;; Maintainer: petersen@kurims.kyoto-u.ac.jp
@@ -112,6 +112,68 @@ See the functions `find-function' and `find-variable'."
 
 ;;; Functions:
 
+(defun find-library-suffixes ()
+  (let ((suffixes nil))
+    (dolist (suffix load-suffixes (nreverse suffixes))
+      (unless (string-match "elc" suffix) (push suffix suffixes)))))
+
+(defun find-library-name (library)
+  "Return the full name of the elisp source of LIBRARY."
+  ;; If the library is byte-compiled, try to find a source library by
+  ;; the same name.
+  (if (string-match "\\.el\\(c\\(\\..*\\)?\\)\\'" library)
+      (setq library (replace-match "" t t library)))
+  (or (locate-file library
+		   (or find-function-source-path load-path)
+		   (append (find-library-suffixes) '("")))
+      (error "Can't find library %s" library)))
+
+(defvar find-function-C-source-directory
+  (let ((dir (expand-file-name "src" source-directory)))
+    (when (and (file-directory-p dir) (file-readable-p dir))
+      dir))
+  "Directory where the C source files of Emacs 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 variable-p)
+  "Find the source location where SUBR-OR-VAR is defined in FILE.
+VARIABLE-P should be non-nil for a variable or nil for a subroutine."
+  (unless find-function-C-source-directory
+    (setq find-function-C-source-directory
+	  (read-directory-name "Emacs 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 variable-p
+    (setq fun-or-var (indirect-function fun-or-var)))
+  (with-current-buffer (find-file-noselect file)
+    (goto-char (point-min))
+    (unless (re-search-forward
+	     (if variable-p
+		 (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-library (library)
+  "Find the elisp source of LIBRARY."
+  (interactive
+   (list
+    (completing-read "Library name: "
+		     'locate-file-completion
+		     (cons (or find-function-source-path load-path)
+			   (find-library-suffixes)))))
+  (let ((buf (find-file-noselect (find-library-name library))))
+    (condition-case nil (switch-to-buffer buf) (error (pop-to-buffer buf)))))
+
 ;;;###autoload
 (defun find-function-search-for-symbol (symbol variable-p library)
   "Search for SYMBOL.
@@ -121,28 +183,13 @@ If VARIABLE-P is nil, `find-function-regexp' is used, otherwise
       (error "Don't know where `%s' is defined" symbol))
   ;; Some functions are defined as part of the construct
   ;; that defines something else.
-  (while (get symbol 'definition-name)
+  (while (and (symbolp symbol) (get symbol 'definition-name))
     (setq symbol (get symbol 'definition-name)))
-  (save-match-data
+  (if (string-match "\\`src/\\(.*\\.c\\)\\'" library)
+      (find-function-C-source symbol (match-string 1 library) variable-p)
     (if (string-match "\\.el\\(c\\)\\'" library)
 	(setq library (substring library 0 (match-beginning 1))))
-    (let* ((path find-function-source-path)
-	   (compression (or (rassq 'jka-compr-handler file-name-handler-alist)
-			    (member 'crypt-find-file-hook find-file-hook)))
-	   (filename (progn
-		       ;; 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 compression
-			       (or (locate-library (concat library ".el.gz")
-						   t path)
-				   (locate-library (concat library ".gz")
-						   t path)))))))
-      (if (not filename)
-	  (error "The library `%s' is not in the path" library))
+    (let* ((filename (find-library-name library)))
       (with-current-buffer (find-file-noselect filename)
 	(let ((regexp (format (if variable-p
 				  find-variable-regexp
@@ -300,7 +347,8 @@ The library where VARIABLE is defined is searched for in FILE or
 `find-function-source-path', if non nil, otherwise in `load-path'."
   (if (not variable)
       (error "You didn't specify a variable"))
-  (let ((library (or file (symbol-file variable))))
+  ;; Fixme: I think `symbol-file' should be fixed instead.  -- fx
+  (let ((library (or file (symbol-file (cons 'defvar variable)))))
     (find-function-search-for-symbol variable 'variable library)))
 
 ;;;###autoload
@@ -339,26 +387,27 @@ See `find-variable' for more details."
   "Find the function that KEY invokes.  KEY is a string.
 Point is saved if FUNCTION is in the current buffer."
   (interactive "kFind function on key: ")
-  (save-excursion
-    (let* ((event (and (eventp key) (aref key 0))) ; Null event OK below.
-	   (start (event-start event))
-	   (modifiers (event-modifiers event))
-	   (window (and (or (memq 'click modifiers) (memq 'down modifiers)
-			    (memq 'drag modifiers))
-			(posn-window start))))
-      ;; For a mouse button event, go to the button it applies to
-      ;; to get the right key bindings.  And go to the right place
-      ;; in case the keymap depends on where you clicked.
-      (when (windowp window)
-	(set-buffer (window-buffer window))
-	(goto-char (posn-point start)))
-      (let ((defn (key-binding key))
-	    (key-desc (key-description key)))
-	(if (or (null defn) (integerp defn))
-	    (message "%s is unbound" key-desc)
-	  (if (consp defn)
-	      (message "%s runs %s" key-desc (prin1-to-string defn))
-	    (find-function-other-window defn)))))))
+  (let (defn)
+    (save-excursion
+      (let* ((event (and (eventp key) (aref key 0))) ; Null event OK below.
+	     (start (event-start event))
+	     (modifiers (event-modifiers event))
+	     (window (and (or (memq 'click modifiers) (memq 'down modifiers)
+			      (memq 'drag modifiers))
+			  (posn-window start))))
+	;; For a mouse button event, go to the button it applies to
+	;; to get the right key bindings.  And go to the right place
+	;; in case the keymap depends on where you clicked.
+	(when (windowp window)
+	  (set-buffer (window-buffer window))
+	  (goto-char (posn-point start)))
+	(setq defn (key-binding key))))
+    (let ((key-desc (key-description key)))
+      (if (or (null defn) (integerp defn))
+	  (message "%s is unbound" key-desc)
+	(if (consp defn)
+	    (message "%s runs %s" key-desc (prin1-to-string defn))
+	  (find-function-other-window defn))))))
 
 ;;;###autoload
 (defun find-function-at-point ()
@@ -389,4 +438,5 @@ Point is saved if FUNCTION is in the current buffer."
 
 (provide 'find-func)
 
+;;; arch-tag: 43ecd81c-74dc-4d9a-8f63-a61e55670d64
 ;;; find-func.el ends here