Show aliases

Closes #27

4 files changed, 98 insertions, 0 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index c664ffc..3a65b36 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -4,6 +4,9 @@ Allow function tracing to be enabled/disabled from Helpful buffers.
 
 Ensure docstring references to Info nodes are converted to buttons.
 
+Helpful now shows all aliases for callables and variables, and
+highlights which aliases are obsolete.
+
 # v0.4
 
 You can now enable edebug directly from helpful buffers!
diff --git a/README.md b/README.md
index 37a6223..175d8f9 100644
--- a/README.md
+++ b/README.md
@@ -77,6 +77,8 @@ Helpful will show you the properties that have been applied to the
 current symbol. This provides visibility of features
 like edebug or byte-code optimisation.
 
+Helpful will also highlight any symbol aliases.
+
 ### Describe Commands
 
 Helpful provides a separate `helpful-command` function, for when you
diff --git a/helpful.el b/helpful.el
index a70e9db..bc47a11 100644
--- a/helpful.el
+++ b/helpful.el
@@ -110,6 +110,59 @@ with double-quotes."
     (cl-prettyprint value)
     (s-trim (buffer-string))))
 
+(defun helpful--canonical-symbol (sym callable-p)
+  "If SYM is an alias, return the underlying symbol.
+Return SYM otherwise."
+  (let ((depth 0))
+    (if callable-p
+        (while (and (symbolp (symbol-function sym))
+                    (< depth 10))
+          (setq sym (symbol-function sym))
+          (setq depth (1+ depth)))
+      (setq sym (indirect-variable sym))))
+  sym)
+
+(defun helpful--aliases (sym callable-p)
+  "Return all the aliases for SYM."
+  (let ((changed t)
+        (canonical (helpful--canonical-symbol sym callable-p))
+        aliases)
+    (while changed
+      (setq changed nil)
+      (mapatoms
+       (lambda (s)
+         (when (and
+                ;; Skip variables that aren't bound, so we're faster.
+                (if callable-p (fboundp s) (boundp s))
+
+                ;; If this symbol is a new alias for our target sym,
+                ;; add it.
+                (eq canonical (helpful--canonical-symbol s callable-p))
+                (not (-contains-p aliases s)))
+           (push s aliases)
+           (setq changed t)))))
+    (--sort
+     (string< (symbol-name it) (symbol-name other))
+     aliases)))
+
+(defun helpful--format-alias (sym callable-p)
+  (let ((obsolete-info (if callable-p
+                           (get sym 'byte-obsolete-info)
+                         (get sym 'byte-obsolete-variable)))
+        (sym-button (make-text-button
+                     ;; symbol-name can return a pure string, e.g. for
+                     ;; 'report-errors, so take a copy so we can add
+                     ;; properties to it.
+                     (substring (symbol-name sym)) nil
+                     :type 'helpful-describe-exactly-button
+                     'symbol sym
+                     'callable-p callable-p)))
+    (cond
+     (obsolete-info
+      (format "%s (obsolete since %s)" sym-button (-last-item obsolete-info)))
+     (t
+      sym-button))))
+
 (defun helpful--indent-rigidly (s amount)
   "Indent string S by adding AMOUNT spaces to each line."
   (with-temp-buffer
@@ -388,6 +441,23 @@ or disable if already enabled."
   (let ((sym (button-get button 'symbol)))
     (helpful-symbol sym)))
 
+(define-button-type 'helpful-describe-exactly-button
+  'action #'helpful--describe-exactly
+  'symbol nil
+  'callable-p nil
+  'follow-link t
+  'help-echo "Describe this symbol")
+
+(defun helpful--describe-exactly (button)
+  "Describe the symbol that this BUTTON represents.
+This differs from `helpful--describe' because here we know
+whether the symbol represents a variable or a callable."
+  (let ((sym (button-get button 'symbol))
+        (callable-p (button-get button 'callable-p)))
+    (if callable-p
+        (helpful-callable sym)
+      (helpful-variable sym))))
+
 (define-button-type 'helpful-info-button
   'action #'helpful--info
   'info-node nil
@@ -961,6 +1031,13 @@ state of the current symbol."
           'symbol helpful--sym
           'callable-p helpful--callable-p))))
 
+    (let ((aliases (helpful--aliases helpful--sym helpful--callable-p)))
+      (when (> (length aliases) 1)
+        (insert
+         (helpful--heading "\n\nAliases\n")
+         (s-join "\n" (--map (helpful--format-alias it helpful--callable-p)
+                             aliases)))))
+
     (insert
      (helpful--heading "\n\nSource Code\n")
      (cond
diff --git a/test/unit-test.el b/test/unit-test.el
index 46db04a..9fd4112 100644
--- a/test/unit-test.el
+++ b/test/unit-test.el
@@ -207,3 +207,19 @@ and that buffer has been killed, handle it gracefully."
       (setq helpful-buf (current-buffer)))
     (with-current-buffer helpful-buf
       (helpful-update))))
+
+(ert-deftest helpful--canonical-symbol ()
+  (should
+   (eq (helpful--canonical-symbol 'not t)
+       'null))
+  (should
+   (eq (helpful--canonical-symbol 'emacs-bzr-version nil)
+       'emacs-repository-version)))
+
+(ert-deftest helpful--aliases ()
+  (should
+   (equal (helpful--aliases 'null t)
+          (list 'not 'null)))
+  (should
+   (equal (helpful--aliases 'emacs-repository-version nil)
+          (list 'emacs-bzr-version 'emacs-repository-version))))