├── README.org ├── ghelp-builtin.el ├── ghelp-eglot-800.gif ├── ghelp-eglot.el ├── ghelp-geiser.el ├── ghelp-helpful-800.gif ├── ghelp-helpful.el ├── ghelp-lspce.el ├── ghelp-sly.el ├── ghelp-sly.png ├── ghelp-test.el ├── ghelp.el └── run-test.sh /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: ghelp 2 | 3 | This package provides a generic help system similar to Emacs Help. Unlike Emacs Help, ghelp works for more major-modes and is extensible with backends. 4 | 5 | *Features* 6 | - Unified entry command 7 | - Unified UI 8 | - Documentation history, you can search in history, go back/forward. 9 | 10 | *Currently supported backends* 11 | - builtin Help 12 | - [[https://github.com/Wilfred/helpful][helpful]] 13 | - [[https://github.com/joaotavora/eglot][eglot]] 14 | - [[https://www.nongnu.org/geiser/][geiser]] 15 | - [[https://github.com/joaotavora/sly][sly]] 16 | 17 | [[https://github.com/casouri/ghelp#screencasts][☞ Screencasts]] 18 | 19 | * Install & load 20 | Download the files and add them to load path. 21 | 22 | With ~use-package~: 23 | #+BEGIN_SRC emacs-lisp 24 | (use-package ghelp) 25 | #+END_SRC 26 | Without ~use-package~: 27 | #+BEGIN_SRC emacs-lisp 28 | (require 'ghelp) 29 | #+END_SRC 30 | 31 | * Usage 32 | 33 | | ~ghelp-describe~ | Describe a symbol in current major mode | 34 | | ~gehlp-describe-at-point~ | Describe symbol at point (without prompt) | 35 | | ~ghelp-resume~ | Reopen last page | 36 | 37 | | ~ghelp-describe-elisp~ | Describe a Emacs symbol (like apropos) | 38 | | ~ghelp-describe-function~ | Describe a Elisp function/macro/keyboard macro | 39 | | ~ghelp-describe-variable~ | Describe a Elisp variable | 40 | | ~ghelp-describe-key~ | Describe a key sequence | 41 | 42 | Normally ~ghelp-describe~ shows documentation of the symbol at point, If you want to query for a symbol (e.g., with completion), type =C-u= then ~ghelp-describe~. 43 | 44 | * Enable backends 45 | 46 | Each backend are loaded automatically when you enabled the corresponding package. For example, when you load =helpful.el=, ghelp automatically loads its helpful backend. 47 | 48 | * In ghelp buffer 49 | A ghelp buffer is called a page. Each page is made of several entries. Each entry is a self-contained documentation. (For example, you could have a entry for a symbol as a function and another one for it as a variable.) 50 | 51 | Commands you can use: 52 | 53 | | Key | Command | 54 | |---------+--------------------------------| 55 | | =?= | show help | 56 | | =f/b= | go forward/backward in history | 57 | | =TAB= | next button | 58 | | =S-TAB= | previous button | 59 | | =h= | collapse/expand entry | 60 | | =g= | refresh page | 61 | | =q= | close page | 62 | | =s= | search/switch to a page | 63 | 64 | For more bindings, type =?= in a ghelp buffer, or type =M-x ghelp-describe ghelp-page-mode-map RET=. 65 | 66 | * Customization 67 | If you want several major modes to share the same set of history and backends (like ~lisp-interaction-mode~ and ~emacs-lisp-mode~), add an entry ~(mode1 . mode2)~ to ~ghelp-mode-share-alist~, and ~mode1~ will share everything of ~mode2~. 68 | 69 | You can customize faces: ~ghelp-entry~, ~ghelp-folded-entry~, and ~ghelp-entry-title~. 70 | 71 | Normally if you call ~ghelp-describe-function~ it selects the backends to use by the current major-mode. If you want to look up some symbol with a specific backend, try ~(ghelp-describe-with-mode ’prompt 'mode)~. For example, you can bind 72 | #+BEGIN_SRC emacs-lisp 73 | (define-key (kbd "C-h C-e") (lambda () (interactive) (ghelp-describe-with-mode ’force-prompt ’emacs-lisp-mode))) 74 | #+END_SRC 75 | to look up Emacs Lisp symbols regardless of which major mode you are currently in. 76 | 77 | * Write a backend 78 | A backend is a function that takes two arguments ~COMMAND~ and ~DATA~. 79 | 80 | If ~COMMAND~ is ~symbol~, return a string representing the symbol that the user wants documentation for. 81 | 82 | If ~COMMAND~ is ~doc~, return the documentation for ~SYMBOL~, where ~SYMBOL~ is from ~DATA~: 83 | #+BEGIN_SRC emacs-lisp 84 | (:symbol-name SYMBOL :marker MARKER) 85 | #+END_SRC 86 | And ~MARKER~ is the marker at the point where user invoked ~ghelp-describe~. Returned documentation should be a string ending with a newline. Return nil if no documentation is found. 87 | 88 | Below is an example backend that gets the symbol and then the documentation and returns them. It only recognizes “woome”, “veemo”, “love” and “tank”. 89 | #+BEGIN_SRC emacs-lisp 90 | (defun ghelp-dummy-backend (command data) 91 | (pcase command 92 | ('symbol (completing-read "Symbol: " 93 | '("woome" "veemo" "love" "tank"))) 94 | ('doc (pcase (plist-get data :symbol-name) 95 | ("woome" "Woome!!\n") 96 | ("veemo" "Veemo!!\n") 97 | ("love" "Peace!!\n") 98 | ("tank" "TANK! THE! BEST!\n"))))) 99 | #+END_SRC 100 | You can try this out by typing ~M-x ghelp-dummy RET~. 101 | 102 | Once you have a backend, register it by 103 | #+BEGIN_SRC emacs-lisp 104 | (ghelp-register-backend 'major-mode #'your-backend-function) 105 | #+END_SRC 106 | 107 | * Advanced backend 108 | 109 | ** Returned documentation 110 | Besides a string, the returned documentation could carry more information. 111 | 112 | First, it can be a list of form ~(TITLE BODY)~ where ~TITLE~ is the title for your documentation, and ~BODY~ is the body of your documentation. This way you can use a title other than the symbol name. 113 | 114 | Second, you can return multiple documentations by returning a list ~((TITLE BODY)...)~, where each element is a ~(TITLE BODY)~ form. 115 | 116 | ** Asynchronous backend 117 | Ghelp also supports asynchronous backends. Instead of returning the documentation immediately, a backend can return a callback function. This function should have a signature like ~(display-fn &rest _)~. ~display-fn~ is a function that takes a single argument ~doc~. ~&rest _~ allows ghelp to extend this interface in the future. 118 | 119 | An example: 120 | 121 | #+begin_src emacs-lisp 122 | (lambda (display-fn) 123 | (backend-async-call 124 | (lambda (doc) 125 | (funcall display-fn "(documentation)")))) 126 | #+end_src 127 | 128 | ** Use buttons in your documentation 129 | You can use buttons in your documentation as long they are text buttons made by text properties, rather than overlay buttons. After all your are returning a string, which doesn’t carry overlays. 130 | 131 | However, one problem might arise if the command invoked by your button needs some information, like the symbol that this documentation page is describing. You can get that by ~(ghelp-get-page-data)~, which returns a plist of form 132 | #+begin_src emacs-lisp 133 | (:symbol-name SYMBOL :mode MODE :marker MARKER) 134 | #+end_src 135 | ~SYMBOL~ and ~MARKER~ are the same as before, ~MODE~ is the major mode. 136 | 137 | ** Use a phony major mode 138 | Normally each backend is tied to an actual major mode. But if you want to write a backend that doesn’t associate with any major mode, like a dictionary, you can use ~ghelp-describe-with-mode~, and use ~dictionary~ as your “major mode”. 139 | 140 | ** Backend that can support undetermined major modes 141 | 142 | Backends like eglot can support a wide range of major modes that can’t be determined ahead of time. For this kinds of backends, use ~t~ for the ~MODE~ argument when registering them: 143 | 144 | #+begin_src emacs-lisp 145 | (ghelp-register-backend t #'your-backend-function) 146 | #+end_src 147 | 148 | Your backend function should support the ~available-p~ command, in addition to the ~symbol~ and ~doc~ command. It should return t/nil indication the backend’s availability in the current buffer. 149 | 150 | * Screencasts 151 | *Eglot* 152 | 153 | [[./ghelp-eglot-800.gif]] 154 | 155 | *Helpful* 156 | 157 | [[./ghelp-helpful-800.gif]] 158 | 159 | *Sly* 160 | 161 | [[./ghelp-sly.png]] 162 | -------------------------------------------------------------------------------- /ghelp-builtin.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-builtin.el --- Ghelp+builtin -*- lexical-binding: t; -*- 2 | 3 | ;;; This file is NOT part of GNU Emacs 4 | 5 | ;;; Commentary: 6 | ;; 7 | ;; This file contains the builtin Help backend for Ghelp. I copied 8 | ;; code from various builtin functions and modified them to work with 9 | ;; Ghelp. 10 | 11 | ;;; Code: 12 | ;; 13 | 14 | (require 'help-fns) 15 | (require 'cl-lib) 16 | ;; For `cl--describe-class'. 17 | (require 'cl-extra) 18 | 19 | ;;; Function 20 | 21 | (defun ghelp-help-backend (command data) 22 | "Help backend. 23 | COMMAND and DATA are described in the Commentary of ghelp.el. 24 | FUNCTION-BACKEND returns the documentation of the symbol as a 25 | function, VARIABLE-BACKEND returns the documentation of the 26 | symbol as a variable, other backends in BACKEND-LIST returns the 27 | documentation of the symbol as other things." 28 | (ghelp-help-backend-1 29 | command data #'ghelp-help--function #'ghelp-help--variable 30 | #'ghelp-help--face #'ghelp-help-cl-type)) 31 | 32 | (defun ghelp-help-backend-1 33 | (command data function-backend variable-backend &rest backend-list) 34 | "Help backend. 35 | COMMAND and DATA are described in the Commentary of ghelp.el. 36 | FUNCTION-BACKEND returns the documentation of the symbol as a 37 | function, VARIABLE-BACKEND returns the documentation of the 38 | symbol as a variable, other backends in BACKEND-LIST returns the 39 | documentation of the symbol as other things." 40 | (pcase command 41 | ('symbol 42 | (pcase (plist-get data :category) 43 | ('function (completing-read 44 | "Function: " 45 | #'help--symbol-completion-table 46 | (lambda (fn) 47 | (or (fboundp fn) 48 | (get fn 'function-documentation))) 49 | t)) 50 | ('variable (completing-read 51 | "Variable: " 52 | #'help--symbol-completion-table 53 | (lambda (var) 54 | (or (get var 'variable-documentation) 55 | (and (boundp var) (not (keywordp var))))) 56 | t)) 57 | (_ (completing-read "Symbol: " obarray 58 | (lambda (s) 59 | (let ((s (intern-soft s))) 60 | (or (fboundp s) 61 | (boundp s) 62 | (facep s) 63 | (cl--class-p s)))) 64 | t)))) 65 | ('doc 66 | ;; This way refreshing works with buffer-local variables. 67 | (let ((original-buffer (marker-buffer (plist-get data :marker)))) 68 | (if-let ((kmacro (plist-get data :kmacro))) 69 | ;; Describe a keyboard macro. 70 | (let ((macro-name (plist-get data :symbol-name))) 71 | (list (list 72 | macro-name 73 | (format "%s is a keyboard macro that expands to %s" 74 | macro-name 75 | (key-description kmacro))))) 76 | ;; Describe a symbol. 77 | (let ((symbol (intern-soft (plist-get data :symbol-name)))) 78 | ;; But wait, symbol could be a keymap, which helpful 79 | ;; doesn’t support yet. 80 | (if (keymapp (symbol-function symbol)) 81 | (format "%s is a sparse keymap. Meaning it is used as a prefix key" symbol) 82 | ;; Normal symbol. 83 | (let* ((symbol (intern-soft (plist-get data :symbol-name))) 84 | (category (plist-get data :category)) 85 | (func-doc (funcall function-backend symbol 86 | original-buffer)) 87 | (var-doc (funcall variable-backend symbol 88 | original-buffer)) 89 | (entry-list 90 | ;; If the user only requested for 91 | ;; function/variable, only show 92 | ;; function/variable. 93 | (pcase category 94 | ('function (list func-doc)) 95 | ('variable (list var-doc)) 96 | (_ (append 97 | (list func-doc var-doc) 98 | (cl-loop 99 | for fn in backend-list 100 | collect 101 | (funcall fn symbol original-buffer))))))) 102 | (remove nil entry-list))))))))) 103 | 104 | (defun ghelp-help--function (symbol _) 105 | "Return documentation for SYMBOL. 106 | SYMBOL could be a function, a macro, or a keyboard macro." 107 | (with-temp-buffer 108 | (let ((function symbol) 109 | (standard-output (current-buffer))) 110 | (when (fboundp symbol) 111 | (let ((start (point))) 112 | (prin1 symbol) 113 | (princ " is ") 114 | (help-fns-function-description-header function) 115 | (fill-region-as-paragraph start (point))) 116 | (terpri) (terpri) 117 | (pcase-let* ((`(,real-function ,def ,_aliased ,real-def) 118 | (help-fns--analyze-function function)) 119 | (doc-raw (condition-case nil 120 | ;; FIXME: Maybe `documentation' should return nil 121 | ;; for invalid functions i.s.o. signaling an error. 122 | (documentation function t) 123 | ;; E.g. an alias for a not yet defined function. 124 | ((invalid-function void-function) nil))) 125 | (key-bindings-buffer (current-buffer))) 126 | 127 | ;; If the function is autoloaded, and its docstring has 128 | ;; key substitution constructs, load the library. 129 | (and (autoloadp real-def) doc-raw 130 | help-enable-autoload 131 | (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw) 132 | (autoload-do-load real-def)) 133 | 134 | (help-fns--key-bindings function) 135 | (with-current-buffer standard-output 136 | (let ((doc (condition-case nil 137 | ;; FIXME: Maybe `help-fns--signature' should return `doc' 138 | ;; for invalid functions i.s.o. signaling an error. 139 | (help-fns--signature 140 | function doc-raw 141 | (if (subrp def) (indirect-function real-def) real-def) 142 | real-function key-bindings-buffer) 143 | ;; E.g. an alias for a not yet defined function. 144 | ((invalid-function void-function) doc-raw)))) 145 | (help-fns--ensure-empty-line) 146 | (run-hook-with-args 'help-fns-describe-function-functions function) 147 | (help-fns--ensure-empty-line) 148 | (insert (or doc "Not documented."))) 149 | ;; Avoid asking the user annoying questions if she decides 150 | ;; to save the help buffer, when her locale's codeset 151 | ;; isn't UTF-8. 152 | (unless (memq text-quoting-style '(straight grave)) 153 | (set-buffer-file-coding-system 'utf-8)))) 154 | (list (format "%s (%s)" symbol 155 | (if (symbolp symbol) 156 | (if (functionp (symbol-function symbol)) 157 | "function" "macro") 158 | "keyboard macro")) 159 | (buffer-string)))))) 160 | 161 | (defun ghelp-help--variable (symbol buffer) 162 | "Return documentation for SYMBOL as a variable. 163 | BUFFER is the original buffer the symbol is in." 164 | (let (file-name 165 | (frame (selected-frame)) 166 | (variable symbol)) 167 | (with-temp-buffer 168 | (if (not (with-current-buffer buffer (boundp variable))) 169 | nil 170 | (let ((standard-output (current-buffer)) 171 | val val-start-pos locus) 172 | ;; Extract the value before setting up the output buffer, 173 | ;; in case `buffer' *is* the output buffer. 174 | (with-selected-frame frame 175 | (with-current-buffer buffer 176 | (setq val (symbol-value variable) 177 | locus (variable-binding-locus variable)))) 178 | 179 | (with-current-buffer buffer 180 | (prin1 variable) 181 | (setq file-name (find-lisp-object-file-name variable 'defvar)) 182 | 183 | (princ (if file-name 184 | (progn 185 | (princ (format-message 186 | " is a variable defined in `%s'.\n" 187 | (if (eq file-name 'C-source) 188 | "C source code" 189 | (help-fns-short-filename file-name)))) 190 | (with-current-buffer standard-output 191 | (save-excursion 192 | (re-search-backward (substitute-command-keys 193 | "`\\([^`']+\\)'") 194 | nil t) 195 | (help-xref-button 1 'help-variable-def 196 | variable file-name))))))) 197 | (with-current-buffer standard-output 198 | (setq val-start-pos (point)) 199 | (princ "Its value is") 200 | (let ((line-beg (line-beginning-position)) 201 | (print-rep 202 | (let ((rep 203 | (let ((print-quoted t) 204 | (print-circle t)) 205 | (cl-prin1-to-string val)))) 206 | (if (and (symbolp val) (not (booleanp val))) 207 | (format-message "`%s'" rep) 208 | rep)))) 209 | (if (< (+ (length print-rep) (point) (- line-beg)) 68) 210 | (insert " " print-rep) 211 | (terpri) 212 | (let ((buf (current-buffer))) 213 | (with-temp-buffer 214 | (lisp-mode-variables nil) 215 | (set-syntax-table emacs-lisp-mode-syntax-table) 216 | (insert print-rep) 217 | (pp-buffer) 218 | (let ((pp-buffer (current-buffer))) 219 | (with-current-buffer buf 220 | (insert-buffer-substring pp-buffer))))) 221 | ;; Remove trailing newline. 222 | (and (= (char-before) ?\n) (delete-char -1))) 223 | (let* ((sv (get variable 'standard-value)) 224 | (origval (and (consp sv) 225 | (condition-case nil 226 | (eval (car sv) t) 227 | (error :help-eval-error)))) 228 | from) 229 | (when (and (consp sv) 230 | (not (equal origval val)) 231 | (not (equal origval :help-eval-error))) 232 | (princ "\nOriginal value was \n") 233 | (setq from (point)) 234 | (if (and (symbolp origval) (not (booleanp origval))) 235 | (let* ((rep (cl-prin1-to-string origval)) 236 | (print-rep (format-message "`%s'" rep))) 237 | (insert print-rep)) 238 | (cl-prin1 origval)) 239 | (save-restriction 240 | (narrow-to-region from (point)) 241 | (save-excursion (pp-buffer))) 242 | (if (< (point) (+ from 20)) 243 | (delete-region (1- from) from)))))) 244 | (terpri) 245 | (when locus 246 | (cond 247 | ((bufferp locus) 248 | (princ (format "Local in buffer %s; " 249 | (buffer-name buffer)))) 250 | ((terminal-live-p locus) 251 | (princ (format "It is a terminal-local variable; "))) 252 | (t 253 | (princ (format "It is local to %S" locus)))) 254 | (if (not (default-boundp variable)) 255 | (princ "globally void") 256 | (let ((global-val (default-value variable))) 257 | (with-current-buffer standard-output 258 | (princ "global value is ") 259 | (if (eq val global-val) 260 | (princ "the same.") 261 | (terpri) 262 | ;; Fixme: pp can take an age if you happen to 263 | ;; ask for a very large expression. We should 264 | ;; probably print it raw once and check it's a 265 | ;; sensible size before prettyprinting. -- fx 266 | (let ((from (point))) 267 | (cl-prin1 global-val) 268 | (save-restriction 269 | (narrow-to-region from (point)) 270 | (save-excursion (pp-buffer))) 271 | ;; See previous comment for this function. 272 | ;; (help-xref-on-pp from (point)) 273 | (if (< (point) (+ from 20)) 274 | (delete-region (1- from) from))))))) 275 | (terpri)) 276 | 277 | ;; If the value is large, move it to the end. 278 | (with-current-buffer standard-output 279 | (when (> (count-lines (point-min) (point-max)) 10) 280 | ;; Note that setting the syntax table like below 281 | ;; makes forward-sexp move over a `'s' at the end 282 | ;; of a symbol. 283 | (set-syntax-table emacs-lisp-mode-syntax-table) 284 | (goto-char val-start-pos) 285 | ;; The line below previously read as 286 | ;; (delete-region (point) (progn (end-of-line) (point))) 287 | ;; which suppressed display of the buffer local value for 288 | ;; large values. 289 | (when (looking-at "value is") (replace-match "")) 290 | (save-excursion 291 | (insert "\n\nValue:") 292 | (set (make-local-variable 'help-button-cache) 293 | (point-marker))) 294 | (insert "value is shown ") 295 | (insert-button "below" 296 | 'action help-button-cache 297 | 'follow-link t 298 | 'help-echo "mouse-2, RET: show value") 299 | (insert ".\n"))) 300 | (terpri) 301 | 302 | (let* ((alias (condition-case nil 303 | (indirect-variable variable) 304 | (error variable))) 305 | (doc (or (documentation-property 306 | variable 'variable-documentation) 307 | (documentation-property 308 | alias 'variable-documentation)))) 309 | 310 | (with-current-buffer standard-output 311 | (help-fns--ensure-empty-line)) 312 | (princ "Documentation:\n") 313 | (with-current-buffer standard-output 314 | (insert (or doc "Not documented as a variable.")))) 315 | 316 | (with-current-buffer standard-output 317 | ;; Return the text we displayed. 318 | (list (format "%s (variable)" variable) (buffer-string)))))))) 319 | 320 | ;;; Face 321 | 322 | (defun ghelp-help--face (symbol _) 323 | "Return the documentation for SYMBOL as a face." 324 | (let* ((face (intern-soft symbol)) 325 | (attrs '((:family . "Family") 326 | (:foundry . "Foundry") 327 | (:width . "Width") 328 | (:height . "Height") 329 | (:weight . "Weight") 330 | (:slant . "Slant") 331 | (:foreground . "Foreground") 332 | (:distant-foreground . "DistantForeground") 333 | (:background . "Background") 334 | (:underline . "Underline") 335 | (:overline . "Overline") 336 | (:strike-through . "Strike-through") 337 | (:box . "Box") 338 | (:inverse-video . "Inverse") 339 | (:stipple . "Stipple") 340 | (:font . "Font") 341 | (:fontset . "Fontset") 342 | (:inherit . "Inherit"))) 343 | (max-width (apply #'max (mapcar #'(lambda (x) (length (cdr x))) 344 | attrs))) 345 | (frame nil)) 346 | (when (facep face) 347 | (unless face 348 | (setq face 'default)) 349 | (if (not (listp face)) 350 | (setq face (list face))) 351 | (with-temp-buffer 352 | (let ((standard-output (current-buffer))) 353 | (dolist (f face (buffer-string)) 354 | (if (stringp f) (setq f (intern f))) 355 | ;; We may get called for anonymous faces (i.e., faces 356 | ;; expressed using prop-value plists). Those can't be 357 | ;; usefully customized, so ignore them. 358 | (when (symbolp f) 359 | (insert "Face: " (symbol-name f)) 360 | (if (not (facep f)) 361 | (insert " undefined face.\n") 362 | (let ((customize-label "customize this face") 363 | file-name) 364 | (insert (concat " (" (propertize "sample" 'font-lock-face f) ")")) 365 | (princ (concat " (" customize-label ")\n")) 366 | ;; FIXME not sure how much of this belongs here, and 367 | ;; how much in `face-documentation'. The latter is 368 | ;; not used much, but needs to return nil for 369 | ;; undocumented faces. 370 | (let ((alias (get f 'face-alias)) 371 | (face f) 372 | obsolete) 373 | (when alias 374 | (setq face alias) 375 | (insert 376 | (format-message 377 | "\n %s is an alias for the face `%s'.\n%s" 378 | f alias 379 | (if (setq obsolete (get f 'obsolete-face)) 380 | (format-message 381 | " This face is obsolete%s; use `%s' instead.\n" 382 | (if (stringp obsolete) 383 | (format " since %s" obsolete) 384 | "") 385 | alias) 386 | "")))) 387 | (insert "\nDocumentation:\n" 388 | (substitute-command-keys 389 | (or (face-documentation face) 390 | "Not documented as a face.")) 391 | "\n\n")) 392 | (with-current-buffer standard-output 393 | (save-excursion 394 | (re-search-backward 395 | (concat "\\(" customize-label "\\)") nil t) 396 | (help-xref-button 1 'help-customize-face f))) 397 | (setq file-name (find-lisp-object-file-name f 'defface)) 398 | (when file-name 399 | (princ (substitute-command-keys "Defined in `")) 400 | (princ (file-name-nondirectory file-name)) 401 | (princ (substitute-command-keys "'")) 402 | ;; Make a hyperlink to the library. 403 | (save-excursion 404 | (re-search-backward 405 | (substitute-command-keys "`\\([^`']+\\)'") nil t) 406 | (help-xref-button 1 'help-face-def f file-name)) 407 | (princ ".") 408 | (terpri) 409 | (terpri)) 410 | (dolist (a attrs) 411 | (let ((attr (face-attribute f (car a) frame))) 412 | (insert (make-string (- max-width (length (cdr a))) ?\s) 413 | (cdr a) ": " (format "%s" attr)) 414 | (if (and (eq (car a) :inherit) 415 | (not (eq attr 'unspecified))) 416 | ;; Make a hyperlink to the parent face. 417 | (save-excursion 418 | (re-search-backward ": \\([^:]+\\)" nil t) 419 | (help-xref-button 1 'help-face attr))) 420 | (insert "\n"))))) 421 | (terpri))) 422 | (let ((yank-excluded-properties nil)) 423 | (list (format "%s (face)" symbol) (buffer-string)))))))) 424 | 425 | ;;; cl-class 426 | 427 | (defun ghelp-help-cl-type (symbol _) 428 | "Return the documentation for SYMBOL as a CL type." 429 | (with-temp-buffer 430 | (let ((standard-output (current-buffer)) 431 | (symbol (intern-soft symbol))) 432 | (when-let ((class (cl-find-class symbol))) 433 | (cl--describe-class symbol class) 434 | (let ((yank-excluded-properties nil)) 435 | (list (format "%s (type)" symbol) (buffer-string))))))) 436 | 437 | (provide 'ghelp-builtin) 438 | 439 | ;;; ghelp-builtin.el ends here 440 | -------------------------------------------------------------------------------- /ghelp-eglot-800.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/casouri/ghelp/89d106a7c3563cd97e108975baa01ecfa980a9ce/ghelp-eglot-800.gif -------------------------------------------------------------------------------- /ghelp-eglot.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-eglot.el --- Ghelp+Eglot -*- lexical-binding: t; -*- 2 | 3 | ;;; This file is NOT part of GNU Emacs 4 | 5 | ;;; Commentary: 6 | ;; 7 | ;; This file contains the eglot.el backend for Ghelp. I copied code 8 | ;; from eglot.el and modified them to work with Ghelp. 9 | 10 | ;;; Code: 11 | ;; 12 | 13 | (require 'eglot) 14 | (require 'pcase) 15 | 16 | (defun ghelp-eglot-backend (command data) 17 | "Eglot backend." 18 | (pcase command 19 | ('available-p eglot--managed-mode) 20 | ('symbol (user-error "Eglot backend doesn’t support symbol lookup")) 21 | ('doc (save-excursion 22 | (goto-char (plist-get data :marker)) 23 | (when eglot--managed-mode 24 | (eglot--dbind 25 | ((Hover) contents range) 26 | (jsonrpc-request (eglot--current-server-or-lose) 27 | :textDocument/hover 28 | (eglot--TextDocumentPositionParams)) 29 | (when (not (seq-empty-p contents)) 30 | (concat (eglot--hover-info contents range) "\n")))))))) 31 | 32 | 33 | 34 | (provide 'ghelp-eglot) 35 | 36 | ;;; ghelp-eglot.el ends here 37 | -------------------------------------------------------------------------------- /ghelp-geiser.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-geiser.el --- Ghelp backend for geiser -*- lexical-binding: t; -*- 2 | 3 | ;; Author: Yuan Fu 4 | 5 | ;;; This file is NOT part of GNU Emacs 6 | 7 | ;;; Commentary: 8 | ;; 9 | ;; This file contains the geiser.el backend for Ghelp. I copied code 10 | ;; from geiser.el and modified them to work with Ghelp. 11 | 12 | ;;; Code: 13 | ;; 14 | 15 | (require 'geiser-doc) 16 | 17 | (defun ghelp-geiser-backend (command data) 18 | "Backend for geiser." 19 | (pcase command 20 | ('symbol (geiser-completion--read-symbol "Symbol: ")) 21 | ('doc (let* ((symbol (intern-soft (plist-get data :symbol-name))) 22 | (impl geiser-impl--implementation) 23 | (module (geiser-doc--module (geiser-eval--get-module) 24 | impl))) 25 | (ghelp-geiser--doc-symbol-advice symbol module impl))))) 26 | 27 | (defun ghelp-geiser--doc-symbol-advice (symbol &optional module impl) 28 | (let ((doc (let ((ds (geiser-doc--get-docstring symbol module))) 29 | (if (or (not ds) (not (listp ds))) 30 | nil 31 | (with-temp-buffer 32 | (geiser-doc--render-docstring ds symbol module impl) 33 | (buffer-string))))) 34 | (sym-name (symbol-name symbol))) 35 | (if (not (derived-mode-p 'ghelp-page-mode)) 36 | doc 37 | (let ((mode (plist-get (ghelp-get-page-data) :mode))) 38 | (ghelp--show-page `((,sym-name ,doc)) 39 | `(:symbol-name ,sym-name :mode ,mode) 40 | (selected-window)))))) 41 | 42 | (advice-add 'geiser-doc-symbol 43 | :override #'ghelp-geiser--doc-symbol-advice) 44 | 45 | (ghelp-register-backend 'geiser-repl-mode #'ghelp-geiser-backend) 46 | 47 | (provide 'ghelp-geiser) 48 | 49 | ;;; ghelp-geiser.el ends here 50 | -------------------------------------------------------------------------------- /ghelp-helpful-800.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/casouri/ghelp/89d106a7c3563cd97e108975baa01ecfa980a9ce/ghelp-helpful-800.gif -------------------------------------------------------------------------------- /ghelp-helpful.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-helpful.el --- Ghelp+Helpful -*- lexical-binding: t; -*- 2 | 3 | ;;; This file is NOT part of GNU Emacs 4 | 5 | ;;; Commentary: 6 | ;; 7 | ;; This file contains the Helpful.el backend for Ghelp. I copied code 8 | ;; from helpful.el and modified them to work with Ghelp. 9 | 10 | ;;; Code: 11 | ;; 12 | 13 | (require 'helpful) 14 | (require 'ghelp-builtin) 15 | (require 'pcase) 16 | 17 | (defvar ghelp-helpful--advice-installed) 18 | 19 | (defun ghelp-helpful-backend (command data) 20 | "Help backend. 21 | COMMAND and DATA are described in the Commentary of ghelp.el. 22 | FUNCTION-BACKEND returns the documentation of the symbol as a 23 | function, VARIABLE-BACKEND returns the documentation of the 24 | symbol as a variable, other backends in BACKEND-LIST returns the 25 | documentation of the symbol as other things." 26 | (unless ghelp-helpful--advice-installed 27 | (ghelp-helpful--install-advice)) 28 | (ghelp-help-backend-1 29 | command data #'ghelp-helpful-callable #'ghelp-helpful-variable 30 | #'ghelp-help--face #'ghelp-help-cl-type)) 31 | 32 | (defun ghelp-helpful-callable (symbol original-buffer) 33 | "Return documentation for SYMBOL as a function. 34 | ORIGINAL-BUFFER is the buffer where user requested for documentation." 35 | (with-current-buffer original-buffer 36 | (when (or (and (symbolp symbol) (fboundp symbol)) 37 | (vectorp symbol) (stringp symbol)) 38 | (let ((buf (helpful--buffer symbol t))) 39 | (with-current-buffer buf 40 | (helpful-update) 41 | ;; insert an ending line 42 | (let ((inhibit-read-only t)) 43 | (goto-char (point-max)) 44 | (insert "\n")) 45 | (prog1 (list (format 46 | "%s (%s)" symbol 47 | (if (symbolp symbol) 48 | (if (functionp (symbol-function symbol)) 49 | "function" "macro") 50 | "keyboard macro")) 51 | (buffer-string)) 52 | (kill-buffer buf))))))) 53 | 54 | (defun ghelp-helpful-variable (symbol original-buffer) 55 | "Return documentation for SYMBOL as a variable. 56 | ORIGINAL-BUFFER is the buffer where user requested for documentation." 57 | ;; For some reason, helpful-variable sometimes moves the point to 58 | ;; the definition. 59 | (save-excursion 60 | (with-current-buffer original-buffer 61 | (when (helpful--variable-p symbol) 62 | (let ((buf (helpful--buffer symbol nil))) 63 | (with-current-buffer buf 64 | (helpful-update) 65 | ;; insert an ending newline 66 | (let ((inhibit-read-only t)) 67 | (goto-char (point-max)) 68 | (insert "\n")) 69 | (prog1 (let ((yank-excluded-properties nil)) 70 | (list (format "%s (variable)" symbol) 71 | (buffer-string))) 72 | (kill-buffer buf)))))))) 73 | 74 | ;;; Advices 75 | 76 | (defun ghelp-helpful--describe-advice (oldfn button) 77 | "Describe the symbol that this BUTTON represents. 78 | OLDFN can be `helpful--describe' or `helpful--describe-exactly'." 79 | (if (derived-mode-p 'ghelp-page-mode) 80 | (let* ((data (ghelp-get-page-data))) 81 | (setq data (plist-put data :symbol-name 82 | (symbol-name (button-get button 'symbol)))) 83 | (setq data (plist-put data :marker (point-marker))) 84 | (ghelp-describe-1 'no-prompt data)) 85 | (funcall oldfn button))) 86 | 87 | (defun ghelp-helpful--update-advice (oldfn) 88 | "Refresh ghelp page after OLDFN. 89 | OLDFN is `helpful-update'." 90 | (if (derived-mode-p 'ghelp-page-mode) 91 | (ghelp-refresh) 92 | (funcall oldfn))) 93 | 94 | (defvar ghelp-helpful--advice-installed nil 95 | "Non-nil if advice are installed.") 96 | 97 | (defun ghelp-helpful--install-advice () 98 | "Install advice." 99 | (advice-add 'helpful-update :around #'ghelp-helpful--update-advice) 100 | (advice-add 'helpful--describe :around #'ghelp-helpful--describe-advice) 101 | (advice-add 'helpful--describe-exactly 102 | :around #'ghelp-helpful--describe-advice) 103 | (setq ghelp-helpful--advice-installed t)) 104 | 105 | (provide 'ghelp-helpful) 106 | 107 | ;;; ghelp-helpful.el ends here 108 | -------------------------------------------------------------------------------- /ghelp-lspce.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-lspce.el --- Ghelp + lspce -*- lexical-binding: t; -*- 2 | 3 | ;;; This file is NOT part of GNU Emacs 4 | 5 | ;;; Commentary: 6 | ;; 7 | ;; This file contains the lspce backend for Ghelp. It will make use of 8 | ;; ‘markdown-mode’ to render markdown-formatted documentation, if 9 | ;; ‘markdown-mode’ is available. 10 | 11 | ;;; Code: 12 | 13 | (require 'lspce) 14 | (require 'pcase) 15 | 16 | (defun ghelp-lspce-backend (command data) 17 | "Lspce backend for ghelp. 18 | For COMMAND and DATA, see ‘ghelp-register-backend’." 19 | (pcase command 20 | ('available-p lspce-mode) 21 | ('symbol (user-error "Lspce backend doesn’t support symbol lookup")) 22 | ('doc (save-excursion 23 | (goto-char (plist-get data :marker)) 24 | (when lspce-mode 25 | (when-let ((hover-info (lspce--hover-at-point))) 26 | (with-temp-buffer 27 | (let ((markdown-fontify-code-blocks-natively t) 28 | (view-inhibit-help-message t)) 29 | (insert (cadr hover-info)) 30 | (when (and (equal (car hover-info) "markdown") 31 | (require 'markdown-mode nil t)) 32 | (gfm-view-mode) 33 | (font-lock-ensure)) 34 | (buffer-string))))))))) 35 | 36 | 37 | 38 | (provide 'ghelp-lspce) 39 | 40 | ;;; ghelp-lspce.el ends here 41 | -------------------------------------------------------------------------------- /ghelp-sly.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-sly.el --- Ghelp sly backend -*- lexical-binding: t; -*- 2 | 3 | ;;; This file is NOT part of GNU Emacs 4 | 5 | ;;; Commentary: 6 | ;; 7 | ;; This file contains the sly backend for Ghelp. I copied code from 8 | ;; sly.el and modified them to work with Ghelp. 9 | 10 | ;;; Code: 11 | ;; 12 | 13 | (require 'sly) 14 | (require 'pcase) 15 | 16 | (defun ghelp-sly-backend (command data) 17 | "Sly backend." 18 | (pcase command 19 | ('symbol (sly-read-symbol-name "Documentation for symbol: ")) 20 | ('doc 21 | (let ((package (sly-current-package)) 22 | (connection (sly-current-connection)) 23 | (symbol-name (plist-get data :symbol-name))) 24 | (ignore connection) 25 | (lambda (display-fn &rest _) 26 | ;; ‘slynk:describe-symbol’ returns more information than 27 | ;; ‘slynk:documentation-symbol’. 28 | (sly-eval-async `(slynk:describe-symbol ,symbol-name) 29 | (lambda (doc) 30 | (with-temp-buffer 31 | (insert doc) 32 | (ghelp-sly--fontify-doc) 33 | (funcall display-fn (buffer-string)))) 34 | package)))))) 35 | 36 | (defun ghelp-sly--fontify-doc () 37 | "Fontify the documentation in the current buffer." 38 | (goto-char (point-min)) 39 | ;; Highlight entry titles. 40 | (while (re-search-forward "^ +.*:[ \n]" nil t) 41 | (save-excursion 42 | (put-text-property (match-beginning 0) (match-end 0) 43 | 'face '(:weight bold)) 44 | (goto-char (match-beginning 0)))) 45 | ;; Make the link to the source file a clickable button. 46 | (goto-char (point-min)) 47 | (when (re-search-forward "Source file: \\(.*\\)$" nil t) 48 | (make-text-button (match-beginning 1) (match-end 1) 49 | 'action (let ((path (match-string 1))) 50 | (lambda (&rest _) 51 | (find-file path))) 52 | 'follow-link t))) 53 | 54 | 55 | (provide 'ghelp-sly) 56 | 57 | ;;; ghelp-sly.el ends here 58 | -------------------------------------------------------------------------------- /ghelp-sly.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/casouri/ghelp/89d106a7c3563cd97e108975baa01ecfa980a9ce/ghelp-sly.png -------------------------------------------------------------------------------- /ghelp-test.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp-test.el --- Ghelp tests -*- lexical-binding: t; -*- 2 | 3 | ;; Author: Yuan Fu 4 | 5 | ;;; This file is NOT part of GNU Emacs 6 | 7 | ;;; Commentary: 8 | ;; 9 | 10 | ;;; Code: 11 | ;; 12 | 13 | (require 'ert) 14 | (require 'ghelp) 15 | 16 | ;; TODO: Update the test. 17 | ;; (ert-deftest ert-test-history () 18 | ;; "Create a history, push, jump and find." 19 | ;; (let* ((modes '(A B C D)) 20 | ;; (symbols '(a b c d)) 21 | ;; (buffers (cl-loop for idx from 0 to 3 22 | ;; collect (generate-new-buffer "test"))) 23 | ;; (nodes (cl-loop 24 | ;; for idx from 0 to 3 25 | ;; for node = (make-ghelp-history-node 26 | ;; :mode (nth idx modes) 27 | ;; :symbol-name (nth idx symbols) 28 | ;; :buffer (nth idx buffers)) 29 | ;; collect node)) 30 | ;; (history (make-ghelp-history :nodes nodes)) 31 | ;; buf) 32 | ;; ;; a b c *d 33 | ;; (ghelp-history--goto history 'd) 34 | ;; (should (eq 3 (ghelp-history-point history))) 35 | 36 | ;; ;; a b c *d 37 | ;; (setq buf (ghelp-history--find history 'a)) 38 | ;; (should (equal buf (nth 0 buffers))) 39 | 40 | ;; ;; *b a c d 41 | ;; (setq buf (ghelp-history--find-and-move history 'b)) 42 | ;; (should (eq 0 (ghelp-history-point history))) 43 | ;; (should (eq buf (nth 1 buffers))) 44 | 45 | ;; ;; b *a c d 46 | ;; (ghelp-history--forward history 2) 47 | ;; (ghelp-history--back history 1) 48 | ;; (should (eq 1 (ghelp-history-point history))) 49 | 50 | ;; ;; clean up buffers 51 | ;; (dolist (node nodes) 52 | ;; (kill-buffer (ghelp-history-node-buffer node))))) 53 | 54 | (provide 'ghelp-test) 55 | 56 | ;;; ghelp-test.el ends here 57 | -------------------------------------------------------------------------------- /ghelp.el: -------------------------------------------------------------------------------- 1 | ;;; ghelp.el --- Generic help -*- lexical-binding: t; -*- 2 | 3 | ;; Author: Yuan Fu 4 | ;; Version: 0.10.0 5 | 6 | ;;; This file is NOT part of GNU Emacs 7 | 8 | ;;; Commentary: 9 | ;; 10 | ;; Ghelp provides a unified interface for documentations. 11 | ;; 12 | ;; Available commands: 13 | ;; 14 | ;; General: 15 | ;; 16 | ;; ghelp-describe Describe a symbol in the current major mode 17 | ;; gehlp-describe-at-point Describe symbol at point (without prompt) 18 | ;; ghelp-resume Reopen last page 19 | ;; 20 | ;; Emacs help: 21 | ;; 22 | ;; ghelp-describe-elisp Describe a Emacs symbol (like apropos) 23 | ;; ghelp-describe-function Describe a Elisp function/macro/kmacro 24 | ;; ghelp-describe-variable Describe a Elisp variable 25 | ;; ghelp-describe-key Describe a key sequence 26 | ;; 27 | ;; Commands in ghelp buffer: 28 | ;; 29 | ;; ? Show help 30 | ;; f/b Go forward/backward in history 31 | ;; TAB Next button 32 | ;; S-TAB Previous button 33 | ;; h Hide/show entry 34 | ;; g Refresh page 35 | ;; q Close page 36 | ;; s Search in history 37 | ;; 38 | ;; Ghelp provides documentations through backends. Each backend is 39 | ;; automatically loaded when the corresponding major mode loads. 40 | ;; helpful.el is an exception: ghelp.el automatically loads 41 | ;; helpful.el (rather than the other way around). 42 | ;; 43 | ;; If we want to major modes to use the same backend and history, add 44 | ;; (MODE-1 . MODE-2) to ‘ghelp-mode-share-alist’. Then MODE-1 will 45 | ;; share everything of MODE-2. 46 | ;; 47 | ;; If you want to write a backend, checkout “Write a backend” section 48 | ;; in the README. 49 | ;; 50 | ;;; Developer: 51 | ;; 52 | ;;;; Terminology 53 | ;; 54 | ;; - ghelp This package. 55 | ;; 56 | ;; - page The buffer displaying documentation. 57 | ;; 58 | ;; - backend The backend providing documentation. Each major mode 59 | ;; has one backend 60 | ;; 61 | ;; - entry A page is made of entries. Each entry is a self-contained 62 | ;; documentation for the symbol. Each symbol can be 63 | ;; interpreted in different ways and we present each 64 | ;; interpretation’s documentation in a entry. 65 | ;; 66 | ;; - history Each major-mode has it’s own page history. 67 | ;; 68 | ;;;; Page anatomy 69 | ;; 70 | ;; A page is made of a series of entries. Each entry is made of a 71 | ;; title and a documentation body. 72 | ;; 73 | ;;;; Backends 74 | ;; 75 | ;; Each major mode has one backend that can be accessed through 76 | ;; ‘ghelp-describe’ function. Multiple major modes could share 77 | ;; the same backend (and history). 78 | ;; 79 | ;;;; History 80 | ;; 81 | ;; Each major mode has a page history. Though multiple major mode 82 | ;; could share the same history. A history has a list of nodes. The list 83 | ;; is sorted from newest node to oldest node (so we can remove oldest 84 | ;; node when necessary). The nodes themselves constructs a 85 | ;; doubly-linked list. This list is sorted in logical order -- every 86 | ;; time when ghelp creates a new page, it inserts the page after the 87 | ;; last viewed page. For example, suppose this is our history: 88 | ;; 89 | ;; A - B - C - D 90 | ;; 91 | ;; And the last viewed page is C. Now, if the user requested for the 92 | ;; documentation for E, E is inserted after C and before D: 93 | ;; 94 | ;; A - B - C - E - D 95 | ;; 96 | ;; 97 | ;;;; Code structure 98 | ;; 99 | ;; Ghelp contains self-contained sub-modules: ghelp-entry, ghelp-page, 100 | ;; and ghelp-history. They don’t know the detail of each other and 101 | ;; only communicates by “exposed” functions. (At least that’s what I 102 | ;; attempt to do.) You can find the “exposed” functions on the 103 | ;; beginning of each section. 104 | 105 | ;;; Code: 106 | 107 | (require 'cl-lib) 108 | (require 'pcase) 109 | (require 'seq) 110 | (require 'find-func) ; For ‘find-library-name’. 111 | 112 | ;;; Global 113 | 114 | (defun ghelp-describe-elisp () 115 | "Describe Emacs symbol." 116 | (interactive) 117 | (ghelp-describe-with-mode 'force-prompt 'emacs-lisp-mode)) 118 | 119 | (defvar ghelp-map 120 | (let ((map (make-sparse-keymap))) 121 | (define-key map (kbd "C-h") #'ghelp-describe) 122 | (define-key map "h" #'help-command) 123 | (define-key map "e" #'ghelp-describe-elisp) 124 | (define-key map "f" #'ghelp-describe-function) 125 | (define-key map "v" #'ghelp-describe-variable) 126 | (define-key map "k" #'ghelp-describe-key) 127 | (define-key map "r" #'ghelp-resume) 128 | map) 129 | "Map for ghelp. Bind this map to some entry key sequence.") 130 | 131 | ;;; Etc 132 | 133 | (defgroup ghelp nil 134 | "Gneric help." 135 | :group 'help) 136 | 137 | (defcustom ghelp-mode-share-alist 138 | `((lisp-interaction-mode . emacs-lisp-mode) 139 | ;; Without this setting ghelp can’t 140 | ;; resolve the backend if you call 141 | ;; helpful commands directly (instead 142 | ;; of through ‘ghelp-describe’), e.g, 143 | ;; ‘helpful-key’. 144 | (helpful-mode . emacs-lisp-mode)) 145 | "An alist specifying how major modes shares documentations. 146 | 147 | An entry like (major-mode1 . major-mode2) makes MAJOR-MODE1 148 | share the history and backends of MAJOR-MODE2. 149 | 150 | If there is another entry (major-mode2 . major-mode3), then 151 | both MAJOR-MODE1 and MAJOR-MODE2 shares with MAJOR-MODE3. 152 | 153 | The maximum levels you can connect these references depends 154 | on ‘ghelp--max-reference-count’." 155 | :type '(alist :key-type symbol :value-type symbol)) 156 | 157 | (defvar ghelp--max-reference-count 17 158 | "Maximum number of levels of reference allowed... 159 | ...in ‘ghelp-mode-share-alist’.") 160 | 161 | (defun ghelp--resolve-mode (mode) 162 | "Return the major mode that MODE points to... 163 | ...in ‘ghelp-mode-share-alist’. 164 | If MODE doesn’t point to anything, return itself." 165 | (let (prev-mode) 166 | ;; if MODE doesn’t point to anything anymore (MODE = nil), 167 | ;; return it (PREV-MODE) 168 | (while mode 169 | (setq prev-mode mode 170 | mode (alist-get mode ghelp-mode-share-alist))) 171 | prev-mode)) 172 | 173 | (defun ghelp-get-mode () 174 | "Return major mode for use." 175 | (ghelp--resolve-mode 176 | (if (derived-mode-p 'ghelp-page-mode) 177 | (plist-get ghelp-page-data :mode) 178 | major-mode))) 179 | 180 | ;;; Commands 181 | 182 | (defun ghelp-quit () 183 | "Close ghelp buffer." 184 | (interactive) 185 | (cl-loop for buffer1 in (window-prev-buffers) 186 | for buffer = (car buffer1) 187 | for is-ghelp = (eq 'ghelp-page-mode 188 | (buffer-local-value 189 | 'major-mode buffer)) 190 | if (not is-ghelp) 191 | do (switch-to-buffer buffer) 192 | and return nil 193 | finally (delete-window))) 194 | 195 | (defun ghelp-resume () 196 | "Resume to last opened page." 197 | (interactive) 198 | (let* ((mode (ghelp--resolve-mode (ghelp-get-mode))) 199 | (page (ghelp-history--current-page mode))) 200 | (if page 201 | (let ((win (display-buffer page))) 202 | (when (and (window-live-p win) help-window-select) 203 | (select-window win))) 204 | (user-error "Can’t find a previous page for mode %s" mode)))) 205 | 206 | (defun ghelp-refresh () 207 | "Refresh current page." 208 | (interactive) 209 | (if (derived-mode-p 'ghelp-page-mode) 210 | (ghelp-describe-1 'no-prompt (copy-tree ghelp-page-data)) 211 | (user-error "Not in a ghelp page"))) 212 | 213 | (defun ghelp-describe (prompt) 214 | "Describe symbol. 215 | When called interactively, use prefix argument to force prompt. 216 | 217 | PROMPT" 218 | (interactive "p") 219 | (let ((prompt (if (eq prompt 4) 'force-prompt nil))) 220 | (ghelp--maybe-update-current-page) 221 | (ghelp-describe-1 prompt nil))) 222 | 223 | (defun ghelp-describe-with-mode (prompt mode) 224 | "Describe symbol for MODE. 225 | 226 | PROMPT can be 'no-prompt, 'force-prompt or nil: 227 | 228 | no-prompt means don’t prompt for symbol; 229 | force-prompt means always prompt for symbol; 230 | nil means only prompt when there is no valid symbol at point. 231 | 232 | MODE is the major mode of the symbol your want to describe." 233 | (ghelp--maybe-update-current-page) 234 | (ghelp-describe-1 prompt `(:mode ,mode))) 235 | 236 | (defun ghelp--plist-set (plist prop val) 237 | "Set PROP to VAL in PLIST non-destructively." 238 | (if (plist-get plist prop) 239 | (let ((idx (1+ (seq-position plist prop)))) 240 | (append (seq-subseq plist 0 idx) 241 | (list val) 242 | (seq-subseq plist (1+ idx)))) 243 | (append (list prop val) plist))) 244 | 245 | (defun ghelp-describe-1 (prompt data) 246 | "Describe symbol. 247 | 248 | PROMPT is the same as in ‘ghelp-describe-with-mode’. 249 | 250 | DATA is a plist of form (:symbol-name SYMBOL :mode MODE :marker MARKER). 251 | SYMBOL is the symbol we want to describe, MODE is the major mode, 252 | MARKER is the marker at where user requested for documentation. 253 | 254 | If SYMBOL is nil, we try to guess or prompt for the symbol. 255 | If MODE is nil, we use current buffer’s major mode. 256 | If MARKER is nil, we use the marker at point." 257 | (interactive "p") 258 | (let* ((data data) ; Create a lexical local variable. 259 | (mode (or (plist-get data :mode) (ghelp-get-mode))) 260 | (symbol (plist-get data :symbol-name)) 261 | (marker (or (plist-get data :marker) (point-marker))) 262 | (backend (ghelp--get-backend mode)) 263 | (window (when (derived-mode-p 'ghelp-page-mode) 264 | (selected-window)))) 265 | (setq data (ghelp--plist-set data :mode mode)) 266 | (setq data (ghelp--plist-set data :marker marker)) 267 | (when (not backend) 268 | (user-error "No backend found for %s" major-mode)) 269 | ;; Get symbol. 270 | (when (not symbol) 271 | (setq symbol (let* ((sym (when-let ((sym (symbol-at-point))) 272 | (symbol-name sym)))) 273 | (pcase prompt 274 | ('no-prompt sym) 275 | ('force-prompt 276 | (funcall backend 'symbol (copy-tree data))) 277 | ('nil 278 | (or sym (funcall backend 'symbol 279 | (copy-tree data))))))) 280 | (if (not (stringp symbol)) 281 | (error "Symbol return by the backend is not a string")) 282 | ;; Still no symbol? 283 | (when (not symbol) 284 | (user-error "No symbol at point")) 285 | (setq data (ghelp--plist-set data :symbol-name symbol))) 286 | ;; Request for documentation. 287 | (let ((doc (funcall backend 'doc (copy-tree data))) 288 | ;; DOC could be nil, a string, (TITLE BODY), ((TITLE 289 | ;; BODY)...) or a function. 290 | (display-fn 291 | (lambda (doc) 292 | (let ((entry-list 293 | (cond ((stringp doc) `((,symbol ,doc))) 294 | ((and (consp doc) (stringp (car doc))) 295 | (list doc)) 296 | (t doc)))) 297 | (ghelp--show-page entry-list data window))))) 298 | (when (not doc) 299 | (user-error "No documentation found for %s" symbol)) 300 | (if (functionp doc) 301 | (funcall doc display-fn) 302 | (funcall display-fn doc))))) 303 | 304 | (defun ghelp-describe-at-point () 305 | "Describe symbol at point." 306 | (interactive) 307 | (ghelp--maybe-update-current-page) 308 | (ghelp-describe 'no-prompt)) 309 | 310 | (defun ghelp-describe-function (&optional function) 311 | "Describe a function/macro/keyboard macro. 312 | FUNCTION is the same as in ‘describe-function’." 313 | ;; Copied from ‘describe-function’. 314 | (interactive) 315 | (ghelp--maybe-update-current-page) 316 | (ghelp-describe-1 317 | (if function 'no-prompt 'force-prompt) 318 | (append (if function (list :symbol-name (symbol-name function))) 319 | '(:mode emacs-lisp-mode :category function)))) 320 | 321 | (defun ghelp-describe-variable (&optional variable buffer frame) 322 | "Describe a variable. 323 | VARIABLE, BUFFER and FRAME are the same as in ‘describe-variable’." 324 | ;; Copied straight from ‘describe-variable’. 325 | (interactive) 326 | (ignore frame) 327 | (ghelp--maybe-update-current-page) 328 | (with-current-buffer (or buffer (current-buffer)) 329 | (ghelp-describe-1 330 | (if variable 'no-prompt 'force-prompt) 331 | (append (if variable (list :symbol-name (symbol-name variable))) 332 | '(:mode emacs-lisp-mode :category variable))))) 333 | 334 | (defun ghelp-describe-key (key-sequence) 335 | "Describe KEY-SEQUENCE." 336 | (interactive 337 | (list (read-key-sequence "Press key: "))) 338 | (ghelp--maybe-update-current-page) 339 | (let ((def (key-binding key-sequence)) 340 | (key-name (key-description key-sequence))) 341 | (pcase def 342 | ('nil (user-error "No command is bound to %s" 343 | (key-description key-sequence))) 344 | ((pred commandp) 345 | (if (or (stringp def) (vectorp def)) 346 | ;; DEF is a keyboard macro. 347 | (ghelp-describe-1 348 | 'no-prompt `(:symbol-name 349 | ,key-name 350 | :mode emacs-lisp-mode 351 | :marker ,(point-marker) 352 | :category function 353 | :kmacro ,def)) 354 | ;; DEF is a symbol for a function. 355 | (ghelp-describe-1 356 | 'no-prompt `(:symbol-name 357 | ,(symbol-name def) 358 | :mode emacs-lisp-mode 359 | :category function 360 | :marker ,(point-marker))))) 361 | (_ (user-error "%s is bound to %s which is not a command" 362 | (key-description key-sequence) 363 | def))))) 364 | 365 | ;;; History 366 | ;; 367 | ;; Functions: 368 | ;; - ‘ghelp-history--of’ 369 | ;; - ‘ghelp-history--push’ 370 | ;; - ‘ghelp-history--page-at’ 371 | ;; - ‘ghelp-history--set-current-page’ 372 | ;; - ‘ghelp-history--current-page’ 373 | 374 | ;;;; Variables 375 | 376 | (defvar ghelp-history-max-length 50 377 | "Maximum length of each history.") 378 | 379 | (defvar ghelp-history-alist nil 380 | "A list of (major-mode . history). 381 | HISTORY is the history of documentation queries.") 382 | 383 | (cl-defstruct ghelp-history 384 | "History for a major mode. 385 | 386 | - nodes :: A list of ‘ghelp-history-node’. 387 | - current :: The last viewed node." 388 | nodes 389 | current) 390 | 391 | (cl-defstruct ghelp-history-node 392 | "A node in a ‘ghelp-history’. 393 | 394 | - mode :: Major mode. 395 | - symbol-name :: Symbol that the documentation describes. 396 | - buffer :: The ghelp buffer containing the documentation. 397 | - prev :: Previous node. 398 | - next :: next node." 399 | mode 400 | symbol-name 401 | buffer 402 | prev 403 | next) 404 | 405 | (defun ghelp-history--set-nodes (nodes mode) 406 | "Set nodes of the history of MODE to NODES." 407 | (setf (ghelp-history-nodes (alist-get mode ghelp-history-alist)) 408 | nodes)) 409 | 410 | (defun ghelp-history--set-current (node mode) 411 | "Set current node of the history of MODE to NODE." 412 | (setf (ghelp-history-current (alist-get mode ghelp-history-alist)) 413 | node)) 414 | 415 | ;;;; Private 416 | 417 | (defun ghelp-history--symbol-node (symbol history) 418 | "Return the node describing SYMBOL in HISTORY or nil." 419 | ;; Remember that SYMBOL is string. 420 | (seq-find (lambda (node) 421 | (equal (ghelp-history-node-symbol-name node) symbol)) 422 | (ghelp-history-nodes history))) 423 | 424 | (defun ghelp-history--remove-node (node history) 425 | "Remove NODE from HISTORY and destroy NODE." 426 | (let ((buf (ghelp-history-node-buffer node)) 427 | (prev (ghelp-history-node-prev node)) 428 | (next (ghelp-history-node-next node))) 429 | (when (buffer-live-p (kill-buffer buf))) 430 | (when prev (setf (ghelp-history-node-next prev) next)) 431 | (when next (setf (ghelp-history-node-prev next) prev))) 432 | (setf (ghelp-history-nodes history) 433 | (remq node (ghelp-history-nodes history))) 434 | ;; We are deleting the current node. 435 | (when (eq node (ghelp-history-current history)) 436 | (setf (ghelp-history-current history) 437 | (or (ghelp-history-node-prev node) 438 | (ghelp-history-node-next node) 439 | (car (ghelp-history-nodes history)))))) 440 | 441 | (defun ghelp-history--trim (history) 442 | "Remove old nodes from HISTORY if it’s too long. 443 | HiSTORY is too long when its length exceeds 444 | ‘ghelp-history-max-length’." 445 | (let ((nodes (ghelp-history-nodes history))) 446 | (when (> (length nodes) ghelp-history-max-length) 447 | (dolist (node (seq-subseq nodes ghelp-history-max-length)) 448 | (ghelp-history--remove-node node history))))) 449 | 450 | (defun ghelp-history--insert-after (node1 node2 history) 451 | "Insert NODE1 after NODE2 in HISTORY." 452 | (push node1 (ghelp-history-nodes history)) 453 | (let ((after-node2 (ghelp-history-node-next node2))) 454 | (setf (ghelp-history-node-next node2) node1) 455 | (setf (ghelp-history-node-next node1) after-node2) 456 | (setf (ghelp-history-node-prev node1) node2) 457 | (when after-node2 458 | (setf (ghelp-history-node-prev after-node2) node1)))) 459 | 460 | (defun ghelp-history--insert-before (node1 node2 history) 461 | "Insert NODE1 before NODE2 in HISTORY." 462 | (push node1 (ghelp-history-nodes history)) 463 | (let ((before-node2 (ghelp-history-node-prev node2))) 464 | (setf (ghelp-history-node-prev node2) node1) 465 | (setf (ghelp-history-node-prev node1) before-node2) 466 | (setf (ghelp-history-node-next node1) node2) 467 | (when before-node2 468 | (setf (ghelp-history-node-next before-node2) node1)))) 469 | 470 | (defun ghelp-history--bring-node-to-front (node history) 471 | "Make NODE the latest node in HISTORY." 472 | (let ((nodes (ghelp-history-nodes history))) 473 | (setf (ghelp-history-nodes history) 474 | (cons node (remq node nodes))))) 475 | 476 | ;;;; Public 477 | 478 | (defun ghelp-history--of (mode) 479 | "Return history of MODE." 480 | (or (alist-get mode ghelp-history-alist) 481 | ;; TODO remove workaround 482 | ;; needed for all version before 27.1 483 | (let ((h (make-ghelp-history :nodes nil :current nil))) 484 | (setf (alist-get mode ghelp-history-alist) h) 485 | h))) 486 | 487 | (defun ghelp-history--push (page symbol mode) 488 | "Push PAGE for SYMBOL of MODE to the history of MODE." 489 | (let* ((node (make-ghelp-history-node :buffer page 490 | :symbol-name symbol 491 | :mode mode)) 492 | (history (ghelp-history--of mode)) 493 | (current (ghelp-history-current history))) 494 | (if current (ghelp-history--insert-after node current history) 495 | (setf (ghelp-history-nodes history) (list node))) 496 | (setf (ghelp-history-current history) node))) 497 | 498 | (defun ghelp-history--page-at (where symbol mode) 499 | "Return the page at POS in MODE. 500 | POS is WHERE SYMBOL 501 | POS can be 502 | :at SYMBOL meaning return the page for SYMBOL, or 503 | :after SYMBOL meaning return the page after the one for 504 | SYMBOL, or 505 | :before SYMBOL meaning return the page before the one for 506 | SYMBOL. 507 | 508 | Return nil if didn’t find the page, or the page is killed." 509 | (when-let* ((history (ghelp-history--of mode)) 510 | (node (ghelp-history--symbol-node symbol history)) 511 | (real-node (pcase where 512 | (:at node) 513 | (:after (ghelp-history-node-next node)) 514 | (:before (ghelp-history-node-prev node)))) 515 | (buffer (ghelp-history-node-buffer real-node))) 516 | (if (buffer-live-p buffer) 517 | buffer 518 | ;; If user tries to go to prev/next page but that page is 519 | ;; killed, we fix the history behind the scene. 520 | (ghelp-history--remove-node real-node history) 521 | nil))) 522 | 523 | (defun ghelp-history--set-current-page (where symbol mode) 524 | "Set the current page of MODE to the page describing SYMBOL. 525 | Specifically, set the current page of the history of MODE. 526 | WHERE is the same as in ‘ghelp-history--page-at’. 527 | If such page doesn’t exist, do nothing and return nil." 528 | (when-let* ((history (ghelp-history--of mode)) 529 | (node (ghelp-history--symbol-node symbol history)) 530 | (real-node (pcase where 531 | (:at node) 532 | (:after (ghelp-history-node-next node)) 533 | (:before (ghelp-history-node-prev node))))) 534 | (setf (ghelp-history-current history) real-node))) 535 | 536 | (defun ghelp-history--current-page (mode) 537 | "Return the current page for MODE. 538 | If can’t find one, return nil." 539 | (when-let* ((history (ghelp-history--of mode)) 540 | (node (ghelp-history-current history)) 541 | (page (ghelp-history-node-buffer node))) 542 | ;; We fix the error behind the scene. 543 | (if (buffer-live-p page) 544 | page 545 | (message "Last viewed page is killed, showing the second last.") 546 | (ghelp-history--remove-node node history) 547 | (ghelp-history--current-page mode)))) 548 | 549 | (defun ghelp-history--symbols (mode) 550 | "Return a list of symbols (string) that the history for MODE contains." 551 | (when-let* ((history (ghelp-history--of mode)) 552 | (nodes (ghelp-history-nodes history))) 553 | (mapcar #'ghelp-history-node-symbol-name nodes))) 554 | 555 | ;;; Entry 556 | ;; 557 | ;; Functions: 558 | ;; 559 | ;; - ‘ghelp-entry-fold’ 560 | ;; - ‘ghelp-entry-unfold’ 561 | ;; - ‘ghelp-previous-entry’ 562 | ;; - ‘ghelp-next-entry’ 563 | ;; - ‘ghelp-toggle-entry’ 564 | 565 | (defvar-local ghelp--page-entry-list nil 566 | "A list of documentation entries. 567 | Each entry is a ‘ghelp-entry’.") 568 | 569 | (defun ghelp-toggle-entry () 570 | "Toggle visibility of entry at point." 571 | (interactive) 572 | (if (ghelp-entry-folded) 573 | (ghelp-entry-unfold) 574 | (ghelp-entry-fold))) 575 | 576 | (defmacro ghelp-entry--with-ov (ov-symbol &rest body) 577 | "Evaluate BODY with OV-SYMBOL bounded to ghelp overlay at point." 578 | (declare (indent 1)) 579 | `(let ((,ov-symbol (ghelp--overlay-at-point))) 580 | (if (not ov) 581 | (user-error "No entries found at point") 582 | ,@body))) 583 | 584 | (defun ghelp-next-entry () 585 | "Go to next entry." 586 | (interactive) 587 | ;; state 0: on entry 588 | ;; state 1: not on entry 589 | ;; state 2: on entry 590 | (let ((state (if (ghelp--overlay-at-point) 0 1))) 591 | (condition-case nil 592 | (while (< state 2) 593 | (forward-char) 594 | (pcase state 595 | (1 (when (ghelp--overlay-at-point) 596 | (setq state (1+ state)))) 597 | (0 (when (not (ghelp--overlay-at-point)) 598 | (setq state (1+ state)))))) 599 | (end-of-buffer nil)))) 600 | 601 | (defun ghelp-previous-entry () 602 | "Go to beginning of the previous entry." 603 | (interactive) 604 | ;; state 0: on entry 605 | ;; state 1: not on entry 606 | ;; state 2: on entry 607 | ;; state 3: not on entry 608 | (let ((state (if (ghelp--overlay-at-point) 0 1))) 609 | (condition-case nil 610 | (while (< state 3) 611 | (backward-char) 612 | (pcase state 613 | (1 (when (ghelp--overlay-at-point) 614 | (setq state (1+ state)))) 615 | ((or 0 2) (when (not (ghelp--overlay-at-point)) 616 | (setq state (1+ state)))))) 617 | (beginning-of-buffer nil)) 618 | (when (eq state 3) 619 | (forward-char)))) 620 | 621 | (defun ghelp-entry-unfold () 622 | "Unfold OVERLAY." 623 | (interactive) 624 | (ghelp-entry--with-ov ov 625 | (ghelp-entry--unfold ov))) 626 | 627 | (defun ghelp-entry-fold () 628 | "Fold OVERLAY." 629 | (interactive) 630 | (ghelp-entry--with-ov ov 631 | (ghelp-entry--fold ov))) 632 | 633 | (defun ghelp-entry-folded () 634 | "Return non-nil if OVERLAY is folded in terms of ghelp entry." 635 | (ghelp-entry--with-ov ov 636 | (ghelp-entry--folded ov))) 637 | 638 | (defun ghelp-entry--folded (overlay) 639 | "Return non-nil if OVERLAY is folded in terms of ghelp entry." 640 | (overlay-get overlay 'display)) 641 | 642 | (defun ghelp-entry--fold (overlay) 643 | "Fold OVERLAY." 644 | (overlay-put overlay 'face 'ghelp-folded-entry) 645 | (overlay-put overlay 'display (overlay-get 646 | overlay 'ghelp-entry-name))) 647 | 648 | 649 | 650 | (defun ghelp-entry--unfold (overlay) 651 | "Unfold OVERLAY." 652 | (overlay-put overlay 'display nil) 653 | (overlay-put overlay 'face 'ghelp-entry)) 654 | 655 | ;;; Page 656 | ;; 657 | ;; - ‘ghelp-page-insert-entry’ 658 | ;; - ‘ghelp-page-clear’ 659 | ;; - ‘ghelp-get-page-or-create’ 660 | ;; - ‘ghelp-switch-to-page’ 661 | ;; - ‘ghelp-forward’ 662 | ;; - ‘ghelp-back’ 663 | ;; - ‘ghelp-folded-entry’ 664 | ;; - ‘ghelp-entry’ 665 | ;; - ‘ghelp--show-page’ 666 | ;; - ‘ghelp-page-data’ 667 | ;; - ‘ghelp-get-page-data’ 668 | 669 | ;;;;; Modes 670 | 671 | (defvar ghelp-page-mode-map 672 | (let ((map (make-sparse-keymap))) 673 | (define-key map (kbd "RET") #'ghelp-toggle-entry) 674 | (define-key map (kbd "TAB") #'forward-button) 675 | (define-key map (kbd "C-TAB") #'backward-button) 676 | (define-key map (kbd "") #'backward-button) 677 | (define-key map "q" #'ghelp-quit) 678 | (define-key map "b" #'ghelp-back) 679 | (define-key map "f" #'ghelp-forward) 680 | (define-key map "]" #'ghelp-next-entry) 681 | (define-key map "[" #'ghelp-previous-entry) 682 | (define-key map "n" #'next-line) 683 | (define-key map "p" #'previous-line) 684 | (define-key map (kbd "SPC") #'scroll-up-command) 685 | (define-key map (kbd "") #'scroll-down-command) 686 | (define-key map "g" #'ghelp-refresh) 687 | (define-key map "s" #'ghelp-switch-to-page) 688 | (define-key map "?" #'ghelp-page-show-help) 689 | map)) 690 | 691 | (define-derived-mode ghelp-page-mode fundamental-mode 692 | "Ghelp" "Major mode for ghelp pages." 693 | (setq buffer-read-only t)) 694 | 695 | ;;;;; Variables 696 | 697 | (defcustom ghelp-enable-header-line t 698 | "Whether to display information on the header line. 699 | Changeling this variable doesn’t affect existing ghelp pages." 700 | :type 'boolean 701 | :group 'ghelp) 702 | 703 | (defface ghelp-entry (let ((display t) 704 | (atts nil)) 705 | `((,display . ,atts))) 706 | "Face for each entry in a documentation." 707 | :group 'ghelp) 708 | 709 | (defface ghelp-folded-entry (let ((display t) 710 | (atts '(:inherit highlight))) 711 | `((,display . ,atts))) 712 | "Face for a folded entry in a documentation." 713 | :group 'ghelp) 714 | 715 | (defface ghelp-entry-title (let ((display t) 716 | (atts '(:inherit (ghelp-entry 717 | info-title-3)))) 718 | `((,display . ,atts))) 719 | "Face for the title of an entry in a documentation." 720 | :group 'ghelp) 721 | 722 | (defface ghelp-header-button (let ((display t) 723 | (atts '(:slant normal :weight normal 724 | :inherit 725 | info-header-node))) 726 | `((,display . ,atts))) 727 | "Face for back and forward button in header line." 728 | :group 'ghelp) 729 | 730 | (defvar-local ghelp-page-data nil 731 | "A plist that stores information about the documentation. 732 | The plist includes these values: 733 | 734 | :symbol-name A string; the documentation is about this symbol. 735 | :mode The major mode; it is used by ‘ghelp--show-page’. 736 | :marker The marker at the point where the user requested 737 | documentation of this symbol. 738 | 739 | NOTE: Backends should not use this variable, instead, use 740 | ‘ghelp-get-page-data’.") 741 | 742 | (defun ghelp-get-page-data () 743 | "Return a plist that’s identical to ‘ghelp-page-data’. 744 | The plist contains useful information like symbol and marker." 745 | (if (derived-mode-p 'ghelp-page-mode) 746 | (copy-tree ghelp-page-data) 747 | (error "Not in a ghelp page"))) 748 | 749 | ;; (defvar ghelp-entry-map 750 | ;; (let ((map (make-sparse-keymap))) 751 | ;; (define-key map (kbd "TAB") #'ghelp-toggle-entry) 752 | ;; map) 753 | ;; "Keymap activated when point is in an entry.") 754 | 755 | (defun ghelp-page--header-line-format () 756 | "Return back and forward button for the current page." 757 | (let ((symbol (plist-get ghelp-page-data :symbol-name))) 758 | (concat (propertize " " 'display '(space :width (10))) 759 | ;; [back] 760 | (propertize 761 | (ghelp--make-button "<>" #'ghelp-forward) 770 | 'face 'ghelp-header-button 771 | 'mouse-face 'highlight)))) 772 | 773 | ;;;;; Commands 774 | 775 | (defun ghelp-back () 776 | "Go back one page." 777 | (interactive) 778 | (let* ((symbol (plist-get ghelp-page-data :symbol-name)) 779 | (mode (plist-get ghelp-page-data :mode)) 780 | (page (ghelp-history--page-at :before symbol mode))) 781 | (when page 782 | (ghelp-history--set-current-page :before symbol mode) 783 | (switch-to-buffer page)))) 784 | 785 | (defun ghelp-forward () 786 | "Go forward one page." 787 | (interactive) 788 | (let* ((symbol (plist-get ghelp-page-data :symbol-name)) 789 | (mode (plist-get ghelp-page-data :mode)) 790 | (page (ghelp-history--page-at :after symbol mode))) 791 | (when page 792 | (ghelp-history--set-current-page :after symbol mode) 793 | (switch-to-buffer page)))) 794 | 795 | (defun ghelp-switch-to-page () 796 | "Switch to a page in history." 797 | (interactive) 798 | (let* ((mode (plist-get ghelp-page-data :mode)) 799 | (symbol (completing-read 800 | "Switch to: " 801 | (ghelp-history--symbols mode) 802 | nil t)) 803 | (page (ghelp-history--page-at :at symbol mode))) 804 | (switch-to-buffer page))) 805 | 806 | (defun ghelp-page-show-help () 807 | "Show help for available commands in `ghelp-page-mode'." 808 | (interactive) 809 | (message "q quit RET hide/show entry 810 | g refresh s switch to page 811 | 812 | TAB next button S-TAB previous button 813 | SPC scroll down DEL scroll up 814 | 815 | f next page b previous page 816 | ] next entry [ previous entry 817 | ")) 818 | 819 | ;;;;; Functions 820 | 821 | (defun ghelp--generate-new-page (mode symbol) 822 | "Generate a new page for MODE (major mode) and SYMBOL and return it." 823 | (with-current-buffer (generate-new-buffer 824 | (ghelp--page-name-from mode symbol)) 825 | (ghelp-page-mode) 826 | (setq ghelp-page-data 827 | (ghelp--plist-set ghelp-page-data :symbol-name symbol)) 828 | (setq ghelp-page-data 829 | (ghelp--plist-set ghelp-page-data :mode mode)) 830 | (when ghelp-enable-header-line 831 | (setq header-line-format 832 | '((:eval (ghelp-page--header-line-format))))) 833 | (current-buffer))) 834 | 835 | (defun ghelp-get-page-or-create (mode symbol) 836 | "Return the page for MODE (major mode) and SYMBOL. 837 | Assume a history is available for MODE, else error. 838 | POINT is the point of the symbol." 839 | (let* ((page (ghelp-history--page-at :at symbol mode))) 840 | (if page 841 | (ghelp-history--set-current-page :at symbol mode) 842 | (setq page (ghelp--generate-new-page mode symbol)) 843 | (ghelp-history--push page symbol mode)) 844 | page)) 845 | 846 | (defun ghelp-page-clear () 847 | "Clear PAGE." 848 | (let ((inhibit-read-only t)) 849 | (erase-buffer))) 850 | 851 | (defun ghelp-page-insert-entry (entry &optional fold) 852 | "Insert ENTRY at the end of PAGE (buffer) and return the entry. 853 | 854 | If FOLD non-nil, fold the entry after insertion." 855 | (let ((inhibit-read-only t) 856 | (name (nth 0 entry)) 857 | (text (nth 1 entry)) 858 | ov beg) 859 | (save-excursion 860 | (goto-char (point-max)) 861 | ;; this newline therefore is not included in the overlay 862 | (insert "\n") 863 | (backward-char) 864 | (setq beg (point)) 865 | (insert (propertize (format "%s\n" name) 'face 'ghelp-entry-title) 866 | text) 867 | (setq ov (make-overlay beg (point))) 868 | (overlay-put ov 'ghelp-ov t) 869 | (overlay-put ov 'ghelp-entry-name name) 870 | (overlay-put ov 'face 'ghelp-entry) 871 | ;; FIXME keymap as a symbol doesn’t seem to work 872 | ;; keymap property blocks text buttons 873 | ;; (overlay-put ov 'keymap ghelp-entry-map) 874 | (when fold (ghelp-entry--fold ov)) 875 | entry))) 876 | 877 | (defun ghelp-page-insert-entry-list (entry-list &optional fold) 878 | "Insert entries in ENTRY-LIST one-by-one. 879 | For FOLD, see ‘ghelp-page-insert-entry’." 880 | (dolist (entry entry-list) 881 | (ghelp-page-insert-entry entry fold))) 882 | 883 | (defun ghelp--overlay-at-point () 884 | "Return ghelp overlay at point or nil." 885 | (catch 'ret 886 | (let ((overlays (overlays-at (point)))) 887 | (while overlays 888 | (let ((overlay (car overlays))) 889 | (when (overlay-get overlay 'ghelp-ov) 890 | (throw 'ret overlay))) 891 | (setq overlays (cdr overlays)))))) 892 | 893 | (defun ghelp--page-name-from (mode symbol) 894 | "Return the buffer name used by ghelp page for MODE and SYMBOL." 895 | (format " *ghelp %s : %s*" mode symbol)) 896 | 897 | ;; Helpers 898 | 899 | (defun ghelp--make-button (text fn) 900 | "Return a clickable TEXT that invokes FN when clicked by mouse-1." 901 | (propertize text 'keymap (let ((map (make-sparse-keymap))) 902 | (define-key map [header-line mouse-1] fn) 903 | (define-key map [mode-line mouse-1] fn) 904 | (define-key map [mouse-1] fn) 905 | map))) 906 | 907 | (defun ghelp-page--history () 908 | "Return non-nil ‘ghelp-page-history’ or error." 909 | (ghelp-history--of (plist-get ghelp-page-data :mode))) 910 | 911 | (defun ghelp--show-page (entry-list data &optional window) 912 | "Display page with ENTRY-LIST in WINDOW (if non-nil). 913 | DATA contains useful information like symbol and mode, see 914 | ‘ghelp-page-data’ for more. ENTRY-LIST is of the form 915 | \((TITLE . BODY) ...)." 916 | (let* ((mode (plist-get data :mode)) 917 | (marker (plist-get data :marker)) 918 | (symbol (plist-get data :symbol-name)) 919 | (page (ghelp-get-page-or-create mode symbol))) 920 | (with-current-buffer page 921 | ;; Set data before calling the callback, not that it matters... 922 | (setq ghelp-page-data 923 | (ghelp--plist-set ghelp-page-data :symbol-name symbol)) 924 | (setq ghelp-page-data 925 | (ghelp--plist-set ghelp-page-data :marker marker)) 926 | (setq ghelp-page-data 927 | (ghelp--plist-set ghelp-page-data :mode mode)) 928 | (ghelp-page-clear) 929 | (ghelp-page-insert-entry-list entry-list t) 930 | (goto-char (point-max)) 931 | (ghelp-previous-entry) 932 | (ghelp-entry-unfold)) 933 | (if window 934 | (window--display-buffer page window 'window) 935 | (setq window (display-buffer page))) 936 | (when (and (window-live-p window) help-window-select) 937 | (select-window window)))) 938 | 939 | (defun ghelp--maybe-update-current-page () 940 | "Update current page of history. 941 | If user opened a page with ‘swtich-to-buffer’, we have no way to 942 | know and can’t update the current page to it. To make sure the 943 | current page of our history is almost always up to date, call 944 | this function. This function looks at visible ghelp pages and set 945 | them to current in their history." 946 | (dolist (window (window-list nil 'never)) 947 | (with-current-buffer (window-buffer window) 948 | (when (derived-mode-p 'ghelp-page-mode) 949 | (let* ((symbol (plist-get ghelp-page-data :symbol-name)) 950 | (mode (plist-get ghelp-page-data :mode))) 951 | (ghelp-history--set-current-page :at symbol mode)))))) 952 | 953 | ;;; Backend 954 | ;; 955 | ;; Functions: 956 | ;; 957 | ;; - ‘ghelp--get-backend’ 958 | 959 | (defvar ghelp-backend-alist () 960 | "An alist of (major-mode . backend).") 961 | 962 | (defun ghelp--get-backend (mode) 963 | "Get ghelp backend by MODE." 964 | (or (alist-get mode ghelp-backend-alist) 965 | (catch 'found 966 | (dolist (backend ghelp-backend-alist) 967 | (when (and (eq t (car backend)) 968 | (funcall (cdr backend) 'available-p nil)) 969 | (throw 'found (cdr backend))))))) 970 | 971 | (defun ghelp-register-backend (mode backend-function) 972 | "Register BACKEND-FUNCTION for each MODE. 973 | MODE can be a major mode symbol or a list of it. If MODE is t, 974 | the backend should support the ‘available-p’ command and is used 975 | as a fallback backend. Ie, it is called if no explicit backends 976 | is available." 977 | (cond ((eq mode t) 978 | (let ((entry (cons mode backend-function))) 979 | (unless (member entry ghelp-backend-alist) 980 | (push entry ghelp-backend-alist)))) 981 | ((symbolp mode) 982 | (setf (alist-get mode ghelp-backend-alist) backend-function)) 983 | ((consp mode) 984 | (dolist (mode1 mode) 985 | (setf (alist-get mode1 ghelp-backend-alist) backend-function))) 986 | (t (error "MODE should be either a list or a symbol")))) 987 | 988 | (defun ghelp-deregister-backend (mode backend-function) 989 | "Deregister BACKEND-FUNCTION for MODE." 990 | (let ((new-list nil)) 991 | (dolist (entry ghelp-backend-alist) 992 | (unless (equal (cons mode backend-function) entry) 993 | (push entry new-list))) 994 | (setq ghelp-backend-alist (nconc new-list)))) 995 | 996 | ;;; Dummy 997 | 998 | (defun ghelp-dummy-backend (command data) 999 | "Demo. Prompt behavior depends on PROMPT. 1000 | 1001 | If COMMAND is 'symbol, return a string representing the symbol 1002 | that the user wants documentation for. DATA is a plist of form 1003 | 1004 | (:marker MARKER) 1005 | 1006 | where MARKER is the marker at the point where user invoked 1007 | ‘ghelp-describe’. 1008 | 1009 | If COMMAND is 'doc, return the documentation for SYMBOL, where 1010 | SYMBOL is from DATA: 1011 | 1012 | (:symbol-name SYMBOL :marker MARKER) 1013 | 1014 | Returned documentation is a string ending with a newline. 1015 | Return nil if no documentation is found." 1016 | (pcase command 1017 | ('symbol (completing-read "Symbol: " 1018 | '("woome" "veemo" "love" "tank"))) 1019 | ('doc (pcase (plist-get data :symbol-name) 1020 | ("woome" "Woome!!\n") 1021 | ("veemo" "Veemo!!\n") 1022 | ("love" "Peace!!\n") 1023 | ("tank" "TANK! THE! BEST!\n") 1024 | ("async" (lambda (display-fn) 1025 | (funcall display-fn "Promise!"))))))) 1026 | 1027 | (defun ghelp-dummy () 1028 | "Demonstrate the dummy backend." 1029 | (interactive) 1030 | (ghelp-describe-with-mode 'force-prompt 'dummy-mode)) 1031 | 1032 | (ghelp-register-backend 'dummy-mode #'ghelp-dummy-backend) 1033 | 1034 | ;;; Setup 1035 | 1036 | (declare-function ghelp-help-backend "ghelp-builtin.el") 1037 | (declare-function ghelp-helpful-backend "ghelp-helpful.el") 1038 | (declare-function ghelp-eglot-backend "ghelp-eglot.el") 1039 | (declare-function ghelp-geiser-backend "ghelp-geiser.el") 1040 | (declare-function ghelp-sly-backend "ghelp-sly.el") 1041 | (declare-function ghelp-lspce-backend "ghelp-lspce.el") 1042 | 1043 | (require 'ghelp-builtin) 1044 | (ghelp-register-backend 'emacs-lisp-mode #'ghelp-help-backend) 1045 | 1046 | (when (condition-case nil 1047 | (find-library-name "helpful") 1048 | (error nil)) 1049 | (require 'helpful)) 1050 | 1051 | (with-eval-after-load 'helpful 1052 | (require 'ghelp-helpful) 1053 | (ghelp-register-backend 'emacs-lisp-mode #'ghelp-helpful-backend)) 1054 | 1055 | (with-eval-after-load 'eglot 1056 | (require 'ghelp-eglot) 1057 | (ghelp-register-backend t #'ghelp-eglot-backend)) 1058 | 1059 | (with-eval-after-load 'lspce 1060 | (require 'ghelp-lspce) 1061 | (ghelp-register-backend t #'ghelp-lspce-backend)) 1062 | 1063 | (with-eval-after-load 'geiser 1064 | (require 'ghelp-geiser) 1065 | (ghelp-register-backend 'scheme-mode #'ghelp-geiser-backend) 1066 | (ghelp-register-backend 'geiser-repl-mode #'ghelp-geiser-backend)) 1067 | 1068 | (with-eval-after-load 'sly 1069 | (require 'ghelp-sly) 1070 | (ghelp-register-backend 'lisp-mode #'ghelp-sly-backend) 1071 | (ghelp-register-backend 'sly-mrepl-mode #'ghelp-sly-backend)) 1072 | 1073 | 1074 | (provide 'ghelp) 1075 | 1076 | ;;; ghelp.el ends here 1077 | -------------------------------------------------------------------------------- /run-test.sh: -------------------------------------------------------------------------------- 1 | echo Byte compiler 2 | emacs -Q --batch -L . -f batch-byte-compile *.el 3 | echo ERT test 4 | emacs -Q --batch -L . -l ghelp-test -f ert-run-tests-batch-and-exit 5 | --------------------------------------------------------------------------------