Commit 24b7f775 authored by Stefan Monnier's avatar Stefan Monnier

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.
parent a2cd6d90
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
Improve handling of doc-strings and describe-function for cl-generic.
* help-mode.el (help-function-def): Add optional arg `type'.
* 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.
* 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'.
* 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.
* 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.
* 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.
2015-01-16 Artur Malabarba <bruce.connor.am@gmail.com>
* emacs-lisp/package.el (package--read-pkg-desc): New
......
......@@ -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.
......
......@@ -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))
......
......@@ -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))))
......
;;; 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)))
......
......@@ -183,8 +183,7 @@ OBJECT should be a symbol associated with a function, variable, or face;
alternatively, it can be a function definition.
If TYPE is `defvar', search for a variable definition.
If TYPE is `defface', search for a face definition.
If TYPE is the value returned by `symbol-function' for a function symbol,
search for a function definition.
If TYPE is not a symbol, search for a function definition.
The return value is the absolute name of a readable file where OBJECT is
defined. If several such files exist, preference is given to a file
......@@ -194,9 +193,10 @@ suitable file is found, return nil."
(let* ((autoloaded (autoloadp type))
(file-name (or (and autoloaded (nth 1 type))
(symbol-file
object (if (memq type (list 'defvar 'defface))
type
'defun)))))
;; FIXME: Why do we have this weird "If TYPE is the
;; value returned by `symbol-function' for a function
;; symbol" exception?
object (or (if (symbolp type) type) 'defun)))))
(cond
(autoloaded
;; An autoloaded function: Locate the file since `symbol-function'
......@@ -452,6 +452,18 @@ FILE is the file where FUNCTION was probably defined."
(t "."))
"\n")))))
(defun help-fns-short-filename (filename)
(let* ((abbrev (abbreviate-file-name filename))