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