Improve handling of doc-strings and describe-function for cl-generic

* lisp/help-fns.el (find-lisp-object-file-name): Accept any `type' as long
as it's a symbol.
(help-fns-short-filename): New function.
(describe-function-1): Use it.  Use autoload-do-load.

* lisp/help-mode.el (help-function-def): Add optional arg `type'.

* lisp/emacs-lisp/cl-generic.el (cl-generic-ensure-function): It's OK to
override an autoload.
(cl-generic-current-method-specializers): Replace dyn-bind variable
with a lexically-scoped macro.
(cl--generic-lambda): Update accordingly.
(cl-generic-define-method): Record manually in the load-history with
type `cl-defmethod'.
(cl--generic-get-dispatcher): Minor optimization.
(cl--generic-search-method): New function.
(find-function-regexp-alist): Add entry for `cl-defmethod' type.
(cl--generic-search-method): Add hyperlinks for methods.  Merge the
specializers and the function's arguments.

* lisp/emacs-lisp/eieio-core.el (eieio--defalias): Move to eieio-generic.el.
(eieio-defclass-autoload): Don't record the superclasses any more.
(eieio-defclass-internal): Reuse the old class object if it was just an
autoload stub.
(eieio--class-precedence-list): Load the class if it's autoloaded.

* lisp/emacs-lisp/eieio-generic.el (eieio--defalias): Move from eieio-core.
(eieio--defgeneric-init-form): Don't throw away a previous docstring.
(eieio--method-optimize-primary): Don't mess with the docstring.
(defgeneric): Keep the `args' in the docstring.
(defmethod): Don't use the method's docstring for the generic
function's docstring.

* lisp/emacs-lisp/find-func.el: Use lexical-binding.
(find-function-regexp): Don't rule out `defgeneric'.
(find-function-regexp-alist): Document new possibility of including
a function instead of a regexp.
(find-function-search-for-symbol): Implement that new possibility.
(find-function-library): Don't assume that `function' is a symbol.
(find-function-do-it): Remove unused var `orig-buf'.

* test/automated/cl-generic-tests.el (cl-generic-test-8-after/before):
Rename from cl-generic-test-7-after/before.
(cl--generic-test-advice): New function.
(cl-generic-test-9-advice): New test.

* test/automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1): Reset
eieio-test--1.

4 files changed, 178 insertions, 147 deletions

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 21688bef18a..ae0f129bb23 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -107,6 +107,7 @@ They should be sorted from most specific to least specific.")
                 (symbolp (symbol-function name)))
       (setq name (symbol-function name)))
     (unless (or (not (fboundp name))
+                (autoloadp (symbol-function name))
                 (and (functionp name) generic))
       (error "%s is already defined as something else than a generic function"
              origname))
@@ -153,7 +154,7 @@ via (:documentation DOCSTRING)."
             code))
        (defalias ',name
          (cl-generic-define ',name ',args ',options-and-methods)
-         ,doc))))
+         ,(help-add-fundoc-usage doc args)))))
 
 (defun cl--generic-mandatory-args (args)
   (let ((res ()))
@@ -176,15 +177,10 @@ via (:documentation DOCSTRING)."
     (setf (cl--generic-method-table generic) nil)
     (cl--generic-make-function generic)))
 
-(defvar cl-generic-current-method-specializers nil
-  ;; This is let-bound during macro-expansion of method bodies, so that those
-  ;; bodies can be optimized knowing that the specializers have matched.
-  ;; FIXME: This presumes the formal arguments aren't modified via `setq' and
-  ;; aren't shadowed either ;-(
-  ;; FIXME: This might leak outside the scope of the method if, during
-  ;; macroexpansion of the method, something causes some other macroexpansion
-  ;; (e.g. an autoload).
-  "List of (VAR . TYPE) where TYPE is var's specializer.")
+(defmacro cl-generic-current-method-specializers ()
+  "List of (VAR . TYPE) where TYPE is var's specializer.
+This macro can only be used within the lexical scope of a cl-generic method."
+  (error "cl-generic-current-method-specializers used outside of a method"))
 
 (eval-and-compile         ;Needed while compiling the cl-defmethod calls below!
   (defun cl--generic-fgrep (vars sexp)    ;Copied from pcase.el.
@@ -199,27 +195,29 @@ via (:documentation DOCSTRING)."
   (defun cl--generic-lambda (args body with-cnm)
     "Make the lambda expression for a method with ARGS and BODY."
     (let ((plain-args ())
-          (cl-generic-current-method-specializers nil)
+          (specializers nil)
           (doc-string (if (stringp (car-safe body)) (pop body)))
           (mandatory t))
       (dolist (arg args)
         (push (pcase arg
                 ((or '&optional '&rest '&key) (setq mandatory nil) arg)
                 ((and `(,name . ,type) (guard mandatory))
-                 (push (cons name (car type))
-                       cl-generic-current-method-specializers)
+                 (push (cons name (car type)) specializers)
                  name)
                 (_ arg))
               plain-args))
       (setq plain-args (nreverse plain-args))
       (let ((fun `(cl-function (lambda ,plain-args
                                  ,@(if doc-string (list doc-string))
-                                 ,@body))))
+                                 ,@body)))
+            (macroenv (cons `(cl-generic-current-method-specializers
+                              . ,(lambda () specializers))
+                            macroexpand-all-environment)))
         (if (not with-cnm)
-            (cons nil fun)
+            (cons nil (macroexpand-all fun macroenv))
           ;; First macroexpand away the cl-function stuff (e.g. &key and
           ;; destructuring args, `declare' and whatnot).
-          (pcase (macroexpand fun macroexpand-all-environment)
+          (pcase (macroexpand fun macroenv)
             (`#'(lambda ,args . ,body)
              (require 'cl-lib)          ;Needed to expand `cl-flet'.
              (let* ((doc-string (and doc-string (stringp (car body))
@@ -228,7 +226,7 @@ via (:documentation DOCSTRING)."
                     (nbody (macroexpand-all
                             `(cl-flet ((cl-call-next-method ,cnm))
                                ,@body)
-                            macroexpand-all-environment))
+                            macroenv))
                     ;; FIXME: Rather than `grep' after the fact, the
                     ;; macroexpansion should directly set some flag when cnm
                     ;; is used.
@@ -309,8 +307,13 @@ which case this method will be invoked when the argument is `eql' to VAL.
       (setf (cl--generic-method-table generic)
             (cons `(,key ,uses-cnm . ,function) mt)))
     ;; For aliases, cl--generic-name gives us the actual name.
-    (defalias (cl--generic-name generic)
-      (cl--generic-make-function generic))))
+    (let ((gfun (cl--generic-make-function generic))
+          ;; Prevent `defalias' from recording this as the definition site of
+          ;; the generic function.
+          current-load-list)
+      (defalias (cl--generic-name generic) gfun))
+    (cl-pushnew `(cl-defmethod . (,(cl--generic-name generic) . ,specializers))
+                current-load-list :test #'equal)))
 
 (defmacro cl--generic-with-memoization (place &rest code)
   (declare (indent 1) (debug t))
@@ -327,6 +330,14 @@ which case this method will be invoked when the argument is `eql' to VAL.
   (cl--generic-with-memoization
       (gethash (cons dispatch-arg tagcodes) cl--generic-dispatchers)
     (let ((lexical-binding t)
+          (tag-exp `(or ,@(mapcar #'cdr
+				  ;; Minor optimization: since this tag-exp is
+				  ;; only used to lookup the method-cache, it
+				  ;; doesn't matter if the default value is some
+				  ;; constant or nil.
+				  (if (macroexp-const-p (car (last tagcodes)))
+				      (butlast tagcodes)
+				    tagcodes))))
           (extraargs ()))
       (dotimes (_ dispatch-arg)
         (push (make-symbol "arg") extraargs))
@@ -335,7 +346,7 @@ which case this method will be invoked when the argument is `eql' to VAL.
           (let ((method-cache (make-hash-table :test #'eql)))
             (lambda (,@extraargs arg &rest args)
               (apply (cl--generic-with-memoization
-                         (gethash (or ,@(mapcar #'cdr tagcodes)) method-cache)
+                         (gethash ,tag-exp method-cache)
                        (cl--generic-cache-miss
                         generic ',dispatch-arg dispatches-left
                         (list ,@(mapcar #'cdr tagcodes))))
@@ -456,31 +467,63 @@ Can only be used from within the lexical body of a primary or around method."
 
 ;;; Add support for describe-function
 
-(add-hook 'help-fns-describe-function-functions 'cl--generic-describe)
+(defun cl--generic-search-method (met-name)
+  (let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
+                         (regexp-quote (format "%s\\_>" (car met-name))))))
+    (or
+     (re-search-forward
+      (concat base-re "[^&\"\n]*"
+              (mapconcat (lambda (specializer)
+                           (regexp-quote
+                            (format "%S" (if (consp specializer)
+                                             (nth 1 specializer) specializer))))
+                         (remq t (cdr met-name))
+                         "[ \t\n]*)[^&\"\n]*"))
+      nil t)
+     (re-search-forward base-re nil t))))
+
+
+(with-eval-after-load 'find-func
+  (defvar find-function-regexp-alist)
+  (add-to-list 'find-function-regexp-alist
+               `(cl-defmethod . ,#'cl--generic-search-method)))
+
+(add-hook 'help-fns-describe-function-functions #'cl--generic-describe)
 (defun cl--generic-describe (function)
-  ;; FIXME: Fix up the main "in `<file>'" hyperlink, and add such hyperlinks
-  ;; for each method.
   (let ((generic (if (symbolp function) (cl--generic function))))
     (when generic
+      (require 'help-mode)              ;Needed for `help-function-def' button!
       (save-excursion
         (insert "\n\nThis is a generic function.\n\n")
         (insert (propertize "Implementations:\n\n" 'face 'bold))
         ;; Loop over fanciful generics
-        (pcase-dolist (`((,type . ,qualifier) . ,method)
+        (pcase-dolist (`((,specializers . ,qualifier) ,uses-cnm . ,method)
                        (cl--generic-method-table generic))
-          (insert "`")
-          (if (symbolp type)
-              ;; FIXME: Add support for cl-structs in help-variable.
-              (help-insert-xref-button (symbol-name type)
-				       'help-variable type)
-            (insert (format "%S" type)))
-          (insert (format "' %S %S\n"
-                          (car qualifier)
-                          (let ((args (help-function-arglist method)))
-                            ;; Drop cl--generic-next arg if present.
-                            (if (memq (car qualifier) '(:after :before))
-                                args (cdr args)))))
-          (insert (or (documentation method) "Undocumented") "\n\n"))))))
+          (let* ((args (help-function-arglist method 'names))
+                 (docstring (documentation method))
+                 (doconly (if docstring
+                              (let ((split (help-split-fundoc docstring nil)))
+                                (if split (cdr split) docstring))))
+                 (combined-args ()))
+            (if uses-cnm (setq args (cdr args)))
+            (dolist (specializer specializers)
+              (let ((arg (if (eq '&rest (car args))
+                             (intern (format "arg%d" (length combined-args)))
+                           (pop args))))
+                (push (if (eq specializer t) arg (list arg specializer))
+                      combined-args)))
+            (setq combined-args (append (nreverse combined-args) args))
+            ;; FIXME: Add hyperlinks for the types as well.
+            (insert (format "%S %S" qualifier combined-args))
+            (let* ((met-name (cons function specializers))
+                   (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+              (when file
+                (insert " in `")
+                (help-insert-xref-button (help-fns-short-filename file)
+                                         'help-function-def met-name file
+                                         'cl-defmethod)
+                (insert "'.\n")))
+            (insert "\n" (or doconly "Undocumented") "\n\n")))))))
 
 ;;; Support for (eql <val>) specializers.
 
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index bfa922bade6..e526a41e871 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -34,19 +34,6 @@
 (require 'cl-lib)
 (require 'pcase)
 
-(put 'eieio--defalias 'byte-hunk-handler
-     #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
-(defun eieio--defalias (name body)
-  "Like `defalias', but with less side-effects.
-More specifically, it has no side-effects at all when the new function
-definition is the same (`eq') as the old one."
-  (while (and (fboundp name) (symbolp (symbol-function name)))
-    ;; Follow aliases, so methods applied to obsolete aliases still work.
-    (setq name (symbol-function name)))
-  (unless (and (fboundp name)
-               (eq (symbol-function name) body))
-    (defalias name body)))
-
 ;;;
 ;; A few functions that are better in the official EIEIO src, but
 ;; used from the core.
@@ -292,7 +279,7 @@ Abstract classes cannot be instantiated."
 
 ;; We autoload this because it's used in `make-autoload'.
 ;;;###autoload
-(defun eieio-defclass-autoload (cname superclasses filename doc)
+(defun eieio-defclass-autoload (cname _superclasses filename doc)
   "Create autoload symbols for the EIEIO class CNAME.
 SUPERCLASSES are the superclasses that CNAME inherits from.
 DOC is the docstring for CNAME.
@@ -301,58 +288,35 @@ SUPERCLASSES as children.
 It creates an autoload function for CNAME's constructor."
   ;; Assume we've already debugged inputs.
 
+  ;; We used to store the list of superclasses in the `parent' slot (as a list
+  ;; of class names).  But now this slot holds a list of class objects, and
+  ;; those parents may not exist yet, so the corresponding class objects may
+  ;; simply not exist yet.  So instead we just don't store the list of parents
+  ;; here in eieio-defclass-autoload at all, since it seems that they're just
+  ;; not needed before the class is actually loaded.
   (let* ((oldc (when (class-p cname) (eieio--class-v cname)))
 	 (newc (eieio--class-make cname))
 	 )
     (if oldc
 	nil ;; Do nothing if we already have this class.
 
-      (let ((clear-parent nil))
-	;; No parents?
-	(when (not superclasses)
-	  (setq superclasses '(eieio-default-superclass)
-		clear-parent t)
-	  )
-
-	;; Hook our new class into the existing structures so we can
-	;; autoload it later.
-	(dolist (SC superclasses)
-
-
-	  ;; TODO - If we create an autoload that is in the map, that
-	  ;;        map needs to be cleared!
-
-
-          ;; Save the child in the parent.
-          (cl-pushnew cname (if (class-p SC)
-                                (eieio--class-children (eieio--class-v SC))
-                              ;; Parent doesn't exist yet.
-                              (gethash SC eieio-defclass-autoload-map)))
+      ;; turn this into a usable self-pointing symbol
+      (when eieio-backward-compatibility
+        (set cname cname)
+        (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
 
-	  ;; Save parent in child.
-          (push (eieio--class-v SC) (eieio--class-parent newc)))
+      ;; Store the new class vector definition into the symbol.  We need to
+      ;; do this first so that we can call defmethod for the accessor.
+      ;; The vector will be updated by the following while loop and will not
+      ;; need to be stored a second time.
+      (setf (eieio--class-v cname) newc)
 
-	;; turn this into a usable self-pointing symbol
-        (when eieio-backward-compatibility
-          (set cname cname)
-          (make-obsolete-variable cname (format "use '%s instead" cname) "25.1"))
-
-	;; Store the new class vector definition into the symbol.  We need to
-	;; do this first so that we can call defmethod for the accessor.
-	;; The vector will be updated by the following while loop and will not
-	;; need to be stored a second time.
-	(setf (eieio--class-v cname) newc)
-
-	;; Clear the parent
-	(if clear-parent (setf (eieio--class-parent newc) nil))
-
-	;; Create an autoload on top of our constructor function.
-	(autoload cname filename doc nil nil)
-	(autoload (intern (concat (symbol-name cname) "-p")) filename "" nil nil)
-	(autoload (intern (concat (symbol-name cname) "-child-p")) filename "" nil nil)
-	(autoload (intern (concat (symbol-name cname) "-list-p")) filename "" nil nil)
-
-	))))
+      ;; Create an autoload on top of our constructor function.
+      (autoload cname filename doc nil nil)
+      (autoload (intern (format "%s-p" cname)) filename "" nil nil)
+      (when eieio-backward-compatibility
+        (autoload (intern (format "%s-child-p" cname)) filename "" nil nil)
+        (autoload (intern (format "%s-list-p" cname)) filename "" nil nil)))))
 
 (defsubst eieio-class-un-autoload (cname)
   "If class CNAME is in an autoload state, load its file."
@@ -378,8 +342,13 @@ See `defclass' for more information."
   (setq eieio-hook nil)
 
   (let* ((pname superclasses)
-	 (newc (eieio--class-make cname))
 	 (oldc (when (class-p cname) (eieio--class-v cname)))
+	 (newc (if (and oldc (not (eieio--class-default-object-cache oldc)))
+                   ;; The oldc class is a stub setup by eieio-defclass-autoload.
+                   ;; Reuse it instead of creating a new one, so that existing
+                   ;; references are still valid.
+                   oldc
+                 (eieio--class-make cname)))
 	 (groups nil) ;; list of groups id'd from slots
 	 (clearparent nil))
 
@@ -1284,6 +1253,8 @@ The order, in which the parents are returned depends on the
 method invocation orders of the involved classes."
   (if (or (null class) (eq class eieio-default-superclass))
       nil
+    (unless (eieio--class-default-object-cache class)
+      (eieio-class-un-autoload (eieio--class-symbol class)))
     (cl-case (eieio--class-method-invocation-order class)
       (:depth-first
        (eieio--class-precedence-dfs class))
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el
index 0e90074660e..4045c038033 100644
--- a/lisp/emacs-lisp/eieio-generic.el
+++ b/lisp/emacs-lisp/eieio-generic.el
@@ -33,6 +33,19 @@
 (require 'eieio-core)
 (declare-function child-of-class-p "eieio")
 
+(put 'eieio--defalias 'byte-hunk-handler
+     #'byte-compile-file-form-defalias) ;;(get 'defalias 'byte-hunk-handler)
+(defun eieio--defalias (name body)
+  "Like `defalias', but with less side-effects.
+More specifically, it has no side-effects at all when the new function
+definition is the same (`eq') as the old one."
+  (while (and (fboundp name) (symbolp (symbol-function name)))
+    ;; Follow aliases, so methods applied to obsolete aliases still work.
+    (setq name (symbol-function name)))
+  (unless (and (fboundp name)
+               (eq (symbol-function name) body))
+    (defalias name body)))
+
 (defconst eieio--method-static 0 "Index into :static tag on a method.")
 (defconst eieio--method-before 1 "Index into :before tag on a method.")
 (defconst eieio--method-primary 2 "Index into :primary tag on a method.")
@@ -101,7 +114,7 @@ Methods with only primary implementations are executed in an optimized way."
     ;; Make sure the method tables are installed.
     (eieio--mt-install method)
     ;; Construct the actual body of this function.
-    (put method 'function-documentation doc-string)
+    (if doc-string (put method 'function-documentation doc-string))
     (eieio--defgeneric-form method))
    ((generic-p method) (symbol-function method))           ;Leave it as-is.
    (t (error "You cannot create a generic/method over an existing symbol: %s"
@@ -177,20 +190,18 @@ but remove reference to all implementations of METHOD."
     ;;
     ;; If this method, after this setup, only has primary methods, then
     ;; we can setup the generic that way.
-    (let ((doc-string (documentation method 'raw)))
-      (put method 'function-documentation doc-string)
-      ;; Use `defalias' so as to interact properly with nadvice.el.
-      (defalias method
-        (if (eieio--generic-primary-only-p method)
-            ;; If there is only one primary method, then we can go one more
-            ;; optimization step.
-            (if (eieio--generic-primary-only-one-p method)
-                (let* ((M (get method 'eieio-method-tree))
-                       (entry (car (aref M eieio--method-primary))))
-                  (eieio--defgeneric-form-primary-only-one
-                   method (car entry) (cdr entry)))
-              (eieio--defgeneric-form-primary-only method))
-          (eieio--defgeneric-form method))))))
+    ;; Use `defalias' so as to interact properly with nadvice.el.
+    (defalias method
+      (if (eieio--generic-primary-only-p method)
+          ;; If there is only one primary method, then we can go one more
+          ;; optimization step.
+          (if (eieio--generic-primary-only-one-p method)
+              (let* ((M (get method 'eieio-method-tree))
+                     (entry (car (aref M eieio--method-primary))))
+                (eieio--defgeneric-form-primary-only-one
+                 method (car entry) (cdr entry)))
+            (eieio--defgeneric-form-primary-only method))
+        (eieio--defgeneric-form method)))))
 
 (defun eieio--defmethod (method kind argclass code)
   "Work part of the `defmethod' macro defining METHOD with ARGS."
@@ -627,7 +638,7 @@ is memorized for faster future use."
 
 ;;; CLOS methods and generics
 ;;
-(defmacro defgeneric (method _args &optional doc-string)
+(defmacro defgeneric (method args &optional doc-string)
   "Create a generic function METHOD.
 DOC-STRING is the base documentation for this class.  A generic
 function has no body, as its purpose is to decide which method body
@@ -637,7 +648,9 @@ currently ignored.  You can use `defgeneric' to apply specialized
 top level documentation to a method."
   (declare (doc-string 3))
   `(eieio--defalias ',method
-                    (eieio--defgeneric-init-form ',method ,doc-string)))
+                    (eieio--defgeneric-init-form
+                     ',method
+                     ,(if doc-string (help-add-fundoc-usage doc-string args)))))
 
 (defmacro defmethod (method &rest args)
   "Create a new METHOD through `defgeneric' with ARGS.
@@ -684,9 +697,7 @@ Summary:
          (code `(lambda ,fargs ,@(cdr args))))
     `(progn
        ;; Make sure there is a generic and the byte-compiler sees it.
-       (defgeneric ,method ,args
-         ,(or (documentation code)
-              (format "Generically created method `%s'." method)))
+       (defgeneric ,method ,args)
        (eieio--defmethod ',method ',key ',class #',code))))
 
 
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index cc7b06c35b1..6c9c798bc16 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -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-2015 Free Software Foundation, Inc.
 
@@ -59,7 +59,7 @@
   (concat
    "^\\s-*(\\(def\\(ine-skeleton\\|ine-generic-mode\\|ine-derived-mode\\|\
 ine\\(?:-global\\)?-minor-mode\\|ine-compilation-mode\\|un-cvs-mode\\|\
-foo\\|[^icfgv]\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
+foo\\|\\(?:[^icfv]\\|g[^r]\\)\\(\\w\\|\\s_\\)+\\*?\\)\\|easy-mmode-define-[a-z-]+\\|easy-menu-define\\|\
 menu-bar-make-toggle\\)"
    find-function-space-re
    "\\('\\|\(quote \\)?%s\\(\\s-\\|$\\|\(\\|\)\\)")
@@ -106,7 +106,10 @@ Please send improvements and fixes to the maintainer."
     (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.")
+to be used to substitute the desired symbol name into the regexp.
+Instead of regexp variable, types can be mapped to functions as well,
+in which case the function is called with one argument (the object
+we're looking for) and it should search for it.")
 (put 'find-function-regexp-alist 'risky-local-variable t)
 
 (defcustom find-function-source-path nil
@@ -282,30 +285,33 @@ The search is done in the source for library LIBRARY."
     (let* ((filename (find-library-name library))
 	   (regexp-symbol (cdr (assq type find-function-regexp-alist))))
       (with-current-buffer (find-file-noselect filename)
-	(let ((regexp (format (symbol-value regexp-symbol)
-			      ;; Entry for ` (backquote) macro in loaddefs.el,
-			      ;; (defalias (quote \`)..., has a \ but
-			      ;; (symbol-name symbol) doesn't.  Add an
-			      ;; optional \ to catch this.
-			      (concat "\\\\?"
-				      (regexp-quote (symbol-name symbol)))))
+	(let ((regexp (if (functionp regexp-symbol) regexp-symbol
+                        (format (symbol-value regexp-symbol)
+                                ;; Entry for ` (backquote) macro in loaddefs.el,
+                                ;; (defalias (quote \`)..., has a \ but
+                                ;; (symbol-name symbol) doesn't.  Add an
+                                ;; optional \ to catch this.
+                                (concat "\\\\?"
+                                        (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)
-                    ;; `regexp' matches definitions using known forms like
-                    ;; `defun', or `defvar'.  But some functions/variables
-                    ;; are defined using special macros (or functions), so
-                    ;; if `regexp' can't find the definition, we look for
-                    ;; something of the form "(SOMETHING <symbol> ...)".
-                    ;; This fails to distinguish function definitions from
-                    ;; variable declarations (or even uses thereof), but is
-                    ;; a good pragmatic fallback.
-		    (re-search-forward
-		     (concat "^([^ ]+" find-function-space-re "['(]?"
-			     (regexp-quote (symbol-name symbol))
-			     "\\_>")
-		     nil t))
+	    (if (if (functionp regexp)
+                    (funcall regexp symbol)
+                  (or (re-search-forward regexp nil t)
+                      ;; `regexp' matches definitions using known forms like
+                      ;; `defun', or `defvar'.  But some functions/variables
+                      ;; are defined using special macros (or functions), so
+                      ;; if `regexp' can't find the definition, we look for
+                      ;; something of the form "(SOMETHING <symbol> ...)".
+                      ;; This fails to distinguish function definitions from
+                      ;; variable declarations (or even uses thereof), but is
+                      ;; a good pragmatic fallback.
+                      (re-search-forward
+                       (concat "^([^ ]+" find-function-space-re "['(]?"
+                               (regexp-quote (symbol-name symbol))
+                               "\\_>")
+                       nil t)))
 		(progn
 		  (beginning-of-line)
 		  (cons (current-buffer) (point)))
@@ -324,18 +330,19 @@ signal an error.
 
 If VERBOSE is non-nil, and FUNCTION is an alias, display a
 message about the whole chain of aliases."
-  (let ((def (symbol-function (find-function-advised-original function)))
+  (let ((def (if (symbolp function)
+                 (symbol-function (find-function-advised-original function))))
         aliases)
     ;; FIXME for completeness, it might be nice to print something like:
     ;; foo (which is advised), which is an alias for bar (which is advised).
-    (while (symbolp def)
+    (while (and def (symbolp def))
       (or (eq def function)
           (not verbose)
-          (if aliases
-              (setq aliases (concat aliases
+          (setq aliases (if aliases
+                            (concat aliases
                                     (format ", which is an alias for `%s'"
-                                            (symbol-name def))))
-            (setq aliases (format "`%s' is an alias for `%s'"
+                                            (symbol-name def)))
+                          (format "`%s' is an alias for `%s'"
                                   function (symbol-name def)))))
       (setq function (symbol-function (find-function-advised-original function))
             def (symbol-function (find-function-advised-original function))))
@@ -408,7 +415,6 @@ See also `find-function-after-hook'.
 
 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)))