dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

helpful.el (102195B)


      1 ;;; helpful.el --- A better *help* buffer            -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2017-2020  Wilfred Hughes
      4 
      5 ;; Author: Wilfred Hughes <me@wilfred.me.uk>
      6 ;; URL: https://github.com/Wilfred/helpful
      7 ;; Package-Version: 20220220.2308
      8 ;; Package-Commit: 67cdd1030b3022d3dc4da2297f55349da57cde01
      9 ;; Keywords: help, lisp
     10 ;; Version: 0.19
     11 ;; Package-Requires: ((emacs "25") (dash "2.18.0") (s "1.11.0") (f "0.20.0") (elisp-refs "1.2"))
     12 
     13 ;; This program is free software; you can redistribute it and/or modify
     14 ;; it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or
     16 ;; (at your option) any later version.
     17 
     18 ;; This program is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     21 ;; GNU General Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 
     28 ;; Helpful is a replacement for *help* buffers that provides much more
     29 ;; contextual information.  To get started, try:
     30 ;; `M-x helpful-function RET helpful-function
     31 ;;
     32 ;; The full set of commands you can try is:
     33 ;;
     34 ;; * helpful-function
     35 ;; * helpful-command
     36 ;; * helpful-key
     37 ;; * helpful-macro
     38 ;; * helpful-callable
     39 ;; * helpful-variable
     40 ;; * helpful-at-point
     41 ;;
     42 ;; For more information and screenshots, see
     43 ;; https://github.com/wilfred/helpful
     44 
     45 ;;; Code:
     46 
     47 (require 'elisp-refs)
     48 (require 'help)
     49 (require 'help-fns)
     50 (require 'dash)
     51 (require 's)
     52 (require 'f)
     53 (require 'find-func)
     54 (require 'nadvice)
     55 (require 'info-look)
     56 (require 'edebug)
     57 (require 'trace)
     58 (require 'imenu)
     59 
     60 (defvar-local helpful--sym nil)
     61 (defvar-local helpful--callable-p nil)
     62 (defvar-local helpful--associated-buffer nil
     63   "The buffer being used when showing inspecting
     64 buffer-local variables.")
     65 (defvar-local helpful--start-buffer nil
     66   "The buffer we were originally called from.")
     67 (defvar-local helpful--view-literal nil
     68   "Whether to show a value as a literal, or a pretty interactive
     69 view.")
     70 (defvar-local helpful--first-display t
     71   "Whether this is the first time this results buffer has been
     72 displayed.
     73 
     74 Nil means that we're refreshing, so we don't want to clobber any
     75 settings changed by the user.")
     76 
     77 (defgroup helpful nil
     78   "A rich help system with contextual information."
     79   :link '(url-link "https://github.com/Wilfred/helpful")
     80   :group 'help)
     81 
     82 (defcustom helpful-max-buffers
     83   5
     84   "Helpful will kill the least recently used Helpful buffer
     85 if there are more than this many.
     86 
     87 To disable cleanup entirely, set this variable to nil. See also
     88 `helpful-kill-buffers' for a one-off cleanup."
     89   :type '(choice (const nil) number)
     90   :group 'helpful)
     91 
     92 (defcustom helpful-switch-buffer-function
     93   #'pop-to-buffer
     94   "Function called to display the *Helpful* buffer."
     95   :type 'function
     96   :group 'helpful)
     97 
     98 ;; TODO: explore whether more basic highlighting is fast enough to
     99 ;; handle larger functions. See `c-font-lock-init' and its use of
    100 ;; font-lock-keywords-1.
    101 (defconst helpful-max-highlight 5000
    102   "Don't highlight code with more than this many characters.
    103 
    104 This is currently only used for C code, as lisp highlighting
    105 seems to be more efficient. This may change again in future.
    106 
    107 See `this-command' as an example of a large piece of C code that
    108 can make Helpful very slow.")
    109 
    110 (defun helpful--kind-name (symbol callable-p)
    111   "Describe what kind of symbol this is."
    112   (cond
    113    ((not callable-p) "variable")
    114    ((commandp symbol) "command")
    115    ((macrop symbol) "macro")
    116    ((functionp symbol) "function")
    117    ((special-form-p symbol) "special form")))
    118 
    119 (defun helpful--buffer (symbol callable-p)
    120   "Return a buffer to show help for SYMBOL in."
    121   (let* ((current-buffer (current-buffer))
    122          (buf-name
    123           (format "*helpful %s*"
    124                   (if (symbolp symbol)
    125                       (format "%s: %s"
    126                               (helpful--kind-name symbol callable-p)
    127                               symbol)
    128                     "lambda")))
    129          (buf (get-buffer buf-name)))
    130     (unless buf
    131       ;; If we need to create the buffer, ensure we don't exceed
    132       ;; `helpful-max-buffers' by killing the least recently used.
    133       (when (numberp helpful-max-buffers)
    134         (let* ((buffers (buffer-list))
    135                (helpful-bufs (--filter (with-current-buffer it
    136                                          (eq major-mode 'helpful-mode))
    137                                        buffers))
    138                ;; `buffer-list' seems to be ordered by most recently
    139                ;; visited first, so keep those.
    140                (excess-buffers (-drop (1- helpful-max-buffers) helpful-bufs)))
    141           ;; Kill buffers so we have one buffer less than the maximum
    142           ;; before we create a new one.
    143           (-each excess-buffers #'kill-buffer)))
    144 
    145       (setq buf (get-buffer-create buf-name)))
    146 
    147     ;; Initialise the buffer with the symbol and associated data.
    148     (with-current-buffer buf
    149       (helpful-mode)
    150       (setq helpful--sym symbol)
    151       (setq helpful--callable-p callable-p)
    152       (setq helpful--start-buffer current-buffer)
    153       (setq helpful--associated-buffer current-buffer)
    154       (if (helpful--primitive-p symbol callable-p)
    155           (setq-local comment-start "//")
    156         (setq-local comment-start ";")))
    157     buf))
    158 
    159 (defface helpful-heading
    160   '((t (:weight bold)))
    161   "Face used for headings in Helpful buffers.")
    162 
    163 (defun helpful--heading (text)
    164   "Propertize TEXT as a heading."
    165   (format "%s\n" (propertize text 'face 'helpful-heading)))
    166 
    167 (defun helpful--format-closure (sym form)
    168   "Given a closure, return an equivalent defun form."
    169   (-let (((_keyword _env args . body) form)
    170          (docstring nil))
    171     (when (stringp (car body))
    172       (setq docstring (car body))
    173       (setq body (cdr body))
    174       ;; Ensure that the docstring doesn't have lines starting with (,
    175       ;; or it breaks indentation.
    176       (setq docstring
    177             (s-replace "\n(" "\n\\(" docstring)))
    178     (if docstring
    179         `(defun ,sym ,args ,docstring ,@body)
    180       `(defun ,sym ,args ,@body))))
    181 
    182 (defun helpful--pretty-print (value)
    183   "Pretty-print VALUE.
    184 
    185 If VALUE is very big, the user may press \\[keyboard-quit] to
    186 gracefully stop the printing. If VALUE is self-referential, the
    187 error will be caught and displayed."
    188   ;; Inspired by `ielm-eval-input'.
    189   (condition-case err
    190       (s-trim-right (pp-to-string value))
    191     (error
    192      (propertize (format "(Display error: %s)" (cadr err))
    193                  'face 'font-lock-comment-face))
    194     (quit
    195      (propertize "(User quit during pretty-printing.)"
    196                  'face 'font-lock-comment-face))))
    197 
    198 (defun helpful--sort-symbols (sym-list)
    199   "Sort symbols in SYM-LIST alphabetically."
    200   (--sort
    201    (string< (symbol-name it) (symbol-name other))
    202    sym-list))
    203 
    204 (defun helpful--button (text type &rest properties)
    205   ;; `make-text-button' mutates our string to add properties. Copy
    206   ;; TEXT to prevent mutating our arguments, and to support 'pure'
    207   ;; strings, which are read-only.
    208   (setq text (substring-no-properties text))
    209   (apply #'make-text-button
    210          text nil
    211          :type type
    212          properties))
    213 
    214 (defun helpful--canonical-symbol (sym callable-p)
    215   "If SYM is an alias, return the underlying symbol.
    216 Return SYM otherwise."
    217   (let ((depth 0))
    218     (if (and (symbolp sym) callable-p)
    219         (progn
    220           ;; Follow the chain of symbols until we find a symbol that
    221           ;; isn't pointing to a symbol.
    222           (while (and (symbolp (symbol-function sym))
    223                       (< depth 10))
    224             (setq sym (symbol-function sym))
    225             (setq depth (1+ depth)))
    226           ;; If this is an alias to a primitive, return the
    227           ;; primitive's symbol.
    228           (when (subrp (symbol-function sym))
    229             (setq sym (intern (subr-name (symbol-function sym))))))
    230       (setq sym (indirect-variable sym))))
    231   sym)
    232 
    233 (defun helpful--aliases (sym callable-p)
    234   "Return all the aliases for SYM."
    235   (let ((canonical (helpful--canonical-symbol sym callable-p))
    236         aliases)
    237     (mapatoms
    238      (lambda (s)
    239        (when (and
    240               ;; Skip variables that aren't bound, so we're faster.
    241               (if callable-p (fboundp s) (boundp s))
    242 
    243               ;; If this symbol is a new alias for our target sym,
    244               ;; add it.
    245               (eq canonical (helpful--canonical-symbol s callable-p))
    246 
    247               ;; Don't include SYM.
    248               (not (eq sym s)))
    249          (push s aliases))))
    250     (helpful--sort-symbols aliases)))
    251 
    252 (defun helpful--obsolete-info (sym callable-p)
    253   (when (symbolp sym)
    254     (get sym (if callable-p 'byte-obsolete-info 'byte-obsolete-variable))))
    255 
    256 (defun helpful--format-alias (sym callable-p)
    257   (let ((obsolete-info (helpful--obsolete-info sym callable-p))
    258         (sym-button (helpful--button
    259                      (symbol-name sym)
    260                      'helpful-describe-exactly-button
    261                      'symbol sym
    262                      'callable-p callable-p)))
    263     (cond
    264      (obsolete-info
    265       (-if-let (version (-last-item obsolete-info))
    266           (format "%s (obsolete since %s)" sym-button version)
    267         (format "%s (obsolete)" sym-button)))
    268      (t
    269       sym-button))))
    270 
    271 (defun helpful--indent-rigidly (s amount)
    272   "Indent string S by adding AMOUNT spaces to each line."
    273   (with-temp-buffer
    274     (insert s)
    275     (indent-rigidly (point-min) (point-max) amount)
    276     (buffer-string)))
    277 
    278 (defun helpful--format-properties (symbol)
    279   "Return a string describing all the properties of SYMBOL."
    280   (let* ((syms-and-vals
    281           (-partition 2 (and (symbolp symbol) (symbol-plist symbol))))
    282          (syms-and-vals
    283           (-sort (-lambda ((sym1 _) (sym2 _))
    284                    (string-lessp (symbol-name sym1) (symbol-name sym2)))
    285                  syms-and-vals))
    286          (lines
    287           (--map
    288            (-let* (((sym val) it)
    289                    (pretty-val
    290                     (helpful--pretty-print val)))
    291              (format "%s\n%s%s"
    292                      (propertize (symbol-name sym)
    293                                  'face 'font-lock-constant-face)
    294                      (helpful--indent-rigidly pretty-val 2)
    295                      (cond
    296                       ;; Also offer to disassemble byte-code
    297                       ;; properties.
    298                       ((byte-code-function-p val)
    299                        (format "\n  %s"
    300                                (helpful--make-disassemble-button val)))
    301                       ((eq sym 'ert--test)
    302                        (format "\n  %s"
    303                                (helpful--make-run-test-button symbol)))
    304                       (t
    305                        ""))))
    306            syms-and-vals)))
    307     (when lines
    308       (s-join "\n" lines))))
    309 
    310 (define-button-type 'helpful-forget-button
    311   'action #'helpful--forget
    312   'symbol nil
    313   'callable-p nil
    314   'follow-link t
    315   'help-echo "Unbind this function")
    316 
    317 ;; TODO: it would be nice to optionally delete the source code too.
    318 (defun helpful--forget (button)
    319   "Unbind the current symbol."
    320   (let* ((sym (button-get button 'symbol))
    321          (callable-p (button-get button 'callable-p))
    322          (kind (helpful--kind-name sym callable-p)))
    323     (when (yes-or-no-p (format "Forget %s %s?" kind sym))
    324       (if callable-p
    325           (fmakunbound sym)
    326         (makunbound sym))
    327       (message "Forgot %s %s." kind sym)
    328       (kill-buffer (current-buffer)))))
    329 
    330 (define-button-type 'helpful-c-source-directory
    331   'action #'helpful--c-source-directory
    332   'follow-link t
    333   'help-echo "Set directory to Emacs C source code")
    334 
    335 (defun helpful--c-source-directory (_button)
    336   "Set `find-function-C-source-directory' so we can show the
    337 source code to primitives."
    338   (let ((emacs-src-dir (read-directory-name "Path to Emacs source code: ")))
    339     ;; Let the user specify the source path with or without src/,
    340     ;; which is a subdirectory in the Emacs tree.
    341     (unless (equal (f-filename emacs-src-dir) "src")
    342       (setq emacs-src-dir (f-join emacs-src-dir "src")))
    343     (setq find-function-C-source-directory emacs-src-dir))
    344   (helpful-update))
    345 
    346 (define-button-type 'helpful-disassemble-button
    347   'action #'helpful--disassemble
    348   'follow-link t
    349   'object nil
    350   'help-echo "Show disassembled bytecode")
    351 
    352 (defun helpful--disassemble (button)
    353   "Disassemble the current symbol."
    354   ;; `disassemble' can handle both symbols (e.g. 'when) and raw
    355   ;; byte-code objects.
    356   (disassemble (button-get button 'object)))
    357 
    358 (define-button-type 'helpful-run-test-button
    359   'action #'helpful--run-test
    360   'follow-link t
    361   'symbol nil
    362   'help-echo "Run ERT test")
    363 
    364 (defun helpful--run-test (button)
    365   "Disassemble the current symbol."
    366   (ert (button-get button 'symbol)))
    367 
    368 (define-button-type 'helpful-edebug-button
    369   'action #'helpful--edebug
    370   'follow-link t
    371   'symbol nil
    372   'help-echo "Toggle edebug (re-evaluates definition)")
    373 
    374 (defun helpful--kbd-macro-p (sym)
    375   "Is SYM a keyboard macro?"
    376   (and (symbolp sym)
    377        (let ((func (symbol-function sym)))
    378          (or (stringp func)
    379              (vectorp func)))))
    380 
    381 (defun helpful--edebug-p (sym)
    382   "Does function SYM have its definition patched by edebug?"
    383   (let ((fn-def (indirect-function sym)))
    384     ;; Edebug replaces function source code with a sexp that has
    385     ;; `edebug-enter', `edebug-after' etc interleaved. This means the
    386     ;; function is interpreted, so `indirect-function' returns a list.
    387     (when (and (consp fn-def) (consp (cdr fn-def)))
    388       (-let [fn-end (-last-item fn-def)]
    389         (and (consp fn-end)
    390              (eq (car fn-end) 'edebug-enter))))))
    391 
    392 (defun helpful--can-edebug-p (sym callable-p buf pos)
    393   "Can we use edebug with SYM?"
    394   (and
    395    ;; SYM must be a function.
    396    callable-p
    397    ;; The function cannot be a primitive, it must be defined in elisp.
    398    (not (helpful--primitive-p sym callable-p))
    399    ;; We need to be able to find its definition, or we can't step
    400    ;; through the source.
    401    buf pos))
    402 
    403 (defun helpful--toggle-edebug (sym)
    404   "Enable edebug when function SYM is called,
    405 or disable if already enabled."
    406   (-let ((should-edebug (not (helpful--edebug-p sym)))
    407          ((buf pos created) (helpful--definition sym t)))
    408     (if (and buf pos)
    409         (progn
    410           (with-current-buffer buf
    411             (save-excursion
    412               (save-restriction
    413                 (widen)
    414                 (goto-char pos)
    415 
    416                 (let* ((edebug-all-forms should-edebug)
    417                        (edebug-all-defs should-edebug)
    418                        (form (edebug-read-top-level-form)))
    419                   ;; Based on `edebug-eval-defun'.
    420                   (eval (eval-sexp-add-defvars form) lexical-binding)))))
    421           ;; If we're enabling edebug, we need the source buffer to
    422           ;; exist. Otherwise, we can clean it up.
    423           (when (and created (not should-edebug))
    424             (kill-buffer buf)))
    425 
    426       (user-error "Could not find source for edebug"))))
    427 
    428 (defun helpful--edebug (button)
    429   "Toggle edebug for the current symbol."
    430   (helpful--toggle-edebug (button-get button 'symbol))
    431   (helpful-update))
    432 
    433 (define-button-type 'helpful-trace-button
    434   'action #'helpful--trace
    435   'follow-link t
    436   'symbol nil
    437   'help-echo "Toggle function tracing")
    438 
    439 (defun helpful--trace (button)
    440   "Toggle tracing for the current symbol."
    441   (let ((sym (button-get button 'symbol)))
    442     (if (trace-is-traced sym)
    443         (untrace-function sym)
    444       (trace-function sym)))
    445   (helpful-update))
    446 
    447 (define-button-type 'helpful-navigate-button
    448   'action #'helpful--navigate
    449   'path nil
    450   'position nil
    451   'follow-link t
    452   'help-echo "Navigate to definition")
    453 
    454 (defun helpful--goto-char-widen (pos)
    455   "Move point to POS in the current buffer.
    456 If narrowing is in effect, widen if POS isn't in the narrowed area."
    457   (when (or (< pos (point-min))
    458             (> pos (point-max)))
    459     (widen))
    460   (goto-char pos))
    461 
    462 (defun helpful--navigate (button)
    463   "Navigate to the path this BUTTON represents."
    464   (find-file (substring-no-properties (button-get button 'path)))
    465   ;; We use `get-text-property' to work around an Emacs 25 bug:
    466   ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=f7c4bad17d83297ee9a1b57552b1944020f23aea
    467   (-when-let (pos (get-text-property button 'position
    468                                      (marker-buffer button)))
    469     (helpful--goto-char-widen pos)))
    470 
    471 (defun helpful--navigate-button (text path &optional pos)
    472   "Return a button that opens PATH and puts point at POS."
    473   (helpful--button
    474    text
    475    'helpful-navigate-button
    476    'path path
    477    'position pos))
    478 
    479 (define-button-type 'helpful-buffer-button
    480   'action #'helpful--switch-to-buffer
    481   'buffer nil
    482   'position nil
    483   'follow-link t
    484   'help-echo "Switch to this buffer")
    485 
    486 (defun helpful--switch-to-buffer (button)
    487   "Navigate to the buffer this BUTTON represents."
    488   (let ((buf (button-get button 'buffer))
    489         (pos (button-get button 'position)))
    490     (switch-to-buffer buf)
    491     (when pos
    492       (helpful--goto-char-widen pos))))
    493 
    494 (defun helpful--buffer-button (buffer &optional pos)
    495   "Return a button that switches to BUFFER and puts point at POS."
    496   (helpful--button
    497    (buffer-name buffer)
    498    'helpful-buffer-button
    499    'buffer buffer
    500    'position pos))
    501 
    502 (define-button-type 'helpful-customize-button
    503   'action #'helpful--customize
    504   'symbol nil
    505   'follow-link t
    506   'help-echo "Open Customize for this symbol")
    507 
    508 (defun helpful--customize (button)
    509   "Open Customize for this symbol."
    510   (customize-variable (button-get button 'symbol)))
    511 
    512 (define-button-type 'helpful-associated-buffer-button
    513   'action #'helpful--associated-buffer
    514   'symbol nil
    515   'prompt-p nil
    516   'follow-link t
    517   'help-echo "Change associated buffer")
    518 
    519 (defun helpful--read-live-buffer (prompt predicate)
    520   "Read a live buffer name, and return the buffer object.
    521 
    522 This is largely equivalent to `read-buffer', but counsel.el
    523 overrides that to include previously opened buffers."
    524   (let* ((names (-map #'buffer-name (buffer-list)))
    525          (default
    526            (cond
    527             ;; If we're already looking at a buffer-local value, start
    528             ;; the prompt from the relevant buffer.
    529             ((and helpful--associated-buffer
    530                   (buffer-live-p helpful--associated-buffer))
    531              (buffer-name helpful--associated-buffer))
    532             ;; If we're looking at the global value, offer the initial
    533             ;; buffer.
    534             ((and helpful--start-buffer
    535                   (buffer-live-p helpful--start-buffer))
    536              (buffer-name helpful--start-buffer))
    537             ;; If we're looking at the global value and have no initial
    538             ;; buffer, choose the first normal buffer.
    539             (t
    540              (--first (and (not (s-starts-with-p " " it))
    541                            (not (s-starts-with-p "*" it)))
    542                       names))
    543             )))
    544     (get-buffer
    545      (completing-read
    546       prompt
    547       names
    548       predicate
    549       t
    550       nil
    551       nil
    552       default))))
    553 
    554 (defun helpful--associated-buffer (button)
    555   "Change the associated buffer, so we can see buffer-local values."
    556   (let ((sym (button-get button 'symbol))
    557         (prompt-p (button-get button 'prompt-p)))
    558     (if prompt-p
    559         (setq helpful--associated-buffer
    560               (helpful--read-live-buffer
    561                "View variable in: "
    562                (lambda (buf-name)
    563                  (local-variable-p sym (get-buffer buf-name)))))
    564       (setq helpful--associated-buffer nil)))
    565   (helpful-update))
    566 
    567 (define-button-type 'helpful-toggle-button
    568   'action #'helpful--toggle
    569   'symbol nil
    570   'buffer nil
    571   'follow-link t
    572   'help-echo "Toggle this symbol between t and nil")
    573 
    574 (defun helpful--toggle (button)
    575   "Toggle the symbol between nil and t."
    576   (let ((sym (button-get button 'symbol))
    577         (buf (button-get button 'buffer)))
    578     (save-current-buffer
    579       ;; If this is a buffer-local variable, ensure we're in the right
    580       ;; buffer.
    581       (when buf
    582         (set-buffer buf))
    583       (set sym (not (symbol-value sym))))
    584     (helpful-update)))
    585 
    586 (define-button-type 'helpful-set-button
    587   'action #'helpful--set
    588   'symbol nil
    589   'buffer nil
    590   'follow-link t
    591   'help-echo "Set the value of this symbol")
    592 
    593 (defun helpful--set (button)
    594   "Set the value of this symbol."
    595   (let* ((sym (button-get button 'symbol))
    596          (buf (button-get button 'buffer))
    597          (sym-value (helpful--sym-value sym buf))
    598          ;; Inspired by `counsel-read-setq-expression'.
    599          (expr
    600           (minibuffer-with-setup-hook
    601               (lambda ()
    602                 (add-function :before-until (local 'eldoc-documentation-function)
    603                               #'elisp-eldoc-documentation-function)
    604                 (run-hooks 'eval-expression-minibuffer-setup-hook)
    605                 (goto-char (minibuffer-prompt-end))
    606                 (forward-char (length (format "(setq %S " sym))))
    607             (read-from-minibuffer
    608              "Eval: "
    609              (format
    610               (if (or (consp sym-value)
    611                       (and (symbolp sym-value)
    612                            (not (null sym-value))
    613                            (not (keywordp sym-value))))
    614                   "(setq %s '%S)"
    615                 "(setq %s %S)")
    616               sym sym-value)
    617              read-expression-map t
    618              'read-expression-history))))
    619     (save-current-buffer
    620       ;; If this is a buffer-local variable, ensure we're in the right
    621       ;; buffer.
    622       (when buf
    623         (set-buffer buf))
    624       (eval-expression expr))
    625     (helpful-update)))
    626 
    627 (define-button-type 'helpful-view-literal-button
    628   'action #'helpful--view-literal
    629   'help-echo "Toggle viewing as a literal")
    630 
    631 (defun helpful--view-literal (_button)
    632   "Set the value of this symbol."
    633   (setq helpful--view-literal
    634         (not helpful--view-literal))
    635   (helpful-update))
    636 
    637 (define-button-type 'helpful-all-references-button
    638   'action #'helpful--all-references
    639   'symbol nil
    640   'callable-p nil
    641   'follow-link t
    642   'help-echo "Find all references to this symbol")
    643 
    644 (defun helpful--all-references (button)
    645   "Find all the references to the symbol that this BUTTON represents."
    646   (let ((sym (button-get button 'symbol))
    647         (callable-p (button-get button 'callable-p)))
    648     (cond
    649      ((not callable-p)
    650       (elisp-refs-variable sym))
    651      ((functionp sym)
    652       (elisp-refs-function sym))
    653      ((macrop sym)
    654       (elisp-refs-macro sym)))))
    655 
    656 (define-button-type 'helpful-callees-button
    657   'action #'helpful--show-callees
    658   'symbol nil
    659   'source nil
    660   'follow-link t
    661   'help-echo "Find the functions called by this function/macro")
    662 
    663 (defun helpful--display-callee-group (callees)
    664   "Insert every entry in CALLEES."
    665   (dolist (sym (helpful--sort-symbols callees))
    666     (insert "  "
    667             (helpful--button
    668              (symbol-name sym)
    669              'helpful-describe-exactly-button
    670              'symbol sym
    671              'callable-p t)
    672             "\n")))
    673 
    674 (defun helpful--show-callees (button)
    675   "Find all the references to the symbol that this BUTTON represents."
    676   (let* ((buf (get-buffer-create "*helpful callees*"))
    677          (sym (button-get button 'symbol))
    678          (raw-source (button-get button 'source))
    679          (source
    680           (if (stringp raw-source)
    681               (read raw-source)
    682             raw-source))
    683          (syms (helpful--callees source))
    684          (primitives (-filter (lambda (sym) (helpful--primitive-p sym t)) syms))
    685          (compounds (-remove (lambda (sym) (helpful--primitive-p sym t)) syms)))
    686 
    687     (pop-to-buffer buf)
    688     (let ((inhibit-read-only t))
    689       (erase-buffer)
    690 
    691       ;; TODO: Macros used, special forms used, global vars used.
    692       (insert (format "Functions called by %s:\n\n" sym))
    693       (helpful--display-callee-group compounds)
    694 
    695       (when primitives
    696         (insert "\n")
    697         (insert (format "Primitives called by %s:\n\n" sym))
    698         (helpful--display-callee-group primitives))
    699 
    700       (goto-char (point-min))
    701 
    702       (helpful-mode))))
    703 
    704 (define-button-type 'helpful-manual-button
    705   'action #'helpful--manual
    706   'symbol nil
    707   'follow-link t
    708   'help-echo "View this symbol in the Emacs manual")
    709 
    710 (defun helpful--manual (button)
    711   "Open the manual for the system that this BUTTON represents."
    712   (let ((sym (button-get button 'symbol)))
    713     (info-lookup 'symbol sym #'emacs-lisp-mode)))
    714 
    715 (define-button-type 'helpful-describe-button
    716   'action #'helpful--describe
    717   'symbol nil
    718   'follow-link t
    719   'help-echo "Describe this symbol")
    720 
    721 (defun helpful--describe (button)
    722   "Describe the symbol that this BUTTON represents."
    723   (let ((sym (button-get button 'symbol)))
    724     (helpful-symbol sym)))
    725 
    726 (define-button-type 'helpful-describe-exactly-button
    727   'action #'helpful--describe-exactly
    728   'symbol nil
    729   'callable-p nil
    730   'follow-link t
    731   'help-echo "Describe this symbol")
    732 
    733 (defun helpful--describe-exactly (button)
    734   "Describe the symbol that this BUTTON represents.
    735 This differs from `helpful--describe' because here we know
    736 whether the symbol represents a variable or a callable."
    737   (let ((sym (button-get button 'symbol))
    738         (callable-p (button-get button 'callable-p)))
    739     (if callable-p
    740         (helpful-callable sym)
    741       (helpful-variable sym))))
    742 
    743 (define-button-type 'helpful-info-button
    744   'action #'helpful--info
    745   'info-node nil
    746   'follow-link t
    747   'help-echo "View this Info node")
    748 
    749 (defun helpful--info (button)
    750   "Describe the symbol that this BUTTON represents."
    751   (info (button-get button 'info-node)))
    752 
    753 (defun helpful--split-first-line (docstring)
    754   "If the first line is a standalone sentence, ensure we have a
    755 blank line afterwards."
    756   (let* ((lines (s-lines docstring))
    757          (first-line (-first-item lines))
    758          (second-line (when (> (length lines) 1) (nth 1 lines))))
    759     (if (and (s-ends-with-p "." first-line)
    760              (stringp second-line)
    761              (not (equal second-line "")))
    762         (s-join "\n"
    763                 (-cons* first-line "" (cdr lines)))
    764       docstring)))
    765 
    766 (defun helpful--propertize-sym-ref (sym-name before-txt after-txt)
    767   "Given a symbol name from a docstring, convert to a button (if
    768 bound) or else highlight."
    769   (let* ((sym (intern sym-name)))
    770     (cond
    771      ;; Highlight keywords.
    772      ((s-matches-p
    773        (rx ":"
    774            symbol-start
    775            (+? (or (syntax word) (syntax symbol)))
    776            symbol-end)
    777        sym-name)
    778       (propertize sym-name
    779                   'face 'font-lock-builtin-face))
    780      ((and (boundp sym) (s-ends-with-p "variable " before-txt))
    781       (helpful--button
    782        sym-name
    783        'helpful-describe-exactly-button
    784        'symbol sym
    785        'callable-p nil))
    786      ((and (fboundp sym) (or
    787                           (s-starts-with-p " command" after-txt)
    788                           (s-ends-with-p "function " before-txt)))
    789       (helpful--button
    790        sym-name
    791        'helpful-describe-exactly-button
    792        'symbol sym
    793        'callable-p t))
    794      ;; Only create a link if this is a symbol that is bound as a
    795      ;; variable or callable.
    796      ((or (boundp sym) (fboundp sym))
    797       (helpful--button
    798        sym-name
    799        'helpful-describe-button
    800        'symbol sym))
    801      ;; If this is already a button, don't modify it.
    802      ((get-text-property 0 'button sym-name)
    803       sym-name)
    804      ;; Highlight the quoted string.
    805      (t
    806       (propertize sym-name
    807                   'face 'font-lock-constant-face)))))
    808 
    809 (defun helpful--propertize-info (docstring)
    810   "Convert info references in DOCSTRING to buttons."
    811   (replace-regexp-in-string
    812    ;; Replace all text that looks like a link to an Info page.
    813    (rx (seq (group
    814              bow
    815              (any "Ii")
    816              "nfo"
    817              (one-or-more whitespace))
    818             (group
    819              (or "node" "anchor")
    820              (one-or-more whitespace))
    821             (any "'`‘")
    822             (group
    823              (one-or-more
    824               (not (any "'’"))))
    825             (any "'’")))
    826    (lambda (it)
    827      ;; info-name matches "[Ii]nfo ".
    828      ;; space matches "node " or "anchor ".
    829      ;; info-node has the form "(cl)Loop Facility".
    830      (let ((info-name (match-string 1 it))
    831            (space (match-string 2 it))
    832            (info-node (match-string 3 it)))
    833        ;; If the docstring doesn't specify a manual, assume the Emacs manual.
    834        (save-match-data
    835          (unless (string-match "^([^)]+)" info-node)
    836            (setq info-node (concat "(emacs)" info-node))))
    837        (concat
    838         info-name
    839         space
    840         (helpful--button
    841          info-node
    842          'helpful-info-button
    843          'info-node info-node))))
    844    docstring
    845    t t))
    846 
    847 (defun helpful--keymap-keys (keymap)
    848   "Return all the keys and commands in KEYMAP.
    849 Flattens nested keymaps and follows remapped commands.
    850 
    851 Returns a list of pairs (KEYCODES COMMAND), where KEYCODES is a
    852 vector suitable for `key-description', and COMMAND is a smbol."
    853   (cond
    854    ;; Prefix keys.
    855    ((and
    856      (symbolp keymap)
    857      (fboundp keymap)
    858      ;; Prefix keys use a keymap in the function slot of a symbol.
    859      (keymapp (symbol-function keymap)))
    860     (helpful--keymap-keys (symbol-function keymap)))
    861    ;; Other symbols or compiled functions mean we've reached a leaf,
    862    ;; so this is a command we can call.
    863    ((or
    864      (symbolp keymap)
    865      (functionp keymap)
    866      ;; Strings or vectors mean a keyboard macro.
    867      (stringp keymap)
    868      (vectorp keymap))
    869     `(([] ,keymap)))
    870    ((stringp (car keymap))
    871     (helpful--keymap-keys (cdr keymap)))
    872    ;; Otherwise, recurse on the keys at this level of the keymap.
    873    (t
    874     (let (result)
    875       (dolist (item (cdr keymap))
    876         (cond
    877          ((and (consp item)
    878                (eq (car item) 'menu-bar))
    879           ;; Skip menu bar items.
    880           nil)
    881          ;; Sparse keymaps are lists.
    882          ((consp item)
    883           (-let [(keycode . value) item]
    884             (-each (helpful--keymap-keys value)
    885               (-lambda ((keycodes command))
    886                 (push (list (vconcat (vector keycode) keycodes) command)
    887                       result)))))
    888          ;; Dense keymaps are char-tables.
    889          ((char-table-p item)
    890           (map-char-table
    891            (lambda (keycode value)
    892              (-each (helpful--keymap-keys value)
    893                (-lambda ((keycodes command))
    894                  (push (list (vconcat (vector keycode) keycodes) command)
    895                        result))))
    896            item))))
    897       ;; For every command `new-func' mapped to a command `orig-func', show `new-func' with
    898       ;; the key sequence for `orig-func'.
    899       (setq result
    900             (-map-when
    901              (-lambda ((keycodes _))
    902                (and (> (length keycodes) 1)
    903                     (eq (elt keycodes 0) 'remap)))
    904              (-lambda ((keycodes command))
    905                (list
    906                 (where-is-internal (elt keycodes 1) global-map t)
    907                 command))
    908              result))
    909       ;; Preserve the original order of the keymap.
    910       (nreverse result)))))
    911 
    912 (defun helpful--format-hook (hook-val)
    913   "Given a list value assigned to a hook, format it with links to functions."
    914   (let ((lines
    915          (--map
    916           (if (and (symbolp it) (fboundp it))
    917               (helpful--button
    918                (symbol-name it)
    919                'helpful-describe-exactly-button
    920                'symbol it
    921                'callable-p t)
    922             (helpful--syntax-highlight (helpful--pretty-print it)))
    923           hook-val)))
    924     (format "(%s)"
    925             (s-join "\n " lines))))
    926 
    927 ;; TODO: unlike `substitute-command-keys', this shows keybindings
    928 ;; which are currently shadowed (e.g. a global minor mode map).
    929 (defun helpful--format-keymap (keymap)
    930   "Format KEYMAP."
    931   (let* ((keys-and-commands (helpful--keymap-keys keymap))
    932          ;; Convert keycodes [27 i] to "C-M-i".
    933          (keys (-map #'-first-item keys-and-commands))
    934          ;; Add padding so all our strings are the same length.
    935          (formatted-keys (-map #'key-description keys))
    936          (max-formatted-length (-max (cons 0 (-map #'length formatted-keys))))
    937          (aligned-keys (--map (s-pad-right (1+ max-formatted-length)
    938                                            " " it)
    939                               formatted-keys))
    940          ;; Format commands as buttons.
    941          (commands (-map (-lambda ((_ command)) command)
    942                          keys-and-commands))
    943          (formatted-commands
    944           (--map
    945            (cond
    946             ((symbolp it)
    947              (helpful--button
    948               (symbol-name it)
    949               'helpful-describe-button
    950               'symbol it))
    951             ((or (stringp it) (vectorp it))
    952              "Keyboard Macro")
    953             (t
    954              "#<anonymous-function>"))
    955            commands))
    956          ;; Build lines for display.
    957          (lines
    958           (-map (-lambda ((key . command)) (format "%s %s" key command))
    959                 (-zip-pair aligned-keys formatted-commands))))
    960     ;; The flattened keymap will have normal bindings first, and
    961     ;; inherited bindings last. Sort so that we group by prefix.
    962     (s-join "\n" (-sort #'string< lines))))
    963 
    964 (defun helpful--format-commands (str keymap)
    965   "Replace all the \\[ references in STR with buttons."
    966   (replace-regexp-in-string
    967    ;; Text of the form \\[foo-command]
    968    (rx "\\[" (group (+ (not (in "]")))) "]")
    969    (lambda (it)
    970      (let* ((symbol-name (match-string 1 it))
    971             (symbol (intern symbol-name))
    972             (key (where-is-internal symbol keymap t))
    973             (key-description
    974              (if key
    975                  (key-description key)
    976                (format "M-x %s" symbol-name))))
    977        (helpful--button
    978         key-description
    979         'helpful-describe-exactly-button
    980         'symbol symbol
    981         'callable-p t)))
    982    str
    983    t
    984    t))
    985 
    986 (defun helpful--chars-before (pos n)
    987   "Return up to N chars before POS in the current buffer.
    988 The string may be shorter than N or empty if out-of-range."
    989   (buffer-substring
    990    (max (point-min) (- pos n))
    991    pos))
    992 
    993 (defun helpful--chars-after (pos n)
    994   "Return up to N chars after POS in the current buffer.
    995 The string may be shorter than N or empty if out-of-range."
    996   (buffer-substring
    997    pos
    998    (min (point-max) (+ pos n))))
    999 
   1000 (defun helpful--format-command-keys (docstring)
   1001   "Convert command key references and keymap references
   1002 in DOCSTRING to buttons.
   1003 
   1004 Emacs uses \\= to escape \\[ references, so replace that
   1005 unescaping too."
   1006   ;; Loosely based on `substitute-command-keys', but converts
   1007   ;; references to buttons.
   1008   (let ((keymap nil))
   1009     (with-temp-buffer
   1010       (insert docstring)
   1011       (goto-char (point-min))
   1012       (while (not (eobp))
   1013         (cond
   1014          ((looking-at
   1015            ;; Text of the form "foo"
   1016            (rx "\""))
   1017           ;; For literal strings, escape backslashes so our output
   1018           ;; shows copy-pasteable literals.
   1019           (let* ((start-pos (point))
   1020                  (end-pos (progn (forward-char) (search-forward "\"" nil t)))
   1021                  contents)
   1022             (if end-pos
   1023                 (progn
   1024                   (setq contents (buffer-substring start-pos end-pos))
   1025                   (delete-region start-pos end-pos)
   1026                   (insert (s-replace "\\" "\\\\" contents)))
   1027               (forward-char 1))))
   1028          ((looking-at
   1029            ;; Text of the form \=X
   1030            (rx "\\="))
   1031           ;; Remove the escaping, then step over the escaped char.
   1032           ;; Step over the escaped character.
   1033           (delete-region (point) (+ (point) 2))
   1034           (forward-char 1))
   1035          ((looking-at
   1036            ;; Text of the form `foo'
   1037            (rx "`"))
   1038           (let* ((start-pos (point))
   1039                  (end-pos (search-forward "'" nil t))
   1040                  (contents
   1041                   (when end-pos
   1042                     (buffer-substring (1+ start-pos) (1- end-pos)))))
   1043             (cond
   1044              ((null contents)
   1045               ;; If there's no closing ' to match the opening `, just
   1046               ;; leave it.
   1047               (goto-char (1+ start-pos)))
   1048              ((s-contains-p "`" contents)
   1049               ;; If we have repeated backticks `foo `bar', leave the
   1050               ;; first one.
   1051               (goto-char (1+ start-pos)))
   1052              ((s-contains-p "\\[" contents)
   1053               (delete-region start-pos end-pos)
   1054               (insert (helpful--format-commands contents keymap)))
   1055              ;; Highlight a normal `foo', extracting the surrounding
   1056              ;; text so we can detect e.g. "function `foo'".
   1057              (t
   1058               (let ((before (helpful--chars-before start-pos 10))
   1059                     (after (helpful--chars-after end-pos 10)))
   1060                 (delete-region start-pos end-pos)
   1061                 (insert (helpful--propertize-sym-ref contents before after)))))))
   1062          ((looking-at
   1063            ;; Text of the form \\<foo-keymap>
   1064            (rx "\\<" (group (+ (not (in ">")))) ">"
   1065                (? "\n")))
   1066           (let* ((symbol-with-parens (match-string 0))
   1067                  (symbol-name (match-string 1)))
   1068             ;; Remove the original string.
   1069             (delete-region (point)
   1070                            (+ (point) (length symbol-with-parens)))
   1071             ;; Set the new keymap.
   1072             (setq keymap (symbol-value (intern symbol-name)))))
   1073          ((looking-at
   1074            ;; Text of the form \\{foo-mode-map}
   1075            (rx "\\{" (group (+ (not (in "}")))) "}"))
   1076           (let* ((symbol-with-parens (match-string 0))
   1077                  (symbol-name (match-string 1))
   1078                  (keymap
   1079                   ;; Gracefully handle variables not being defined.
   1080                   (ignore-errors
   1081                     (symbol-value (intern symbol-name)))))
   1082             ;; Remove the original string.
   1083             (delete-region (point)
   1084                            (+ (point) (length symbol-with-parens)))
   1085             (if keymap
   1086                 (insert (helpful--format-keymap keymap))
   1087               (insert (format "Keymap %s is not currently defined."
   1088                               symbol-name)))))
   1089          ((looking-at
   1090            ;; Text of the form \\[foo-command]
   1091            (rx "\\[" (group (+ (not (in "]")))) "]"))
   1092           (let* ((symbol-with-parens (match-string 0)))
   1093             ;; Remove the original string.
   1094             (delete-region (point)
   1095                            (+ (point) (length symbol-with-parens)))
   1096             ;; Add a button.
   1097             (insert (helpful--format-commands symbol-with-parens keymap))))
   1098          ;; Don't modify other characters.
   1099          (t
   1100           (forward-char 1))))
   1101       (buffer-string))))
   1102 
   1103 ;; TODO: fix upstream Emacs bug that means `-map' is not highlighted
   1104 ;; in the docstring for `--map'.
   1105 (defun helpful--format-docstring (docstring)
   1106   "Replace cross-references with links in DOCSTRING."
   1107   (-> docstring
   1108       (helpful--split-first-line)
   1109       (helpful--propertize-info)
   1110       (helpful--propertize-links)
   1111       (helpful--propertize-bare-links)
   1112       (helpful--format-command-keys)
   1113       (s-trim)))
   1114 
   1115 (define-button-type 'helpful-link-button
   1116   'action #'helpful--follow-link
   1117   'follow-link t
   1118   'help-echo "Follow this link")
   1119 
   1120 (defun helpful--propertize-links (docstring)
   1121   "Convert URL links in docstrings to buttons."
   1122   (replace-regexp-in-string
   1123    (rx "URL `" (group (*? any)) "'")
   1124    (lambda (match)
   1125      (let ((url (match-string 1 match)))
   1126        (concat "URL "
   1127                (helpful--button
   1128                 url
   1129                 'helpful-link-button
   1130                 'url url))))
   1131    docstring))
   1132 
   1133 (defun helpful--propertize-bare-links (docstring)
   1134   "Convert URL links in docstrings to buttons."
   1135   (replace-regexp-in-string
   1136    (rx (group (or string-start space "<"))
   1137        (group "http" (? "s") "://" (+? (not (any space))))
   1138        (group (? (any "." ">" ")"))
   1139               (or space string-end ">")))
   1140    (lambda (match)
   1141      (let ((space-before (match-string 1 match))
   1142            (url (match-string 2 match))
   1143            (after (match-string 3 match)))
   1144        (concat
   1145         space-before
   1146         (helpful--button
   1147          url
   1148          'helpful-link-button
   1149          'url url)
   1150         after)))
   1151    docstring))
   1152 
   1153 (defun helpful--follow-link (button)
   1154   "Follow the URL specified by BUTTON."
   1155   (browse-url (button-get button 'url)))
   1156 
   1157 (defconst helpful--highlighting-funcs
   1158   '(ert--activate-font-lock-keywords
   1159     highlight-quoted-mode
   1160     rainbow-delimiters-mode)
   1161   "Highlighting functions that are safe to run in a temporary buffer.
   1162 This is used in `helpful--syntax-highlight' to support extra
   1163 highlighting that the user may have configured in their mode
   1164 hooks.")
   1165 
   1166 ;; TODO: crashes on `backtrace-frame' on a recent checkout.
   1167 
   1168 (defun helpful--syntax-highlight (source &optional mode)
   1169   "Return a propertized version of SOURCE in MODE."
   1170   (unless mode
   1171     (setq mode #'emacs-lisp-mode))
   1172   (if (or
   1173        (< (length source) helpful-max-highlight)
   1174        (eq mode 'emacs-lisp-mode))
   1175       (with-temp-buffer
   1176         (insert source)
   1177 
   1178         ;; Switch to major-mode MODE, but don't run any hooks.
   1179         (delay-mode-hooks (funcall mode))
   1180 
   1181         ;; `delayed-mode-hooks' contains mode hooks like
   1182         ;; `emacs-lisp-mode-hook'. Build a list of functions that are run
   1183         ;; when the mode hooks run.
   1184         (let (hook-funcs)
   1185           (dolist (hook delayed-mode-hooks)
   1186             (let ((funcs (symbol-value hook)))
   1187               (setq hook-funcs (append hook-funcs funcs))))
   1188 
   1189           ;; Filter hooks to those that relate to highlighting, and run them.
   1190           (setq hook-funcs (-intersection hook-funcs helpful--highlighting-funcs))
   1191           (-map #'funcall hook-funcs))
   1192 
   1193         (if (fboundp 'font-lock-ensure)
   1194             (font-lock-ensure)
   1195           (with-no-warnings
   1196             (font-lock-fontify-buffer)))
   1197         (buffer-string))
   1198     ;; SOURCE was too long to highlight in a reasonable amount of
   1199     ;; time.
   1200     (concat
   1201      (propertize
   1202       "// Skipping highlighting due to "
   1203       'face 'font-lock-comment-face)
   1204      (helpful--button
   1205       "helpful-max-highlight"
   1206       'helpful-describe-exactly-button
   1207       'symbol 'helpful-max-highlight
   1208       'callable-p nil)
   1209      (propertize
   1210       ".\n"
   1211       'face 'font-lock-comment-face)
   1212      source)))
   1213 
   1214 (defun helpful--source (sym callable-p buf pos)
   1215   "Return the source code of SYM.
   1216 If the source code cannot be found, return the sexp used."
   1217   (catch 'source
   1218     (unless (symbolp sym)
   1219       (throw 'source sym))
   1220 
   1221     (let ((source nil))
   1222       (when (and buf pos)
   1223         (with-current-buffer buf
   1224           (save-excursion
   1225             (save-restriction
   1226               (goto-char pos)
   1227 
   1228               (if (and (helpful--primitive-p sym callable-p)
   1229                        (not callable-p))
   1230                   ;; For variables defined in .c files, only show the
   1231                   ;; DEFVAR expression rather than the huge containing
   1232                   ;; function.
   1233                   (progn
   1234                     (setq pos (line-beginning-position))
   1235                     (forward-list)
   1236                     (forward-char)
   1237                     (narrow-to-region pos (point)))
   1238                 ;; Narrow to the top-level definition.
   1239                 (narrow-to-defun t))
   1240 
   1241               ;; If there was a preceding comment, POS will be
   1242               ;; after that comment. Move the position to include that comment.
   1243               (setq pos (point-min))
   1244 
   1245               (setq source (buffer-substring-no-properties (point-min) (point-max))))))
   1246         (setq source (s-trim-right source))
   1247         (when (and source (buffer-file-name buf))
   1248           (setq source (propertize source
   1249                                    'helpful-path (buffer-file-name buf)
   1250                                    'helpful-pos pos
   1251                                    'helpful-pos-is-start t)))
   1252         (throw 'source source)))
   1253 
   1254     (when callable-p
   1255       ;; Could not find source -- probably defined interactively, or via
   1256       ;; a macro, or file has changed.
   1257       ;; TODO: verify that the source hasn't changed before showing.
   1258       ;; TODO: offer to download C sources for current version.
   1259       (throw 'source (indirect-function sym)))))
   1260 
   1261 (defun helpful--in-manual-p (sym)
   1262   "Return non-nil if SYM is in an Info manual."
   1263   (let ((completions
   1264          (cl-letf (((symbol-function #'message)
   1265                     (lambda (_format-string &rest _args))))
   1266            (info-lookup->completions 'symbol 'emacs-lisp-mode))))
   1267     (-when-let (buf (get-buffer " temp-info-look"))
   1268       (kill-buffer buf))
   1269     (or (assoc sym completions)
   1270         (assoc-string sym completions))))
   1271 
   1272 (defun helpful--version-info (sym)
   1273   "If SYM has version information, format and return it.
   1274 Return nil otherwise."
   1275   (when (symbolp sym)
   1276     (let ((package-version
   1277            (get sym 'custom-package-version))
   1278           (emacs-version
   1279            (get sym 'custom-version)))
   1280       (cond
   1281        (package-version
   1282         (format
   1283          "This variable was added, or its default value changed, in %s version %s."
   1284          (car package-version)
   1285          (cdr package-version)))
   1286        (emacs-version
   1287         (format
   1288          "This variable was added, or its default value changed, in Emacs %s."
   1289          emacs-version))))))
   1290 
   1291 (defun helpful--library-path (library-name)
   1292   "Find the absolute path for the source of LIBRARY-NAME.
   1293 
   1294 LIBRARY-NAME takes the form \"foo.el\" , \"foo.el\" or
   1295 \"src/foo.c\".
   1296 
   1297 If .elc files exist without the corresponding .el, return nil."
   1298   (when (member (f-ext library-name) '("c" "rs"))
   1299     (setq library-name
   1300           (f-expand library-name
   1301                     (f-parent find-function-C-source-directory))))
   1302   (condition-case nil
   1303       (find-library-name library-name)
   1304     (error nil)))
   1305 
   1306 (defun helpful--macroexpand-try (form)
   1307   "Try to fully macroexpand FORM.
   1308 If it fails, attempt to partially macroexpand FORM."
   1309   (catch 'result
   1310     (ignore-errors
   1311       ;; Happy path: we can fully expand the form.
   1312       (throw 'result (macroexpand-all form)))
   1313     (ignore-errors
   1314       ;; Attempt one level of macroexpansion.
   1315       (throw 'result (macroexpand-1 form)))
   1316     ;; Fallback: just return the original form.
   1317     form))
   1318 
   1319 (defun helpful--tree-any-p (pred tree)
   1320   "Walk TREE, applying PRED to every subtree.
   1321 Return t if PRED ever returns t."
   1322   (catch 'found
   1323     (let ((stack (list tree)))
   1324       (while stack
   1325         (let ((next (pop stack)))
   1326           (cond
   1327            ((funcall pred next)
   1328             (throw 'found t))
   1329            ((consp next)
   1330             (push (car next) stack)
   1331             (push (cdr next) stack))))))
   1332     nil))
   1333 
   1334 (defun helpful--find-by-macroexpanding (buf sym callable-p)
   1335   "Search BUF for the definition of SYM by macroexpanding
   1336 interesting forms in BUF."
   1337   (catch 'found
   1338     (with-current-buffer buf
   1339       (save-excursion
   1340         (goto-char (point-min))
   1341         (condition-case nil
   1342             (while t
   1343               (let ((form (read (current-buffer)))
   1344                     (var-def-p
   1345                      (lambda (sexp)
   1346                        (and (eq (car-safe sexp) 'defvar)
   1347                             (eq (car-safe (cdr sexp)) sym))))
   1348                     (fn-def-p
   1349                      (lambda (sexp)
   1350                        ;; `defun' ultimately expands to `defalias'.
   1351                        (and (eq (car-safe sexp) 'defalias)
   1352                             (equal (car-safe (cdr sexp)) `(quote ,sym))))))
   1353                 (setq form (helpful--macroexpand-try form))
   1354 
   1355                 (when (helpful--tree-any-p
   1356                        (if callable-p fn-def-p var-def-p)
   1357                        form)
   1358                   ;; `read' puts point at the end of the form, so go
   1359                   ;; back to the start.
   1360                   (throw 'found (scan-sexps (point) -1)))))
   1361           (end-of-file nil))))))
   1362 
   1363 (defun helpful--definition (sym callable-p)
   1364   "Return a list (BUF POS OPENED) where SYM is defined.
   1365 
   1366 BUF is the buffer containing the definition. If the user wasn't
   1367 already visiting this buffer, OPENED is t and callers should kill
   1368 the buffer when done.
   1369 
   1370 POS is the position of the start of the definition within the
   1371 buffer."
   1372   (let ((initial-buffers (buffer-list))
   1373         (primitive-p (helpful--primitive-p sym callable-p))
   1374         (library-name nil)
   1375         (buf nil)
   1376         (pos nil)
   1377         (opened nil)
   1378         ;; Skip running hooks that may prompt the user.
   1379         (find-file-hook nil)
   1380         (after-change-major-mode-hook nil)
   1381         ;; If we end up opening a buffer, don't bother with file
   1382         ;; variables. It prompts the user, and we discard the buffer
   1383         ;; afterwards anyway.
   1384         (enable-local-variables nil))
   1385     ;; We shouldn't be called on primitive functions if we don't have
   1386     ;; a directory of Emacs C sourcecode.
   1387     (cl-assert
   1388      (or find-function-C-source-directory
   1389          (not primitive-p)))
   1390 
   1391     (when (and (symbolp sym) callable-p)
   1392       (setq library-name (cdr (find-function-library sym))))
   1393 
   1394     (cond
   1395      ((and (not (symbolp sym)) (functionp sym))
   1396       (list nil nil nil))
   1397      ((and callable-p library-name)
   1398       (-when-let (src-path (helpful--library-path library-name))
   1399         ;; Opening large .c files can be slow (e.g. when looking at
   1400         ;; `defalias'), especially if the user has configured mode hooks.
   1401         ;;
   1402         ;; Bind `auto-mode-alist' to nil, so we open the buffer in
   1403         ;; `fundamental-mode' if it isn't already open.
   1404         (let ((auto-mode-alist nil))
   1405           ;; Open `src-path' ourselves, so we can widen before searching.
   1406           (setq buf (find-file-noselect src-path)))
   1407 
   1408         (unless (-contains-p initial-buffers buf)
   1409           (setq opened t))
   1410 
   1411         ;; If it's a freshly opened buffer, we need to switch to the
   1412         ;; correct mode so we can search correctly. Enable the mode, but
   1413         ;; don't bother with mode hooks, because we just need the syntax
   1414         ;; table for searching.
   1415         (when opened
   1416           (with-current-buffer buf
   1417             (delay-mode-hooks (normal-mode t))))
   1418 
   1419         ;; Based on `find-function-noselect'.
   1420         (with-current-buffer buf
   1421           ;; `find-function-search-for-symbol' moves point. Prevent
   1422           ;; that.
   1423           (save-excursion
   1424             ;; Narrowing has been fixed upstream:
   1425             ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=abd18254aec76b26e86ae27e91d2c916ec20cc46
   1426             (save-restriction
   1427               (widen)
   1428               (setq pos
   1429                     (cdr (find-function-search-for-symbol sym nil library-name))))))
   1430         ;; If we found the containing buffer, but not the symbol, attempt
   1431         ;; to find it by macroexpanding interesting forms.
   1432         (when (and buf (not pos))
   1433           (setq pos (helpful--find-by-macroexpanding buf sym t)))))
   1434      ;; A function, but no file found.
   1435      (callable-p
   1436       ;; Functions defined interactively may have an edebug property
   1437       ;; that contains the location of the definition.
   1438       (-when-let (edebug-info (get sym 'edebug))
   1439         (-let [marker (if (consp edebug-info)
   1440                           (car edebug-info)
   1441                         edebug-info)]
   1442           (setq buf (marker-buffer marker))
   1443           (setq pos (marker-position marker)))))
   1444      ((not callable-p)
   1445       (condition-case _err
   1446           (-let [(sym-buf . sym-pos) (find-definition-noselect sym 'defvar)]
   1447             (setq buf sym-buf)
   1448             (unless (-contains-p initial-buffers buf)
   1449               (setq opened t))
   1450             (setq pos sym-pos))
   1451         (search-failed nil)
   1452         ;; If your current Emacs instance doesn't match the source
   1453         ;; code configured in find-function-C-source-directory, we can
   1454         ;; get an error about not finding source. Try
   1455         ;; `default-tab-width' against Emacs trunk.
   1456         (error nil))))
   1457     (list buf pos opened)))
   1458 
   1459 (defun helpful--reference-positions (sym callable-p buf)
   1460   "Return all the buffer positions of references to SYM in BUF."
   1461   (-let* ((forms-and-bufs
   1462            (elisp-refs--search-1
   1463             (list buf)
   1464             (lambda (buf)
   1465               (elisp-refs--read-and-find
   1466                buf sym
   1467                (if callable-p
   1468                    #'elisp-refs--function-p
   1469                  #'elisp-refs--variable-p)))))
   1470           ;; Since we only searched one buffer, we know that
   1471           ;; forms-and-bufs has only one item.
   1472           (forms-and-buf (-first-item forms-and-bufs))
   1473           ((forms . _buf) forms-and-buf))
   1474     (-map
   1475      (-lambda ((_code start-pos _end-pos)) start-pos)
   1476      forms)))
   1477 
   1478 (defun helpful--all-keymap-syms ()
   1479   "Return all keymaps defined in this Emacs instance."
   1480   (let (keymaps)
   1481     (mapatoms
   1482      (lambda (sym)
   1483        (when (and (boundp sym) (keymapp (symbol-value sym)))
   1484          (push sym keymaps))))
   1485     keymaps))
   1486 
   1487 (defun helpful--key-sequences (command-sym keymap global-keycodes)
   1488   "Return all the key sequences of COMMAND-SYM in KEYMAP."
   1489   (let* ((keycodes
   1490           ;; Look up this command in the keymap, its parent and the
   1491           ;; global map. We need to include the global map to find
   1492           ;; remapped commands.
   1493           (where-is-internal command-sym keymap nil t))
   1494          ;; Look up this command in the parent keymap.
   1495          (parent-keymap (keymap-parent keymap))
   1496          (parent-keycodes
   1497           (when parent-keymap
   1498             (where-is-internal
   1499              command-sym (list parent-keymap) nil t)))
   1500          ;; Look up this command in the global map.
   1501          (global-keycodes
   1502           (unless (eq keymap global-map)
   1503             global-keycodes)))
   1504     (->> keycodes
   1505          ;; Ignore keybindings from the parent or global map.
   1506          (--remove (or (-contains-p global-keycodes it)
   1507                        (-contains-p parent-keycodes it)))
   1508          ;; Convert raw keycode vectors into human-readable strings.
   1509          (-map #'key-description))))
   1510 
   1511 (defun helpful--keymaps-containing (command-sym)
   1512   "Return a list of pairs listing keymap names that contain COMMAND-SYM,
   1513 along with the keybindings in each keymap.
   1514 
   1515 Keymap names are typically variable names, but may also be
   1516 descriptions of values in `minor-mode-map-alist'.
   1517 
   1518 We ignore keybindings that are menu items, and ignore keybindings
   1519 from parent keymaps.
   1520 
   1521 `widget-global-map' is also ignored as it generally contains the
   1522 same bindings as `global-map'."
   1523   (let* ((keymap-syms (helpful--all-keymap-syms))
   1524          (keymap-sym-vals (-map #'symbol-value keymap-syms))
   1525          (global-keycodes (where-is-internal
   1526                            command-sym (list global-map) nil t))
   1527          matching-keymaps)
   1528     ;; Look for this command in all keymaps bound to variables.
   1529     (-map
   1530      (-lambda ((keymap-sym . keymap))
   1531        (let ((key-sequences (helpful--key-sequences command-sym keymap global-keycodes)))
   1532          (when (and key-sequences (not (eq keymap-sym 'widget-global-map)))
   1533            (push (cons (symbol-name keymap-sym) key-sequences)
   1534                  matching-keymaps))))
   1535      (-zip keymap-syms keymap-sym-vals))
   1536 
   1537     ;; Look for this command in keymaps used by minor modes that
   1538     ;; aren't bound to variables.
   1539     (-map
   1540      (-lambda ((minor-mode . keymap))
   1541        ;; Only consider this keymap if we didn't find it bound to a variable.
   1542        (when (and (keymapp keymap)
   1543                   (not (memq keymap keymap-sym-vals)))
   1544          (let ((key-sequences (helpful--key-sequences command-sym keymap global-keycodes)))
   1545            (when key-sequences
   1546              (push (cons (format "minor-mode-map-alist (%s)" minor-mode)
   1547                          key-sequences)
   1548                    matching-keymaps)))))
   1549      ;; TODO: examine `minor-mode-overriding-map-alist' too.
   1550      minor-mode-map-alist)
   1551 
   1552     matching-keymaps))
   1553 
   1554 (defun helpful--merge-alists (l1 l2)
   1555   "Given two alists mapping symbols to lists, return a single
   1556 alist with the lists concatenated."
   1557   (let* ((l1-keys (-map #'-first-item l1))
   1558          (l2-keys (-map #'-first-item l2))
   1559          (l2-extra-keys (-difference l2-keys l1-keys))
   1560          (l2-extra-values
   1561           (--map (assoc it l2) l2-extra-keys))
   1562          (l1-with-values
   1563           (-map (-lambda ((key . values))
   1564                   (cons key (append values
   1565                                     (cdr (assoc key l2)))))
   1566                 l1)))
   1567     (append l1-with-values l2-extra-values)))
   1568 
   1569 (defun helpful--keymaps-containing-aliases (command-sym aliases)
   1570   "Return a list of pairs mapping keymap symbols to the
   1571 keybindings for COMMAND-SYM in each keymap.
   1572 
   1573 Includes keybindings for aliases, unlike
   1574 `helpful--keymaps-containing'."
   1575   (let* ((syms (cons command-sym aliases))
   1576          (syms-keymaps (-map #'helpful--keymaps-containing syms)))
   1577     (-reduce #'helpful--merge-alists syms-keymaps)))
   1578 
   1579 (defun helpful--format-keys (command-sym aliases)
   1580   "Describe all the keys that call COMMAND-SYM."
   1581   (let (mode-lines
   1582         global-lines)
   1583     (--each (helpful--keymaps-containing-aliases command-sym aliases)
   1584       (-let [(map . keys) it]
   1585         (dolist (key keys)
   1586           (push
   1587            (format "%s %s"
   1588                    (propertize map 'face 'font-lock-variable-name-face)
   1589                    key)
   1590            (if (eq map 'global-map) global-lines mode-lines)))))
   1591     (setq global-lines (-sort #'string< global-lines))
   1592     (setq mode-lines (-sort #'string< mode-lines))
   1593     (-let [lines (-concat global-lines mode-lines)]
   1594       (if lines
   1595           (s-join "\n" lines)
   1596         "This command is not in any keymaps."))))
   1597 
   1598 (defun helpful--outer-sexp (buf pos)
   1599   "Find position POS in BUF, and return the name of the outer sexp,
   1600 along with its position.
   1601 
   1602 Moves point in BUF."
   1603   (with-current-buffer buf
   1604     (goto-char pos)
   1605     (let* ((ppss (syntax-ppss))
   1606            (outer-sexp-posns (nth 9 ppss)))
   1607       (when outer-sexp-posns
   1608         (goto-char (car outer-sexp-posns))))
   1609     (list (point) (-take 2 (read buf)))))
   1610 
   1611 (defun helpful--count-values (items)
   1612   "Return an alist of the count of each value in ITEMS.
   1613 E.g. (x x y z y) -> ((x . 2) (y . 2) (z . 1))"
   1614   (let (counts)
   1615     (dolist (item items (nreverse counts))
   1616       (-if-let (item-and-count (assoc item counts))
   1617           (setcdr item-and-count (1+ (cdr item-and-count)))
   1618         (push (cons item 1) counts)))))
   1619 
   1620 (defun helpful--without-advice (sym)
   1621   "Given advised function SYM, return the function object
   1622 without the advice. Assumes function has been loaded."
   1623   (advice--cd*r
   1624    (advice--symbol-function sym)))
   1625 
   1626 (defun helpful--advised-p (sym)
   1627   "Does SYM have advice associated with it?"
   1628   (and (symbolp sym)
   1629        (advice--p (advice--symbol-function sym))))
   1630 
   1631 (defun helpful--format-head (head)
   1632   "Given a 'head' (the first two symbols of a sexp) format and
   1633 syntax highlight it."
   1634   (-let* (((def name) head)
   1635           (formatted-name
   1636            (if (and (consp name) (eq (car name) 'quote))
   1637                (format "'%S" (cadr name))
   1638              (format "%S" name)))
   1639           (formatted-def
   1640            (format "(%s %s ...)" def formatted-name))
   1641           )
   1642     (helpful--syntax-highlight formatted-def)))
   1643 
   1644 (defun helpful--format-reference (head longest-head ref-count position path)
   1645   "Return a syntax-highlighted version of HEAD, with a link
   1646 to its source location."
   1647   (let ((formatted-count
   1648          (format "%d reference%s"
   1649                  ref-count (if (> ref-count 1) "s" ""))))
   1650     (propertize
   1651      (format
   1652       "%s %s"
   1653       (s-pad-right longest-head " " (helpful--format-head head))
   1654       (propertize formatted-count 'face 'font-lock-comment-face))
   1655      'helpful-path path
   1656      'helpful-pos position)))
   1657 
   1658 (defun helpful--format-position-heads (position-heads path)
   1659   "Given a list of outer sexps, format them for display.
   1660 POSITION-HEADS takes the form ((123 (defun foo)) (456 (defun bar)))."
   1661   (let ((longest-head
   1662          (->> position-heads
   1663               (-map (-lambda ((_pos head)) (helpful--format-head head)))
   1664               (-map #'length)
   1665               (-max))))
   1666     (->> (helpful--count-values position-heads)
   1667          (-map (-lambda (((pos head) . count))
   1668                  (helpful--format-reference head longest-head count pos path)))
   1669          (s-join "\n"))))
   1670 
   1671 (defun helpful--primitive-p (sym callable-p)
   1672   "Return t if SYM is defined in C."
   1673   (cond
   1674    ((and callable-p (helpful--advised-p sym))
   1675     (subrp (helpful--without-advice sym)))
   1676    (callable-p
   1677     (and (not (and (fboundp 'subr-native-elisp-p)
   1678                    (subr-native-elisp-p (indirect-function sym))))
   1679          (subrp (indirect-function sym))))
   1680    (t
   1681     (let ((filename (find-lisp-object-file-name sym 'defvar)))
   1682       (or (eq filename 'C-source)
   1683           (and (stringp filename)
   1684                (let ((ext (file-name-extension filename)))
   1685                  (or (equal ext "c")
   1686                      (equal ext "rs")))))))))
   1687 
   1688 (defun helpful--sym-value (sym buf)
   1689   "Return the value of SYM in BUF."
   1690   (cond
   1691    ;; If we're given a buffer, look up the variable in that buffer.
   1692    (buf
   1693     (with-current-buffer buf
   1694       (symbol-value sym)))
   1695    ;; If we don't have a buffer, and this is a buffer-local variable,
   1696    ;; ensure we return the default value.
   1697    ((local-variable-if-set-p sym)
   1698     (default-value sym))
   1699    ;; Otherwise, just return the value in the current buffer, which is
   1700    ;; the global value.
   1701    (t
   1702     (symbol-value sym))))
   1703 
   1704 (defun helpful--insert-section-break ()
   1705   "Insert section break into helpful buffer."
   1706   (insert "\n\n"))
   1707 
   1708 (defun helpful--insert-implementations ()
   1709   "When `helpful--sym' is a generic method, insert its implementations."
   1710   (let ((func helpful--sym)
   1711         (content))
   1712     (when (fboundp #'cl--generic-describe)
   1713       (with-temp-buffer
   1714         (declare-function cl--generic-describe "cl-generic" (function))
   1715         (cl--generic-describe func)
   1716         (setf (point) (point-min))
   1717         (when (re-search-forward "^Implementations:$" nil t)
   1718           (setq content (buffer-substring (point) (point-max)))))
   1719       (when content
   1720         (helpful--insert-section-break)
   1721         (insert (helpful--heading "Implementations") (s-trim content))))))
   1722 
   1723 (defun helpful--calculate-references (sym callable-p source-path)
   1724   "Calculate references for SYM in SOURCE-PATH."
   1725   (when source-path
   1726     (let* ((primitive-p (helpful--primitive-p sym callable-p))
   1727            (buf (elisp-refs--contents-buffer source-path))
   1728            (positions
   1729             (if primitive-p
   1730                 nil
   1731               (helpful--reference-positions
   1732                helpful--sym helpful--callable-p buf)))
   1733            (return-value (--map (helpful--outer-sexp buf it) positions)))
   1734       (kill-buffer buf)
   1735       return-value)))
   1736 
   1737 (defun helpful--make-manual-button (sym)
   1738   "Make manual button for SYM."
   1739   (helpful--button
   1740    "View in manual"
   1741    'helpful-manual-button
   1742    'symbol sym))
   1743 
   1744 (defun helpful--make-toggle-button (sym buffer)
   1745   "Make toggle button for SYM in BUFFER."
   1746   (helpful--button
   1747    "Toggle"
   1748    'helpful-toggle-button
   1749    'symbol sym
   1750    'buffer buffer))
   1751 
   1752 (defun helpful--make-set-button (sym buffer)
   1753   "Make set button for SYM in BUFFER."
   1754   (helpful--button
   1755    "Set"
   1756    'helpful-set-button
   1757    'symbol sym
   1758    'buffer buffer))
   1759 
   1760 (defun helpful--make-toggle-literal-button ()
   1761   "Make set button for SYM in BUFFER."
   1762   (helpful--button
   1763    (if helpful--view-literal
   1764        ;; TODO: only offer for strings that have newlines, tabs or
   1765        ;; properties.
   1766        "Pretty view"
   1767      "View as literal")
   1768    'helpful-view-literal-button))
   1769 
   1770 (defun helpful--make-customize-button (sym)
   1771   "Make customize button for SYM."
   1772   (helpful--button
   1773    "Customize"
   1774    'helpful-customize-button
   1775    'symbol sym))
   1776 
   1777 (defun helpful--make-references-button (sym callable-p)
   1778   "Make references button for SYM."
   1779   (helpful--button
   1780    "Find all references"
   1781    'helpful-all-references-button
   1782    'symbol sym
   1783    'callable-p callable-p))
   1784 
   1785 (defun helpful--make-edebug-button (sym)
   1786   "Make edebug button for SYM."
   1787   (helpful--button
   1788    (format "%s edebug"
   1789            (if (helpful--edebug-p sym)
   1790                "Disable" "Enable"))
   1791    'helpful-edebug-button
   1792    'symbol sym))
   1793 
   1794 (defun helpful--make-tracing-button (sym)
   1795   "Make tracing button for SYM."
   1796   (helpful--button
   1797    (format "%s tracing"
   1798            (if (trace-is-traced sym)
   1799                "Disable" "Enable"))
   1800    'helpful-trace-button
   1801    'symbol sym))
   1802 
   1803 (defun helpful--make-disassemble-button (obj)
   1804   "Make disassemble button for OBJ.
   1805 OBJ may be a symbol or a compiled function object."
   1806   (helpful--button
   1807    "Disassemble"
   1808    'helpful-disassemble-button
   1809    'object obj))
   1810 
   1811 (defun helpful--make-run-test-button (sym)
   1812   "Make an ERT test button for SYM."
   1813   (helpful--button
   1814    "Run test"
   1815    'helpful-run-test-button
   1816    'symbol sym))
   1817 
   1818 (defun helpful--make-forget-button (sym callable-p)
   1819   "Make forget button for SYM."
   1820   (helpful--button
   1821    "Forget"
   1822    'helpful-forget-button
   1823    'symbol sym
   1824    'callable-p callable-p))
   1825 
   1826 (defun helpful--make-callees-button (sym source)
   1827   (helpful--button
   1828    (format "Functions used by %s" sym)
   1829    'helpful-callees-button
   1830    'symbol sym
   1831    'source source))
   1832 
   1833 ;; TODO: this only reports if a function is autoloaded because we
   1834 ;; autoloaded it. This ignores newly defined functions that are
   1835 ;; autoloaded. Built-in help has this limitation too, but if we can
   1836 ;; find the source, we should instead see if there's an autoload
   1837 ;; cookie.
   1838 (defun helpful--autoloaded-p (sym buf)
   1839   "Return non-nil if function SYM is autoloaded."
   1840   (-when-let (file-name (buffer-file-name buf))
   1841     (setq file-name (s-chop-suffix ".gz" file-name))
   1842     (condition-case nil
   1843         (help-fns--autoloaded-p sym file-name)
   1844       ; new in Emacs 29.0.50
   1845       ; see https://github.com/Wilfred/helpful/pull/283
   1846       (error (help-fns--autoloaded-p sym)))))
   1847 
   1848 (defun helpful--compiled-p (sym)
   1849   "Return non-nil if function SYM is byte-compiled"
   1850   (and (symbolp sym)
   1851        (byte-code-function-p (symbol-function sym))))
   1852 
   1853 (defun helpful--native-compiled-p (sym)
   1854   "Return non-nil if function SYM is native-compiled"
   1855   (and (symbolp sym)
   1856        (fboundp 'subr-native-elisp-p)
   1857        (subr-native-elisp-p (symbol-function sym))))
   1858 
   1859 (defun helpful--join-and (items)
   1860   "Join a list of strings with commas and \"and\"."
   1861   (cond
   1862    ((= (length items) 0)
   1863     "")
   1864    ((= (length items) 1)
   1865     (car items))
   1866    (t
   1867     (format "%s and %s"
   1868             (s-join ", " (-drop-last 1 items))
   1869             (-last-item items)))))
   1870 
   1871 (defun helpful--summary (sym callable-p buf pos)
   1872   "Return a one sentence summary for SYM."
   1873   (-let* ((primitive-p (helpful--primitive-p sym callable-p))
   1874           (canonical-sym (helpful--canonical-symbol sym callable-p))
   1875           (alias-p (not (eq canonical-sym sym)))
   1876           (alias-button
   1877            (if callable-p
   1878                ;; Show a link to 'defalias' in the manual.
   1879                (helpful--button
   1880                 "function alias"
   1881                 'helpful-manual-button
   1882                 'symbol 'defalias)
   1883              ;; Show a link to the variable aliases section in the
   1884              ;; manual.
   1885              (helpful--button
   1886               "alias"
   1887               'helpful-info-button
   1888               'info-node "(elisp)Variable Aliases")))
   1889           (special-form-button
   1890            (helpful--button
   1891             "special form"
   1892             'helpful-info-button
   1893             'info-node "(elisp)Special Forms"))
   1894           (keyboard-macro-button
   1895            (helpful--button
   1896             "keyboard macro"
   1897             'helpful-info-button
   1898             'info-node "(elisp)Keyboard Macros"))
   1899           (interactive-button
   1900            (helpful--button
   1901             "interactive"
   1902             'helpful-info-button
   1903             'info-node "(elisp)Using Interactive"))
   1904           (autoload-button
   1905            (helpful--button
   1906             "autoloaded"
   1907             'helpful-info-button
   1908             'info-node "(elisp)Autoload"))
   1909           (compiled-button
   1910            (helpful--button
   1911             "byte-compiled"
   1912             'helpful-info-button
   1913             'info-node "(elisp)Byte Compilation"))
   1914           (native-compiled-button
   1915            (helpful--button
   1916             "natively compiled"
   1917             'helpful-describe-button
   1918             'symbol 'native-compile))
   1919           (buffer-local-button
   1920            (helpful--button
   1921             "buffer-local"
   1922             'helpful-info-button
   1923             'info-node "(elisp)Buffer-Local Variables"))
   1924           (autoloaded-p
   1925            (and callable-p buf (helpful--autoloaded-p sym buf)))
   1926           (compiled-p
   1927            (and callable-p (helpful--compiled-p sym)))
   1928           (native-compiled-p
   1929            (and callable-p (helpful--native-compiled-p sym)))
   1930           (buttons
   1931            (list
   1932             (if alias-p alias-button)
   1933             (if (and callable-p autoloaded-p) autoload-button)
   1934             (if (and callable-p (commandp sym)) interactive-button)
   1935             (if compiled-p compiled-button)
   1936             (if native-compiled-p native-compiled-button)
   1937             (if (and (not callable-p) (local-variable-if-set-p sym))
   1938                 buffer-local-button)))
   1939           (description
   1940            (helpful--join-and (-non-nil buttons)))
   1941           (kind
   1942            (cond
   1943             ((special-form-p sym)
   1944              special-form-button)
   1945             (alias-p
   1946              (format "for %s,"
   1947                      (helpful--button
   1948                       (symbol-name canonical-sym)
   1949                       'helpful-describe-exactly-button
   1950                       'symbol canonical-sym
   1951                       'callable-p callable-p)))
   1952             ((not callable-p) "variable")
   1953             ((macrop sym) "macro")
   1954             ((helpful--kbd-macro-p sym) keyboard-macro-button)
   1955             (t "function")))
   1956           (defined
   1957             (cond
   1958              (buf
   1959               (let ((path (buffer-file-name buf)))
   1960                 (if path
   1961                     (format
   1962                      "defined in %s"
   1963                      (helpful--navigate-button
   1964                       (file-name-nondirectory path) path pos))
   1965                   (format "defined in buffer %s"
   1966                           (helpful--buffer-button buf pos)))))
   1967              (primitive-p
   1968               "defined in C source code")
   1969              ((helpful--kbd-macro-p sym) nil)
   1970              (t
   1971               "without a source file"))))
   1972 
   1973     (s-word-wrap
   1974      70
   1975      (format "%s is %s %s %s%s."
   1976              (if (symbolp sym)
   1977                  (helpful--format-symbol sym)
   1978                "This lambda")
   1979              (if (string-match-p
   1980                   (rx bos (or "a" "e" "i" "o" "u"))
   1981                   description)
   1982                  "an"
   1983                "a")
   1984              description
   1985              kind
   1986              (if defined (concat " " defined) "")))))
   1987 
   1988 (defun helpful--callees (form)
   1989   "Given source code FORM, return a list of all the functions called."
   1990   (let* ((expanded-form (macroexpand-all form))
   1991          ;; Find all the functions called after macro expansion.
   1992          (all-fns (helpful--callees-1 expanded-form))
   1993          ;; Only consider the functions that were in the original code
   1994          ;; before macro expansion.
   1995          (form-syms (-filter #'symbolp (-flatten form)))
   1996          (form-fns (--filter (memq it form-syms) all-fns)))
   1997     (-distinct form-fns)))
   1998 
   1999 (defun helpful--callees-1 (form)
   2000   "Return a list of all the functions called in FORM.
   2001 Assumes FORM has been macro expanded. The returned list
   2002 may contain duplicates."
   2003   (cond
   2004    ((not (consp form))
   2005     nil)
   2006    ;; See `(elisp)Special Forms'. For these special forms, we recurse
   2007    ;; just like functions but ignore the car.
   2008    ((memq (car form) '(and catch defconst defvar if interactive
   2009                            or prog1 prog2 progn save-current-buffer
   2010                            save-restriction setq setq-default
   2011                            track-mouse unwind-protect while))
   2012     (-flatten
   2013      (-map #'helpful--callees-1 (cdr form))))
   2014 
   2015    ((eq (car form) 'cond)
   2016     (let* ((clauses (cdr form))
   2017            (clause-fns
   2018             ;; Each clause is a list of forms.
   2019             (--map
   2020              (-map #'helpful--callees-1 it) clauses)))
   2021       (-flatten clause-fns)))
   2022 
   2023    ((eq (car form) 'condition-case)
   2024     (let* ((protected-form (nth 2 form))
   2025            (protected-form-fns (helpful--callees-1 protected-form))
   2026            (handlers (-drop 3 form))
   2027            (handler-bodies (-map #'cdr handlers))
   2028            (handler-fns
   2029             (--map
   2030              (-map #'helpful--callees-1 it) handler-bodies)))
   2031       (append
   2032        protected-form-fns
   2033        (-flatten handler-fns))))
   2034 
   2035    ;; Calling a function with a well known higher order function, for
   2036    ;; example (funcall 'foo 1 2).
   2037    ((and
   2038      (memq (car form) '(funcall apply call-interactively
   2039                                 mapcar mapc mapconcat -map))
   2040      (eq (car-safe (nth 1 form)) 'quote))
   2041     (cons
   2042      (cadr (nth 1 form))
   2043      (-flatten
   2044       (-map #'helpful--callees-1 (cdr form)))))
   2045 
   2046    ((eq (car form) 'function)
   2047     (let ((arg (nth 1 form)))
   2048       (if (symbolp arg)
   2049           ;; #'foo, which is the same as (function foo), is a function
   2050           ;; reference.
   2051           (list arg)
   2052         ;; Handle (function (lambda ...)).
   2053         (helpful--callees-1 arg))))
   2054 
   2055    ((eq (car form) 'lambda)
   2056     ;; Only consider the body, not the param list.
   2057     (-flatten (-map #'helpful--callees-1 (-drop 2 form))))
   2058 
   2059    ((eq (car form) 'closure)
   2060     ;; Same as lambda, but has an additional argument of the
   2061     ;; closed-over variables.
   2062     (-flatten (-map #'helpful--callees-1 (-drop 3 form))))
   2063 
   2064    ((memq (car form) '(let let*))
   2065     ;; Extract function calls used to set the let-bound variables.
   2066     (let* ((var-vals (-second-item form))
   2067            (var-val-callees
   2068             (--map
   2069              (if (consp it)
   2070                  (-map #'helpful--callees-1 it)
   2071                nil)
   2072              var-vals)))
   2073       (append
   2074        (-flatten var-val-callees)
   2075        ;; Function calls in the let body.
   2076        (-map #'helpful--callees-1 (-drop 2 form)))))
   2077 
   2078    ((eq (car form) 'quote)
   2079     nil)
   2080    (t
   2081     (cons
   2082      (car form)
   2083      (-flatten
   2084       (-map #'helpful--callees-1 (cdr form)))))))
   2085 
   2086 (defun helpful--ensure-loaded ()
   2087   "Ensure the symbol associated with the current buffer has been loaded."
   2088   (when (and helpful--callable-p
   2089              (symbolp helpful--sym))
   2090     (let ((fn-obj (symbol-function helpful--sym)))
   2091       (when (autoloadp fn-obj)
   2092         (autoload-do-load fn-obj)))))
   2093 
   2094 (defun helpful--hook-p (symbol value)
   2095   "Does SYMBOL look like a hook?"
   2096   (and
   2097    (or
   2098     (s-ends-with-p "-hook" (symbol-name symbol))
   2099     ;; E.g. `after-change-functions', which can be used with
   2100     ;; `add-hook'.
   2101     (s-ends-with-p "-functions" (symbol-name symbol)))
   2102    (consp value)))
   2103 
   2104 (defun helpful--format-value (sym value)
   2105   "Format VALUE as a string."
   2106   (cond
   2107    (helpful--view-literal
   2108     (helpful--syntax-highlight (helpful--pretty-print value)))
   2109    ;; Allow strings to be viewed with properties rendered in
   2110    ;; Emacs, rather than as a literal.
   2111    ((stringp value)
   2112     value)
   2113    ;; Allow keymaps to be viewed with keybindings shown and
   2114    ;; links to the commands bound.
   2115    ((keymapp value)
   2116     (helpful--format-keymap value))
   2117    ((helpful--hook-p sym value)
   2118     (helpful--format-hook value))
   2119    (t
   2120     (helpful--pretty-print value))))
   2121 
   2122 (defun helpful--original-value (sym)
   2123   "Return the original value for SYM, if any.
   2124 
   2125 If SYM has an original value, return it in a list. Return nil
   2126 otherwise."
   2127   (let* ((orig-val-expr (get sym 'standard-value)))
   2128     (when (consp orig-val-expr)
   2129       (ignore-errors
   2130         (list
   2131          (eval (car orig-val-expr)))))))
   2132 
   2133 (defun helpful--original-value-differs-p (sym)
   2134   "Return t if SYM has an original value, and its current
   2135 value is different."
   2136   (let ((orig-val-list (helpful--original-value sym)))
   2137     (and (consp orig-val-list)
   2138          (not (eq (car orig-val-list)
   2139                   (symbol-value sym))))))
   2140 
   2141 (defun helpful-update ()
   2142   "Update the current *Helpful* buffer to the latest
   2143 state of the current symbol."
   2144   (interactive)
   2145   (cl-assert (not (null helpful--sym)))
   2146   (unless (buffer-live-p helpful--associated-buffer)
   2147     (setq helpful--associated-buffer nil))
   2148   (helpful--ensure-loaded)
   2149   (-let* ((val
   2150            ;; Look at the value before setting `inhibit-read-only', so
   2151            ;; users can see the correct value of that variable.
   2152            (unless helpful--callable-p
   2153              (helpful--sym-value helpful--sym helpful--associated-buffer)))
   2154           (inhibit-read-only t)
   2155           (start-line (line-number-at-pos))
   2156           (start-column (current-column))
   2157           (primitive-p (helpful--primitive-p helpful--sym helpful--callable-p))
   2158           (canonical-sym (helpful--canonical-symbol helpful--sym helpful--callable-p))
   2159           (look-for-src (or (not primitive-p)
   2160                             find-function-C-source-directory))
   2161           ((buf pos opened)
   2162            (if look-for-src
   2163                (helpful--definition helpful--sym helpful--callable-p)
   2164              '(nil nil nil)))
   2165           (source (when look-for-src
   2166                     (helpful--source helpful--sym helpful--callable-p buf pos)))
   2167           (source-path (when buf
   2168                          (buffer-file-name buf)))
   2169           (references (helpful--calculate-references
   2170                        helpful--sym helpful--callable-p
   2171                        source-path))
   2172           (aliases (helpful--aliases helpful--sym helpful--callable-p)))
   2173 
   2174     (erase-buffer)
   2175 
   2176     (insert (helpful--summary helpful--sym helpful--callable-p buf pos))
   2177 
   2178     (when (helpful--obsolete-info helpful--sym helpful--callable-p)
   2179       (insert
   2180        "\n\n"
   2181        (helpful--format-obsolete-info helpful--sym helpful--callable-p)))
   2182 
   2183     (when (and helpful--callable-p
   2184                (not (helpful--kbd-macro-p helpful--sym)))
   2185       (helpful--insert-section-break)
   2186       (insert
   2187        (helpful--heading "Signature")
   2188        (helpful--syntax-highlight (helpful--signature helpful--sym))))
   2189 
   2190     (when (not helpful--callable-p)
   2191       (helpful--insert-section-break)
   2192       (let* ((sym helpful--sym)
   2193              (multiple-views-p
   2194               (or (stringp val)
   2195                   (keymapp val)
   2196                   (helpful--hook-p sym val))))
   2197         (when helpful--first-display
   2198           (if (stringp val)
   2199               ;; For strings, it's more intuitive to display them as
   2200               ;; literals, so "1" and 1 are distinct.
   2201               (setq helpful--view-literal t)
   2202             ;; For everything else, prefer the pretty view if available.
   2203             (setq helpful--view-literal nil)))
   2204         (insert
   2205          (helpful--heading
   2206           (cond
   2207            ;; Buffer-local variable and we're looking at the value in
   2208            ;; a specific buffer.
   2209            ((and
   2210              helpful--associated-buffer
   2211              (local-variable-p sym helpful--associated-buffer))
   2212             (format "Value in %s"
   2213                     (helpful--button
   2214                      (format "#<buffer %s>" (buffer-name helpful--associated-buffer))
   2215                      'helpful-buffer-button
   2216                      'buffer helpful--associated-buffer
   2217                      'position pos)))
   2218            ;; Buffer-local variable but default/global value.
   2219            ((local-variable-if-set-p sym)
   2220             "Global Value")
   2221            ;; This variable is not buffer-local.
   2222            (t "Value")))
   2223          (helpful--format-value sym val)
   2224          "\n\n")
   2225         (when (helpful--original-value-differs-p sym)
   2226           (insert
   2227            (helpful--heading "Original Value")
   2228            (helpful--format-value
   2229             sym
   2230             (car (helpful--original-value sym)))
   2231            "\n\n"))
   2232         (when multiple-views-p
   2233           (insert (helpful--make-toggle-literal-button) " "))
   2234 
   2235         (when (local-variable-if-set-p sym)
   2236           (insert
   2237            (helpful--button
   2238             "Buffer values"
   2239             'helpful-associated-buffer-button
   2240             'symbol sym
   2241             'prompt-p t)
   2242            " "
   2243            (helpful--button
   2244             "Global value"
   2245             'helpful-associated-buffer-button
   2246             'symbol sym
   2247             'prompt-p nil)
   2248            " "))
   2249         (when (memq (helpful--sym-value helpful--sym helpful--associated-buffer) '(nil t))
   2250           (insert (helpful--make-toggle-button helpful--sym helpful--associated-buffer) " "))
   2251         (insert (helpful--make-set-button helpful--sym helpful--associated-buffer))
   2252         (when (custom-variable-p helpful--sym)
   2253           (insert " " (helpful--make-customize-button helpful--sym)))))
   2254 
   2255     (let ((docstring (helpful--docstring helpful--sym helpful--callable-p))
   2256           (version-info (unless helpful--callable-p
   2257                           (helpful--version-info helpful--sym))))
   2258       (when (or docstring version-info)
   2259         (helpful--insert-section-break)
   2260         (insert
   2261          (helpful--heading "Documentation"))
   2262         (when docstring
   2263           (insert (helpful--format-docstring docstring)))
   2264         (when version-info
   2265           (insert "\n\n" (s-word-wrap 70 version-info)))
   2266         (when (and (symbolp helpful--sym) (helpful--in-manual-p helpful--sym))
   2267           (insert "\n\n")
   2268           (insert (helpful--make-manual-button helpful--sym)))))
   2269 
   2270     ;; Show keybindings.
   2271     ;; TODO: allow users to conveniently add and remove keybindings.
   2272     (when (commandp helpful--sym)
   2273       (helpful--insert-section-break)
   2274       (insert
   2275        (helpful--heading "Key Bindings")
   2276        (helpful--format-keys helpful--sym aliases)))
   2277 
   2278     (helpful--insert-section-break)
   2279 
   2280     (insert
   2281      (helpful--heading "References")
   2282      (let ((src-button
   2283             (when source-path
   2284               (helpful--navigate-button
   2285                (file-name-nondirectory source-path)
   2286                source-path
   2287                (or pos
   2288                    0)))))
   2289        (cond
   2290         ((and source-path references)
   2291          (format "References in %s:\n%s"
   2292                  src-button
   2293                  (helpful--format-position-heads references source-path)))
   2294         ((and source-path primitive-p)
   2295          (format
   2296           "Finding references in a .%s file is not supported."
   2297           (f-ext source-path)))
   2298         (source-path
   2299          (format "%s is unused in %s."
   2300                  helpful--sym
   2301                  src-button))
   2302         ((and primitive-p (null find-function-C-source-directory))
   2303          "C code is not yet loaded.")
   2304         (t
   2305          "Could not find source file.")))
   2306      "\n\n"
   2307      (helpful--make-references-button helpful--sym helpful--callable-p))
   2308 
   2309     (when (and
   2310            helpful--callable-p
   2311            (symbolp helpful--sym)
   2312            source
   2313            (not primitive-p))
   2314       (insert
   2315        " "
   2316        (helpful--make-callees-button helpful--sym source)))
   2317 
   2318     (when (helpful--advised-p helpful--sym)
   2319       (helpful--insert-section-break)
   2320       (insert
   2321        (helpful--heading "Advice")
   2322        (format "This %s is advised."
   2323                (if (macrop helpful--sym) "macro" "function"))))
   2324 
   2325     (let ((can-edebug
   2326            (helpful--can-edebug-p helpful--sym helpful--callable-p buf pos))
   2327           (can-trace
   2328            (and (symbolp helpful--sym)
   2329                 helpful--callable-p
   2330                 ;; Tracing uses advice, and you can't apply advice to
   2331                 ;; primitive functions that are replaced with special
   2332                 ;; opcodes. For example, `narrow-to-region'.
   2333                 (not (plist-get (symbol-plist helpful--sym) 'byte-opcode))))
   2334           (can-disassemble
   2335            (and helpful--callable-p (not primitive-p)))
   2336           (can-forget
   2337            (and (not (special-form-p helpful--sym))
   2338                 (not primitive-p))))
   2339       (when (or can-edebug can-trace can-disassemble can-forget)
   2340         (helpful--insert-section-break)
   2341         (insert (helpful--heading "Debugging")))
   2342       (when can-edebug
   2343         (insert
   2344          (helpful--make-edebug-button helpful--sym)))
   2345       (when can-trace
   2346         (when can-edebug
   2347           (insert " "))
   2348         (insert
   2349          (helpful--make-tracing-button helpful--sym)))
   2350 
   2351       (when (and
   2352              (or can-edebug can-trace)
   2353              (or can-disassemble can-forget))
   2354         (insert "\n"))
   2355 
   2356       (when can-disassemble
   2357         (insert (helpful--make-disassemble-button helpful--sym)))
   2358 
   2359       (when can-forget
   2360         (when can-disassemble
   2361           (insert " "))
   2362         (insert (helpful--make-forget-button helpful--sym helpful--callable-p))))
   2363 
   2364     (when aliases
   2365       (helpful--insert-section-break)
   2366       (insert
   2367        (helpful--heading "Aliases")
   2368        (s-join "\n" (--map (helpful--format-alias it helpful--callable-p)
   2369                            aliases))))
   2370 
   2371     (when helpful--callable-p
   2372       (helpful--insert-implementations))
   2373 
   2374     (helpful--insert-section-break)
   2375 
   2376     (when (or source-path primitive-p)
   2377       (insert
   2378        (helpful--heading
   2379         (if (eq helpful--sym canonical-sym)
   2380             "Source Code"
   2381           "Alias Source Code"))
   2382        (cond
   2383         (source-path
   2384          (concat
   2385           (propertize (format "%s Defined in " (if primitive-p "//" ";;"))
   2386                       'face 'font-lock-comment-face)
   2387           (helpful--navigate-button
   2388            (f-abbrev source-path)
   2389            source-path
   2390            pos)
   2391           "\n"))
   2392         (primitive-p
   2393          (concat
   2394           (propertize
   2395            "C code is not yet loaded."
   2396            'face 'font-lock-comment-face)
   2397           "\n\n"
   2398           (helpful--button
   2399            "Set C source directory"
   2400            'helpful-c-source-directory))))))
   2401     (when source
   2402       (insert
   2403        (cond
   2404         ((stringp source)
   2405          (let ((mode (when primitive-p
   2406                        (pcase (file-name-extension source-path)
   2407                          ("c" 'c-mode)
   2408                          ("rs" (when (fboundp 'rust-mode) 'rust-mode))))))
   2409            (helpful--syntax-highlight source mode)))
   2410         ((and (consp source) (eq (car source) 'closure))
   2411          (helpful--syntax-highlight
   2412           (concat ";; Closure converted to defun by helpful.\n"
   2413                   (helpful--pretty-print
   2414                    (helpful--format-closure helpful--sym source)))))
   2415         (t
   2416          (helpful--syntax-highlight
   2417           (concat
   2418            (if (eq helpful--sym canonical-sym)
   2419                ";; Could not find source code, showing raw function object.\n"
   2420              ";; Could not find alias source code, showing raw function object.\n")
   2421            (helpful--pretty-print source)))))))
   2422 
   2423     (helpful--insert-section-break)
   2424 
   2425     (-when-let (formatted-props (helpful--format-properties helpful--sym))
   2426       (insert
   2427        (helpful--heading "Symbol Properties")
   2428        formatted-props))
   2429 
   2430     (goto-char (point-min))
   2431     (forward-line (1- start-line))
   2432     (forward-char start-column)
   2433     (setq helpful--first-display nil)
   2434 
   2435     (when opened
   2436       (kill-buffer buf))))
   2437 
   2438 ;; TODO: this isn't sufficient for `edebug-eval-defun'.
   2439 (defun helpful--skip-advice (docstring)
   2440   "Remove mentions of advice from DOCSTRING."
   2441   (let* ((lines (s-lines docstring))
   2442          (relevant-lines
   2443           (--drop-while
   2444            (or (s-starts-with-p ":around advice:" it)
   2445                (s-starts-with-p "This function has :around advice:" it))
   2446            lines)))
   2447     (s-trim (s-join "\n" relevant-lines))))
   2448 
   2449 (defun helpful--format-argument (arg)
   2450   "Format ARG (a symbol) according to Emacs help conventions."
   2451   (let ((arg-str (symbol-name arg)))
   2452     (if (s-starts-with-p "&" arg-str)
   2453         arg-str
   2454       (s-upcase arg-str))))
   2455 
   2456 (defun helpful--format-symbol (sym)
   2457   "Format symbol as a string, escaping as necessary."
   2458   ;; Arguably this is an Emacs bug. We should be able to use
   2459   ;; (format "%S" sym)
   2460   ;; but that converts foo? to "foo\\?". You can see this in other
   2461   ;; parts of the Emacs UI, such as ERT.
   2462   (s-replace " " "\\ " (format "%s" sym)))
   2463 
   2464 ;; TODO: this is broken for -any?.
   2465 (defun helpful--signature (sym)
   2466   "Get the signature for function SYM, as a string.
   2467 For example, \"(some-func FOO &optional BAR)\"."
   2468   (let (docstring-sig
   2469         source-sig
   2470         (advertised-args
   2471          (when (symbolp sym)
   2472            (gethash (symbol-function sym) advertised-signature-table))))
   2473     ;; Get the usage from the function definition.
   2474     (let* ((function-args
   2475             (cond
   2476              ((symbolp sym)
   2477               (help-function-arglist sym))
   2478              ((byte-code-function-p sym)
   2479               ;; argdesc can be a list of arguments or an integer
   2480               ;; encoding the min/max number of arguments. See
   2481               ;; Byte-Code Function Objects in the elisp manual.
   2482               (let ((argdesc (aref sym 0)))
   2483                 (if (consp argdesc)
   2484                     argdesc
   2485                   ;; TODO: properly handle argdesc values.
   2486                   nil)))
   2487              (t
   2488               ;; Interpreted function (lambda ...)
   2489               (cadr sym))))
   2490            (formatted-args
   2491             (cond
   2492              (advertised-args
   2493               (-map #'helpful--format-argument advertised-args))
   2494              ((listp function-args)
   2495               (-map #'helpful--format-argument function-args))
   2496              (t
   2497               (list function-args)))))
   2498       (setq source-sig
   2499             (cond
   2500              ;; If it's a function object, just show the arguments.
   2501              ((not (symbolp sym))
   2502               (format "(%s)"
   2503                       (s-join " " formatted-args)))
   2504              ;; If it has multiple arguments, join them with spaces.
   2505              (formatted-args
   2506               (format "(%s %s)"
   2507                       (helpful--format-symbol sym)
   2508                       (s-join " " formatted-args)))
   2509              ;; Otherwise, this function takes no arguments when called.
   2510              (t
   2511               (format "(%s)" (helpful--format-symbol sym))))))
   2512 
   2513     ;; If the docstring ends with (fn FOO BAR), extract that.
   2514     (-when-let (docstring (documentation sym))
   2515       (-when-let (docstring-with-usage (help-split-fundoc docstring sym))
   2516         (setq docstring-sig (car docstring-with-usage))))
   2517 
   2518     (cond
   2519      ;; Advertised signature always wins.
   2520      (advertised-args
   2521       source-sig)
   2522      ;; If that's not set, use the usage specification in the
   2523      ;; docstring, if present.
   2524      (docstring-sig)
   2525      (t
   2526       ;; Otherwise, just use the signature from the source code.
   2527       source-sig))))
   2528 
   2529 (defun helpful--format-obsolete-info (sym callable-p)
   2530   (-let [(use _ date) (helpful--obsolete-info sym callable-p)]
   2531     (helpful--format-docstring
   2532      (s-word-wrap
   2533       70
   2534       (format "This %s is obsolete%s%s"
   2535               (helpful--kind-name sym callable-p)
   2536               (if date (format " since %s" date)
   2537                 "")
   2538               (cond ((stringp use) (concat "; " use))
   2539                     (use (format "; use `%s' instead." use))
   2540                     (t ".")))))))
   2541 
   2542 (defun helpful--docstring (sym callable-p)
   2543   "Get the docstring for SYM.
   2544 Note that this returns the raw docstring, including \\=\\=
   2545 escapes that are used by `substitute-command-keys'."
   2546   (let ((text-quoting-style 'grave)
   2547         docstring)
   2548     (if callable-p
   2549         (progn
   2550           (setq docstring (documentation sym t))
   2551           (-when-let (docstring-with-usage (help-split-fundoc docstring sym))
   2552             (setq docstring (cdr docstring-with-usage))
   2553             (when docstring
   2554               ;; Advice mutates the docstring, see
   2555               ;; `advice--make-docstring'. Undo that.
   2556               ;; TODO: Only do this if the function is advised.
   2557               (setq docstring (helpful--skip-advice docstring)))))
   2558       (setq docstring
   2559             (documentation-property sym 'variable-documentation t)))
   2560     docstring))
   2561 
   2562 (defun helpful--read-symbol (prompt default-val predicate)
   2563   "Read a symbol from the minibuffer, with completion.
   2564 Returns the symbol."
   2565   (when (and default-val
   2566              (not (funcall predicate default-val)))
   2567     (setq default-val nil))
   2568   (when default-val
   2569     ;; `completing-read' expects a string.
   2570     (setq default-val (symbol-name default-val))
   2571 
   2572     ;; TODO: Only modify the prompt when we don't have ido/ivy/helm,
   2573     ;; because the default is obvious for them.
   2574     (setq prompt
   2575           (replace-regexp-in-string
   2576            (rx ": " eos)
   2577            (format " (default: %s): " default-val)
   2578            prompt)))
   2579   (intern (completing-read prompt obarray
   2580                            predicate t nil nil
   2581                            default-val)))
   2582 
   2583 (defun helpful--update-and-switch-buffer (symbol callable-p)
   2584   "Update and switch to help buffer for SYMBOL."
   2585   (let ((buf (helpful--buffer symbol callable-p)))
   2586     (with-current-buffer buf
   2587       (helpful-update))
   2588     (funcall helpful-switch-buffer-function buf)))
   2589 
   2590 ;;;###autoload
   2591 (defun helpful-function (symbol)
   2592   "Show help for function named SYMBOL.
   2593 
   2594 See also `helpful-macro', `helpful-command' and `helpful-callable'."
   2595   (interactive
   2596    (list (helpful--read-symbol
   2597           "Function: "
   2598           (helpful--callable-at-point)
   2599           #'functionp)))
   2600   (helpful--update-and-switch-buffer symbol t))
   2601 
   2602 ;;;###autoload
   2603 (defun helpful-command (symbol)
   2604   "Show help for interactive function named SYMBOL.
   2605 
   2606 See also `helpful-function'."
   2607   (interactive
   2608    (list (helpful--read-symbol
   2609           "Command: "
   2610           (helpful--callable-at-point)
   2611           #'commandp)))
   2612   (helpful--update-and-switch-buffer symbol t))
   2613 
   2614 ;;;###autoload
   2615 (defun helpful-key (key-sequence)
   2616   "Show help for interactive command bound to KEY-SEQUENCE."
   2617   (interactive
   2618    (list (read-key-sequence "Press key: ")))
   2619   (let ((sym (key-binding key-sequence)))
   2620     (cond
   2621      ((null sym)
   2622       (user-error "No command is bound to %s"
   2623                   (key-description key-sequence)))
   2624      ((commandp sym)
   2625       (helpful--update-and-switch-buffer sym t))
   2626      (t
   2627       (user-error "%s is bound to %s which is not a command"
   2628                   (key-description key-sequence)
   2629                   sym)))))
   2630 
   2631 ;;;###autoload
   2632 (defun helpful-macro (symbol)
   2633   "Show help for macro named SYMBOL."
   2634   (interactive
   2635    (list (helpful--read-symbol
   2636           "Macro: "
   2637           (helpful--callable-at-point)
   2638           #'macrop)))
   2639   (helpful--update-and-switch-buffer symbol t))
   2640 
   2641 ;;;###autoload
   2642 (defun helpful-callable (symbol)
   2643   "Show help for function, macro or special form named SYMBOL.
   2644 
   2645 See also `helpful-macro', `helpful-function' and `helpful-command'."
   2646   (interactive
   2647    (list (helpful--read-symbol
   2648           "Callable: "
   2649           (helpful--callable-at-point)
   2650           #'fboundp)))
   2651   (helpful--update-and-switch-buffer symbol t))
   2652 
   2653 (defun helpful--variable-p (symbol)
   2654   "Return non-nil if SYMBOL is a variable."
   2655   (or (get symbol 'variable-documentation)
   2656       (and (boundp symbol)
   2657            (not (keywordp symbol))
   2658            (not (eq symbol nil))
   2659            (not (eq symbol t)))))
   2660 
   2661 (defun helpful--bound-p (symbol)
   2662   "Return non-nil if SYMBOL is a variable or callable.
   2663 
   2664 This differs from `boundp' because we do not consider nil, t
   2665 or :foo."
   2666   (or (fboundp symbol)
   2667       (helpful--variable-p symbol)))
   2668 
   2669 (defun helpful--bookmark-jump (bookmark)
   2670   "Create and switch to helpful bookmark BOOKMARK."
   2671   (let ((callable-p (bookmark-prop-get bookmark 'callable-p))
   2672         (sym (bookmark-prop-get bookmark 'sym))
   2673         (position (bookmark-prop-get bookmark 'position)))
   2674     (if callable-p
   2675         (helpful-callable sym)
   2676       (helpful-variable sym))
   2677     (goto-char position)))
   2678 
   2679 (defun helpful--bookmark-make-record ()
   2680   "Create a bookmark record for helpful buffers.
   2681 
   2682 See docs of `bookmark-make-record-function'."
   2683   `((sym . ,helpful--sym)
   2684     (callable-p . ,helpful--callable-p)
   2685     (position    . ,(point))
   2686     (handler     . helpful--bookmark-jump)))
   2687 
   2688 (defun helpful--convert-c-name (symbol var)
   2689   "Convert SYMBOL from a C name to an Elisp name.
   2690 E.g. convert `Fmake_string' to `make-string' or
   2691 `Vgc_cons_percentage' to `gc-cons-percentage'. Interpret
   2692 SYMBOL as variable name if VAR, else a function name. Return
   2693 nil if SYMBOL doesn't begin with \"F\" or \"V\"."
   2694   (let ((string (symbol-name symbol))
   2695         (prefix (if var "V" "F")))
   2696     (when (s-starts-with-p prefix string)
   2697       (intern
   2698        (s-chop-prefix
   2699         prefix
   2700         (s-replace "_" "-" string))))))
   2701 
   2702 ;;;###autoload
   2703 (defun helpful-symbol (symbol)
   2704   "Show help for SYMBOL, a variable, function or macro.
   2705 
   2706 See also `helpful-callable' and `helpful-variable'."
   2707   (interactive
   2708    (list (helpful--read-symbol
   2709           "Symbol: "
   2710           (helpful--symbol-at-point)
   2711           #'helpful--bound-p)))
   2712   (let ((c-var-sym (helpful--convert-c-name symbol t))
   2713         (c-fn-sym (helpful--convert-c-name symbol nil)))
   2714     (cond
   2715      ((and (boundp symbol) (fboundp symbol))
   2716       (if (y-or-n-p
   2717            (format "%s is a both a variable and a callable, show variable?"
   2718                    symbol))
   2719           (helpful-variable symbol)
   2720         (helpful-callable symbol)))
   2721      ((fboundp symbol)
   2722       (helpful-callable symbol))
   2723      ((boundp symbol)
   2724       (helpful-variable symbol))
   2725      ((and c-fn-sym (fboundp c-fn-sym))
   2726       (helpful-callable c-fn-sym))
   2727      ((and c-var-sym (boundp c-var-sym))
   2728       (helpful-variable c-var-sym))
   2729      (t
   2730       (user-error "Not bound: %S" symbol)))))
   2731 
   2732 ;;;###autoload
   2733 (defun helpful-variable (symbol)
   2734   "Show help for variable named SYMBOL."
   2735   (interactive
   2736    (list (helpful--read-symbol
   2737           "Variable: "
   2738           (helpful--variable-at-point)
   2739           #'helpful--variable-p)))
   2740   (helpful--update-and-switch-buffer symbol nil))
   2741 
   2742 (defun helpful--variable-at-point-exactly ()
   2743   "Return the symbol at point, if it's a bound variable."
   2744   (let ((var (variable-at-point)))
   2745     ;; `variable-at-point' uses 0 rather than nil to signify no symbol
   2746     ;; at point (presumably because 'nil is a symbol).
   2747     (unless (symbolp var)
   2748       (setq var nil))
   2749     (when (helpful--variable-p var)
   2750       var)))
   2751 
   2752 (defun helpful--variable-defined-at-point ()
   2753   "Return the variable defined in the form enclosing point."
   2754   ;; TODO: do the same thing if point is just before a top-level form.
   2755   (save-excursion
   2756     (save-restriction
   2757       (widen)
   2758       (let* ((ppss (syntax-ppss))
   2759              (sexp-start (nth 1 ppss))
   2760              sexp)
   2761         (when sexp-start
   2762           (goto-char sexp-start)
   2763           (setq sexp (condition-case nil
   2764                          (read (current-buffer))
   2765                        (error nil)))
   2766           (when (memq (car-safe sexp)
   2767                       (list 'defvar 'defvar-local 'defcustom 'defconst))
   2768             (nth 1 sexp)))))))
   2769 
   2770 (defun helpful--variable-at-point ()
   2771   "Return the variable exactly under point, or defined at point."
   2772   (let ((var (helpful--variable-at-point-exactly)))
   2773     (if var
   2774         var
   2775       (let ((var (helpful--variable-defined-at-point)))
   2776         (when (helpful--variable-p var)
   2777           var)))))
   2778 
   2779 (defun helpful--callable-at-point ()
   2780   (let ((sym (symbol-at-point))
   2781         (enclosing-sym (function-called-at-point)))
   2782     (if (fboundp sym)
   2783         sym
   2784       enclosing-sym)))
   2785 
   2786 (defun helpful--symbol-at-point-exactly ()
   2787   "Return the symbol at point, if it's bound."
   2788   (let ((sym (symbol-at-point)))
   2789     (when (helpful--bound-p sym)
   2790       sym)))
   2791 
   2792 (defun helpful--symbol-at-point ()
   2793   "Find the most relevant symbol at or around point.
   2794 Returns nil if nothing found."
   2795   (or
   2796    (helpful--symbol-at-point-exactly)
   2797    (helpful--callable-at-point)
   2798    (helpful--variable-at-point)))
   2799 
   2800 ;;;###autoload
   2801 (defun helpful-at-point ()
   2802   "Show help for the symbol at point."
   2803   (interactive)
   2804   (-if-let (symbol (helpful--symbol-at-point))
   2805       (helpful-symbol symbol)
   2806     (user-error "There is no symbol at point.")))
   2807 
   2808 (defun helpful--imenu-index ()
   2809   "Return a list of headings in the current buffer, suitable for
   2810 imenu."
   2811   (let (headings)
   2812     (goto-char (point-min))
   2813     (while (not (eobp))
   2814       (when (eq (get-text-property (point) 'face)
   2815                 'helpful-heading)
   2816         (push
   2817          (cons
   2818           (buffer-substring-no-properties
   2819            (line-beginning-position) (line-end-position))
   2820           (line-beginning-position))
   2821          headings))
   2822       (forward-line))
   2823     (nreverse headings)))
   2824 
   2825 (defun helpful--flash-region (start end)
   2826   "Temporarily highlight region from START to END."
   2827   (let ((overlay (make-overlay start end)))
   2828     (overlay-put overlay 'face 'highlight)
   2829     (run-with-timer 1.5 nil 'delete-overlay overlay)))
   2830 
   2831 (defun helpful-visit-reference ()
   2832   "Go to the reference at point."
   2833   (interactive)
   2834   (let* ((sym helpful--sym)
   2835          (path (get-text-property (point) 'helpful-path))
   2836          (pos (get-text-property (point) 'helpful-pos))
   2837          (pos-is-start (get-text-property (point) 'helpful-pos-is-start)))
   2838     (when (and path pos)
   2839       ;; If we're looking at a source excerpt, calculate the offset of
   2840       ;; point, so we don't just go the start of the excerpt.
   2841       (when pos-is-start
   2842         (save-excursion
   2843           (let ((offset 0))
   2844             (while (and
   2845                     (get-text-property (point) 'helpful-pos)
   2846                     (not (eobp)))
   2847               (backward-char 1)
   2848               (setq offset (1+ offset)))
   2849             ;; On the last iteration we moved outside the source
   2850             ;; excerpt, so we overcounted by one character.
   2851             (setq offset (1- offset))
   2852 
   2853             ;; Set POS so we go to exactly the place in the source
   2854             ;; code where point was in the helpful excerpt.
   2855             (setq pos (+ pos offset)))))
   2856 
   2857       (find-file path)
   2858       (helpful--goto-char-widen pos)
   2859       (recenter 0)
   2860       (save-excursion
   2861         (let ((defun-end (scan-sexps (point) 1)))
   2862           (while (re-search-forward
   2863                   (rx-to-string `(seq symbol-start ,(symbol-name sym) symbol-end))
   2864                   defun-end t)
   2865             (helpful--flash-region (match-beginning 0) (match-end 0))))))))
   2866 
   2867 (defun helpful-kill-buffers ()
   2868   "Kill all `helpful-mode' buffers.
   2869 
   2870 See also `helpful-max-buffers'."
   2871   (interactive)
   2872   (dolist (buffer (buffer-list))
   2873     (when (eq (buffer-local-value 'major-mode buffer) 'helpful-mode)
   2874       (kill-buffer buffer))))
   2875 
   2876 (defvar helpful-mode-map
   2877   (let* ((map (make-sparse-keymap)))
   2878     (define-key map (kbd "g") #'helpful-update)
   2879     (define-key map (kbd "RET") #'helpful-visit-reference)
   2880 
   2881     (define-key map (kbd "TAB") #'forward-button)
   2882     (define-key map (kbd "<backtab>") #'backward-button)
   2883 
   2884     (define-key map (kbd "n") #'forward-button)
   2885     (define-key map (kbd "p") #'backward-button)
   2886     map)
   2887   "Keymap for `helpful-mode'.")
   2888 
   2889 (declare-function bookmark-prop-get "bookmark" (bookmark prop))
   2890 (declare-function bookmark-make-record-default "bookmark"
   2891                   (&optional no-file no-context posn))
   2892 ;; Ensure this variable is defined even if bookmark.el isn't loaded
   2893 ;; yet. This follows the pattern in help-mode.el.gz.
   2894 ;; TODO: find a cleaner solution.
   2895 (defvar bookmark-make-record-function)
   2896 
   2897 (define-derived-mode helpful-mode special-mode "Helpful"
   2898   "Major mode for *Helpful* buffers."
   2899   (add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
   2900 
   2901   (setq imenu-create-index-function #'helpful--imenu-index)
   2902   ;; Prevent imenu converting "Source Code" to "Source.Code".
   2903   (setq-local imenu-space-replacement " ")
   2904 
   2905   ;; Enable users to bookmark helpful buffers.
   2906   (set (make-local-variable 'bookmark-make-record-function)
   2907        #'helpful--bookmark-make-record))
   2908 
   2909 (provide 'helpful)
   2910 ;;; helpful.el ends here