commit c2870c3ee72c9be65d627639f2371ffc4f094e15
parent 0d98a4b1ace03375bf8cdd6933c968ca125557c0
Author: Wilfred Hughes <me@wilfred.me.uk>
Date: Sat, 17 Feb 2018 18:16:58 +0000
Handle unnamed functions bound to keys
Fixes #96.
Diffstat:
2 files changed, 76 insertions(+), 36 deletions(-)
diff --git a/helpful.el b/helpful.el
@@ -89,9 +89,13 @@ To disable cleanup entirely, set this variable to nil. See also
(defun helpful--buffer (symbol callable-p)
"Return a buffer to show help for SYMBOL in."
(let* ((current-buffer (current-buffer))
- (buf-name (format "*helpful %s: %s*"
- (helpful--kind-name symbol callable-p)
- symbol))
+ (buf-name
+ (format "*helpful %s*"
+ (if (symbolp symbol)
+ (format "%s: %s"
+ (helpful--kind-name symbol callable-p)
+ symbol)
+ "lambda")))
(buf (get-buffer buf-name)))
(unless buf
;; If we need to create the buffer, ensure we don't exceed
@@ -164,7 +168,7 @@ with double-quotes."
"If SYM is an alias, return the underlying symbol.
Return SYM otherwise."
(let ((depth 0))
- (if callable-p
+ (if (and (symbolp sym) callable-p)
(while (and (symbolp (symbol-function sym))
(< depth 10))
(setq sym (symbol-function sym))
@@ -220,7 +224,7 @@ Return SYM otherwise."
(defun helpful--format-properties (symbol)
"Return a string describing all the properties of SYMBOL."
(let* ((syms-and-vals
- (-partition 2 (symbol-plist symbol)))
+ (-partition 2 (and (symbolp symbol) (symbol-plist symbol))))
(syms-and-vals
(-sort (-lambda ((sym1 _) (sym2 _))
(string-lessp (symbol-name sym1) (symbol-name sym2)))
@@ -830,30 +834,35 @@ hooks.")
(defun helpful--source (sym callable-p)
"Return the source code of SYM.
If the source code cannot be found, return the sexp used."
- (-let (((buf start-pos created) (helpful--definition sym callable-p))
- (source nil))
- (when (and buf start-pos)
- (with-current-buffer buf
- (save-excursion
- (save-restriction
- (goto-char start-pos)
- (narrow-to-defun)
- (setq source (buffer-substring-no-properties (point-min) (point-max))))))
- (setq source (s-trim-right source))
- (when (and source (buffer-file-name buf))
- (setq source (propertize source
- 'helpful-path (buffer-file-name buf)
- 'helpful-pos start-pos
- 'helpful-pos-is-start t))))
- (when (and buf created)
- (kill-buffer buf))
- (when (and (null source) callable-p)
+ (catch 'source
+ (when (functionp sym)
+ (throw 'source sym))
+
+ (-let (((buf start-pos created) (helpful--definition sym callable-p))
+ (source nil))
+ (when (and buf start-pos)
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (goto-char start-pos)
+ (narrow-to-defun)
+ (setq source (buffer-substring-no-properties (point-min) (point-max))))))
+ (setq source (s-trim-right source))
+ (when (and source (buffer-file-name buf))
+ (setq source (propertize source
+ 'helpful-path (buffer-file-name buf)
+ 'helpful-pos start-pos
+ 'helpful-pos-is-start t))))
+ (when (and buf created)
+ (kill-buffer buf))
+ (throw 'source source))
+
+ (when callable-p
;; Could not find source -- probably defined interactively, or via
;; a macro, or file has changed.
;; TODO: verify that the source hasn't changed before showing.
;; TODO: offer to download C sources for current version.
- (setq source (indirect-function sym)))
- source))
+ (throw 'source (indirect-function sym)))))
(defun helpful--in-manual-p (sym)
"Return non-nil if SYM is in an Info manual."
@@ -890,7 +899,7 @@ buffer."
(buf nil)
(pos nil)
(opened nil))
- (when callable-p
+ (when (and (symbolp sym) callable-p)
(-let [(base-sym . src-path) (find-function-library sym)]
;; `base-sym' is the underlying symbol if `sym' is an alias.
(setq sym base-sym)
@@ -901,6 +910,8 @@ buffer."
(f-parent find-function-C-source-directory))))
(cond
+ ((and (not (symbolp sym)) (functionp sym))
+ (list nil nil nil))
((and callable-p path)
;; Convert foo.elc to foo.el.
(-when-let (src-path (helpful--find-library-name path))
@@ -1080,7 +1091,8 @@ E.g. (x x y z y) -> ((x . 2) (y . 2) (z . 1))"
(defun helpful--advised-p (sym)
"A list of advice associated with SYM."
- (advice--p (advice--symbol-function sym)))
+ (and (symbolp sym)
+ (advice--p (advice--symbol-function sym))))
(defun helpful--format-head (head)
"Given a 'head' (the first two symbols of a sexp) format and
@@ -1288,7 +1300,9 @@ OBJ may be a symbol or a compiled function object."
(when opened
(kill-buffer buf))
- (format "%s is %s %s %s." sym description kind defined)))
+ (format "%s is %s %s %s."
+ (if (symbolp sym) sym "This lambda")
+ description kind defined)))
(defun helpful-update ()
"Update the current *Helpful* buffer to the latest
@@ -1309,7 +1323,7 @@ state of the current symbol."
find-function-C-source-directory))
(source (when look-for-src
(helpful--source helpful--sym helpful--callable-p)))
- (source-path (when look-for-src
+ (source-path (when (and look-for-src (symbolp helpful--sym))
(helpful--source-path helpful--sym helpful--callable-p)))
(references (helpful--calculate-references
helpful--sym helpful--callable-p
@@ -1393,7 +1407,8 @@ state of the current symbol."
(let ((can-edebug
(helpful--can-edebug-p helpful--sym helpful--callable-p))
(can-trace
- (and helpful--callable-p
+ (and (symbolp helpful--sym)
+ helpful--callable-p
;; Tracing uses advice, and you can't apply advice to
;; primitive functions that are replaced with special
;; opcodes. For example, `narrow-to-region'.
@@ -1461,7 +1476,7 @@ state of the current symbol."
'helpful-c-source-directory)))
(t
(helpful--syntax-highlight
- (format ";; Source file is unknown")))))
+ (format ";; Source file is unknown\n")))))
(when source
(insert
(cond
@@ -1508,17 +1523,28 @@ For example, \"(some-func FOO &optional BAR)\"."
(let (docstring-sig
source-sig)
;; Get the usage from the function definition.
- (let* ((function-args (help-function-arglist sym))
+ (let* ((function-args
+ (if (symbolp sym)
+ (help-function-arglist sym)
+ (cadr sym)))
(formatted-args
(if (listp function-args)
(-map #'helpful--format-argument
function-args)
(list function-args))))
(setq source-sig
- (if formatted-args
- (format "(%s %s)" sym
- (s-join " " formatted-args))
- (format "(%s)" sym))))
+ (cond
+ ;; If it's a function object, just show the arguments.
+ ((not (symbolp sym))
+ (format "(%s)"
+ (s-join " " formatted-args)))
+ ;; If it has multiple arguments, join them with spaces.
+ (formatted-args
+ (format "(%s %s)" sym
+ (s-join " " formatted-args)))
+ ;; Otherwise, this function takes no arguments when called.
+ (t
+ (format "(%s)" sym)))))
;; If the docstring ends with (fn FOO BAR), extract that.
(-when-let (docstring (documentation sym))
diff --git a/test/unit-test.el b/test/unit-test.el
@@ -318,6 +318,20 @@ file."
;; This should not error.
(helpful-function 'helpful-fn-in-elc)))
+(ert-deftest helpful--unnamed-func ()
+ "Ensure we handle unnamed functions too.
+
+This is important for `helpful-key', where a user may have
+associated a lambda with a keybinding."
+ (let* ((fun (lambda (x) x))
+ (buf (helpful--buffer fun t)))
+ ;; There's no name, so just show lambda in the buffer name.
+ (should
+ (equal (buffer-name buf) "*helpful lambda*"))
+ ;; Don't crash when we show the buffer.
+ (with-current-buffer buf
+ (helpful-update))))
+
(ert-deftest helpful--keymap-keys--sparse ()
(let* ((parent-keymap (make-sparse-keymap))
(keymap (make-sparse-keymap)))
