commit 168c040b54b24220ca8d799eadfbb37b47dd2924 parent 78ca7bf09b26818c35b5715645899aa31b35610b Author: Lukas Henkel <lh@entf.net> Date: Thu, 31 Mar 2022 22:13:06 +0200 Add helpful Diffstat:
13 files changed, 3999 insertions(+), 3 deletions(-)
diff --git a/elpa/dash-functional-20210210.1449/dash-functional-autoloads.el b/elpa/dash-functional-20210210.1449/dash-functional-autoloads.el @@ -0,0 +1,15 @@ +;;; dash-functional-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: +;;; dash-functional-autoloads.el ends here diff --git a/elpa/dash-functional-20210210.1449/dash-functional-pkg.el b/elpa/dash-functional-20210210.1449/dash-functional-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from dash-functional.el -*- no-byte-compile: t -*- +(define-package "dash-functional" "20210210.1449" "Collection of useful combinators for Emacs Lisp" '((dash "2.18.0")) :commit "da167c51e9fd167a48d06c7c0ee8e3ac7abd9718" :authors '(("Matus Goljer" . "matus.goljer@gmail.com") ("Magnar Sveen" . "magnars@gmail.com")) :maintainer '("Matus Goljer" . "matus.goljer@gmail.com") :keywords '("extensions" "lisp") :url "https://github.com/magnars/dash.el") diff --git a/elpa/dash-functional-20210210.1449/dash-functional.el b/elpa/dash-functional-20210210.1449/dash-functional.el @@ -0,0 +1,55 @@ +;;; dash-functional.el --- Collection of useful combinators for Emacs Lisp -*- lexical-binding: t -*- + +;; Copyright (C) 2013-2021 Free Software Foundation, Inc. + +;; Author: Matus Goljer <matus.goljer@gmail.com> +;; Magnar Sveen <magnars@gmail.com> +;; Version: 1.3.0 +;; Package-Version: 20210210.1449 +;; Package-Commit: da167c51e9fd167a48d06c7c0ee8e3ac7abd9718 +;; Package-Requires: ((dash "2.18.0")) +;; Keywords: extensions, lisp +;; Homepage: https://github.com/magnars/dash.el + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; *N.B.:* This package has been absorbed, and is therefore made +;; obsolete, by the `dash' package, version 2.18.0. +;; +;; If you maintain a package that depends on `dash-functional', then +;; you should change that to instead depend on `dash' version 2.18.0, +;; and remove all references to `dash-functional'. +;; +;; If you use any packages that depend on `dash-functional', either +;; directly or indirectly, then you will have to wait until all of +;; them have transitioned away from it before you can remove it. +;; +;; For more information on this, see the following URL: +;; `https://github.com/magnars/dash.el/wiki/Obsoletion-of-dash-functional.el' + +;;; Code: + +(require 'dash) + +(eval-and-compile + (let ((msg "Package dash-functional is obsolete; use dash 2.18.0 instead")) + (if (and noninteractive (fboundp 'byte-compile-warn)) + (byte-compile-warn msg) + (message "%s" msg)))) + +(provide 'dash-functional) + +;;; dash-functional.el ends here diff --git a/elpa/dash-functional-20210210.1449/dash-functional.elc b/elpa/dash-functional-20210210.1449/dash-functional.elc Binary files differ. diff --git a/elpa/elisp-refs-20220220.2305/elisp-refs-autoloads.el b/elpa/elisp-refs-20220220.2305/elisp-refs-autoloads.el @@ -0,0 +1,68 @@ +;;; elisp-refs-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "elisp-refs" "elisp-refs.el" (0 0 0 0)) +;;; Generated autoloads from elisp-refs.el + +(autoload 'elisp-refs-function "elisp-refs" "\ +Display all the references to function SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +This searches for functions, not macros. For that, see +`elisp-refs-macro'. + +\(fn SYMBOL &optional PATH-PREFIX)" t nil) + +(autoload 'elisp-refs-macro "elisp-refs" "\ +Display all the references to macro SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +This searches for macros, not functions. For that, see +`elisp-refs-function'. + +\(fn SYMBOL &optional PATH-PREFIX)" t nil) + +(autoload 'elisp-refs-special "elisp-refs" "\ +Display all the references to special form SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +\(fn SYMBOL &optional PATH-PREFIX)" t nil) + +(autoload 'elisp-refs-variable "elisp-refs" "\ +Display all the references to variable SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +\(fn SYMBOL &optional PATH-PREFIX)" t nil) + +(autoload 'elisp-refs-symbol "elisp-refs" "\ +Display all the references to SYMBOL in all loaded elisp files. + +If called with a prefix, prompt for a directory to limit the +search. + +\(fn SYMBOL &optional PATH-PREFIX)" t nil) + +(register-definition-prefixes "elisp-refs" '("elisp-refs-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: +;;; elisp-refs-autoloads.el ends here diff --git a/elpa/elisp-refs-20220220.2305/elisp-refs-pkg.el b/elpa/elisp-refs-20220220.2305/elisp-refs-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from elisp-refs.el -*- no-byte-compile: t -*- +(define-package "elisp-refs" "20220220.2305" "find callers of elisp functions or macros" '((dash "2.12.0") (s "1.11.0")) :commit "8f84280997d8b233d66fb9958a34b46078c58b03" :authors '(("Wilfred Hughes" . "me@wilfred.me.uk")) :maintainer '("Wilfred Hughes" . "me@wilfred.me.uk") :keywords '("lisp")) diff --git a/elpa/elisp-refs-20220220.2305/elisp-refs.el b/elpa/elisp-refs-20220220.2305/elisp-refs.el @@ -0,0 +1,867 @@ +;;; elisp-refs.el --- find callers of elisp functions or macros -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2020 Wilfred Hughes <me@wilfred.me.uk> + +;; Author: Wilfred Hughes <me@wilfred.me.uk> +;; Version: 1.5 +;; Package-Version: 20220220.2305 +;; Package-Commit: 8f84280997d8b233d66fb9958a34b46078c58b03 +;; Keywords: lisp +;; Package-Requires: ((dash "2.12.0") (s "1.11.0")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; elisp-refs.el is an Emacs package for finding references to +;; functions, macros or variables. Unlike a dumb text search, +;; elisp-refs.el actually parses the code, so it's never confused by +;; comments or `foo-bar' matching `foo'. +;; +;; See https://github.com/Wilfred/refs.el/blob/master/README.md for +;; more information. + +;;; Code: + +(require 'dash) +(require 's) +(require 'format) +(eval-when-compile (require 'cl-lib)) + +;;; Internal + +(defvar elisp-refs-verbose t) + +(defun elisp-refs--format-int (integer) + "Format INTEGER as a string, with , separating thousands." + (let ((number (abs integer)) + (parts nil)) + (while (> number 999) + (push (format "%03d" (mod number 1000)) + parts) + (setq number (/ number 1000))) + (push (format "%d" number) parts) + (concat + (if (< integer 0) "-" "") + (s-join "," parts)))) + +(defsubst elisp-refs--start-pos (end-pos) + "Find the start position of form ending at END-POS +in the current buffer." + (let ((parse-sexp-ignore-comments t)) + (scan-sexps end-pos -1))) + +(defun elisp-refs--sexp-positions (buffer start-pos end-pos) + "Return a list of start and end positions of all the sexps +between START-POS and END-POS (inclusive) in BUFFER. + +Positions exclude quote characters, so given 'foo or `foo, we +report the position of the f. + +Not recursive, so we don't consider subelements of nested sexps." + (let ((positions nil)) + (with-current-buffer buffer + (condition-case _err + (catch 'done + (while t + (let* ((sexp-end-pos (let ((parse-sexp-ignore-comments t)) + (scan-sexps start-pos 1)))) + ;; If we've reached a sexp beyond the range requested, + ;; or if there are no sexps left, we're done. + (when (or (null sexp-end-pos) (> sexp-end-pos end-pos)) + (throw 'done nil)) + ;; Otherwise, this sexp is in the range requested. + (push (list (elisp-refs--start-pos sexp-end-pos) sexp-end-pos) + positions) + (setq start-pos sexp-end-pos)))) + ;; Terminate when we see "Containing expression ends prematurely" + (scan-error nil))) + (nreverse positions))) + +(defun elisp-refs--read-buffer-form () + "Read a form from the current buffer, starting at point. +Returns a list: +\(form form-start-pos form-end-pos symbol-positions read-start-pos) + +SYMBOL-POSITIONS are 0-indexed, relative to READ-START-POS." + (let* ((read-with-symbol-positions t) + (read-start-pos (point)) + (form (read (current-buffer))) + (symbols (if (boundp 'read-symbol-positions-list) + read-symbol-positions-list + (read-positioning-symbols (current-buffer)))) + (end-pos (point)) + (start-pos (elisp-refs--start-pos end-pos))) + (list form start-pos end-pos symbols read-start-pos))) + +(defvar elisp-refs--path nil + "A buffer-local variable used by `elisp-refs--contents-buffer'. +Internal implementation detail.") + +(defun elisp-refs--read-all-buffer-forms (buffer) + "Read all the forms in BUFFER, along with their positions." + (with-current-buffer buffer + (goto-char (point-min)) + (let ((forms nil)) + (condition-case err + (while t + (push (elisp-refs--read-buffer-form) forms)) + (error + (if (or (equal (car err) 'end-of-file) + ;; TODO: this shouldn't occur in valid elisp files, + ;; but it's happening in helm-utils.el. + (equal (car err) 'scan-error)) + ;; Reached end of file, we're done. + (nreverse forms) + ;; Some unexpected error, propagate. + (error "Unexpected error whilst reading %s position %s: %s" + (abbreviate-file-name elisp-refs--path) (point) err))))))) + +(defun elisp-refs--proper-list-p (val) + "Is VAL a proper list?" + (if (fboundp 'format-proper-list-p) + ;; Emacs stable. + (with-no-warnings (format-proper-list-p val)) + ;; Function was renamed in Emacs master: + ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2fde6275b69fd113e78243790bf112bbdd2fe2bf + (with-no-warnings (proper-list-p val)))) + +(defun elisp-refs--walk (buffer form start-pos end-pos symbol match-p &optional path) + "Walk FORM, a nested list, and return a list of sublists (with +their positions) where MATCH-P returns t. FORM is traversed +depth-first (pre-order traversal, left-to-right). + +MATCH-P is called with three arguments: +\(SYMBOL CURRENT-FORM PATH). + +PATH is the first element of all the enclosing forms of +CURRENT-FORM, innermost first, along with the index of the +current form. + +For example if we are looking at h in (e f (g h)), PATH takes the +value ((g . 1) (e . 2)). + +START-POS and END-POS should be the position of FORM within BUFFER." + (cond + ((funcall match-p symbol form path) + ;; If this form matches, just return it, along with the position. + (list (list form start-pos end-pos))) + ;; Otherwise, recurse on the subforms. + ((consp form) + (let ((matches nil) + ;; Find the positions of the subforms. + (subforms-positions + (if (eq (car-safe form) '\`) + ;; Kludge: `elisp-refs--sexp-positions' excludes the ` when + ;; calculating positions. So, to find the inner + ;; positions when walking from `(...) to (...), we + ;; don't need to increment the start position. + (cons nil (elisp-refs--sexp-positions buffer start-pos end-pos)) + ;; Calculate the positions after the opening paren. + (elisp-refs--sexp-positions buffer (1+ start-pos) end-pos)))) + ;; For each subform, recurse if it's a list, or a matching symbol. + (--each (-zip form subforms-positions) + (-let [(subform subform-start subform-end) it] + (when (or + (and (consp subform) (elisp-refs--proper-list-p subform)) + (and (symbolp subform) (eq subform symbol))) + (-when-let (subform-matches + (elisp-refs--walk + buffer subform + subform-start subform-end + symbol match-p + (cons (cons (car-safe form) it-index) path))) + (push subform-matches matches))))) + + ;; Concat the results from all the subforms. + (apply #'append (nreverse matches)))))) + +;; TODO: condition-case (condition-case ... (error ...)) is not a call +;; TODO: (cl-destructuring-bind (foo &rest bar) ...) is not a call +;; TODO: letf, cl-letf, -let, -let* +(defun elisp-refs--function-p (symbol form path) + "Return t if FORM looks like a function call to SYMBOL." + (cond + ((not (consp form)) + nil) + ;; Ignore (defun _ (SYMBOL ...) ...) + ((or (equal (car path) '(defsubst . 2)) + (equal (car path) '(defun . 2)) + (equal (car path) '(defmacro . 2)) + (equal (car path) '(cl-defun . 2))) + nil) + ;; Ignore (lambda (SYMBOL ...) ...) + ((equal (car path) '(lambda . 1)) + nil) + ;; Ignore (let (SYMBOL ...) ...) + ;; and (let* (SYMBOL ...) ...) + ((or + (equal (car path) '(let . 1)) + (equal (car path) '(let* . 1))) + nil) + ;; Ignore (let ((SYMBOL ...)) ...) + ((or + (equal (cl-second path) '(let . 1)) + (equal (cl-second path) '(let* . 1))) + nil) + ;; Ignore (declare-function NAME (ARGS...)) + ((equal (car path) '(declare-function . 3)) + nil) + ;; (SYMBOL ...) + ((eq (car form) symbol) + t) + ;; (foo ... #'SYMBOL ...) + ((--any-p (equal it (list 'function symbol)) form) + t) + ;; (funcall 'SYMBOL ...) + ((and (eq (car form) 'funcall) + (equal `',symbol (cl-second form))) + t) + ;; (apply 'SYMBOL ...) + ((and (eq (car form) 'apply) + (equal `',symbol (cl-second form))) + t))) + +(defun elisp-refs--macro-p (symbol form path) + "Return t if FORM looks like a macro call to SYMBOL." + (cond + ((not (consp form)) + nil) + ;; Ignore (defun _ (SYMBOL ...) ...) + ((or (equal (car path) '(defsubst . 2)) + (equal (car path) '(defun . 2)) + (equal (car path) '(defmacro . 2))) + nil) + ;; Ignore (lambda (SYMBOL ...) ...) + ((equal (car path) '(lambda . 1)) + nil) + ;; Ignore (let (SYMBOL ...) ...) + ;; and (let* (SYMBOL ...) ...) + ((or + (equal (car path) '(let . 1)) + (equal (car path) '(let* . 1))) + nil) + ;; Ignore (let ((SYMBOL ...)) ...) + ((or + (equal (cl-second path) '(let . 1)) + (equal (cl-second path) '(let* . 1))) + nil) + ;; (SYMBOL ...) + ((eq (car form) symbol) + t))) + +;; Looking for a special form is exactly the same as looking for a +;; macro. +(defalias 'elisp-refs--special-p 'elisp-refs--macro-p) + +(defun elisp-refs--variable-p (symbol form path) + "Return t if this looks like a variable reference to SYMBOL. +We consider parameters to be variables too." + (cond + ((consp form) + nil) + ;; Ignore (defun _ (SYMBOL ...) ...) + ((or (equal (car path) '(defsubst . 1)) + (equal (car path) '(defun . 1)) + (equal (car path) '(defmacro . 1)) + (equal (car path) '(cl-defun . 1))) + nil) + ;; (let (SYMBOL ...) ...) is a variable, not a function call. + ((or + (equal (cl-second path) '(let . 1)) + (equal (cl-second path) '(let* . 1))) + t) + ;; (lambda (SYMBOL ...) ...) is a variable + ((equal (cl-second path) '(lambda . 1)) + t) + ;; (let ((SYMBOL ...)) ...) is also a variable. + ((or + (equal (cl-third path) '(let . 1)) + (equal (cl-third path) '(let* . 1))) + t) + ;; Ignore (SYMBOL ...) otherwise, we assume it's a function/macro + ;; call. + ((equal (car path) (cons symbol 0)) + nil) + ((eq form symbol) + t))) + +;; TODO: benchmark building a list with `push' rather than using +;; mapcat. +(defun elisp-refs--read-and-find (buffer symbol match-p) + "Read all the forms in BUFFER, and return a list of all forms that +contain SYMBOL where MATCH-P returns t. + +For every matching form found, we return the form itself along +with its start and end position." + (-non-nil + (--mapcat + (-let [(form start-pos end-pos symbol-positions _read-start-pos) it] + ;; Optimisation: don't bother walking a form if contains no + ;; references to the symbol we're looking for. + (when (assq symbol symbol-positions) + (elisp-refs--walk buffer form start-pos end-pos symbol match-p))) + (elisp-refs--read-all-buffer-forms buffer)))) + +(defun elisp-refs--read-and-find-symbol (buffer symbol) + "Read all the forms in BUFFER, and return a list of all +positions of SYMBOL." + (-non-nil + (--mapcat + (-let [(_ _ _ symbol-positions read-start-pos) it] + (--map + (-let [(sym . offset) it] + (when (eq sym symbol) + (-let* ((start-pos (+ read-start-pos offset)) + (end-pos (+ start-pos (length (symbol-name sym))))) + (list sym start-pos end-pos)))) + symbol-positions)) + + (elisp-refs--read-all-buffer-forms buffer)))) + +(defun elisp-refs--filter-obarray (pred) + "Return a list of all the items in `obarray' where PRED returns t." + (let (symbols) + (mapatoms (lambda (symbol) + (when (and (funcall pred symbol) + (not (equal (symbol-name symbol) ""))) + (push symbol symbols)))) + symbols)) + +(defun elisp-refs--loaded-paths () + "Return a list of all files that have been loaded in Emacs. +Where the file was a .elc, return the path to the .el file instead." + (let ((elc-paths (-non-nil (mapcar #'-first-item load-history)))) + (-non-nil + (--map + (let ((el-name (format "%s.el" (file-name-sans-extension it))) + (el-gz-name (format "%s.el.gz" (file-name-sans-extension it)))) + (cond ((file-exists-p el-name) el-name) + ((file-exists-p el-gz-name) el-gz-name) + ;; Ignore files where we can't find a .el file. + (t nil))) + elc-paths)))) + +(defun elisp-refs--contents-buffer (path) + "Read PATH into a disposable buffer, and return it. +Works around the fact that Emacs won't allow multiple buffers +visiting the same file." + (let ((fresh-buffer (generate-new-buffer (format " *refs-%s*" path))) + ;; Be defensive against users overriding encoding + ;; configurations (Helpful bugs #75 and #147). + (coding-system-for-read nil) + (file-name-handler-alist + '(("\\(?:\\.dz\\|\\.txz\\|\\.xz\\|\\.lzma\\|\\.lz\\|\\.g?z\\|\\.\\(?:tgz\\|svgz\\|sifz\\)\\|\\.tbz2?\\|\\.bz2\\|\\.Z\\)\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)?\\'" . + jka-compr-handler) + ("\\`/:" . file-name-non-special)))) + (with-current-buffer fresh-buffer + (setq-local elisp-refs--path path) + (insert-file-contents path) + ;; We don't enable emacs-lisp-mode because it slows down this + ;; function significantly. We just need the syntax table for + ;; scan-sexps to do the right thing with comments. + (set-syntax-table emacs-lisp-mode-syntax-table)) + fresh-buffer)) + +(defvar elisp-refs--highlighting-buffer + nil + "A temporary buffer used for highlighting. +Since `elisp-refs--syntax-highlight' is a hot function, we +don't want to create lots of temporary buffers.") + +(defun elisp-refs--syntax-highlight (str) + "Apply font-lock properties to a string STR of Emacs lisp code." + ;; Ensure we have a highlighting buffer to work with. + (unless (and elisp-refs--highlighting-buffer + (buffer-live-p elisp-refs--highlighting-buffer)) + (setq elisp-refs--highlighting-buffer + (generate-new-buffer " *refs-highlighting*")) + (with-current-buffer elisp-refs--highlighting-buffer + (delay-mode-hooks (emacs-lisp-mode)))) + + (with-current-buffer elisp-refs--highlighting-buffer + (erase-buffer) + (insert str) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (with-no-warnings + (font-lock-fontify-buffer))) + (buffer-string))) + +(defun elisp-refs--replace-tabs (string) + "Replace tabs in STRING with spaces." + ;; This is important for unindenting, as we may unindent by less + ;; than one whole tab. + (s-replace "\t" (s-repeat tab-width " ") string)) + +(defun elisp-refs--lines (string) + "Return a list of all the lines in STRING. +'a\nb' -> ('a\n' 'b')" + (let ((lines nil)) + (while (> (length string) 0) + (let ((index (s-index-of "\n" string))) + (if index + (progn + (push (substring string 0 (1+ index)) lines) + (setq string (substring string (1+ index)))) + (push string lines) + (setq string "")))) + (nreverse lines))) + +(defun elisp-refs--map-lines (string fn) + "Execute FN for each line in string, and join the result together." + (let ((result nil)) + (dolist (line (elisp-refs--lines string)) + (push (funcall fn line) result)) + (apply #'concat (nreverse result)))) + +(defun elisp-refs--unindent-rigidly (string) + "Given an indented STRING, unindent rigidly until +at least one line has no indent. + +STRING should have a 'elisp-refs-start-pos property. The returned +string will have this property updated to reflect the unindent." + (let* ((lines (s-lines string)) + ;; Get the leading whitespace for each line. + (indents (--map (car (s-match (rx bos (+ whitespace)) it)) + lines)) + (min-indent (-min (--map (length it) indents)))) + (propertize + (elisp-refs--map-lines + string + (lambda (line) (substring line min-indent))) + 'elisp-refs-unindented min-indent))) + +(defun elisp-refs--containing-lines (buffer start-pos end-pos) + "Return a string, all the lines in BUFFER that are between +START-POS and END-POS (inclusive). + +For the characters that are between START-POS and END-POS, +propertize them." + (let (expanded-start-pos expanded-end-pos) + (with-current-buffer buffer + ;; Expand START-POS and END-POS to line boundaries. + (goto-char start-pos) + (beginning-of-line) + (setq expanded-start-pos (point)) + (goto-char end-pos) + (end-of-line) + (setq expanded-end-pos (point)) + + ;; Extract the rest of the line before and after the section we're interested in. + (let* ((before-match (buffer-substring expanded-start-pos start-pos)) + (after-match (buffer-substring end-pos expanded-end-pos)) + ;; Concat the extra text with the actual match, ensuring we + ;; highlight the match as code, but highlight the rest as as + ;; comments. + (text (concat + (propertize before-match + 'face 'font-lock-comment-face) + (elisp-refs--syntax-highlight (buffer-substring start-pos end-pos)) + (propertize after-match + 'face 'font-lock-comment-face)))) + (-> text + (elisp-refs--replace-tabs) + (elisp-refs--unindent-rigidly) + (propertize 'elisp-refs-start-pos expanded-start-pos + 'elisp-refs-path elisp-refs--path)))))) + +(defun elisp-refs--find-file (button) + "Open the file referenced by BUTTON." + (find-file (button-get button 'path)) + (goto-char (point-min))) + +(define-button-type 'elisp-refs-path-button + 'action 'elisp-refs--find-file + 'follow-link t + 'help-echo "Open file") + +(defun elisp-refs--path-button (path) + "Return a button that navigates to PATH." + (with-temp-buffer + (insert-text-button + (abbreviate-file-name path) + :type 'elisp-refs-path-button + 'path path) + (buffer-string))) + +(defun elisp-refs--describe (button) + "Show *Help* for the symbol referenced by BUTTON." + (let ((symbol (button-get button 'symbol)) + (kind (button-get button 'kind))) + (cond ((eq kind 'symbol) + (describe-symbol symbol)) + ((eq kind 'variable) + (describe-variable symbol)) + (t + ;; Emacs uses `describe-function' for functions, macros and + ;; special forms. + (describe-function symbol))))) + +(define-button-type 'elisp-refs-describe-button + 'action 'elisp-refs--describe + 'follow-link t + 'help-echo "Describe") + +(defun elisp-refs--describe-button (symbol kind) + "Return a button that shows *Help* for SYMBOL. +KIND should be 'function, 'macro, 'variable, 'special or 'symbol." + (with-temp-buffer + (insert (symbol-name kind) " ") + (insert-text-button + (symbol-name symbol) + :type 'elisp-refs-describe-button + 'symbol symbol + 'kind kind) + (buffer-string))) + +(defun elisp-refs--pluralize (number thing) + "Human-friendly description of NUMBER occurrences of THING." + (format "%s %s%s" + (elisp-refs--format-int number) + thing + (if (equal number 1) "" "s"))) + +(defun elisp-refs--format-count (symbol ref-count file-count + searched-file-count prefix) + (let* ((file-str (if (zerop file-count) + "" + (format " in %s" (elisp-refs--pluralize file-count "file")))) + (found-str (format "Found %s to %s%s." + (elisp-refs--pluralize ref-count "reference") + symbol + file-str)) + (searched-str (if prefix + (format "Searched %s in %s." + (elisp-refs--pluralize searched-file-count "loaded file") + (elisp-refs--path-button (file-name-as-directory prefix))) + (format "Searched all %s loaded in Emacs." + (elisp-refs--pluralize searched-file-count "file"))))) + (s-word-wrap 70 (format "%s %s" found-str searched-str)))) + +;; TODO: if we have multiple matches on one line, we repeatedly show +;; that line. That's slightly confusing. +(defun elisp-refs--show-results (symbol description results + searched-file-count prefix) + "Given a RESULTS list where each element takes the form \(forms . buffer\), +render a friendly results buffer." + (let ((buf (get-buffer-create (format "*refs: %s*" symbol)))) + (switch-to-buffer buf) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + ;; Insert the header. + (insert + (elisp-refs--format-count + description + (-sum (--map (length (car it)) results)) + (length results) + searched-file-count + prefix) + "\n\n") + ;; Insert the results. + (--each results + (-let* (((forms . buf) it) + (path (with-current-buffer buf elisp-refs--path))) + (insert + (propertize "File: " 'face 'bold) + (elisp-refs--path-button path) "\n") + (--each forms + (-let [(_ start-pos end-pos) it] + (insert (elisp-refs--containing-lines buf start-pos end-pos) + "\n"))) + (insert "\n"))) + ;; Prepare the buffer for the user. + (elisp-refs-mode))) + ;; Cleanup buffers created when highlighting results. + (when elisp-refs--highlighting-buffer + (kill-buffer elisp-refs--highlighting-buffer)))) + +(defun elisp-refs--loaded-bufs () + "Return a list of open buffers, one for each path in `load-path'." + (mapcar #'elisp-refs--contents-buffer (elisp-refs--loaded-paths))) + +(defun elisp-refs--search-1 (bufs match-fn) + "Call MATCH-FN on each buffer in BUFS, reporting progress +and accumulating results. + +BUFS should be disposable: we make no effort to preserve their +state during searching. + +MATCH-FN should return a list where each element takes the form: +\(form start-pos end-pos)." + (let* (;; Our benchmark suggests we spend a lot of time in GC, and + ;; performance improves if we GC less frequently. + (gc-cons-percentage 0.8) + (total-bufs (length bufs))) + (let ((searched 0) + (forms-and-bufs nil)) + (dolist (buf bufs) + (let* ((matching-forms (funcall match-fn buf))) + ;; If there were any matches in this buffer, push the + ;; matches along with the buffer into our results + ;; list. + (when matching-forms + (push (cons matching-forms buf) forms-and-bufs)) + ;; Give feedback to the user on our progress, because + ;; searching takes several seconds. + (when (and (zerop (mod searched 10)) + elisp-refs-verbose) + (message "Searched %s/%s files" searched total-bufs)) + (cl-incf searched))) + (when elisp-refs-verbose + (message "Searched %s/%s files" total-bufs total-bufs)) + forms-and-bufs))) + +(defun elisp-refs--search (symbol description match-fn &optional path-prefix) + "Find references to SYMBOL in all loaded files; call MATCH-FN on each buffer. +When PATH-PREFIX, limit to loaded files whose path starts with that prefix. + +Display the results in a hyperlinked buffer. + +MATCH-FN should return a list where each element takes the form: +\(form start-pos end-pos)." + (let* ((loaded-paths (elisp-refs--loaded-paths)) + (matching-paths (if path-prefix + (--filter (s-starts-with? path-prefix it) loaded-paths) + loaded-paths)) + (loaded-src-bufs (mapcar #'elisp-refs--contents-buffer matching-paths))) + ;; Use unwind-protect to ensure we always cleanup temporary + ;; buffers, even if the user hits C-g. + (unwind-protect + (progn + (let ((forms-and-bufs + (elisp-refs--search-1 loaded-src-bufs match-fn))) + (elisp-refs--show-results symbol description forms-and-bufs + (length loaded-src-bufs) path-prefix))) + ;; Clean up temporary buffers. + (--each loaded-src-bufs (kill-buffer it))))) + +(defun elisp-refs--completing-read-symbol (prompt &optional filter) + "Read an interned symbol from the minibuffer, +defaulting to the symbol at point. PROMPT is the string to prompt +with. + +If FILTER is given, only offer symbols where (FILTER sym) returns +t." + (let ((filter (or filter (lambda (_) t)))) + (read + (completing-read prompt + (elisp-refs--filter-obarray filter) + nil nil nil nil + (-if-let (sym (thing-at-point 'symbol)) + (when (funcall filter (read sym)) + sym)))))) + +;;; Commands + +;;;###autoload +(defun elisp-refs-function (symbol &optional path-prefix) + "Display all the references to function SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +This searches for functions, not macros. For that, see +`elisp-refs-macro'." + (interactive + (list (elisp-refs--completing-read-symbol "Function: " #'functionp) + (when current-prefix-arg + (read-directory-name "Limit search to loaded files in: ")))) + (when (not (functionp symbol)) + (if (macrop symbol) + (user-error "%s is a macro. Did you mean elisp-refs-macro?" + symbol) + (user-error "%s is not a function. Did you mean elisp-refs-symbol?" + symbol))) + (elisp-refs--search symbol + (elisp-refs--describe-button symbol 'function) + (lambda (buf) + (elisp-refs--read-and-find buf symbol #'elisp-refs--function-p)) + path-prefix)) + +;;;###autoload +(defun elisp-refs-macro (symbol &optional path-prefix) + "Display all the references to macro SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search. + +This searches for macros, not functions. For that, see +`elisp-refs-function'." + (interactive + (list (elisp-refs--completing-read-symbol "Macro: " #'macrop) + (when current-prefix-arg + (read-directory-name "Limit search to loaded files in: ")))) + (when (not (macrop symbol)) + (if (functionp symbol) + (user-error "%s is a function. Did you mean elisp-refs-function?" + symbol) + (user-error "%s is not a function. Did you mean elisp-refs-symbol?" + symbol))) + (elisp-refs--search symbol + (elisp-refs--describe-button symbol 'macro) + (lambda (buf) + (elisp-refs--read-and-find buf symbol #'elisp-refs--macro-p)) + path-prefix)) + +;;;###autoload +(defun elisp-refs-special (symbol &optional path-prefix) + "Display all the references to special form SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search." + (interactive + (list (elisp-refs--completing-read-symbol "Special form: " #'special-form-p) + (when current-prefix-arg + (read-directory-name "Limit search to loaded files in: ")))) + (elisp-refs--search symbol + (elisp-refs--describe-button symbol 'special-form) + (lambda (buf) + (elisp-refs--read-and-find buf symbol #'elisp-refs--special-p)) + path-prefix)) + +;;;###autoload +(defun elisp-refs-variable (symbol &optional path-prefix) + "Display all the references to variable SYMBOL, in all loaded +elisp files. + +If called with a prefix, prompt for a directory to limit the search." + (interactive + ;; This is awkward. We don't want to just offer defvar variables, + ;; because then we can't search for code which uses `let' to bind + ;; symbols. There doesn't seem to be a good way to only offer + ;; variables that have been bound at some point. + (list (elisp-refs--completing-read-symbol "Variable: " ) + (when current-prefix-arg + (read-directory-name "Limit search to loaded files in: ")))) + (elisp-refs--search symbol + (elisp-refs--describe-button symbol 'variable) + (lambda (buf) + (elisp-refs--read-and-find buf symbol #'elisp-refs--variable-p)) + path-prefix)) + +;;;###autoload +(defun elisp-refs-symbol (symbol &optional path-prefix) + "Display all the references to SYMBOL in all loaded elisp files. + +If called with a prefix, prompt for a directory to limit the +search." + (interactive + (list (elisp-refs--completing-read-symbol "Symbol: " ) + (when current-prefix-arg + (read-directory-name "Limit search to loaded files in: ")))) + (elisp-refs--search symbol + (elisp-refs--describe-button symbol 'symbol) + (lambda (buf) + (elisp-refs--read-and-find-symbol buf symbol)) + path-prefix)) + +;;; Mode + +(defvar elisp-refs-mode-map + (let ((map (make-sparse-keymap))) + ;; TODO: it would be nice for TAB to navigate to file buttons too, + ;; like *Help* does. + (set-keymap-parent map special-mode-map) + (define-key map (kbd "<tab>") #'elisp-refs-next-match) + (define-key map (kbd "<backtab>") #'elisp-refs-prev-match) + (define-key map (kbd "n") #'elisp-refs-next-match) + (define-key map (kbd "p") #'elisp-refs-prev-match) + (define-key map (kbd "q") #'kill-this-buffer) + (define-key map (kbd "RET") #'elisp-refs-visit-match) + map) + "Keymap for `elisp-refs-mode'.") + +(define-derived-mode elisp-refs-mode special-mode "Refs" + "Major mode for refs results buffers.") + +(defun elisp-refs-visit-match () + "Go to the search result at point." + (interactive) + (let* ((path (get-text-property (point) 'elisp-refs-path)) + (pos (get-text-property (point) 'elisp-refs-start-pos)) + (unindent (get-text-property (point) 'elisp-refs-unindented)) + (column-offset (current-column)) + (line-offset -1)) + (when (null path) + (user-error "No match here")) + + ;; If point is not on the first line of the match, work out how + ;; far away the first line is. + (save-excursion + (while (equal pos (get-text-property (point) 'elisp-refs-start-pos)) + (forward-line -1) + (cl-incf line-offset))) + + (find-file path) + (goto-char pos) + ;; Move point so we're on the same char in the buffer that we were + ;; on in the results buffer. + (forward-line line-offset) + (beginning-of-line) + (let ((target-offset (+ column-offset unindent)) + (i 0)) + (while (< i target-offset) + (if (looking-at "\t") + (cl-incf i tab-width) + (cl-incf i)) + (forward-char 1))))) + +(defun elisp-refs--move-to-match (direction) + "Move point one match forwards. +If DIRECTION is -1, moves backwards instead." + (let* ((start-pos (point)) + (match-pos (get-text-property start-pos 'elisp-refs-start-pos)) + current-match-pos) + (condition-case _err + (progn + ;; Move forward/backwards until we're on the next/previous match. + (catch 'done + (while t + (setq current-match-pos + (get-text-property (point) 'elisp-refs-start-pos)) + (when (and current-match-pos + (not (equal match-pos current-match-pos))) + (throw 'done nil)) + (forward-char direction))) + ;; Move to the beginning of that match. + (while (equal (get-text-property (point) 'elisp-refs-start-pos) + (get-text-property (1- (point)) 'elisp-refs-start-pos)) + (forward-char -1)) + ;; Move forward until we're on the first char of match within that + ;; line. + (while (or + (looking-at " ") + (eq (get-text-property (point) 'face) + 'font-lock-comment-face)) + (forward-char 1))) + ;; If we're at the last result, don't move point. + (end-of-buffer + (progn + (goto-char start-pos) + (signal 'end-of-buffer nil)))))) + +(defun elisp-refs-prev-match () + "Move to the previous search result in the Refs buffer." + (interactive) + (elisp-refs--move-to-match -1)) + +(defun elisp-refs-next-match () + "Move to the next search result in the Refs buffer." + (interactive) + (elisp-refs--move-to-match 1)) + +(provide 'elisp-refs) +;;; elisp-refs.el ends here diff --git a/elpa/elisp-refs-20220220.2305/elisp-refs.elc b/elpa/elisp-refs-20220220.2305/elisp-refs.elc Binary files differ. diff --git a/elpa/helpful-20220220.2308/helpful-autoloads.el b/elpa/helpful-20220220.2308/helpful-autoloads.el @@ -0,0 +1,68 @@ +;;; helpful-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "helpful" "helpful.el" (0 0 0 0)) +;;; Generated autoloads from helpful.el + +(autoload 'helpful-function "helpful" "\ +Show help for function named SYMBOL. + +See also `helpful-macro', `helpful-command' and `helpful-callable'. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-command "helpful" "\ +Show help for interactive function named SYMBOL. + +See also `helpful-function'. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-key "helpful" "\ +Show help for interactive command bound to KEY-SEQUENCE. + +\(fn KEY-SEQUENCE)" t nil) + +(autoload 'helpful-macro "helpful" "\ +Show help for macro named SYMBOL. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-callable "helpful" "\ +Show help for function, macro or special form named SYMBOL. + +See also `helpful-macro', `helpful-function' and `helpful-command'. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-symbol "helpful" "\ +Show help for SYMBOL, a variable, function or macro. + +See also `helpful-callable' and `helpful-variable'. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-variable "helpful" "\ +Show help for variable named SYMBOL. + +\(fn SYMBOL)" t nil) + +(autoload 'helpful-at-point "helpful" "\ +Show help for the symbol at point." t nil) + +(register-definition-prefixes "helpful" '("helpful-")) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8-emacs-unix +;; End: +;;; helpful-autoloads.el ends here diff --git a/elpa/helpful-20220220.2308/helpful-pkg.el b/elpa/helpful-20220220.2308/helpful-pkg.el @@ -0,0 +1,2 @@ +;;; Generated package description from helpful.el -*- no-byte-compile: t -*- +(define-package "helpful" "20220220.2308" "A better *help* buffer" '((emacs "25") (dash "2.18.0") (s "1.11.0") (f "0.20.0") (elisp-refs "1.2")) :commit "67cdd1030b3022d3dc4da2297f55349da57cde01" :authors '(("Wilfred Hughes" . "me@wilfred.me.uk")) :maintainer '("Wilfred Hughes" . "me@wilfred.me.uk") :keywords '("help" "lisp") :url "https://github.com/Wilfred/helpful") diff --git a/elpa/helpful-20220220.2308/helpful.el b/elpa/helpful-20220220.2308/helpful.el @@ -0,0 +1,2910 @@ +;;; helpful.el --- A better *help* buffer -*- lexical-binding: t; -*- + +;; Copyright (C) 2017-2020 Wilfred Hughes + +;; Author: Wilfred Hughes <me@wilfred.me.uk> +;; URL: https://github.com/Wilfred/helpful +;; Package-Version: 20220220.2308 +;; Package-Commit: 67cdd1030b3022d3dc4da2297f55349da57cde01 +;; Keywords: help, lisp +;; Version: 0.19 +;; Package-Requires: ((emacs "25") (dash "2.18.0") (s "1.11.0") (f "0.20.0") (elisp-refs "1.2")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Helpful is a replacement for *help* buffers that provides much more +;; contextual information. To get started, try: +;; `M-x helpful-function RET helpful-function +;; +;; The full set of commands you can try is: +;; +;; * helpful-function +;; * helpful-command +;; * helpful-key +;; * helpful-macro +;; * helpful-callable +;; * helpful-variable +;; * helpful-at-point +;; +;; For more information and screenshots, see +;; https://github.com/wilfred/helpful + +;;; Code: + +(require 'elisp-refs) +(require 'help) +(require 'help-fns) +(require 'dash) +(require 's) +(require 'f) +(require 'find-func) +(require 'nadvice) +(require 'info-look) +(require 'edebug) +(require 'trace) +(require 'imenu) + +(defvar-local helpful--sym nil) +(defvar-local helpful--callable-p nil) +(defvar-local helpful--associated-buffer nil + "The buffer being used when showing inspecting +buffer-local variables.") +(defvar-local helpful--start-buffer nil + "The buffer we were originally called from.") +(defvar-local helpful--view-literal nil + "Whether to show a value as a literal, or a pretty interactive +view.") +(defvar-local helpful--first-display t + "Whether this is the first time this results buffer has been +displayed. + +Nil means that we're refreshing, so we don't want to clobber any +settings changed by the user.") + +(defgroup helpful nil + "A rich help system with contextual information." + :link '(url-link "https://github.com/Wilfred/helpful") + :group 'help) + +(defcustom helpful-max-buffers + 5 + "Helpful will kill the least recently used Helpful buffer +if there are more than this many. + +To disable cleanup entirely, set this variable to nil. See also +`helpful-kill-buffers' for a one-off cleanup." + :type '(choice (const nil) number) + :group 'helpful) + +(defcustom helpful-switch-buffer-function + #'pop-to-buffer + "Function called to display the *Helpful* buffer." + :type 'function + :group 'helpful) + +;; TODO: explore whether more basic highlighting is fast enough to +;; handle larger functions. See `c-font-lock-init' and its use of +;; font-lock-keywords-1. +(defconst helpful-max-highlight 5000 + "Don't highlight code with more than this many characters. + +This is currently only used for C code, as lisp highlighting +seems to be more efficient. This may change again in future. + +See `this-command' as an example of a large piece of C code that +can make Helpful very slow.") + +(defun helpful--kind-name (symbol callable-p) + "Describe what kind of symbol this is." + (cond + ((not callable-p) "variable") + ((commandp symbol) "command") + ((macrop symbol) "macro") + ((functionp symbol) "function") + ((special-form-p symbol) "special form"))) + +(defun helpful--buffer (symbol callable-p) + "Return a buffer to show help for SYMBOL in." + (let* ((current-buffer (current-buffer)) + (buf-name + (format "*helpful %s*" + (if (symbolp symbol) + (format "%s: %s" + (helpful--kind-name symbol callable-p) + symbol) + "lambda"))) + (buf (get-buffer buf-name))) + (unless buf + ;; If we need to create the buffer, ensure we don't exceed + ;; `helpful-max-buffers' by killing the least recently used. + (when (numberp helpful-max-buffers) + (let* ((buffers (buffer-list)) + (helpful-bufs (--filter (with-current-buffer it + (eq major-mode 'helpful-mode)) + buffers)) + ;; `buffer-list' seems to be ordered by most recently + ;; visited first, so keep those. + (excess-buffers (-drop (1- helpful-max-buffers) helpful-bufs))) + ;; Kill buffers so we have one buffer less than the maximum + ;; before we create a new one. + (-each excess-buffers #'kill-buffer))) + + (setq buf (get-buffer-create buf-name))) + + ;; Initialise the buffer with the symbol and associated data. + (with-current-buffer buf + (helpful-mode) + (setq helpful--sym symbol) + (setq helpful--callable-p callable-p) + (setq helpful--start-buffer current-buffer) + (setq helpful--associated-buffer current-buffer) + (if (helpful--primitive-p symbol callable-p) + (setq-local comment-start "//") + (setq-local comment-start ";"))) + buf)) + +(defface helpful-heading + '((t (:weight bold))) + "Face used for headings in Helpful buffers.") + +(defun helpful--heading (text) + "Propertize TEXT as a heading." + (format "%s\n" (propertize text 'face 'helpful-heading))) + +(defun helpful--format-closure (sym form) + "Given a closure, return an equivalent defun form." + (-let (((_keyword _env args . body) form) + (docstring nil)) + (when (stringp (car body)) + (setq docstring (car body)) + (setq body (cdr body)) + ;; Ensure that the docstring doesn't have lines starting with (, + ;; or it breaks indentation. + (setq docstring + (s-replace "\n(" "\n\\(" docstring))) + (if docstring + `(defun ,sym ,args ,docstring ,@body) + `(defun ,sym ,args ,@body)))) + +(defun helpful--pretty-print (value) + "Pretty-print VALUE. + +If VALUE is very big, the user may press \\[keyboard-quit] to +gracefully stop the printing. If VALUE is self-referential, the +error will be caught and displayed." + ;; Inspired by `ielm-eval-input'. + (condition-case err + (s-trim-right (pp-to-string value)) + (error + (propertize (format "(Display error: %s)" (cadr err)) + 'face 'font-lock-comment-face)) + (quit + (propertize "(User quit during pretty-printing.)" + 'face 'font-lock-comment-face)))) + +(defun helpful--sort-symbols (sym-list) + "Sort symbols in SYM-LIST alphabetically." + (--sort + (string< (symbol-name it) (symbol-name other)) + sym-list)) + +(defun helpful--button (text type &rest properties) + ;; `make-text-button' mutates our string to add properties. Copy + ;; TEXT to prevent mutating our arguments, and to support 'pure' + ;; strings, which are read-only. + (setq text (substring-no-properties text)) + (apply #'make-text-button + text nil + :type type + properties)) + +(defun helpful--canonical-symbol (sym callable-p) + "If SYM is an alias, return the underlying symbol. +Return SYM otherwise." + (let ((depth 0)) + (if (and (symbolp sym) callable-p) + (progn + ;; Follow the chain of symbols until we find a symbol that + ;; isn't pointing to a symbol. + (while (and (symbolp (symbol-function sym)) + (< depth 10)) + (setq sym (symbol-function sym)) + (setq depth (1+ depth))) + ;; If this is an alias to a primitive, return the + ;; primitive's symbol. + (when (subrp (symbol-function sym)) + (setq sym (intern (subr-name (symbol-function sym)))))) + (setq sym (indirect-variable sym)))) + sym) + +(defun helpful--aliases (sym callable-p) + "Return all the aliases for SYM." + (let ((canonical (helpful--canonical-symbol sym callable-p)) + aliases) + (mapatoms + (lambda (s) + (when (and + ;; Skip variables that aren't bound, so we're faster. + (if callable-p (fboundp s) (boundp s)) + + ;; If this symbol is a new alias for our target sym, + ;; add it. + (eq canonical (helpful--canonical-symbol s callable-p)) + + ;; Don't include SYM. + (not (eq sym s))) + (push s aliases)))) + (helpful--sort-symbols aliases))) + +(defun helpful--obsolete-info (sym callable-p) + (when (symbolp sym) + (get sym (if callable-p 'byte-obsolete-info 'byte-obsolete-variable)))) + +(defun helpful--format-alias (sym callable-p) + (let ((obsolete-info (helpful--obsolete-info sym callable-p)) + (sym-button (helpful--button + (symbol-name sym) + 'helpful-describe-exactly-button + 'symbol sym + 'callable-p callable-p))) + (cond + (obsolete-info + (-if-let (version (-last-item obsolete-info)) + (format "%s (obsolete since %s)" sym-button version) + (format "%s (obsolete)" sym-button))) + (t + sym-button)))) + +(defun helpful--indent-rigidly (s amount) + "Indent string S by adding AMOUNT spaces to each line." + (with-temp-buffer + (insert s) + (indent-rigidly (point-min) (point-max) amount) + (buffer-string))) + +(defun helpful--format-properties (symbol) + "Return a string describing all the properties of SYMBOL." + (let* ((syms-and-vals + (-partition 2 (and (symbolp symbol) (symbol-plist symbol)))) + (syms-and-vals + (-sort (-lambda ((sym1 _) (sym2 _)) + (string-lessp (symbol-name sym1) (symbol-name sym2))) + syms-and-vals)) + (lines + (--map + (-let* (((sym val) it) + (pretty-val + (helpful--pretty-print val))) + (format "%s\n%s%s" + (propertize (symbol-name sym) + 'face 'font-lock-constant-face) + (helpful--indent-rigidly pretty-val 2) + (cond + ;; Also offer to disassemble byte-code + ;; properties. + ((byte-code-function-p val) + (format "\n %s" + (helpful--make-disassemble-button val))) + ((eq sym 'ert--test) + (format "\n %s" + (helpful--make-run-test-button symbol))) + (t + "")))) + syms-and-vals))) + (when lines + (s-join "\n" lines)))) + +(define-button-type 'helpful-forget-button + 'action #'helpful--forget + 'symbol nil + 'callable-p nil + 'follow-link t + 'help-echo "Unbind this function") + +;; TODO: it would be nice to optionally delete the source code too. +(defun helpful--forget (button) + "Unbind the current symbol." + (let* ((sym (button-get button 'symbol)) + (callable-p (button-get button 'callable-p)) + (kind (helpful--kind-name sym callable-p))) + (when (yes-or-no-p (format "Forget %s %s?" kind sym)) + (if callable-p + (fmakunbound sym) + (makunbound sym)) + (message "Forgot %s %s." kind sym) + (kill-buffer (current-buffer))))) + +(define-button-type 'helpful-c-source-directory + 'action #'helpful--c-source-directory + 'follow-link t + 'help-echo "Set directory to Emacs C source code") + +(defun helpful--c-source-directory (_button) + "Set `find-function-C-source-directory' so we can show the +source code to primitives." + (let ((emacs-src-dir (read-directory-name "Path to Emacs source code: "))) + ;; Let the user specify the source path with or without src/, + ;; which is a subdirectory in the Emacs tree. + (unless (equal (f-filename emacs-src-dir) "src") + (setq emacs-src-dir (f-join emacs-src-dir "src"))) + (setq find-function-C-source-directory emacs-src-dir)) + (helpful-update)) + +(define-button-type 'helpful-disassemble-button + 'action #'helpful--disassemble + 'follow-link t + 'object nil + 'help-echo "Show disassembled bytecode") + +(defun helpful--disassemble (button) + "Disassemble the current symbol." + ;; `disassemble' can handle both symbols (e.g. 'when) and raw + ;; byte-code objects. + (disassemble (button-get button 'object))) + +(define-button-type 'helpful-run-test-button + 'action #'helpful--run-test + 'follow-link t + 'symbol nil + 'help-echo "Run ERT test") + +(defun helpful--run-test (button) + "Disassemble the current symbol." + (ert (button-get button 'symbol))) + +(define-button-type 'helpful-edebug-button + 'action #'helpful--edebug + 'follow-link t + 'symbol nil + 'help-echo "Toggle edebug (re-evaluates definition)") + +(defun helpful--kbd-macro-p (sym) + "Is SYM a keyboard macro?" + (and (symbolp sym) + (let ((func (symbol-function sym))) + (or (stringp func) + (vectorp func))))) + +(defun helpful--edebug-p (sym) + "Does function SYM have its definition patched by edebug?" + (let ((fn-def (indirect-function sym))) + ;; Edebug replaces function source code with a sexp that has + ;; `edebug-enter', `edebug-after' etc interleaved. This means the + ;; function is interpreted, so `indirect-function' returns a list. + (when (and (consp fn-def) (consp (cdr fn-def))) + (-let [fn-end (-last-item fn-def)] + (and (consp fn-end) + (eq (car fn-end) 'edebug-enter)))))) + +(defun helpful--can-edebug-p (sym callable-p buf pos) + "Can we use edebug with SYM?" + (and + ;; SYM must be a function. + callable-p + ;; The function cannot be a primitive, it must be defined in elisp. + (not (helpful--primitive-p sym callable-p)) + ;; We need to be able to find its definition, or we can't step + ;; through the source. + buf pos)) + +(defun helpful--toggle-edebug (sym) + "Enable edebug when function SYM is called, +or disable if already enabled." + (-let ((should-edebug (not (helpful--edebug-p sym))) + ((buf pos created) (helpful--definition sym t))) + (if (and buf pos) + (progn + (with-current-buffer buf + (save-excursion + (save-restriction + (widen) + (goto-char pos) + + (let* ((edebug-all-forms should-edebug) + (edebug-all-defs should-edebug) + (form (edebug-read-top-level-form))) + ;; Based on `edebug-eval-defun'. + (eval (eval-sexp-add-defvars form) lexical-binding))))) + ;; If we're enabling edebug, we need the source buffer to + ;; exist. Otherwise, we can clean it up. + (when (and created (not should-edebug)) + (kill-buffer buf))) + + (user-error "Could not find source for edebug")))) + +(defun helpful--edebug (button) + "Toggle edebug for the current symbol." + (helpful--toggle-edebug (button-get button 'symbol)) + (helpful-update)) + +(define-button-type 'helpful-trace-button + 'action #'helpful--trace + 'follow-link t + 'symbol nil + 'help-echo "Toggle function tracing") + +(defun helpful--trace (button) + "Toggle tracing for the current symbol." + (let ((sym (button-get button 'symbol))) + (if (trace-is-traced sym) + (untrace-function sym) + (trace-function sym))) + (helpful-update)) + +(define-button-type 'helpful-navigate-button + 'action #'helpful--navigate + 'path nil + 'position nil + 'follow-link t + 'help-echo "Navigate to definition") + +(defun helpful--goto-char-widen (pos) + "Move point to POS in the current buffer. +If narrowing is in effect, widen if POS isn't in the narrowed area." + (when (or (< pos (point-min)) + (> pos (point-max))) + (widen)) + (goto-char pos)) + +(defun helpful--navigate (button) + "Navigate to the path this BUTTON represents." + (find-file (substring-no-properties (button-get button 'path))) + ;; We use `get-text-property' to work around an Emacs 25 bug: + ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=f7c4bad17d83297ee9a1b57552b1944020f23aea + (-when-let (pos (get-text-property button 'position + (marker-buffer button))) + (helpful--goto-char-widen pos))) + +(defun helpful--navigate-button (text path &optional pos) + "Return a button that opens PATH and puts point at POS." + (helpful--button + text + 'helpful-navigate-button + 'path path + 'position pos)) + +(define-button-type 'helpful-buffer-button + 'action #'helpful--switch-to-buffer + 'buffer nil + 'position nil + 'follow-link t + 'help-echo "Switch to this buffer") + +(defun helpful--switch-to-buffer (button) + "Navigate to the buffer this BUTTON represents." + (let ((buf (button-get button 'buffer)) + (pos (button-get button 'position))) + (switch-to-buffer buf) + (when pos + (helpful--goto-char-widen pos)))) + +(defun helpful--buffer-button (buffer &optional pos) + "Return a button that switches to BUFFER and puts point at POS." + (helpful--button + (buffer-name buffer) + 'helpful-buffer-button + 'buffer buffer + 'position pos)) + +(define-button-type 'helpful-customize-button + 'action #'helpful--customize + 'symbol nil + 'follow-link t + 'help-echo "Open Customize for this symbol") + +(defun helpful--customize (button) + "Open Customize for this symbol." + (customize-variable (button-get button 'symbol))) + +(define-button-type 'helpful-associated-buffer-button + 'action #'helpful--associated-buffer + 'symbol nil + 'prompt-p nil + 'follow-link t + 'help-echo "Change associated buffer") + +(defun helpful--read-live-buffer (prompt predicate) + "Read a live buffer name, and return the buffer object. + +This is largely equivalent to `read-buffer', but counsel.el +overrides that to include previously opened buffers." + (let* ((names (-map #'buffer-name (buffer-list))) + (default + (cond + ;; If we're already looking at a buffer-local value, start + ;; the prompt from the relevant buffer. + ((and helpful--associated-buffer + (buffer-live-p helpful--associated-buffer)) + (buffer-name helpful--associated-buffer)) + ;; If we're looking at the global value, offer the initial + ;; buffer. + ((and helpful--start-buffer + (buffer-live-p helpful--start-buffer)) + (buffer-name helpful--start-buffer)) + ;; If we're looking at the global value and have no initial + ;; buffer, choose the first normal buffer. + (t + (--first (and (not (s-starts-with-p " " it)) + (not (s-starts-with-p "*" it))) + names)) + ))) + (get-buffer + (completing-read + prompt + names + predicate + t + nil + nil + default)))) + +(defun helpful--associated-buffer (button) + "Change the associated buffer, so we can see buffer-local values." + (let ((sym (button-get button 'symbol)) + (prompt-p (button-get button 'prompt-p))) + (if prompt-p + (setq helpful--associated-buffer + (helpful--read-live-buffer + "View variable in: " + (lambda (buf-name) + (local-variable-p sym (get-buffer buf-name))))) + (setq helpful--associated-buffer nil))) + (helpful-update)) + +(define-button-type 'helpful-toggle-button + 'action #'helpful--toggle + 'symbol nil + 'buffer nil + 'follow-link t + 'help-echo "Toggle this symbol between t and nil") + +(defun helpful--toggle (button) + "Toggle the symbol between nil and t." + (let ((sym (button-get button 'symbol)) + (buf (button-get button 'buffer))) + (save-current-buffer + ;; If this is a buffer-local variable, ensure we're in the right + ;; buffer. + (when buf + (set-buffer buf)) + (set sym (not (symbol-value sym)))) + (helpful-update))) + +(define-button-type 'helpful-set-button + 'action #'helpful--set + 'symbol nil + 'buffer nil + 'follow-link t + 'help-echo "Set the value of this symbol") + +(defun helpful--set (button) + "Set the value of this symbol." + (let* ((sym (button-get button 'symbol)) + (buf (button-get button 'buffer)) + (sym-value (helpful--sym-value sym buf)) + ;; Inspired by `counsel-read-setq-expression'. + (expr + (minibuffer-with-setup-hook + (lambda () + (add-function :before-until (local 'eldoc-documentation-function) + #'elisp-eldoc-documentation-function) + (run-hooks 'eval-expression-minibuffer-setup-hook) + (goto-char (minibuffer-prompt-end)) + (forward-char (length (format "(setq %S " sym)))) + (read-from-minibuffer + "Eval: " + (format + (if (or (consp sym-value) + (and (symbolp sym-value) + (not (null sym-value)) + (not (keywordp sym-value)))) + "(setq %s '%S)" + "(setq %s %S)") + sym sym-value) + read-expression-map t + 'read-expression-history)))) + (save-current-buffer + ;; If this is a buffer-local variable, ensure we're in the right + ;; buffer. + (when buf + (set-buffer buf)) + (eval-expression expr)) + (helpful-update))) + +(define-button-type 'helpful-view-literal-button + 'action #'helpful--view-literal + 'help-echo "Toggle viewing as a literal") + +(defun helpful--view-literal (_button) + "Set the value of this symbol." + (setq helpful--view-literal + (not helpful--view-literal)) + (helpful-update)) + +(define-button-type 'helpful-all-references-button + 'action #'helpful--all-references + 'symbol nil + 'callable-p nil + 'follow-link t + 'help-echo "Find all references to this symbol") + +(defun helpful--all-references (button) + "Find all the references to the symbol that this BUTTON represents." + (let ((sym (button-get button 'symbol)) + (callable-p (button-get button 'callable-p))) + (cond + ((not callable-p) + (elisp-refs-variable sym)) + ((functionp sym) + (elisp-refs-function sym)) + ((macrop sym) + (elisp-refs-macro sym))))) + +(define-button-type 'helpful-callees-button + 'action #'helpful--show-callees + 'symbol nil + 'source nil + 'follow-link t + 'help-echo "Find the functions called by this function/macro") + +(defun helpful--display-callee-group (callees) + "Insert every entry in CALLEES." + (dolist (sym (helpful--sort-symbols callees)) + (insert " " + (helpful--button + (symbol-name sym) + 'helpful-describe-exactly-button + 'symbol sym + 'callable-p t) + "\n"))) + +(defun helpful--show-callees (button) + "Find all the references to the symbol that this BUTTON represents." + (let* ((buf (get-buffer-create "*helpful callees*")) + (sym (button-get button 'symbol)) + (raw-source (button-get button 'source)) + (source + (if (stringp raw-source) + (read raw-source) + raw-source)) + (syms (helpful--callees source)) + (primitives (-filter (lambda (sym) (helpful--primitive-p sym t)) syms)) + (compounds (-remove (lambda (sym) (helpful--primitive-p sym t)) syms))) + + (pop-to-buffer buf) + (let ((inhibit-read-only t)) + (erase-buffer) + + ;; TODO: Macros used, special forms used, global vars used. + (insert (format "Functions called by %s:\n\n" sym)) + (helpful--display-callee-group compounds) + + (when primitives + (insert "\n") + (insert (format "Primitives called by %s:\n\n" sym)) + (helpful--display-callee-group primitives)) + + (goto-char (point-min)) + + (helpful-mode)))) + +(define-button-type 'helpful-manual-button + 'action #'helpful--manual + 'symbol nil + 'follow-link t + 'help-echo "View this symbol in the Emacs manual") + +(defun helpful--manual (button) + "Open the manual for the system that this BUTTON represents." + (let ((sym (button-get button 'symbol))) + (info-lookup 'symbol sym #'emacs-lisp-mode))) + +(define-button-type 'helpful-describe-button + 'action #'helpful--describe + 'symbol nil + 'follow-link t + 'help-echo "Describe this symbol") + +(defun helpful--describe (button) + "Describe the symbol that this BUTTON represents." + (let ((sym (button-get button 'symbol))) + (helpful-symbol sym))) + +(define-button-type 'helpful-describe-exactly-button + 'action #'helpful--describe-exactly + 'symbol nil + 'callable-p nil + 'follow-link t + 'help-echo "Describe this symbol") + +(defun helpful--describe-exactly (button) + "Describe the symbol that this BUTTON represents. +This differs from `helpful--describe' because here we know +whether the symbol represents a variable or a callable." + (let ((sym (button-get button 'symbol)) + (callable-p (button-get button 'callable-p))) + (if callable-p + (helpful-callable sym) + (helpful-variable sym)))) + +(define-button-type 'helpful-info-button + 'action #'helpful--info + 'info-node nil + 'follow-link t + 'help-echo "View this Info node") + +(defun helpful--info (button) + "Describe the symbol that this BUTTON represents." + (info (button-get button 'info-node))) + +(defun helpful--split-first-line (docstring) + "If the first line is a standalone sentence, ensure we have a +blank line afterwards." + (let* ((lines (s-lines docstring)) + (first-line (-first-item lines)) + (second-line (when (> (length lines) 1) (nth 1 lines)))) + (if (and (s-ends-with-p "." first-line) + (stringp second-line) + (not (equal second-line ""))) + (s-join "\n" + (-cons* first-line "" (cdr lines))) + docstring))) + +(defun helpful--propertize-sym-ref (sym-name before-txt after-txt) + "Given a symbol name from a docstring, convert to a button (if +bound) or else highlight." + (let* ((sym (intern sym-name))) + (cond + ;; Highlight keywords. + ((s-matches-p + (rx ":" + symbol-start + (+? (or (syntax word) (syntax symbol))) + symbol-end) + sym-name) + (propertize sym-name + 'face 'font-lock-builtin-face)) + ((and (boundp sym) (s-ends-with-p "variable " before-txt)) + (helpful--button + sym-name + 'helpful-describe-exactly-button + 'symbol sym + 'callable-p nil)) + ((and (fboundp sym) (or + (s-starts-with-p " command" after-txt) + (s-ends-with-p "function " before-txt))) + (helpful--button + sym-name + 'helpful-describe-exactly-button + 'symbol sym + 'callable-p t)) + ;; Only create a link if this is a symbol that is bound as a + ;; variable or callable. + ((or (boundp sym) (fboundp sym)) + (helpful--button + sym-name + 'helpful-describe-button + 'symbol sym)) + ;; If this is already a button, don't modify it. + ((get-text-property 0 'button sym-name) + sym-name) + ;; Highlight the quoted string. + (t + (propertize sym-name + 'face 'font-lock-constant-face))))) + +(defun helpful--propertize-info (docstring) + "Convert info references in DOCSTRING to buttons." + (replace-regexp-in-string + ;; Replace all text that looks like a link to an Info page. + (rx (seq (group + bow + (any "Ii") + "nfo" + (one-or-more whitespace)) + (group + (or "node" "anchor") + (one-or-more whitespace)) + (any "'`‘") + (group + (one-or-more + (not (any "'’")))) + (any "'’"))) + (lambda (it) + ;; info-name matches "[Ii]nfo ". + ;; space matches "node " or "anchor ". + ;; info-node has the form "(cl)Loop Facility". + (let ((info-name (match-string 1 it)) + (space (match-string 2 it)) + (info-node (match-string 3 it))) + ;; If the docstring doesn't specify a manual, assume the Emacs manual. + (save-match-data + (unless (string-match "^([^)]+)" info-node) + (setq info-node (concat "(emacs)" info-node)))) + (concat + info-name + space + (helpful--button + info-node + 'helpful-info-button + 'info-node info-node)))) + docstring + t t)) + +(defun helpful--keymap-keys (keymap) + "Return all the keys and commands in KEYMAP. +Flattens nested keymaps and follows remapped commands. + +Returns a list of pairs (KEYCODES COMMAND), where KEYCODES is a +vector suitable for `key-description', and COMMAND is a smbol." + (cond + ;; Prefix keys. + ((and + (symbolp keymap) + (fboundp keymap) + ;; Prefix keys use a keymap in the function slot of a symbol. + (keymapp (symbol-function keymap))) + (helpful--keymap-keys (symbol-function keymap))) + ;; Other symbols or compiled functions mean we've reached a leaf, + ;; so this is a command we can call. + ((or + (symbolp keymap) + (functionp keymap) + ;; Strings or vectors mean a keyboard macro. + (stringp keymap) + (vectorp keymap)) + `(([] ,keymap))) + ((stringp (car keymap)) + (helpful--keymap-keys (cdr keymap))) + ;; Otherwise, recurse on the keys at this level of the keymap. + (t + (let (result) + (dolist (item (cdr keymap)) + (cond + ((and (consp item) + (eq (car item) 'menu-bar)) + ;; Skip menu bar items. + nil) + ;; Sparse keymaps are lists. + ((consp item) + (-let [(keycode . value) item] + (-each (helpful--keymap-keys value) + (-lambda ((keycodes command)) + (push (list (vconcat (vector keycode) keycodes) command) + result))))) + ;; Dense keymaps are char-tables. + ((char-table-p item) + (map-char-table + (lambda (keycode value) + (-each (helpful--keymap-keys value) + (-lambda ((keycodes command)) + (push (list (vconcat (vector keycode) keycodes) command) + result)))) + item)))) + ;; For every command `new-func' mapped to a command `orig-func', show `new-func' with + ;; the key sequence for `orig-func'. + (setq result + (-map-when + (-lambda ((keycodes _)) + (and (> (length keycodes) 1) + (eq (elt keycodes 0) 'remap))) + (-lambda ((keycodes command)) + (list + (where-is-internal (elt keycodes 1) global-map t) + command)) + result)) + ;; Preserve the original order of the keymap. + (nreverse result))))) + +(defun helpful--format-hook (hook-val) + "Given a list value assigned to a hook, format it with links to functions." + (let ((lines + (--map + (if (and (symbolp it) (fboundp it)) + (helpful--button + (symbol-name it) + 'helpful-describe-exactly-button + 'symbol it + 'callable-p t) + (helpful--syntax-highlight (helpful--pretty-print it))) + hook-val))) + (format "(%s)" + (s-join "\n " lines)))) + +;; TODO: unlike `substitute-command-keys', this shows keybindings +;; which are currently shadowed (e.g. a global minor mode map). +(defun helpful--format-keymap (keymap) + "Format KEYMAP." + (let* ((keys-and-commands (helpful--keymap-keys keymap)) + ;; Convert keycodes [27 i] to "C-M-i". + (keys (-map #'-first-item keys-and-commands)) + ;; Add padding so all our strings are the same length. + (formatted-keys (-map #'key-description keys)) + (max-formatted-length (-max (cons 0 (-map #'length formatted-keys)))) + (aligned-keys (--map (s-pad-right (1+ max-formatted-length) + " " it) + formatted-keys)) + ;; Format commands as buttons. + (commands (-map (-lambda ((_ command)) command) + keys-and-commands)) + (formatted-commands + (--map + (cond + ((symbolp it) + (helpful--button + (symbol-name it) + 'helpful-describe-button + 'symbol it)) + ((or (stringp it) (vectorp it)) + "Keyboard Macro") + (t + "#<anonymous-function>")) + commands)) + ;; Build lines for display. + (lines + (-map (-lambda ((key . command)) (format "%s %s" key command)) + (-zip-pair aligned-keys formatted-commands)))) + ;; The flattened keymap will have normal bindings first, and + ;; inherited bindings last. Sort so that we group by prefix. + (s-join "\n" (-sort #'string< lines)))) + +(defun helpful--format-commands (str keymap) + "Replace all the \\[ references in STR with buttons." + (replace-regexp-in-string + ;; Text of the form \\[foo-command] + (rx "\\[" (group (+ (not (in "]")))) "]") + (lambda (it) + (let* ((symbol-name (match-string 1 it)) + (symbol (intern symbol-name)) + (key (where-is-internal symbol keymap t)) + (key-description + (if key + (key-description key) + (format "M-x %s" symbol-name)))) + (helpful--button + key-description + 'helpful-describe-exactly-button + 'symbol symbol + 'callable-p t))) + str + t + t)) + +(defun helpful--chars-before (pos n) + "Return up to N chars before POS in the current buffer. +The string may be shorter than N or empty if out-of-range." + (buffer-substring + (max (point-min) (- pos n)) + pos)) + +(defun helpful--chars-after (pos n) + "Return up to N chars after POS in the current buffer. +The string may be shorter than N or empty if out-of-range." + (buffer-substring + pos + (min (point-max) (+ pos n)))) + +(defun helpful--format-command-keys (docstring) + "Convert command key references and keymap references +in DOCSTRING to buttons. + +Emacs uses \\= to escape \\[ references, so replace that +unescaping too." + ;; Loosely based on `substitute-command-keys', but converts + ;; references to buttons. + (let ((keymap nil)) + (with-temp-buffer + (insert docstring) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((looking-at + ;; Text of the form "foo" + (rx "\"")) + ;; For literal strings, escape backslashes so our output + ;; shows copy-pasteable literals. + (let* ((start-pos (point)) + (end-pos (progn (forward-char) (search-forward "\"" nil t))) + contents) + (if end-pos + (progn + (setq contents (buffer-substring start-pos end-pos)) + (delete-region start-pos end-pos) + (insert (s-replace "\\" "\\\\" contents))) + (forward-char 1)))) + ((looking-at + ;; Text of the form \=X + (rx "\\=")) + ;; Remove the escaping, then step over the escaped char. + ;; Step over the escaped character. + (delete-region (point) (+ (point) 2)) + (forward-char 1)) + ((looking-at + ;; Text of the form `foo' + (rx "`")) + (let* ((start-pos (point)) + (end-pos (search-forward "'" nil t)) + (contents + (when end-pos + (buffer-substring (1+ start-pos) (1- end-pos))))) + (cond + ((null contents) + ;; If there's no closing ' to match the opening `, just + ;; leave it. + (goto-char (1+ start-pos))) + ((s-contains-p "`" contents) + ;; If we have repeated backticks `foo `bar', leave the + ;; first one. + (goto-char (1+ start-pos))) + ((s-contains-p "\\[" contents) + (delete-region start-pos end-pos) + (insert (helpful--format-commands contents keymap))) + ;; Highlight a normal `foo', extracting the surrounding + ;; text so we can detect e.g. "function `foo'". + (t + (let ((before (helpful--chars-before start-pos 10)) + (after (helpful--chars-after end-pos 10))) + (delete-region start-pos end-pos) + (insert (helpful--propertize-sym-ref contents before after))))))) + ((looking-at + ;; Text of the form \\<foo-keymap> + (rx "\\<" (group (+ (not (in ">")))) ">" + (? "\n"))) + (let* ((symbol-with-parens (match-string 0)) + (symbol-name (match-string 1))) + ;; Remove the original string. + (delete-region (point) + (+ (point) (length symbol-with-parens))) + ;; Set the new keymap. + (setq keymap (symbol-value (intern symbol-name))))) + ((looking-at + ;; Text of the form \\{foo-mode-map} + (rx "\\{" (group (+ (not (in "}")))) "}")) + (let* ((symbol-with-parens (match-string 0)) + (symbol-name (match-string 1)) + (keymap + ;; Gracefully handle variables not being defined. + (ignore-errors + (symbol-value (intern symbol-name))))) + ;; Remove the original string. + (delete-region (point) + (+ (point) (length symbol-with-parens))) + (if keymap + (insert (helpful--format-keymap keymap)) + (insert (format "Keymap %s is not currently defined." + symbol-name))))) + ((looking-at + ;; Text of the form \\[foo-command] + (rx "\\[" (group (+ (not (in "]")))) "]")) + (let* ((symbol-with-parens (match-string 0))) + ;; Remove the original string. + (delete-region (point) + (+ (point) (length symbol-with-parens))) + ;; Add a button. + (insert (helpful--format-commands symbol-with-parens keymap)))) + ;; Don't modify other characters. + (t + (forward-char 1)))) + (buffer-string)))) + +;; TODO: fix upstream Emacs bug that means `-map' is not highlighted +;; in the docstring for `--map'. +(defun helpful--format-docstring (docstring) + "Replace cross-references with links in DOCSTRING." + (-> docstring + (helpful--split-first-line) + (helpful--propertize-info) + (helpful--propertize-links) + (helpful--propertize-bare-links) + (helpful--format-command-keys) + (s-trim))) + +(define-button-type 'helpful-link-button + 'action #'helpful--follow-link + 'follow-link t + 'help-echo "Follow this link") + +(defun helpful--propertize-links (docstring) + "Convert URL links in docstrings to buttons." + (replace-regexp-in-string + (rx "URL `" (group (*? any)) "'") + (lambda (match) + (let ((url (match-string 1 match))) + (concat "URL " + (helpful--button + url + 'helpful-link-button + 'url url)))) + docstring)) + +(defun helpful--propertize-bare-links (docstring) + "Convert URL links in docstrings to buttons." + (replace-regexp-in-string + (rx (group (or string-start space "<")) + (group "http" (? "s") "://" (+? (not (any space)))) + (group (? (any "." ">" ")")) + (or space string-end ">"))) + (lambda (match) + (let ((space-before (match-string 1 match)) + (url (match-string 2 match)) + (after (match-string 3 match))) + (concat + space-before + (helpful--button + url + 'helpful-link-button + 'url url) + after))) + docstring)) + +(defun helpful--follow-link (button) + "Follow the URL specified by BUTTON." + (browse-url (button-get button 'url))) + +(defconst helpful--highlighting-funcs + '(ert--activate-font-lock-keywords + highlight-quoted-mode + rainbow-delimiters-mode) + "Highlighting functions that are safe to run in a temporary buffer. +This is used in `helpful--syntax-highlight' to support extra +highlighting that the user may have configured in their mode +hooks.") + +;; TODO: crashes on `backtrace-frame' on a recent checkout. + +(defun helpful--syntax-highlight (source &optional mode) + "Return a propertized version of SOURCE in MODE." + (unless mode + (setq mode #'emacs-lisp-mode)) + (if (or + (< (length source) helpful-max-highlight) + (eq mode 'emacs-lisp-mode)) + (with-temp-buffer + (insert source) + + ;; Switch to major-mode MODE, but don't run any hooks. + (delay-mode-hooks (funcall mode)) + + ;; `delayed-mode-hooks' contains mode hooks like + ;; `emacs-lisp-mode-hook'. Build a list of functions that are run + ;; when the mode hooks run. + (let (hook-funcs) + (dolist (hook delayed-mode-hooks) + (let ((funcs (symbol-value hook))) + (setq hook-funcs (append hook-funcs funcs)))) + + ;; Filter hooks to those that relate to highlighting, and run them. + (setq hook-funcs (-intersection hook-funcs helpful--highlighting-funcs)) + (-map #'funcall hook-funcs)) + + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (with-no-warnings + (font-lock-fontify-buffer))) + (buffer-string)) + ;; SOURCE was too long to highlight in a reasonable amount of + ;; time. + (concat + (propertize + "// Skipping highlighting due to " + 'face 'font-lock-comment-face) + (helpful--button + "helpful-max-highlight" + 'helpful-describe-exactly-button + 'symbol 'helpful-max-highlight + 'callable-p nil) + (propertize + ".\n" + 'face 'font-lock-comment-face) + source))) + +(defun helpful--source (sym callable-p buf pos) + "Return the source code of SYM. +If the source code cannot be found, return the sexp used." + (catch 'source + (unless (symbolp sym) + (throw 'source sym)) + + (let ((source nil)) + (when (and buf pos) + (with-current-buffer buf + (save-excursion + (save-restriction + (goto-char pos) + + (if (and (helpful--primitive-p sym callable-p) + (not callable-p)) + ;; For variables defined in .c files, only show the + ;; DEFVAR expression rather than the huge containing + ;; function. + (progn + (setq pos (line-beginning-position)) + (forward-list) + (forward-char) + (narrow-to-region pos (point))) + ;; Narrow to the top-level definition. + (narrow-to-defun t)) + + ;; If there was a preceding comment, POS will be + ;; after that comment. Move the position to include that comment. + (setq pos (point-min)) + + (setq source (buffer-substring-no-properties (point-min) (point-max)))))) + (setq source (s-trim-right source)) + (when (and source (buffer-file-name buf)) + (setq source (propertize source + 'helpful-path (buffer-file-name buf) + 'helpful-pos pos + 'helpful-pos-is-start t))) + (throw 'source source))) + + (when callable-p + ;; Could not find source -- probably defined interactively, or via + ;; a macro, or file has changed. + ;; TODO: verify that the source hasn't changed before showing. + ;; TODO: offer to download C sources for current version. + (throw 'source (indirect-function sym))))) + +(defun helpful--in-manual-p (sym) + "Return non-nil if SYM is in an Info manual." + (let ((completions + (cl-letf (((symbol-function #'message) + (lambda (_format-string &rest _args)))) + (info-lookup->completions 'symbol 'emacs-lisp-mode)))) + (-when-let (buf (get-buffer " temp-info-look")) + (kill-buffer buf)) + (or (assoc sym completions) + (assoc-string sym completions)))) + +(defun helpful--version-info (sym) + "If SYM has version information, format and return it. +Return nil otherwise." + (when (symbolp sym) + (let ((package-version + (get sym 'custom-package-version)) + (emacs-version + (get sym 'custom-version))) + (cond + (package-version + (format + "This variable was added, or its default value changed, in %s version %s." + (car package-version) + (cdr package-version))) + (emacs-version + (format + "This variable was added, or its default value changed, in Emacs %s." + emacs-version)))))) + +(defun helpful--library-path (library-name) + "Find the absolute path for the source of LIBRARY-NAME. + +LIBRARY-NAME takes the form \"foo.el\" , \"foo.el\" or +\"src/foo.c\". + +If .elc files exist without the corresponding .el, return nil." + (when (member (f-ext library-name) '("c" "rs")) + (setq library-name + (f-expand library-name + (f-parent find-function-C-source-directory)))) + (condition-case nil + (find-library-name library-name) + (error nil))) + +(defun helpful--macroexpand-try (form) + "Try to fully macroexpand FORM. +If it fails, attempt to partially macroexpand FORM." + (catch 'result + (ignore-errors + ;; Happy path: we can fully expand the form. + (throw 'result (macroexpand-all form))) + (ignore-errors + ;; Attempt one level of macroexpansion. + (throw 'result (macroexpand-1 form))) + ;; Fallback: just return the original form. + form)) + +(defun helpful--tree-any-p (pred tree) + "Walk TREE, applying PRED to every subtree. +Return t if PRED ever returns t." + (catch 'found + (let ((stack (list tree))) + (while stack + (let ((next (pop stack))) + (cond + ((funcall pred next) + (throw 'found t)) + ((consp next) + (push (car next) stack) + (push (cdr next) stack)))))) + nil)) + +(defun helpful--find-by-macroexpanding (buf sym callable-p) + "Search BUF for the definition of SYM by macroexpanding +interesting forms in BUF." + (catch 'found + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (condition-case nil + (while t + (let ((form (read (current-buffer))) + (var-def-p + (lambda (sexp) + (and (eq (car-safe sexp) 'defvar) + (eq (car-safe (cdr sexp)) sym)))) + (fn-def-p + (lambda (sexp) + ;; `defun' ultimately expands to `defalias'. + (and (eq (car-safe sexp) 'defalias) + (equal (car-safe (cdr sexp)) `(quote ,sym)))))) + (setq form (helpful--macroexpand-try form)) + + (when (helpful--tree-any-p + (if callable-p fn-def-p var-def-p) + form) + ;; `read' puts point at the end of the form, so go + ;; back to the start. + (throw 'found (scan-sexps (point) -1))))) + (end-of-file nil)))))) + +(defun helpful--definition (sym callable-p) + "Return a list (BUF POS OPENED) where SYM is defined. + +BUF is the buffer containing the definition. If the user wasn't +already visiting this buffer, OPENED is t and callers should kill +the buffer when done. + +POS is the position of the start of the definition within the +buffer." + (let ((initial-buffers (buffer-list)) + (primitive-p (helpful--primitive-p sym callable-p)) + (library-name nil) + (buf nil) + (pos nil) + (opened nil) + ;; Skip running hooks that may prompt the user. + (find-file-hook nil) + (after-change-major-mode-hook nil) + ;; If we end up opening a buffer, don't bother with file + ;; variables. It prompts the user, and we discard the buffer + ;; afterwards anyway. + (enable-local-variables nil)) + ;; We shouldn't be called on primitive functions if we don't have + ;; a directory of Emacs C sourcecode. + (cl-assert + (or find-function-C-source-directory + (not primitive-p))) + + (when (and (symbolp sym) callable-p) + (setq library-name (cdr (find-function-library sym)))) + + (cond + ((and (not (symbolp sym)) (functionp sym)) + (list nil nil nil)) + ((and callable-p library-name) + (-when-let (src-path (helpful--library-path library-name)) + ;; Opening large .c files can be slow (e.g. when looking at + ;; `defalias'), especially if the user has configured mode hooks. + ;; + ;; Bind `auto-mode-alist' to nil, so we open the buffer in + ;; `fundamental-mode' if it isn't already open. + (let ((auto-mode-alist nil)) + ;; Open `src-path' ourselves, so we can widen before searching. + (setq buf (find-file-noselect src-path))) + + (unless (-contains-p initial-buffers buf) + (setq opened t)) + + ;; If it's a freshly opened buffer, we need to switch to the + ;; correct mode so we can search correctly. Enable the mode, but + ;; don't bother with mode hooks, because we just need the syntax + ;; table for searching. + (when opened + (with-current-buffer buf + (delay-mode-hooks (normal-mode t)))) + + ;; Based on `find-function-noselect'. + (with-current-buffer buf + ;; `find-function-search-for-symbol' moves point. Prevent + ;; that. + (save-excursion + ;; Narrowing has been fixed upstream: + ;; http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=abd18254aec76b26e86ae27e91d2c916ec20cc46 + (save-restriction + (widen) + (setq pos + (cdr (find-function-search-for-symbol sym nil library-name)))))) + ;; If we found the containing buffer, but not the symbol, attempt + ;; to find it by macroexpanding interesting forms. + (when (and buf (not pos)) + (setq pos (helpful--find-by-macroexpanding buf sym t))))) + ;; A function, but no file found. + (callable-p + ;; Functions defined interactively may have an edebug property + ;; that contains the location of the definition. + (-when-let (edebug-info (get sym 'edebug)) + (-let [marker (if (consp edebug-info) + (car edebug-info) + edebug-info)] + (setq buf (marker-buffer marker)) + (setq pos (marker-position marker))))) + ((not callable-p) + (condition-case _err + (-let [(sym-buf . sym-pos) (find-definition-noselect sym 'defvar)] + (setq buf sym-buf) + (unless (-contains-p initial-buffers buf) + (setq opened t)) + (setq pos sym-pos)) + (search-failed nil) + ;; If your current Emacs instance doesn't match the source + ;; code configured in find-function-C-source-directory, we can + ;; get an error about not finding source. Try + ;; `default-tab-width' against Emacs trunk. + (error nil)))) + (list buf pos opened))) + +(defun helpful--reference-positions (sym callable-p buf) + "Return all the buffer positions of references to SYM in BUF." + (-let* ((forms-and-bufs + (elisp-refs--search-1 + (list buf) + (lambda (buf) + (elisp-refs--read-and-find + buf sym + (if callable-p + #'elisp-refs--function-p + #'elisp-refs--variable-p))))) + ;; Since we only searched one buffer, we know that + ;; forms-and-bufs has only one item. + (forms-and-buf (-first-item forms-and-bufs)) + ((forms . _buf) forms-and-buf)) + (-map + (-lambda ((_code start-pos _end-pos)) start-pos) + forms))) + +(defun helpful--all-keymap-syms () + "Return all keymaps defined in this Emacs instance." + (let (keymaps) + (mapatoms + (lambda (sym) + (when (and (boundp sym) (keymapp (symbol-value sym))) + (push sym keymaps)))) + keymaps)) + +(defun helpful--key-sequences (command-sym keymap global-keycodes) + "Return all the key sequences of COMMAND-SYM in KEYMAP." + (let* ((keycodes + ;; Look up this command in the keymap, its parent and the + ;; global map. We need to include the global map to find + ;; remapped commands. + (where-is-internal command-sym keymap nil t)) + ;; Look up this command in the parent keymap. + (parent-keymap (keymap-parent keymap)) + (parent-keycodes + (when parent-keymap + (where-is-internal + command-sym (list parent-keymap) nil t))) + ;; Look up this command in the global map. + (global-keycodes + (unless (eq keymap global-map) + global-keycodes))) + (->> keycodes + ;; Ignore keybindings from the parent or global map. + (--remove (or (-contains-p global-keycodes it) + (-contains-p parent-keycodes it))) + ;; Convert raw keycode vectors into human-readable strings. + (-map #'key-description)))) + +(defun helpful--keymaps-containing (command-sym) + "Return a list of pairs listing keymap names that contain COMMAND-SYM, +along with the keybindings in each keymap. + +Keymap names are typically variable names, but may also be +descriptions of values in `minor-mode-map-alist'. + +We ignore keybindings that are menu items, and ignore keybindings +from parent keymaps. + +`widget-global-map' is also ignored as it generally contains the +same bindings as `global-map'." + (let* ((keymap-syms (helpful--all-keymap-syms)) + (keymap-sym-vals (-map #'symbol-value keymap-syms)) + (global-keycodes (where-is-internal + command-sym (list global-map) nil t)) + matching-keymaps) + ;; Look for this command in all keymaps bound to variables. + (-map + (-lambda ((keymap-sym . keymap)) + (let ((key-sequences (helpful--key-sequences command-sym keymap global-keycodes))) + (when (and key-sequences (not (eq keymap-sym 'widget-global-map))) + (push (cons (symbol-name keymap-sym) key-sequences) + matching-keymaps)))) + (-zip keymap-syms keymap-sym-vals)) + + ;; Look for this command in keymaps used by minor modes that + ;; aren't bound to variables. + (-map + (-lambda ((minor-mode . keymap)) + ;; Only consider this keymap if we didn't find it bound to a variable. + (when (and (keymapp keymap) + (not (memq keymap keymap-sym-vals))) + (let ((key-sequences (helpful--key-sequences command-sym keymap global-keycodes))) + (when key-sequences + (push (cons (format "minor-mode-map-alist (%s)" minor-mode) + key-sequences) + matching-keymaps))))) + ;; TODO: examine `minor-mode-overriding-map-alist' too. + minor-mode-map-alist) + + matching-keymaps)) + +(defun helpful--merge-alists (l1 l2) + "Given two alists mapping symbols to lists, return a single +alist with the lists concatenated." + (let* ((l1-keys (-map #'-first-item l1)) + (l2-keys (-map #'-first-item l2)) + (l2-extra-keys (-difference l2-keys l1-keys)) + (l2-extra-values + (--map (assoc it l2) l2-extra-keys)) + (l1-with-values + (-map (-lambda ((key . values)) + (cons key (append values + (cdr (assoc key l2))))) + l1))) + (append l1-with-values l2-extra-values))) + +(defun helpful--keymaps-containing-aliases (command-sym aliases) + "Return a list of pairs mapping keymap symbols to the +keybindings for COMMAND-SYM in each keymap. + +Includes keybindings for aliases, unlike +`helpful--keymaps-containing'." + (let* ((syms (cons command-sym aliases)) + (syms-keymaps (-map #'helpful--keymaps-containing syms))) + (-reduce #'helpful--merge-alists syms-keymaps))) + +(defun helpful--format-keys (command-sym aliases) + "Describe all the keys that call COMMAND-SYM." + (let (mode-lines + global-lines) + (--each (helpful--keymaps-containing-aliases command-sym aliases) + (-let [(map . keys) it] + (dolist (key keys) + (push + (format "%s %s" + (propertize map 'face 'font-lock-variable-name-face) + key) + (if (eq map 'global-map) global-lines mode-lines))))) + (setq global-lines (-sort #'string< global-lines)) + (setq mode-lines (-sort #'string< mode-lines)) + (-let [lines (-concat global-lines mode-lines)] + (if lines + (s-join "\n" lines) + "This command is not in any keymaps.")))) + +(defun helpful--outer-sexp (buf pos) + "Find position POS in BUF, and return the name of the outer sexp, +along with its position. + +Moves point in BUF." + (with-current-buffer buf + (goto-char pos) + (let* ((ppss (syntax-ppss)) + (outer-sexp-posns (nth 9 ppss))) + (when outer-sexp-posns + (goto-char (car outer-sexp-posns)))) + (list (point) (-take 2 (read buf))))) + +(defun helpful--count-values (items) + "Return an alist of the count of each value in ITEMS. +E.g. (x x y z y) -> ((x . 2) (y . 2) (z . 1))" + (let (counts) + (dolist (item items (nreverse counts)) + (-if-let (item-and-count (assoc item counts)) + (setcdr item-and-count (1+ (cdr item-and-count))) + (push (cons item 1) counts))))) + +(defun helpful--without-advice (sym) + "Given advised function SYM, return the function object +without the advice. Assumes function has been loaded." + (advice--cd*r + (advice--symbol-function sym))) + +(defun helpful--advised-p (sym) + "Does SYM have advice associated with it?" + (and (symbolp sym) + (advice--p (advice--symbol-function sym)))) + +(defun helpful--format-head (head) + "Given a 'head' (the first two symbols of a sexp) format and +syntax highlight it." + (-let* (((def name) head) + (formatted-name + (if (and (consp name) (eq (car name) 'quote)) + (format "'%S" (cadr name)) + (format "%S" name))) + (formatted-def + (format "(%s %s ...)" def formatted-name)) + ) + (helpful--syntax-highlight formatted-def))) + +(defun helpful--format-reference (head longest-head ref-count position path) + "Return a syntax-highlighted version of HEAD, with a link +to its source location." + (let ((formatted-count + (format "%d reference%s" + ref-count (if (> ref-count 1) "s" "")))) + (propertize + (format + "%s %s" + (s-pad-right longest-head " " (helpful--format-head head)) + (propertize formatted-count 'face 'font-lock-comment-face)) + 'helpful-path path + 'helpful-pos position))) + +(defun helpful--format-position-heads (position-heads path) + "Given a list of outer sexps, format them for display. +POSITION-HEADS takes the form ((123 (defun foo)) (456 (defun bar)))." + (let ((longest-head + (->> position-heads + (-map (-lambda ((_pos head)) (helpful--format-head head))) + (-map #'length) + (-max)))) + (->> (helpful--count-values position-heads) + (-map (-lambda (((pos head) . count)) + (helpful--format-reference head longest-head count pos path))) + (s-join "\n")))) + +(defun helpful--primitive-p (sym callable-p) + "Return t if SYM is defined in C." + (cond + ((and callable-p (helpful--advised-p sym)) + (subrp (helpful--without-advice sym))) + (callable-p + (and (not (and (fboundp 'subr-native-elisp-p) + (subr-native-elisp-p (indirect-function sym)))) + (subrp (indirect-function sym)))) + (t + (let ((filename (find-lisp-object-file-name sym 'defvar))) + (or (eq filename 'C-source) + (and (stringp filename) + (let ((ext (file-name-extension filename))) + (or (equal ext "c") + (equal ext "rs"))))))))) + +(defun helpful--sym-value (sym buf) + "Return the value of SYM in BUF." + (cond + ;; If we're given a buffer, look up the variable in that buffer. + (buf + (with-current-buffer buf + (symbol-value sym))) + ;; If we don't have a buffer, and this is a buffer-local variable, + ;; ensure we return the default value. + ((local-variable-if-set-p sym) + (default-value sym)) + ;; Otherwise, just return the value in the current buffer, which is + ;; the global value. + (t + (symbol-value sym)))) + +(defun helpful--insert-section-break () + "Insert section break into helpful buffer." + (insert "\n\n")) + +(defun helpful--insert-implementations () + "When `helpful--sym' is a generic method, insert its implementations." + (let ((func helpful--sym) + (content)) + (when (fboundp #'cl--generic-describe) + (with-temp-buffer + (declare-function cl--generic-describe "cl-generic" (function)) + (cl--generic-describe func) + (setf (point) (point-min)) + (when (re-search-forward "^Implementations:$" nil t) + (setq content (buffer-substring (point) (point-max))))) + (when content + (helpful--insert-section-break) + (insert (helpful--heading "Implementations") (s-trim content)))))) + +(defun helpful--calculate-references (sym callable-p source-path) + "Calculate references for SYM in SOURCE-PATH." + (when source-path + (let* ((primitive-p (helpful--primitive-p sym callable-p)) + (buf (elisp-refs--contents-buffer source-path)) + (positions + (if primitive-p + nil + (helpful--reference-positions + helpful--sym helpful--callable-p buf))) + (return-value (--map (helpful--outer-sexp buf it) positions))) + (kill-buffer buf) + return-value))) + +(defun helpful--make-manual-button (sym) + "Make manual button for SYM." + (helpful--button + "View in manual" + 'helpful-manual-button + 'symbol sym)) + +(defun helpful--make-toggle-button (sym buffer) + "Make toggle button for SYM in BUFFER." + (helpful--button + "Toggle" + 'helpful-toggle-button + 'symbol sym + 'buffer buffer)) + +(defun helpful--make-set-button (sym buffer) + "Make set button for SYM in BUFFER." + (helpful--button + "Set" + 'helpful-set-button + 'symbol sym + 'buffer buffer)) + +(defun helpful--make-toggle-literal-button () + "Make set button for SYM in BUFFER." + (helpful--button + (if helpful--view-literal + ;; TODO: only offer for strings that have newlines, tabs or + ;; properties. + "Pretty view" + "View as literal") + 'helpful-view-literal-button)) + +(defun helpful--make-customize-button (sym) + "Make customize button for SYM." + (helpful--button + "Customize" + 'helpful-customize-button + 'symbol sym)) + +(defun helpful--make-references-button (sym callable-p) + "Make references button for SYM." + (helpful--button + "Find all references" + 'helpful-all-references-button + 'symbol sym + 'callable-p callable-p)) + +(defun helpful--make-edebug-button (sym) + "Make edebug button for SYM." + (helpful--button + (format "%s edebug" + (if (helpful--edebug-p sym) + "Disable" "Enable")) + 'helpful-edebug-button + 'symbol sym)) + +(defun helpful--make-tracing-button (sym) + "Make tracing button for SYM." + (helpful--button + (format "%s tracing" + (if (trace-is-traced sym) + "Disable" "Enable")) + 'helpful-trace-button + 'symbol sym)) + +(defun helpful--make-disassemble-button (obj) + "Make disassemble button for OBJ. +OBJ may be a symbol or a compiled function object." + (helpful--button + "Disassemble" + 'helpful-disassemble-button + 'object obj)) + +(defun helpful--make-run-test-button (sym) + "Make an ERT test button for SYM." + (helpful--button + "Run test" + 'helpful-run-test-button + 'symbol sym)) + +(defun helpful--make-forget-button (sym callable-p) + "Make forget button for SYM." + (helpful--button + "Forget" + 'helpful-forget-button + 'symbol sym + 'callable-p callable-p)) + +(defun helpful--make-callees-button (sym source) + (helpful--button + (format "Functions used by %s" sym) + 'helpful-callees-button + 'symbol sym + 'source source)) + +;; TODO: this only reports if a function is autoloaded because we +;; autoloaded it. This ignores newly defined functions that are +;; autoloaded. Built-in help has this limitation too, but if we can +;; find the source, we should instead see if there's an autoload +;; cookie. +(defun helpful--autoloaded-p (sym buf) + "Return non-nil if function SYM is autoloaded." + (-when-let (file-name (buffer-file-name buf)) + (setq file-name (s-chop-suffix ".gz" file-name)) + (condition-case nil + (help-fns--autoloaded-p sym file-name) + ; new in Emacs 29.0.50 + ; see https://github.com/Wilfred/helpful/pull/283 + (error (help-fns--autoloaded-p sym))))) + +(defun helpful--compiled-p (sym) + "Return non-nil if function SYM is byte-compiled" + (and (symbolp sym) + (byte-code-function-p (symbol-function sym)))) + +(defun helpful--native-compiled-p (sym) + "Return non-nil if function SYM is native-compiled" + (and (symbolp sym) + (fboundp 'subr-native-elisp-p) + (subr-native-elisp-p (symbol-function sym)))) + +(defun helpful--join-and (items) + "Join a list of strings with commas and \"and\"." + (cond + ((= (length items) 0) + "") + ((= (length items) 1) + (car items)) + (t + (format "%s and %s" + (s-join ", " (-drop-last 1 items)) + (-last-item items))))) + +(defun helpful--summary (sym callable-p buf pos) + "Return a one sentence summary for SYM." + (-let* ((primitive-p (helpful--primitive-p sym callable-p)) + (canonical-sym (helpful--canonical-symbol sym callable-p)) + (alias-p (not (eq canonical-sym sym))) + (alias-button + (if callable-p + ;; Show a link to 'defalias' in the manual. + (helpful--button + "function alias" + 'helpful-manual-button + 'symbol 'defalias) + ;; Show a link to the variable aliases section in the + ;; manual. + (helpful--button + "alias" + 'helpful-info-button + 'info-node "(elisp)Variable Aliases"))) + (special-form-button + (helpful--button + "special form" + 'helpful-info-button + 'info-node "(elisp)Special Forms")) + (keyboard-macro-button + (helpful--button + "keyboard macro" + 'helpful-info-button + 'info-node "(elisp)Keyboard Macros")) + (interactive-button + (helpful--button + "interactive" + 'helpful-info-button + 'info-node "(elisp)Using Interactive")) + (autoload-button + (helpful--button + "autoloaded" + 'helpful-info-button + 'info-node "(elisp)Autoload")) + (compiled-button + (helpful--button + "byte-compiled" + 'helpful-info-button + 'info-node "(elisp)Byte Compilation")) + (native-compiled-button + (helpful--button + "natively compiled" + 'helpful-describe-button + 'symbol 'native-compile)) + (buffer-local-button + (helpful--button + "buffer-local" + 'helpful-info-button + 'info-node "(elisp)Buffer-Local Variables")) + (autoloaded-p + (and callable-p buf (helpful--autoloaded-p sym buf))) + (compiled-p + (and callable-p (helpful--compiled-p sym))) + (native-compiled-p + (and callable-p (helpful--native-compiled-p sym))) + (buttons + (list + (if alias-p alias-button) + (if (and callable-p autoloaded-p) autoload-button) + (if (and callable-p (commandp sym)) interactive-button) + (if compiled-p compiled-button) + (if native-compiled-p native-compiled-button) + (if (and (not callable-p) (local-variable-if-set-p sym)) + buffer-local-button))) + (description + (helpful--join-and (-non-nil buttons))) + (kind + (cond + ((special-form-p sym) + special-form-button) + (alias-p + (format "for %s," + (helpful--button + (symbol-name canonical-sym) + 'helpful-describe-exactly-button + 'symbol canonical-sym + 'callable-p callable-p))) + ((not callable-p) "variable") + ((macrop sym) "macro") + ((helpful--kbd-macro-p sym) keyboard-macro-button) + (t "function"))) + (defined + (cond + (buf + (let ((path (buffer-file-name buf))) + (if path + (format + "defined in %s" + (helpful--navigate-button + (file-name-nondirectory path) path pos)) + (format "defined in buffer %s" + (helpful--buffer-button buf pos))))) + (primitive-p + "defined in C source code") + ((helpful--kbd-macro-p sym) nil) + (t + "without a source file")))) + + (s-word-wrap + 70 + (format "%s is %s %s %s%s." + (if (symbolp sym) + (helpful--format-symbol sym) + "This lambda") + (if (string-match-p + (rx bos (or "a" "e" "i" "o" "u")) + description) + "an" + "a") + description + kind + (if defined (concat " " defined) ""))))) + +(defun helpful--callees (form) + "Given source code FORM, return a list of all the functions called." + (let* ((expanded-form (macroexpand-all form)) + ;; Find all the functions called after macro expansion. + (all-fns (helpful--callees-1 expanded-form)) + ;; Only consider the functions that were in the original code + ;; before macro expansion. + (form-syms (-filter #'symbolp (-flatten form))) + (form-fns (--filter (memq it form-syms) all-fns))) + (-distinct form-fns))) + +(defun helpful--callees-1 (form) + "Return a list of all the functions called in FORM. +Assumes FORM has been macro expanded. The returned list +may contain duplicates." + (cond + ((not (consp form)) + nil) + ;; See `(elisp)Special Forms'. For these special forms, we recurse + ;; just like functions but ignore the car. + ((memq (car form) '(and catch defconst defvar if interactive + or prog1 prog2 progn save-current-buffer + save-restriction setq setq-default + track-mouse unwind-protect while)) + (-flatten + (-map #'helpful--callees-1 (cdr form)))) + + ((eq (car form) 'cond) + (let* ((clauses (cdr form)) + (clause-fns + ;; Each clause is a list of forms. + (--map + (-map #'helpful--callees-1 it) clauses))) + (-flatten clause-fns))) + + ((eq (car form) 'condition-case) + (let* ((protected-form (nth 2 form)) + (protected-form-fns (helpful--callees-1 protected-form)) + (handlers (-drop 3 form)) + (handler-bodies (-map #'cdr handlers)) + (handler-fns + (--map + (-map #'helpful--callees-1 it) handler-bodies))) + (append + protected-form-fns + (-flatten handler-fns)))) + + ;; Calling a function with a well known higher order function, for + ;; example (funcall 'foo 1 2). + ((and + (memq (car form) '(funcall apply call-interactively + mapcar mapc mapconcat -map)) + (eq (car-safe (nth 1 form)) 'quote)) + (cons + (cadr (nth 1 form)) + (-flatten + (-map #'helpful--callees-1 (cdr form))))) + + ((eq (car form) 'function) + (let ((arg (nth 1 form))) + (if (symbolp arg) + ;; #'foo, which is the same as (function foo), is a function + ;; reference. + (list arg) + ;; Handle (function (lambda ...)). + (helpful--callees-1 arg)))) + + ((eq (car form) 'lambda) + ;; Only consider the body, not the param list. + (-flatten (-map #'helpful--callees-1 (-drop 2 form)))) + + ((eq (car form) 'closure) + ;; Same as lambda, but has an additional argument of the + ;; closed-over variables. + (-flatten (-map #'helpful--callees-1 (-drop 3 form)))) + + ((memq (car form) '(let let*)) + ;; Extract function calls used to set the let-bound variables. + (let* ((var-vals (-second-item form)) + (var-val-callees + (--map + (if (consp it) + (-map #'helpful--callees-1 it) + nil) + var-vals))) + (append + (-flatten var-val-callees) + ;; Function calls in the let body. + (-map #'helpful--callees-1 (-drop 2 form))))) + + ((eq (car form) 'quote) + nil) + (t + (cons + (car form) + (-flatten + (-map #'helpful--callees-1 (cdr form))))))) + +(defun helpful--ensure-loaded () + "Ensure the symbol associated with the current buffer has been loaded." + (when (and helpful--callable-p + (symbolp helpful--sym)) + (let ((fn-obj (symbol-function helpful--sym))) + (when (autoloadp fn-obj) + (autoload-do-load fn-obj))))) + +(defun helpful--hook-p (symbol value) + "Does SYMBOL look like a hook?" + (and + (or + (s-ends-with-p "-hook" (symbol-name symbol)) + ;; E.g. `after-change-functions', which can be used with + ;; `add-hook'. + (s-ends-with-p "-functions" (symbol-name symbol))) + (consp value))) + +(defun helpful--format-value (sym value) + "Format VALUE as a string." + (cond + (helpful--view-literal + (helpful--syntax-highlight (helpful--pretty-print value))) + ;; Allow strings to be viewed with properties rendered in + ;; Emacs, rather than as a literal. + ((stringp value) + value) + ;; Allow keymaps to be viewed with keybindings shown and + ;; links to the commands bound. + ((keymapp value) + (helpful--format-keymap value)) + ((helpful--hook-p sym value) + (helpful--format-hook value)) + (t + (helpful--pretty-print value)))) + +(defun helpful--original-value (sym) + "Return the original value for SYM, if any. + +If SYM has an original value, return it in a list. Return nil +otherwise." + (let* ((orig-val-expr (get sym 'standard-value))) + (when (consp orig-val-expr) + (ignore-errors + (list + (eval (car orig-val-expr))))))) + +(defun helpful--original-value-differs-p (sym) + "Return t if SYM has an original value, and its current +value is different." + (let ((orig-val-list (helpful--original-value sym))) + (and (consp orig-val-list) + (not (eq (car orig-val-list) + (symbol-value sym)))))) + +(defun helpful-update () + "Update the current *Helpful* buffer to the latest +state of the current symbol." + (interactive) + (cl-assert (not (null helpful--sym))) + (unless (buffer-live-p helpful--associated-buffer) + (setq helpful--associated-buffer nil)) + (helpful--ensure-loaded) + (-let* ((val + ;; Look at the value before setting `inhibit-read-only', so + ;; users can see the correct value of that variable. + (unless helpful--callable-p + (helpful--sym-value helpful--sym helpful--associated-buffer))) + (inhibit-read-only t) + (start-line (line-number-at-pos)) + (start-column (current-column)) + (primitive-p (helpful--primitive-p helpful--sym helpful--callable-p)) + (canonical-sym (helpful--canonical-symbol helpful--sym helpful--callable-p)) + (look-for-src (or (not primitive-p) + find-function-C-source-directory)) + ((buf pos opened) + (if look-for-src + (helpful--definition helpful--sym helpful--callable-p) + '(nil nil nil))) + (source (when look-for-src + (helpful--source helpful--sym helpful--callable-p buf pos))) + (source-path (when buf + (buffer-file-name buf))) + (references (helpful--calculate-references + helpful--sym helpful--callable-p + source-path)) + (aliases (helpful--aliases helpful--sym helpful--callable-p))) + + (erase-buffer) + + (insert (helpful--summary helpful--sym helpful--callable-p buf pos)) + + (when (helpful--obsolete-info helpful--sym helpful--callable-p) + (insert + "\n\n" + (helpful--format-obsolete-info helpful--sym helpful--callable-p))) + + (when (and helpful--callable-p + (not (helpful--kbd-macro-p helpful--sym))) + (helpful--insert-section-break) + (insert + (helpful--heading "Signature") + (helpful--syntax-highlight (helpful--signature helpful--sym)))) + + (when (not helpful--callable-p) + (helpful--insert-section-break) + (let* ((sym helpful--sym) + (multiple-views-p + (or (stringp val) + (keymapp val) + (helpful--hook-p sym val)))) + (when helpful--first-display + (if (stringp val) + ;; For strings, it's more intuitive to display them as + ;; literals, so "1" and 1 are distinct. + (setq helpful--view-literal t) + ;; For everything else, prefer the pretty view if available. + (setq helpful--view-literal nil))) + (insert + (helpful--heading + (cond + ;; Buffer-local variable and we're looking at the value in + ;; a specific buffer. + ((and + helpful--associated-buffer + (local-variable-p sym helpful--associated-buffer)) + (format "Value in %s" + (helpful--button + (format "#<buffer %s>" (buffer-name helpful--associated-buffer)) + 'helpful-buffer-button + 'buffer helpful--associated-buffer + 'position pos))) + ;; Buffer-local variable but default/global value. + ((local-variable-if-set-p sym) + "Global Value") + ;; This variable is not buffer-local. + (t "Value"))) + (helpful--format-value sym val) + "\n\n") + (when (helpful--original-value-differs-p sym) + (insert + (helpful--heading "Original Value") + (helpful--format-value + sym + (car (helpful--original-value sym))) + "\n\n")) + (when multiple-views-p + (insert (helpful--make-toggle-literal-button) " ")) + + (when (local-variable-if-set-p sym) + (insert + (helpful--button + "Buffer values" + 'helpful-associated-buffer-button + 'symbol sym + 'prompt-p t) + " " + (helpful--button + "Global value" + 'helpful-associated-buffer-button + 'symbol sym + 'prompt-p nil) + " ")) + (when (memq (helpful--sym-value helpful--sym helpful--associated-buffer) '(nil t)) + (insert (helpful--make-toggle-button helpful--sym helpful--associated-buffer) " ")) + (insert (helpful--make-set-button helpful--sym helpful--associated-buffer)) + (when (custom-variable-p helpful--sym) + (insert " " (helpful--make-customize-button helpful--sym))))) + + (let ((docstring (helpful--docstring helpful--sym helpful--callable-p)) + (version-info (unless helpful--callable-p + (helpful--version-info helpful--sym)))) + (when (or docstring version-info) + (helpful--insert-section-break) + (insert + (helpful--heading "Documentation")) + (when docstring + (insert (helpful--format-docstring docstring))) + (when version-info + (insert "\n\n" (s-word-wrap 70 version-info))) + (when (and (symbolp helpful--sym) (helpful--in-manual-p helpful--sym)) + (insert "\n\n") + (insert (helpful--make-manual-button helpful--sym))))) + + ;; Show keybindings. + ;; TODO: allow users to conveniently add and remove keybindings. + (when (commandp helpful--sym) + (helpful--insert-section-break) + (insert + (helpful--heading "Key Bindings") + (helpful--format-keys helpful--sym aliases))) + + (helpful--insert-section-break) + + (insert + (helpful--heading "References") + (let ((src-button + (when source-path + (helpful--navigate-button + (file-name-nondirectory source-path) + source-path + (or pos + 0))))) + (cond + ((and source-path references) + (format "References in %s:\n%s" + src-button + (helpful--format-position-heads references source-path))) + ((and source-path primitive-p) + (format + "Finding references in a .%s file is not supported." + (f-ext source-path))) + (source-path + (format "%s is unused in %s." + helpful--sym + src-button)) + ((and primitive-p (null find-function-C-source-directory)) + "C code is not yet loaded.") + (t + "Could not find source file."))) + "\n\n" + (helpful--make-references-button helpful--sym helpful--callable-p)) + + (when (and + helpful--callable-p + (symbolp helpful--sym) + source + (not primitive-p)) + (insert + " " + (helpful--make-callees-button helpful--sym source))) + + (when (helpful--advised-p helpful--sym) + (helpful--insert-section-break) + (insert + (helpful--heading "Advice") + (format "This %s is advised." + (if (macrop helpful--sym) "macro" "function")))) + + (let ((can-edebug + (helpful--can-edebug-p helpful--sym helpful--callable-p buf pos)) + (can-trace + (and (symbolp helpful--sym) + helpful--callable-p + ;; Tracing uses advice, and you can't apply advice to + ;; primitive functions that are replaced with special + ;; opcodes. For example, `narrow-to-region'. + (not (plist-get (symbol-plist helpful--sym) 'byte-opcode)))) + (can-disassemble + (and helpful--callable-p (not primitive-p))) + (can-forget + (and (not (special-form-p helpful--sym)) + (not primitive-p)))) + (when (or can-edebug can-trace can-disassemble can-forget) + (helpful--insert-section-break) + (insert (helpful--heading "Debugging"))) + (when can-edebug + (insert + (helpful--make-edebug-button helpful--sym))) + (when can-trace + (when can-edebug + (insert " ")) + (insert + (helpful--make-tracing-button helpful--sym))) + + (when (and + (or can-edebug can-trace) + (or can-disassemble can-forget)) + (insert "\n")) + + (when can-disassemble + (insert (helpful--make-disassemble-button helpful--sym))) + + (when can-forget + (when can-disassemble + (insert " ")) + (insert (helpful--make-forget-button helpful--sym helpful--callable-p)))) + + (when aliases + (helpful--insert-section-break) + (insert + (helpful--heading "Aliases") + (s-join "\n" (--map (helpful--format-alias it helpful--callable-p) + aliases)))) + + (when helpful--callable-p + (helpful--insert-implementations)) + + (helpful--insert-section-break) + + (when (or source-path primitive-p) + (insert + (helpful--heading + (if (eq helpful--sym canonical-sym) + "Source Code" + "Alias Source Code")) + (cond + (source-path + (concat + (propertize (format "%s Defined in " (if primitive-p "//" ";;")) + 'face 'font-lock-comment-face) + (helpful--navigate-button + (f-abbrev source-path) + source-path + pos) + "\n")) + (primitive-p + (concat + (propertize + "C code is not yet loaded." + 'face 'font-lock-comment-face) + "\n\n" + (helpful--button + "Set C source directory" + 'helpful-c-source-directory)))))) + (when source + (insert + (cond + ((stringp source) + (let ((mode (when primitive-p + (pcase (file-name-extension source-path) + ("c" 'c-mode) + ("rs" (when (fboundp 'rust-mode) 'rust-mode)))))) + (helpful--syntax-highlight source mode))) + ((and (consp source) (eq (car source) 'closure)) + (helpful--syntax-highlight + (concat ";; Closure converted to defun by helpful.\n" + (helpful--pretty-print + (helpful--format-closure helpful--sym source))))) + (t + (helpful--syntax-highlight + (concat + (if (eq helpful--sym canonical-sym) + ";; Could not find source code, showing raw function object.\n" + ";; Could not find alias source code, showing raw function object.\n") + (helpful--pretty-print source))))))) + + (helpful--insert-section-break) + + (-when-let (formatted-props (helpful--format-properties helpful--sym)) + (insert + (helpful--heading "Symbol Properties") + formatted-props)) + + (goto-char (point-min)) + (forward-line (1- start-line)) + (forward-char start-column) + (setq helpful--first-display nil) + + (when opened + (kill-buffer buf)))) + +;; TODO: this isn't sufficient for `edebug-eval-defun'. +(defun helpful--skip-advice (docstring) + "Remove mentions of advice from DOCSTRING." + (let* ((lines (s-lines docstring)) + (relevant-lines + (--drop-while + (or (s-starts-with-p ":around advice:" it) + (s-starts-with-p "This function has :around advice:" it)) + lines))) + (s-trim (s-join "\n" relevant-lines)))) + +(defun helpful--format-argument (arg) + "Format ARG (a symbol) according to Emacs help conventions." + (let ((arg-str (symbol-name arg))) + (if (s-starts-with-p "&" arg-str) + arg-str + (s-upcase arg-str)))) + +(defun helpful--format-symbol (sym) + "Format symbol as a string, escaping as necessary." + ;; Arguably this is an Emacs bug. We should be able to use + ;; (format "%S" sym) + ;; but that converts foo? to "foo\\?". You can see this in other + ;; parts of the Emacs UI, such as ERT. + (s-replace " " "\\ " (format "%s" sym))) + +;; TODO: this is broken for -any?. +(defun helpful--signature (sym) + "Get the signature for function SYM, as a string. +For example, \"(some-func FOO &optional BAR)\"." + (let (docstring-sig + source-sig + (advertised-args + (when (symbolp sym) + (gethash (symbol-function sym) advertised-signature-table)))) + ;; Get the usage from the function definition. + (let* ((function-args + (cond + ((symbolp sym) + (help-function-arglist sym)) + ((byte-code-function-p sym) + ;; argdesc can be a list of arguments or an integer + ;; encoding the min/max number of arguments. See + ;; Byte-Code Function Objects in the elisp manual. + (let ((argdesc (aref sym 0))) + (if (consp argdesc) + argdesc + ;; TODO: properly handle argdesc values. + nil))) + (t + ;; Interpreted function (lambda ...) + (cadr sym)))) + (formatted-args + (cond + (advertised-args + (-map #'helpful--format-argument advertised-args)) + ((listp function-args) + (-map #'helpful--format-argument function-args)) + (t + (list function-args))))) + (setq source-sig + (cond + ;; If it's a function object, just show the arguments. + ((not (symbolp sym)) + (format "(%s)" + (s-join " " formatted-args))) + ;; If it has multiple arguments, join them with spaces. + (formatted-args + (format "(%s %s)" + (helpful--format-symbol sym) + (s-join " " formatted-args))) + ;; Otherwise, this function takes no arguments when called. + (t + (format "(%s)" (helpful--format-symbol sym)))))) + + ;; If the docstring ends with (fn FOO BAR), extract that. + (-when-let (docstring (documentation sym)) + (-when-let (docstring-with-usage (help-split-fundoc docstring sym)) + (setq docstring-sig (car docstring-with-usage)))) + + (cond + ;; Advertised signature always wins. + (advertised-args + source-sig) + ;; If that's not set, use the usage specification in the + ;; docstring, if present. + (docstring-sig) + (t + ;; Otherwise, just use the signature from the source code. + source-sig)))) + +(defun helpful--format-obsolete-info (sym callable-p) + (-let [(use _ date) (helpful--obsolete-info sym callable-p)] + (helpful--format-docstring + (s-word-wrap + 70 + (format "This %s is obsolete%s%s" + (helpful--kind-name sym callable-p) + (if date (format " since %s" date) + "") + (cond ((stringp use) (concat "; " use)) + (use (format "; use `%s' instead." use)) + (t "."))))))) + +(defun helpful--docstring (sym callable-p) + "Get the docstring for SYM. +Note that this returns the raw docstring, including \\=\\= +escapes that are used by `substitute-command-keys'." + (let ((text-quoting-style 'grave) + docstring) + (if callable-p + (progn + (setq docstring (documentation sym t)) + (-when-let (docstring-with-usage (help-split-fundoc docstring sym)) + (setq docstring (cdr docstring-with-usage)) + (when docstring + ;; Advice mutates the docstring, see + ;; `advice--make-docstring'. Undo that. + ;; TODO: Only do this if the function is advised. + (setq docstring (helpful--skip-advice docstring))))) + (setq docstring + (documentation-property sym 'variable-documentation t))) + docstring)) + +(defun helpful--read-symbol (prompt default-val predicate) + "Read a symbol from the minibuffer, with completion. +Returns the symbol." + (when (and default-val + (not (funcall predicate default-val))) + (setq default-val nil)) + (when default-val + ;; `completing-read' expects a string. + (setq default-val (symbol-name default-val)) + + ;; TODO: Only modify the prompt when we don't have ido/ivy/helm, + ;; because the default is obvious for them. + (setq prompt + (replace-regexp-in-string + (rx ": " eos) + (format " (default: %s): " default-val) + prompt))) + (intern (completing-read prompt obarray + predicate t nil nil + default-val))) + +(defun helpful--update-and-switch-buffer (symbol callable-p) + "Update and switch to help buffer for SYMBOL." + (let ((buf (helpful--buffer symbol callable-p))) + (with-current-buffer buf + (helpful-update)) + (funcall helpful-switch-buffer-function buf))) + +;;;###autoload +(defun helpful-function (symbol) + "Show help for function named SYMBOL. + +See also `helpful-macro', `helpful-command' and `helpful-callable'." + (interactive + (list (helpful--read-symbol + "Function: " + (helpful--callable-at-point) + #'functionp))) + (helpful--update-and-switch-buffer symbol t)) + +;;;###autoload +(defun helpful-command (symbol) + "Show help for interactive function named SYMBOL. + +See also `helpful-function'." + (interactive + (list (helpful--read-symbol + "Command: " + (helpful--callable-at-point) + #'commandp))) + (helpful--update-and-switch-buffer symbol t)) + +;;;###autoload +(defun helpful-key (key-sequence) + "Show help for interactive command bound to KEY-SEQUENCE." + (interactive + (list (read-key-sequence "Press key: "))) + (let ((sym (key-binding key-sequence))) + (cond + ((null sym) + (user-error "No command is bound to %s" + (key-description key-sequence))) + ((commandp sym) + (helpful--update-and-switch-buffer sym t)) + (t + (user-error "%s is bound to %s which is not a command" + (key-description key-sequence) + sym))))) + +;;;###autoload +(defun helpful-macro (symbol) + "Show help for macro named SYMBOL." + (interactive + (list (helpful--read-symbol + "Macro: " + (helpful--callable-at-point) + #'macrop))) + (helpful--update-and-switch-buffer symbol t)) + +;;;###autoload +(defun helpful-callable (symbol) + "Show help for function, macro or special form named SYMBOL. + +See also `helpful-macro', `helpful-function' and `helpful-command'." + (interactive + (list (helpful--read-symbol + "Callable: " + (helpful--callable-at-point) + #'fboundp))) + (helpful--update-and-switch-buffer symbol t)) + +(defun helpful--variable-p (symbol) + "Return non-nil if SYMBOL is a variable." + (or (get symbol 'variable-documentation) + (and (boundp symbol) + (not (keywordp symbol)) + (not (eq symbol nil)) + (not (eq symbol t))))) + +(defun helpful--bound-p (symbol) + "Return non-nil if SYMBOL is a variable or callable. + +This differs from `boundp' because we do not consider nil, t +or :foo." + (or (fboundp symbol) + (helpful--variable-p symbol))) + +(defun helpful--bookmark-jump (bookmark) + "Create and switch to helpful bookmark BOOKMARK." + (let ((callable-p (bookmark-prop-get bookmark 'callable-p)) + (sym (bookmark-prop-get bookmark 'sym)) + (position (bookmark-prop-get bookmark 'position))) + (if callable-p + (helpful-callable sym) + (helpful-variable sym)) + (goto-char position))) + +(defun helpful--bookmark-make-record () + "Create a bookmark record for helpful buffers. + +See docs of `bookmark-make-record-function'." + `((sym . ,helpful--sym) + (callable-p . ,helpful--callable-p) + (position . ,(point)) + (handler . helpful--bookmark-jump))) + +(defun helpful--convert-c-name (symbol var) + "Convert SYMBOL from a C name to an Elisp name. +E.g. convert `Fmake_string' to `make-string' or +`Vgc_cons_percentage' to `gc-cons-percentage'. Interpret +SYMBOL as variable name if VAR, else a function name. Return +nil if SYMBOL doesn't begin with \"F\" or \"V\"." + (let ((string (symbol-name symbol)) + (prefix (if var "V" "F"))) + (when (s-starts-with-p prefix string) + (intern + (s-chop-prefix + prefix + (s-replace "_" "-" string)))))) + +;;;###autoload +(defun helpful-symbol (symbol) + "Show help for SYMBOL, a variable, function or macro. + +See also `helpful-callable' and `helpful-variable'." + (interactive + (list (helpful--read-symbol + "Symbol: " + (helpful--symbol-at-point) + #'helpful--bound-p))) + (let ((c-var-sym (helpful--convert-c-name symbol t)) + (c-fn-sym (helpful--convert-c-name symbol nil))) + (cond + ((and (boundp symbol) (fboundp symbol)) + (if (y-or-n-p + (format "%s is a both a variable and a callable, show variable?" + symbol)) + (helpful-variable symbol) + (helpful-callable symbol))) + ((fboundp symbol) + (helpful-callable symbol)) + ((boundp symbol) + (helpful-variable symbol)) + ((and c-fn-sym (fboundp c-fn-sym)) + (helpful-callable c-fn-sym)) + ((and c-var-sym (boundp c-var-sym)) + (helpful-variable c-var-sym)) + (t + (user-error "Not bound: %S" symbol))))) + +;;;###autoload +(defun helpful-variable (symbol) + "Show help for variable named SYMBOL." + (interactive + (list (helpful--read-symbol + "Variable: " + (helpful--variable-at-point) + #'helpful--variable-p))) + (helpful--update-and-switch-buffer symbol nil)) + +(defun helpful--variable-at-point-exactly () + "Return the symbol at point, if it's a bound variable." + (let ((var (variable-at-point))) + ;; `variable-at-point' uses 0 rather than nil to signify no symbol + ;; at point (presumably because 'nil is a symbol). + (unless (symbolp var) + (setq var nil)) + (when (helpful--variable-p var) + var))) + +(defun helpful--variable-defined-at-point () + "Return the variable defined in the form enclosing point." + ;; TODO: do the same thing if point is just before a top-level form. + (save-excursion + (save-restriction + (widen) + (let* ((ppss (syntax-ppss)) + (sexp-start (nth 1 ppss)) + sexp) + (when sexp-start + (goto-char sexp-start) + (setq sexp (condition-case nil + (read (current-buffer)) + (error nil))) + (when (memq (car-safe sexp) + (list 'defvar 'defvar-local 'defcustom 'defconst)) + (nth 1 sexp))))))) + +(defun helpful--variable-at-point () + "Return the variable exactly under point, or defined at point." + (let ((var (helpful--variable-at-point-exactly))) + (if var + var + (let ((var (helpful--variable-defined-at-point))) + (when (helpful--variable-p var) + var))))) + +(defun helpful--callable-at-point () + (let ((sym (symbol-at-point)) + (enclosing-sym (function-called-at-point))) + (if (fboundp sym) + sym + enclosing-sym))) + +(defun helpful--symbol-at-point-exactly () + "Return the symbol at point, if it's bound." + (let ((sym (symbol-at-point))) + (when (helpful--bound-p sym) + sym))) + +(defun helpful--symbol-at-point () + "Find the most relevant symbol at or around point. +Returns nil if nothing found." + (or + (helpful--symbol-at-point-exactly) + (helpful--callable-at-point) + (helpful--variable-at-point))) + +;;;###autoload +(defun helpful-at-point () + "Show help for the symbol at point." + (interactive) + (-if-let (symbol (helpful--symbol-at-point)) + (helpful-symbol symbol) + (user-error "There is no symbol at point."))) + +(defun helpful--imenu-index () + "Return a list of headings in the current buffer, suitable for +imenu." + (let (headings) + (goto-char (point-min)) + (while (not (eobp)) + (when (eq (get-text-property (point) 'face) + 'helpful-heading) + (push + (cons + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)) + (line-beginning-position)) + headings)) + (forward-line)) + (nreverse headings))) + +(defun helpful--flash-region (start end) + "Temporarily highlight region from START to END." + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'face 'highlight) + (run-with-timer 1.5 nil 'delete-overlay overlay))) + +(defun helpful-visit-reference () + "Go to the reference at point." + (interactive) + (let* ((sym helpful--sym) + (path (get-text-property (point) 'helpful-path)) + (pos (get-text-property (point) 'helpful-pos)) + (pos-is-start (get-text-property (point) 'helpful-pos-is-start))) + (when (and path pos) + ;; If we're looking at a source excerpt, calculate the offset of + ;; point, so we don't just go the start of the excerpt. + (when pos-is-start + (save-excursion + (let ((offset 0)) + (while (and + (get-text-property (point) 'helpful-pos) + (not (eobp))) + (backward-char 1) + (setq offset (1+ offset))) + ;; On the last iteration we moved outside the source + ;; excerpt, so we overcounted by one character. + (setq offset (1- offset)) + + ;; Set POS so we go to exactly the place in the source + ;; code where point was in the helpful excerpt. + (setq pos (+ pos offset))))) + + (find-file path) + (helpful--goto-char-widen pos) + (recenter 0) + (save-excursion + (let ((defun-end (scan-sexps (point) 1))) + (while (re-search-forward + (rx-to-string `(seq symbol-start ,(symbol-name sym) symbol-end)) + defun-end t) + (helpful--flash-region (match-beginning 0) (match-end 0)))))))) + +(defun helpful-kill-buffers () + "Kill all `helpful-mode' buffers. + +See also `helpful-max-buffers'." + (interactive) + (dolist (buffer (buffer-list)) + (when (eq (buffer-local-value 'major-mode buffer) 'helpful-mode) + (kill-buffer buffer)))) + +(defvar helpful-mode-map + (let* ((map (make-sparse-keymap))) + (define-key map (kbd "g") #'helpful-update) + (define-key map (kbd "RET") #'helpful-visit-reference) + + (define-key map (kbd "TAB") #'forward-button) + (define-key map (kbd "<backtab>") #'backward-button) + + (define-key map (kbd "n") #'forward-button) + (define-key map (kbd "p") #'backward-button) + map) + "Keymap for `helpful-mode'.") + +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-make-record-default "bookmark" + (&optional no-file no-context posn)) +;; Ensure this variable is defined even if bookmark.el isn't loaded +;; yet. This follows the pattern in help-mode.el.gz. +;; TODO: find a cleaner solution. +(defvar bookmark-make-record-function) + +(define-derived-mode helpful-mode special-mode "Helpful" + "Major mode for *Helpful* buffers." + (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) + + (setq imenu-create-index-function #'helpful--imenu-index) + ;; Prevent imenu converting "Source Code" to "Source.Code". + (setq-local imenu-space-replacement " ") + + ;; Enable users to bookmark helpful buffers. + (set (make-local-variable 'bookmark-make-record-function) + #'helpful--bookmark-make-record)) + +(provide 'helpful) +;;; helpful.el ends here diff --git a/elpa/helpful-20220220.2308/helpful.elc b/elpa/helpful-20220220.2308/helpful.elc Binary files differ. diff --git a/init.el b/init.el @@ -69,7 +69,7 @@ (("C-x C-M-t" . transpose-regions) ("C-x K" . kill-this-buffer) - ;;;; Consult bindings + ;;;; Consult bindings ;; C-c bindings (mode-specific-map) ("C-c h" . consult-history) ("C-c m" . consult-mode-command) @@ -118,6 +118,13 @@ ("C-c n l" . org-roam-buffer-toggle) ("C-c n f" . org-roam-node-find) ("C-c n i" . org-roam-node-insert))) +(lh/global-set-keys + (("C-h f" . helpful-callable) + ("C-h F" . helpful-function) + ("C-h C" . helpful-command) + ("C-h v" . helpful-variable) + ("C-h k" . helpful-key) + ("C-c C-d" . helpful-at-point))) (lh/define-keys isearch-mode-map (("M-e" . consult-isearch) @@ -185,8 +192,8 @@ ("melpa-stable" . "https://stable.melpa.org/packages/") ("melpa" . "https://melpa.org/packages/"))) '(package-selected-packages - '(ob-http pdf-tools paredit-menu paredit vertico-posframe vertico corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) - '(pcomplete-ignore-case t) + '(helpful ob-http pdf-tools paredit-menu paredit vertico-posframe vertico corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-roam org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) + '(pcomplete-ignore-case t t) '(read-buffer-completion-ignore-case t) '(read-file-name-completion-ignore-case t) '(reb-re-syntax 'string)