helpful

a fork of Wilfred's helpful
git clone https://git.trogloxene.org/helpful.git
Log | Files | Refs | README

helpful.el (113646B)


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