bug#15641: 24.3; [PATCH] Add find-definition for M-.

[Leo Liu <sdl.web@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 226 bytes --]

I think we should just make M-. work on elisp-related places such as
lisp-interaction-mode, emacs-lisp-mode, eval-expression and even
help-mode.

I haven't added the key binding but the function is as in the patch.
Comments?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: find-func.diff --]
[-- Type: text/x-patch, Size: 3957 bytes --]

=== modified file 'lisp/emacs-lisp/find-func.el'
--- lisp/emacs-lisp/find-func.el	2013-01-01 09:11:05 +0000
+++ lisp/emacs-lisp/find-func.el	2013-10-18 07:26:27 +0000
@@ -1,4 +1,4 @@
-;;; find-func.el --- find the definition of the Emacs Lisp function near point
+;;; find-func.el --- find the definition of the Emacs Lisp function near point  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 1997, 1999, 2001-2013 Free Software Foundation, Inc.
 
@@ -138,8 +138,10 @@
 
 (defun find-library-suffixes ()
   (let ((suffixes nil))
-    (dolist (suffix (get-load-suffixes) (nreverse suffixes))
-      (unless (string-match "elc" suffix) (push suffix suffixes)))))
+    (dolist (suffix (get-load-suffixes) )
+      (unless (string-match "elc" suffix)
+	(push suffix suffixes)))
+    (nreverse suffixes)))
 
 (defun find-library--load-name (library)
   (let ((name library))
@@ -392,12 +394,11 @@
 
 Set mark before moving, if the buffer already existed."
   (let* ((orig-point (point))
-	(orig-buf (window-buffer))
-	(orig-buffers (buffer-list))
-	(buffer-point (save-excursion
-			(find-definition-noselect symbol type)))
-	(new-buf (car buffer-point))
-	(new-point (cdr buffer-point)))
+	 (orig-buffers (buffer-list))
+	 (buffer-point (save-excursion
+			 (find-definition-noselect symbol type)))
+	 (new-buf (car buffer-point))
+	 (new-point (cdr buffer-point)))
     (when buffer-point
       (when (memq new-buf orig-buffers)
 	(push-mark orig-point))
@@ -490,16 +491,16 @@
 (defun find-definition-noselect (symbol type &optional file)
   "Return a pair `(BUFFER . POINT)' pointing to the definition of SYMBOL.
 If the definition can't be found in the buffer, return (BUFFER).
-TYPE says what type of definition: nil for a function, `defvar' for a
-variable, `defface' for a face.  This function does not switch to the
-buffer nor display it.
+TYPE says what type of definition: nil or `defun' for a function,
+`defvar' for a variable, `defface' for a face.  This function
+does not switch to the buffer nor 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'."
   (cond
    ((not symbol)
     (error "You didn't specify a symbol"))
-   ((null type)
+   ((memq type '(nil defun))
     (find-function-noselect symbol))
    ((eq type 'defvar)
     (find-variable-noselect symbol file))
@@ -579,6 +580,44 @@
   (define-key ctl-x-4-map "V" 'find-variable-other-window)
   (define-key ctl-x-5-map "V" 'find-variable-other-frame))
 
+;;;###autoload
+(defun find-definition (symbol &optional type)
+  (interactive
+   (let* ((default (or (intern-soft (thing-at-point 'symbol))
+		       (function-called-at-point)))
+	  (symbol (intern-soft
+		   (completing-read
+		    (format (if default "Find symbol (default %s): "
+			      "Find symbol: ") default)
+		    obarray
+		    (lambda (s) (or (fboundp s) (boundp s) (facep s)))
+		    t nil nil default)))
+	  (types (delq nil (list (and (fboundp symbol) 'defun)
+				 (and (boundp symbol) 'defvar)
+				 (and (facep symbol) 'defface)))))
+     (list symbol (if (<= (length types) 1)
+		      (car types)
+		    (intern-soft
+		     (completing-read "Type: "
+				      (mapcar #'symbol-name types) nil t))))))
+  (eval-and-compile (require 'etags))
+  (let ((def (save-excursion (find-definition-noselect symbol type))))
+    (cond
+     ((not (car def))
+      (user-error "No definition found for `%s'" symbol))
+     ((and (not (numberp (cdr def)))
+	   (with-current-buffer (car def)
+	     (buffer-narrowed-p))
+	   (yes-or-no-p
+	    (format "Definition not in accessible portion of buffer %s. Widen? "
+		    (buffer-name (car def)))))
+      (with-current-buffer (car def)
+	(widen))
+      (find-definition symbol type))
+     (t (ring-insert find-tag-marker-ring (point-marker))
+	(switch-to-buffer (car def))
+	(and (cdr def) (goto-char (cdr def)))))))
+
 (provide 'find-func)
 
 ;;; find-func.el ends here