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