helpful.el (102019B)
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: 0.19 8 ;; Package-Commit: 2afbde902742b1aa64daa31a635ba564f14b35ae 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 (help-fns--autoloaded-p sym file-name))) 1843 1844 (defun helpful--compiled-p (sym) 1845 "Return non-nil if function SYM is byte-compiled" 1846 (and (symbolp sym) 1847 (byte-code-function-p (symbol-function sym)))) 1848 1849 (defun helpful--native-compiled-p (sym) 1850 "Return non-nil if function SYM is native-compiled" 1851 (and (symbolp sym) 1852 (fboundp 'subr-native-elisp-p) 1853 (subr-native-elisp-p (symbol-function sym)))) 1854 1855 (defun helpful--join-and (items) 1856 "Join a list of strings with commas and \"and\"." 1857 (cond 1858 ((= (length items) 0) 1859 "") 1860 ((= (length items) 1) 1861 (car items)) 1862 (t 1863 (format "%s and %s" 1864 (s-join ", " (-drop-last 1 items)) 1865 (-last-item items))))) 1866 1867 (defun helpful--summary (sym callable-p buf pos) 1868 "Return a one sentence summary for SYM." 1869 (-let* ((primitive-p (helpful--primitive-p sym callable-p)) 1870 (canonical-sym (helpful--canonical-symbol sym callable-p)) 1871 (alias-p (not (eq canonical-sym sym))) 1872 (alias-button 1873 (if callable-p 1874 ;; Show a link to 'defalias' in the manual. 1875 (helpful--button 1876 "function alias" 1877 'helpful-manual-button 1878 'symbol 'defalias) 1879 ;; Show a link to the variable aliases section in the 1880 ;; manual. 1881 (helpful--button 1882 "alias" 1883 'helpful-info-button 1884 'info-node "(elisp)Variable Aliases"))) 1885 (special-form-button 1886 (helpful--button 1887 "special form" 1888 'helpful-info-button 1889 'info-node "(elisp)Special Forms")) 1890 (keyboard-macro-button 1891 (helpful--button 1892 "keyboard macro" 1893 'helpful-info-button 1894 'info-node "(elisp)Keyboard Macros")) 1895 (interactive-button 1896 (helpful--button 1897 "interactive" 1898 'helpful-info-button 1899 'info-node "(elisp)Using Interactive")) 1900 (autoload-button 1901 (helpful--button 1902 "autoloaded" 1903 'helpful-info-button 1904 'info-node "(elisp)Autoload")) 1905 (compiled-button 1906 (helpful--button 1907 "byte-compiled" 1908 'helpful-info-button 1909 'info-node "(elisp)Byte Compilation")) 1910 (native-compiled-button 1911 (helpful--button 1912 "natively compiled" 1913 'helpful-describe-button 1914 'symbol 'native-compile)) 1915 (buffer-local-button 1916 (helpful--button 1917 "buffer-local" 1918 'helpful-info-button 1919 'info-node "(elisp)Buffer-Local Variables")) 1920 (autoloaded-p 1921 (and callable-p buf (helpful--autoloaded-p sym buf))) 1922 (compiled-p 1923 (and callable-p (helpful--compiled-p sym))) 1924 (native-compiled-p 1925 (and callable-p (helpful--native-compiled-p sym))) 1926 (buttons 1927 (list 1928 (if alias-p alias-button) 1929 (if (and callable-p autoloaded-p) autoload-button) 1930 (if (and callable-p (commandp sym)) interactive-button) 1931 (if compiled-p compiled-button) 1932 (if native-compiled-p native-compiled-button) 1933 (if (and (not callable-p) (local-variable-if-set-p sym)) 1934 buffer-local-button))) 1935 (description 1936 (helpful--join-and (-non-nil buttons))) 1937 (kind 1938 (cond 1939 ((special-form-p sym) 1940 special-form-button) 1941 (alias-p 1942 (format "for %s," 1943 (helpful--button 1944 (symbol-name canonical-sym) 1945 'helpful-describe-exactly-button 1946 'symbol canonical-sym 1947 'callable-p callable-p))) 1948 ((not callable-p) "variable") 1949 ((macrop sym) "macro") 1950 ((helpful--kbd-macro-p sym) keyboard-macro-button) 1951 (t "function"))) 1952 (defined 1953 (cond 1954 (buf 1955 (let ((path (buffer-file-name buf))) 1956 (if path 1957 (format 1958 "defined in %s" 1959 (helpful--navigate-button 1960 (file-name-nondirectory path) path pos)) 1961 (format "defined in buffer %s" 1962 (helpful--buffer-button buf pos))))) 1963 (primitive-p 1964 "defined in C source code") 1965 ((helpful--kbd-macro-p sym) nil) 1966 (t 1967 "without a source file")))) 1968 1969 (s-word-wrap 1970 70 1971 (format "%s is %s %s %s%s." 1972 (if (symbolp sym) 1973 (helpful--format-symbol sym) 1974 "This lambda") 1975 (if (string-match-p 1976 (rx bos (or "a" "e" "i" "o" "u")) 1977 description) 1978 "an" 1979 "a") 1980 description 1981 kind 1982 (if defined (concat " " defined) ""))))) 1983 1984 (defun helpful--callees (form) 1985 "Given source code FORM, return a list of all the functions called." 1986 (let* ((expanded-form (macroexpand-all form)) 1987 ;; Find all the functions called after macro expansion. 1988 (all-fns (helpful--callees-1 expanded-form)) 1989 ;; Only consider the functions that were in the original code 1990 ;; before macro expansion. 1991 (form-syms (-filter #'symbolp (-flatten form))) 1992 (form-fns (--filter (memq it form-syms) all-fns))) 1993 (-distinct form-fns))) 1994 1995 (defun helpful--callees-1 (form) 1996 "Return a list of all the functions called in FORM. 1997 Assumes FORM has been macro expanded. The returned list 1998 may contain duplicates." 1999 (cond 2000 ((not (consp form)) 2001 nil) 2002 ;; See `(elisp)Special Forms'. For these special forms, we recurse 2003 ;; just like functions but ignore the car. 2004 ((memq (car form) '(and catch defconst defvar if interactive 2005 or prog1 prog2 progn save-current-buffer 2006 save-restriction setq setq-default 2007 track-mouse unwind-protect while)) 2008 (-flatten 2009 (-map #'helpful--callees-1 (cdr form)))) 2010 2011 ((eq (car form) 'cond) 2012 (let* ((clauses (cdr form)) 2013 (clause-fns 2014 ;; Each clause is a list of forms. 2015 (--map 2016 (-map #'helpful--callees-1 it) clauses))) 2017 (-flatten clause-fns))) 2018 2019 ((eq (car form) 'condition-case) 2020 (let* ((protected-form (nth 2 form)) 2021 (protected-form-fns (helpful--callees-1 protected-form)) 2022 (handlers (-drop 3 form)) 2023 (handler-bodies (-map #'cdr handlers)) 2024 (handler-fns 2025 (--map 2026 (-map #'helpful--callees-1 it) handler-bodies))) 2027 (append 2028 protected-form-fns 2029 (-flatten handler-fns)))) 2030 2031 ;; Calling a function with a well known higher order function, for 2032 ;; example (funcall 'foo 1 2). 2033 ((and 2034 (memq (car form) '(funcall apply call-interactively 2035 mapcar mapc mapconcat -map)) 2036 (eq (car-safe (nth 1 form)) 'quote)) 2037 (cons 2038 (cadr (nth 1 form)) 2039 (-flatten 2040 (-map #'helpful--callees-1 (cdr form))))) 2041 2042 ((eq (car form) 'function) 2043 (let ((arg (nth 1 form))) 2044 (if (symbolp arg) 2045 ;; #'foo, which is the same as (function foo), is a function 2046 ;; reference. 2047 (list arg) 2048 ;; Handle (function (lambda ...)). 2049 (helpful--callees-1 arg)))) 2050 2051 ((eq (car form) 'lambda) 2052 ;; Only consider the body, not the param list. 2053 (-flatten (-map #'helpful--callees-1 (-drop 2 form)))) 2054 2055 ((eq (car form) 'closure) 2056 ;; Same as lambda, but has an additional argument of the 2057 ;; closed-over variables. 2058 (-flatten (-map #'helpful--callees-1 (-drop 3 form)))) 2059 2060 ((memq (car form) '(let let*)) 2061 ;; Extract function calls used to set the let-bound variables. 2062 (let* ((var-vals (-second-item form)) 2063 (var-val-callees 2064 (--map 2065 (if (consp it) 2066 (-map #'helpful--callees-1 it) 2067 nil) 2068 var-vals))) 2069 (append 2070 (-flatten var-val-callees) 2071 ;; Function calls in the let body. 2072 (-map #'helpful--callees-1 (-drop 2 form))))) 2073 2074 ((eq (car form) 'quote) 2075 nil) 2076 (t 2077 (cons 2078 (car form) 2079 (-flatten 2080 (-map #'helpful--callees-1 (cdr form))))))) 2081 2082 (defun helpful--ensure-loaded () 2083 "Ensure the symbol associated with the current buffer has been loaded." 2084 (when (and helpful--callable-p 2085 (symbolp helpful--sym)) 2086 (let ((fn-obj (symbol-function helpful--sym))) 2087 (when (autoloadp fn-obj) 2088 (autoload-do-load fn-obj))))) 2089 2090 (defun helpful--hook-p (symbol value) 2091 "Does SYMBOL look like a hook?" 2092 (and 2093 (or 2094 (s-ends-with-p "-hook" (symbol-name symbol)) 2095 ;; E.g. `after-change-functions', which can be used with 2096 ;; `add-hook'. 2097 (s-ends-with-p "-functions" (symbol-name symbol))) 2098 (consp value))) 2099 2100 (defun helpful--format-value (sym value) 2101 "Format VALUE as a string." 2102 (cond 2103 (helpful--view-literal 2104 (helpful--syntax-highlight (helpful--pretty-print value))) 2105 ;; Allow strings to be viewed with properties rendered in 2106 ;; Emacs, rather than as a literal. 2107 ((stringp value) 2108 value) 2109 ;; Allow keymaps to be viewed with keybindings shown and 2110 ;; links to the commands bound. 2111 ((keymapp value) 2112 (helpful--format-keymap value)) 2113 ((helpful--hook-p sym value) 2114 (helpful--format-hook value)) 2115 (t 2116 (helpful--pretty-print value)))) 2117 2118 (defun helpful--original-value (sym) 2119 "Return the original value for SYM, if any. 2120 2121 If SYM has an original value, return it in a list. Return nil 2122 otherwise." 2123 (let* ((orig-val-expr (get sym 'standard-value))) 2124 (when (consp orig-val-expr) 2125 (ignore-errors 2126 (list 2127 (eval (car orig-val-expr))))))) 2128 2129 (defun helpful--original-value-differs-p (sym) 2130 "Return t if SYM has an original value, and its current 2131 value is different." 2132 (let ((orig-val-list (helpful--original-value sym))) 2133 (and (consp orig-val-list) 2134 (not (eq (car orig-val-list) 2135 (symbol-value sym)))))) 2136 2137 (defun helpful-update () 2138 "Update the current *Helpful* buffer to the latest 2139 state of the current symbol." 2140 (interactive) 2141 (cl-assert (not (null helpful--sym))) 2142 (unless (buffer-live-p helpful--associated-buffer) 2143 (setq helpful--associated-buffer nil)) 2144 (helpful--ensure-loaded) 2145 (-let* ((val 2146 ;; Look at the value before setting `inhibit-read-only', so 2147 ;; users can see the correct value of that variable. 2148 (unless helpful--callable-p 2149 (helpful--sym-value helpful--sym helpful--associated-buffer))) 2150 (inhibit-read-only t) 2151 (start-line (line-number-at-pos)) 2152 (start-column (current-column)) 2153 (primitive-p (helpful--primitive-p helpful--sym helpful--callable-p)) 2154 (canonical-sym (helpful--canonical-symbol helpful--sym helpful--callable-p)) 2155 (look-for-src (or (not primitive-p) 2156 find-function-C-source-directory)) 2157 ((buf pos opened) 2158 (if look-for-src 2159 (helpful--definition helpful--sym helpful--callable-p) 2160 '(nil nil nil))) 2161 (source (when look-for-src 2162 (helpful--source helpful--sym helpful--callable-p buf pos))) 2163 (source-path (when buf 2164 (buffer-file-name buf))) 2165 (references (helpful--calculate-references 2166 helpful--sym helpful--callable-p 2167 source-path)) 2168 (aliases (helpful--aliases helpful--sym helpful--callable-p))) 2169 2170 (erase-buffer) 2171 2172 (insert (helpful--summary helpful--sym helpful--callable-p buf pos)) 2173 2174 (when (helpful--obsolete-info helpful--sym helpful--callable-p) 2175 (insert 2176 "\n\n" 2177 (helpful--format-obsolete-info helpful--sym helpful--callable-p))) 2178 2179 (when (and helpful--callable-p 2180 (not (helpful--kbd-macro-p helpful--sym))) 2181 (helpful--insert-section-break) 2182 (insert 2183 (helpful--heading "Signature") 2184 (helpful--syntax-highlight (helpful--signature helpful--sym)))) 2185 2186 (when (not helpful--callable-p) 2187 (helpful--insert-section-break) 2188 (let* ((sym helpful--sym) 2189 (multiple-views-p 2190 (or (stringp val) 2191 (keymapp val) 2192 (helpful--hook-p sym val)))) 2193 (when helpful--first-display 2194 (if (stringp val) 2195 ;; For strings, it's more intuitive to display them as 2196 ;; literals, so "1" and 1 are distinct. 2197 (setq helpful--view-literal t) 2198 ;; For everything else, prefer the pretty view if available. 2199 (setq helpful--view-literal nil))) 2200 (insert 2201 (helpful--heading 2202 (cond 2203 ;; Buffer-local variable and we're looking at the value in 2204 ;; a specific buffer. 2205 ((and 2206 helpful--associated-buffer 2207 (local-variable-p sym helpful--associated-buffer)) 2208 (format "Value in %s" 2209 (helpful--button 2210 (format "#<buffer %s>" (buffer-name helpful--associated-buffer)) 2211 'helpful-buffer-button 2212 'buffer helpful--associated-buffer 2213 'position pos))) 2214 ;; Buffer-local variable but default/global value. 2215 ((local-variable-if-set-p sym) 2216 "Global Value") 2217 ;; This variable is not buffer-local. 2218 (t "Value"))) 2219 (helpful--format-value sym val) 2220 "\n\n") 2221 (when (helpful--original-value-differs-p sym) 2222 (insert 2223 (helpful--heading "Original Value") 2224 (helpful--format-value 2225 sym 2226 (car (helpful--original-value sym))) 2227 "\n\n")) 2228 (when multiple-views-p 2229 (insert (helpful--make-toggle-literal-button) " ")) 2230 2231 (when (local-variable-if-set-p sym) 2232 (insert 2233 (helpful--button 2234 "Buffer values" 2235 'helpful-associated-buffer-button 2236 'symbol sym 2237 'prompt-p t) 2238 " " 2239 (helpful--button 2240 "Global value" 2241 'helpful-associated-buffer-button 2242 'symbol sym 2243 'prompt-p nil) 2244 " ")) 2245 (when (memq (helpful--sym-value helpful--sym helpful--associated-buffer) '(nil t)) 2246 (insert (helpful--make-toggle-button helpful--sym helpful--associated-buffer) " ")) 2247 (insert (helpful--make-set-button helpful--sym helpful--associated-buffer)) 2248 (when (custom-variable-p helpful--sym) 2249 (insert " " (helpful--make-customize-button helpful--sym))))) 2250 2251 (let ((docstring (helpful--docstring helpful--sym helpful--callable-p)) 2252 (version-info (unless helpful--callable-p 2253 (helpful--version-info helpful--sym)))) 2254 (when (or docstring version-info) 2255 (helpful--insert-section-break) 2256 (insert 2257 (helpful--heading "Documentation")) 2258 (when docstring 2259 (insert (helpful--format-docstring docstring))) 2260 (when version-info 2261 (insert "\n\n" (s-word-wrap 70 version-info))) 2262 (when (and (symbolp helpful--sym) (helpful--in-manual-p helpful--sym)) 2263 (insert "\n\n") 2264 (insert (helpful--make-manual-button helpful--sym))))) 2265 2266 ;; Show keybindings. 2267 ;; TODO: allow users to conveniently add and remove keybindings. 2268 (when (commandp helpful--sym) 2269 (helpful--insert-section-break) 2270 (insert 2271 (helpful--heading "Key Bindings") 2272 (helpful--format-keys helpful--sym aliases))) 2273 2274 (helpful--insert-section-break) 2275 2276 (insert 2277 (helpful--heading "References") 2278 (let ((src-button 2279 (when source-path 2280 (helpful--navigate-button 2281 (file-name-nondirectory source-path) 2282 source-path 2283 (or pos 2284 0))))) 2285 (cond 2286 ((and source-path references) 2287 (format "References in %s:\n%s" 2288 src-button 2289 (helpful--format-position-heads references source-path))) 2290 ((and source-path primitive-p) 2291 (format 2292 "Finding references in a .%s file is not supported." 2293 (f-ext source-path))) 2294 (source-path 2295 (format "%s is unused in %s." 2296 helpful--sym 2297 src-button)) 2298 ((and primitive-p (null find-function-C-source-directory)) 2299 "C code is not yet loaded.") 2300 (t 2301 "Could not find source file."))) 2302 "\n\n" 2303 (helpful--make-references-button helpful--sym helpful--callable-p)) 2304 2305 (when (and 2306 helpful--callable-p 2307 (symbolp helpful--sym) 2308 source 2309 (not primitive-p)) 2310 (insert 2311 " " 2312 (helpful--make-callees-button helpful--sym source))) 2313 2314 (when (helpful--advised-p helpful--sym) 2315 (helpful--insert-section-break) 2316 (insert 2317 (helpful--heading "Advice") 2318 (format "This %s is advised." 2319 (if (macrop helpful--sym) "macro" "function")))) 2320 2321 (let ((can-edebug 2322 (helpful--can-edebug-p helpful--sym helpful--callable-p buf pos)) 2323 (can-trace 2324 (and (symbolp helpful--sym) 2325 helpful--callable-p 2326 ;; Tracing uses advice, and you can't apply advice to 2327 ;; primitive functions that are replaced with special 2328 ;; opcodes. For example, `narrow-to-region'. 2329 (not (plist-get (symbol-plist helpful--sym) 'byte-opcode)))) 2330 (can-disassemble 2331 (and helpful--callable-p (not primitive-p))) 2332 (can-forget 2333 (and (not (special-form-p helpful--sym)) 2334 (not primitive-p)))) 2335 (when (or can-edebug can-trace can-disassemble can-forget) 2336 (helpful--insert-section-break) 2337 (insert (helpful--heading "Debugging"))) 2338 (when can-edebug 2339 (insert 2340 (helpful--make-edebug-button helpful--sym))) 2341 (when can-trace 2342 (when can-edebug 2343 (insert " ")) 2344 (insert 2345 (helpful--make-tracing-button helpful--sym))) 2346 2347 (when (and 2348 (or can-edebug can-trace) 2349 (or can-disassemble can-forget)) 2350 (insert "\n")) 2351 2352 (when can-disassemble 2353 (insert (helpful--make-disassemble-button helpful--sym))) 2354 2355 (when can-forget 2356 (when can-disassemble 2357 (insert " ")) 2358 (insert (helpful--make-forget-button helpful--sym helpful--callable-p)))) 2359 2360 (when aliases 2361 (helpful--insert-section-break) 2362 (insert 2363 (helpful--heading "Aliases") 2364 (s-join "\n" (--map (helpful--format-alias it helpful--callable-p) 2365 aliases)))) 2366 2367 (when helpful--callable-p 2368 (helpful--insert-implementations)) 2369 2370 (helpful--insert-section-break) 2371 2372 (when (or source-path primitive-p) 2373 (insert 2374 (helpful--heading 2375 (if (eq helpful--sym canonical-sym) 2376 "Source Code" 2377 "Alias Source Code")) 2378 (cond 2379 (source-path 2380 (concat 2381 (propertize (format "%s Defined in " (if primitive-p "//" ";;")) 2382 'face 'font-lock-comment-face) 2383 (helpful--navigate-button 2384 (f-abbrev source-path) 2385 source-path 2386 pos) 2387 "\n")) 2388 (primitive-p 2389 (concat 2390 (propertize 2391 "C code is not yet loaded." 2392 'face 'font-lock-comment-face) 2393 "\n\n" 2394 (helpful--button 2395 "Set C source directory" 2396 'helpful-c-source-directory)))))) 2397 (when source 2398 (insert 2399 (cond 2400 ((stringp source) 2401 (let ((mode (when primitive-p 2402 (pcase (file-name-extension source-path) 2403 ("c" 'c-mode) 2404 ("rs" (when (fboundp 'rust-mode) 'rust-mode)))))) 2405 (helpful--syntax-highlight source mode))) 2406 ((and (consp source) (eq (car source) 'closure)) 2407 (helpful--syntax-highlight 2408 (concat ";; Closure converted to defun by helpful.\n" 2409 (helpful--pretty-print 2410 (helpful--format-closure helpful--sym source))))) 2411 (t 2412 (helpful--syntax-highlight 2413 (concat 2414 (if (eq helpful--sym canonical-sym) 2415 ";; Could not find source code, showing raw function object.\n" 2416 ";; Could not find alias source code, showing raw function object.\n") 2417 (helpful--pretty-print source))))))) 2418 2419 (helpful--insert-section-break) 2420 2421 (-when-let (formatted-props (helpful--format-properties helpful--sym)) 2422 (insert 2423 (helpful--heading "Symbol Properties") 2424 formatted-props)) 2425 2426 (goto-char (point-min)) 2427 (forward-line (1- start-line)) 2428 (forward-char start-column) 2429 (setq helpful--first-display nil) 2430 2431 (when opened 2432 (kill-buffer buf)))) 2433 2434 ;; TODO: this isn't sufficient for `edebug-eval-defun'. 2435 (defun helpful--skip-advice (docstring) 2436 "Remove mentions of advice from DOCSTRING." 2437 (let* ((lines (s-lines docstring)) 2438 (relevant-lines 2439 (--drop-while 2440 (or (s-starts-with-p ":around advice:" it) 2441 (s-starts-with-p "This function has :around advice:" it)) 2442 lines))) 2443 (s-trim (s-join "\n" relevant-lines)))) 2444 2445 (defun helpful--format-argument (arg) 2446 "Format ARG (a symbol) according to Emacs help conventions." 2447 (let ((arg-str (symbol-name arg))) 2448 (if (s-starts-with-p "&" arg-str) 2449 arg-str 2450 (s-upcase arg-str)))) 2451 2452 (defun helpful--format-symbol (sym) 2453 "Format symbol as a string, escaping as necessary." 2454 ;; Arguably this is an Emacs bug. We should be able to use 2455 ;; (format "%S" sym) 2456 ;; but that converts foo? to "foo\\?". You can see this in other 2457 ;; parts of the Emacs UI, such as ERT. 2458 (s-replace " " "\\ " (format "%s" sym))) 2459 2460 ;; TODO: this is broken for -any?. 2461 (defun helpful--signature (sym) 2462 "Get the signature for function SYM, as a string. 2463 For example, \"(some-func FOO &optional BAR)\"." 2464 (let (docstring-sig 2465 source-sig 2466 (advertised-args 2467 (when (symbolp sym) 2468 (gethash (symbol-function sym) advertised-signature-table)))) 2469 ;; Get the usage from the function definition. 2470 (let* ((function-args 2471 (cond 2472 ((symbolp sym) 2473 (help-function-arglist sym)) 2474 ((byte-code-function-p sym) 2475 ;; argdesc can be a list of arguments or an integer 2476 ;; encoding the min/max number of arguments. See 2477 ;; Byte-Code Function Objects in the elisp manual. 2478 (let ((argdesc (aref sym 0))) 2479 (if (consp argdesc) 2480 argdesc 2481 ;; TODO: properly handle argdesc values. 2482 nil))) 2483 (t 2484 ;; Interpreted function (lambda ...) 2485 (cadr sym)))) 2486 (formatted-args 2487 (cond 2488 (advertised-args 2489 (-map #'helpful--format-argument advertised-args)) 2490 ((listp function-args) 2491 (-map #'helpful--format-argument function-args)) 2492 (t 2493 (list function-args))))) 2494 (setq source-sig 2495 (cond 2496 ;; If it's a function object, just show the arguments. 2497 ((not (symbolp sym)) 2498 (format "(%s)" 2499 (s-join " " formatted-args))) 2500 ;; If it has multiple arguments, join them with spaces. 2501 (formatted-args 2502 (format "(%s %s)" 2503 (helpful--format-symbol sym) 2504 (s-join " " formatted-args))) 2505 ;; Otherwise, this function takes no arguments when called. 2506 (t 2507 (format "(%s)" (helpful--format-symbol sym)))))) 2508 2509 ;; If the docstring ends with (fn FOO BAR), extract that. 2510 (-when-let (docstring (documentation sym)) 2511 (-when-let (docstring-with-usage (help-split-fundoc docstring sym)) 2512 (setq docstring-sig (car docstring-with-usage)))) 2513 2514 (cond 2515 ;; Advertised signature always wins. 2516 (advertised-args 2517 source-sig) 2518 ;; If that's not set, use the usage specification in the 2519 ;; docstring, if present. 2520 (docstring-sig) 2521 (t 2522 ;; Otherwise, just use the signature from the source code. 2523 source-sig)))) 2524 2525 (defun helpful--format-obsolete-info (sym callable-p) 2526 (-let [(use _ date) (helpful--obsolete-info sym callable-p)] 2527 (helpful--format-docstring 2528 (s-word-wrap 2529 70 2530 (format "This %s is obsolete%s%s" 2531 (helpful--kind-name sym callable-p) 2532 (if date (format " since %s" date) 2533 "") 2534 (cond ((stringp use) (concat "; " use)) 2535 (use (format "; use `%s' instead." use)) 2536 (t "."))))))) 2537 2538 (defun helpful--docstring (sym callable-p) 2539 "Get the docstring for SYM. 2540 Note that this returns the raw docstring, including \\=\\= 2541 escapes that are used by `substitute-command-keys'." 2542 (let ((text-quoting-style 'grave) 2543 docstring) 2544 (if callable-p 2545 (progn 2546 (setq docstring (documentation sym t)) 2547 (-when-let (docstring-with-usage (help-split-fundoc docstring sym)) 2548 (setq docstring (cdr docstring-with-usage)) 2549 (when docstring 2550 ;; Advice mutates the docstring, see 2551 ;; `advice--make-docstring'. Undo that. 2552 ;; TODO: Only do this if the function is advised. 2553 (setq docstring (helpful--skip-advice docstring))))) 2554 (setq docstring 2555 (documentation-property sym 'variable-documentation t))) 2556 docstring)) 2557 2558 (defun helpful--read-symbol (prompt default-val predicate) 2559 "Read a symbol from the minibuffer, with completion. 2560 Returns the symbol." 2561 (when (and default-val 2562 (not (funcall predicate default-val))) 2563 (setq default-val nil)) 2564 (when default-val 2565 ;; `completing-read' expects a string. 2566 (setq default-val (symbol-name default-val)) 2567 2568 ;; TODO: Only modify the prompt when we don't have ido/ivy/helm, 2569 ;; because the default is obvious for them. 2570 (setq prompt 2571 (replace-regexp-in-string 2572 (rx ": " eos) 2573 (format " (default: %s): " default-val) 2574 prompt))) 2575 (intern (completing-read prompt obarray 2576 predicate t nil nil 2577 default-val))) 2578 2579 ;;;###autoload 2580 (defun helpful-function (symbol) 2581 "Show help for function named SYMBOL. 2582 2583 See also `helpful-macro', `helpful-command' and `helpful-callable'." 2584 (interactive 2585 (list (helpful--read-symbol 2586 "Function: " 2587 (helpful--callable-at-point) 2588 #'functionp))) 2589 (funcall helpful-switch-buffer-function (helpful--buffer symbol t)) 2590 (helpful-update)) 2591 2592 ;;;###autoload 2593 (defun helpful-command (symbol) 2594 "Show help for interactive function named SYMBOL. 2595 2596 See also `helpful-function'." 2597 (interactive 2598 (list (helpful--read-symbol 2599 "Command: " 2600 (helpful--callable-at-point) 2601 #'commandp))) 2602 (funcall helpful-switch-buffer-function (helpful--buffer symbol t)) 2603 (helpful-update)) 2604 2605 ;;;###autoload 2606 (defun helpful-key (key-sequence) 2607 "Show help for interactive command bound to KEY-SEQUENCE." 2608 (interactive 2609 (list (read-key-sequence "Press key: "))) 2610 (let ((sym (key-binding key-sequence))) 2611 (cond 2612 ((null sym) 2613 (user-error "No command is bound to %s" 2614 (key-description key-sequence))) 2615 ((commandp sym) 2616 (funcall helpful-switch-buffer-function (helpful--buffer sym t)) 2617 (helpful-update)) 2618 (t 2619 (user-error "%s is bound to %s which is not a command" 2620 (key-description key-sequence) 2621 sym))))) 2622 2623 ;;;###autoload 2624 (defun helpful-macro (symbol) 2625 "Show help for macro named SYMBOL." 2626 (interactive 2627 (list (helpful--read-symbol 2628 "Macro: " 2629 (helpful--callable-at-point) 2630 #'macrop))) 2631 (funcall helpful-switch-buffer-function (helpful--buffer symbol t)) 2632 (helpful-update)) 2633 2634 ;;;###autoload 2635 (defun helpful-callable (symbol) 2636 "Show help for function, macro or special form named SYMBOL. 2637 2638 See also `helpful-macro', `helpful-function' and `helpful-command'." 2639 (interactive 2640 (list (helpful--read-symbol 2641 "Callable: " 2642 (helpful--callable-at-point) 2643 #'fboundp))) 2644 (funcall helpful-switch-buffer-function (helpful--buffer symbol t)) 2645 (helpful-update)) 2646 2647 (defun helpful--variable-p (symbol) 2648 "Return non-nil if SYMBOL is a variable." 2649 (or (get symbol 'variable-documentation) 2650 (and (boundp symbol) 2651 (not (keywordp symbol)) 2652 (not (eq symbol nil)) 2653 (not (eq symbol t))))) 2654 2655 (defun helpful--bound-p (symbol) 2656 "Return non-nil if SYMBOL is a variable or callable. 2657 2658 This differs from `boundp' because we do not consider nil, t 2659 or :foo." 2660 (or (fboundp symbol) 2661 (helpful--variable-p symbol))) 2662 2663 (defun helpful--bookmark-jump (bookmark) 2664 "Create and switch to helpful bookmark BOOKMARK." 2665 (let ((callable-p (bookmark-prop-get bookmark 'callable-p)) 2666 (sym (bookmark-prop-get bookmark 'sym)) 2667 (position (bookmark-prop-get bookmark 'position))) 2668 (if callable-p 2669 (helpful-callable sym) 2670 (helpful-variable sym)) 2671 (goto-char position))) 2672 2673 (defun helpful--bookmark-make-record () 2674 "Create a bookmark record for helpful buffers. 2675 2676 See docs of `bookmark-make-record-function'." 2677 `((sym . ,helpful--sym) 2678 (callable-p . ,helpful--callable-p) 2679 (position . ,(point)) 2680 (handler . helpful--bookmark-jump))) 2681 2682 (defun helpful--convert-c-name (symbol var) 2683 "Convert SYMBOL from a C name to an Elisp name. 2684 E.g. convert `Fmake_string' to `make-string' or 2685 `Vgc_cons_percentage' to `gc-cons-percentage'. Interpret 2686 SYMBOL as variable name if VAR, else a function name. Return 2687 nil if SYMBOL doesn't begin with \"F\" or \"V\"." 2688 (let ((string (symbol-name symbol)) 2689 (prefix (if var "V" "F"))) 2690 (when (s-starts-with-p prefix string) 2691 (intern 2692 (s-chop-prefix 2693 prefix 2694 (s-replace "_" "-" string)))))) 2695 2696 ;;;###autoload 2697 (defun helpful-symbol (symbol) 2698 "Show help for SYMBOL, a variable, function or macro. 2699 2700 See also `helpful-callable' and `helpful-variable'." 2701 (interactive 2702 (list (helpful--read-symbol 2703 "Symbol: " 2704 (helpful--symbol-at-point) 2705 #'helpful--bound-p))) 2706 (let ((c-var-sym (helpful--convert-c-name symbol t)) 2707 (c-fn-sym (helpful--convert-c-name symbol nil))) 2708 (cond 2709 ((and (boundp symbol) (fboundp symbol)) 2710 (if (y-or-n-p 2711 (format "%s is a both a variable and a callable, show variable?" 2712 symbol)) 2713 (helpful-variable symbol) 2714 (helpful-callable symbol))) 2715 ((fboundp symbol) 2716 (helpful-callable symbol)) 2717 ((boundp symbol) 2718 (helpful-variable symbol)) 2719 ((and c-fn-sym (fboundp c-fn-sym)) 2720 (helpful-callable c-fn-sym)) 2721 ((and c-var-sym (boundp c-var-sym)) 2722 (helpful-variable c-var-sym)) 2723 (t 2724 (user-error "Not bound: %S" symbol))))) 2725 2726 ;;;###autoload 2727 (defun helpful-variable (symbol) 2728 "Show help for variable named SYMBOL." 2729 (interactive 2730 (list (helpful--read-symbol 2731 "Variable: " 2732 (helpful--variable-at-point) 2733 #'helpful--variable-p))) 2734 (funcall helpful-switch-buffer-function (helpful--buffer symbol nil)) 2735 (helpful-update)) 2736 2737 (defun helpful--variable-at-point-exactly () 2738 "Return the symbol at point, if it's a bound variable." 2739 (let ((var (variable-at-point))) 2740 ;; `variable-at-point' uses 0 rather than nil to signify no symbol 2741 ;; at point (presumably because 'nil is a symbol). 2742 (unless (symbolp var) 2743 (setq var nil)) 2744 (when (helpful--variable-p var) 2745 var))) 2746 2747 (defun helpful--variable-defined-at-point () 2748 "Return the variable defined in the form enclosing point." 2749 ;; TODO: do the same thing if point is just before a top-level form. 2750 (save-excursion 2751 (save-restriction 2752 (widen) 2753 (let* ((ppss (syntax-ppss)) 2754 (sexp-start (nth 1 ppss)) 2755 sexp) 2756 (when sexp-start 2757 (goto-char sexp-start) 2758 (setq sexp (condition-case nil 2759 (read (current-buffer)) 2760 (error nil))) 2761 (when (memq (car-safe sexp) 2762 (list 'defvar 'defvar-local 'defcustom 'defconst)) 2763 (nth 1 sexp))))))) 2764 2765 (defun helpful--variable-at-point () 2766 "Return the variable exactly under point, or defined at point." 2767 (let ((var (helpful--variable-at-point-exactly))) 2768 (if var 2769 var 2770 (let ((var (helpful--variable-defined-at-point))) 2771 (when (helpful--variable-p var) 2772 var))))) 2773 2774 (defun helpful--callable-at-point () 2775 (let ((sym (symbol-at-point)) 2776 (enclosing-sym (function-called-at-point))) 2777 (if (fboundp sym) 2778 sym 2779 enclosing-sym))) 2780 2781 (defun helpful--symbol-at-point-exactly () 2782 "Return the symbol at point, if it's bound." 2783 (let ((sym (symbol-at-point))) 2784 (when (helpful--bound-p sym) 2785 sym))) 2786 2787 (defun helpful--symbol-at-point () 2788 "Find the most relevant symbol at or around point. 2789 Returns nil if nothing found." 2790 (or 2791 (helpful--symbol-at-point-exactly) 2792 (helpful--callable-at-point) 2793 (helpful--variable-at-point))) 2794 2795 ;;;###autoload 2796 (defun helpful-at-point () 2797 "Show help for the symbol at point." 2798 (interactive) 2799 (-if-let (symbol (helpful--symbol-at-point)) 2800 (helpful-symbol symbol) 2801 (user-error "There is no symbol at point."))) 2802 2803 (defun helpful--imenu-index () 2804 "Return a list of headings in the current buffer, suitable for 2805 imenu." 2806 (let (headings) 2807 (goto-char (point-min)) 2808 (while (not (eobp)) 2809 (when (eq (get-text-property (point) 'face) 2810 'helpful-heading) 2811 (push 2812 (cons 2813 (buffer-substring-no-properties 2814 (line-beginning-position) (line-end-position)) 2815 (line-beginning-position)) 2816 headings)) 2817 (forward-line)) 2818 (nreverse headings))) 2819 2820 (defun helpful--flash-region (start end) 2821 "Temporarily highlight region from START to END." 2822 (let ((overlay (make-overlay start end))) 2823 (overlay-put overlay 'face 'highlight) 2824 (run-with-timer 1.5 nil 'delete-overlay overlay))) 2825 2826 (defun helpful-visit-reference () 2827 "Go to the reference at point." 2828 (interactive) 2829 (let* ((sym helpful--sym) 2830 (path (get-text-property (point) 'helpful-path)) 2831 (pos (get-text-property (point) 'helpful-pos)) 2832 (pos-is-start (get-text-property (point) 'helpful-pos-is-start))) 2833 (when (and path pos) 2834 ;; If we're looking at a source excerpt, calculate the offset of 2835 ;; point, so we don't just go the start of the excerpt. 2836 (when pos-is-start 2837 (save-excursion 2838 (let ((offset 0)) 2839 (while (and 2840 (get-text-property (point) 'helpful-pos) 2841 (not (eobp))) 2842 (backward-char 1) 2843 (setq offset (1+ offset))) 2844 ;; On the last iteration we moved outside the source 2845 ;; excerpt, so we overcounted by one character. 2846 (setq offset (1- offset)) 2847 2848 ;; Set POS so we go to exactly the place in the source 2849 ;; code where point was in the helpful excerpt. 2850 (setq pos (+ pos offset))))) 2851 2852 (find-file path) 2853 (helpful--goto-char-widen pos) 2854 (recenter 0) 2855 (save-excursion 2856 (let ((defun-end (scan-sexps (point) 1))) 2857 (while (re-search-forward 2858 (rx-to-string `(seq symbol-start ,(symbol-name sym) symbol-end)) 2859 defun-end t) 2860 (helpful--flash-region (match-beginning 0) (match-end 0)))))))) 2861 2862 (defun helpful-kill-buffers () 2863 "Kill all `helpful-mode' buffers. 2864 2865 See also `helpful-max-buffers'." 2866 (interactive) 2867 (dolist (buffer (buffer-list)) 2868 (when (eq (buffer-local-value 'major-mode buffer) 'helpful-mode) 2869 (kill-buffer buffer)))) 2870 2871 (defvar helpful-mode-map 2872 (let* ((map (make-sparse-keymap))) 2873 (define-key map (kbd "g") #'helpful-update) 2874 (define-key map (kbd "RET") #'helpful-visit-reference) 2875 2876 (define-key map (kbd "TAB") #'forward-button) 2877 (define-key map (kbd "<backtab>") #'backward-button) 2878 2879 (define-key map (kbd "n") #'forward-button) 2880 (define-key map (kbd "p") #'backward-button) 2881 map) 2882 "Keymap for `helpful-mode'.") 2883 2884 (declare-function bookmark-prop-get "bookmark" (bookmark prop)) 2885 (declare-function bookmark-make-record-default "bookmark" 2886 (&optional no-file no-context posn)) 2887 ;; Ensure this variable is defined even if bookmark.el isn't loaded 2888 ;; yet. This follows the pattern in help-mode.el.gz. 2889 ;; TODO: find a cleaner solution. 2890 (defvar bookmark-make-record-function) 2891 2892 (define-derived-mode helpful-mode special-mode "Helpful" 2893 "Major mode for *Helpful* buffers." 2894 (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) 2895 2896 (setq imenu-create-index-function #'helpful--imenu-index) 2897 ;; Prevent imenu converting "Source Code" to "Source.Code". 2898 (setq-local imenu-space-replacement " ") 2899 2900 ;; Enable users to bookmark helpful buffers. 2901 (set (make-local-variable 'bookmark-make-record-function) 2902 #'helpful--bookmark-make-record)) 2903 2904 (provide 'helpful) 2905 ;;; helpful.el ends here