geiser-autodoc.el (9494B)
1 ;;; geiser-autodoc.el -- autodoc mode -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2021, 2022 Jose Antonio Ortega Ruiz 4 5 ;; This program is free software; you can redistribute it and/or 6 ;; modify it under the terms of the Modified BSD License. You should 7 ;; have received a copy of the license along with this program. If 8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. 9 10 ;; Start date: Sun Feb 08, 2009 19:44 11 12 13 ;;; Code: 14 15 (require 'geiser-edit) 16 (require 'geiser-eval) 17 (require 'geiser-syntax) 18 (require 'geiser-custom) 19 (require 'geiser-base) 20 21 (require 'eldoc) 22 23 24 ;;; Customization: 25 26 (defgroup geiser-autodoc nil 27 "Options for displaying autodoc strings in the echo area." 28 :group 'geiser) 29 30 (geiser-custom--defface autodoc-current-arg 31 'font-lock-variable-name-face 32 geiser-autodoc "highlighting current argument in autodoc messages") 33 34 (geiser-custom--defface autodoc-identifier 35 'font-lock-function-name-face 36 geiser-autodoc "highlighting procedure name in autodoc messages") 37 38 (geiser-custom--defcustom geiser-autodoc-delay 0.3 39 "Delay before autodoc messages are fetched and displayed, in seconds." 40 :type 'number) 41 42 (geiser-custom--defcustom geiser-autodoc-display-module t 43 "Whether to display procedure module in autodoc strings." 44 :type 'boolean) 45 46 (geiser-custom--defcustom geiser-autodoc-identifier-format "%s:%s" 47 "Format for displaying module and procedure or variable name, in that order, 48 when `geiser-autodoc-display-module' is on." 49 :type 'string) 50 51 (geiser-custom--defcustom geiser-autodoc-use-docsig t 52 "Provide signature docstrings for systems like company or corfu. 53 54 With this flag set, the signature of selected completions using 55 packages like company, corfu or completion-in-region functions 56 will be displayed in the echo area. For the case of a 57 completion-in-region function (e.g. consult's), which collects 58 all the docstrings at once, this might have a performace impact: 59 you can set this variable to nil to avoid them." 60 :type 'boolean) 61 62 63 ;;; Procedure arguments: 64 65 (defvar-local geiser-autodoc--cached-signatures nil) 66 67 (defsubst geiser-autodoc--clean-cache () 68 (setq geiser-autodoc--cached-signatures nil)) 69 70 (defun geiser-autodoc--update-signatures (ret callback) 71 (let ((res (geiser-eval--retort-result ret)) 72 (signs)) 73 (when res 74 (dolist (item res) 75 (push (cons (format "%s" (car item)) (cdr item)) signs)) 76 (when (functionp callback) 77 (let* ((path (geiser-syntax--scan-sexps)) 78 (str (geiser-autodoc--autodoc path nil signs))) 79 (funcall callback str))) 80 (setq geiser-autodoc--cached-signatures signs)))) 81 82 (defun geiser-autodoc--get-signatures (funs callback) 83 (when funs 84 (let* ((m (format "'(%s)" (mapconcat 'identity funs " "))) 85 (str (geiser-eval--scheme-str `(:eval (:ge autodoc (:scm ,m)))))) 86 (if callback 87 (geiser-eval--send str 88 (lambda (r) 89 (geiser-autodoc--update-signatures r callback))) 90 (geiser-autodoc--update-signatures (geiser-eval--send/wait str) nil)))) 91 (and (or (assoc (car funs) geiser-autodoc--cached-signatures) 92 (assoc (cadr funs) geiser-autodoc--cached-signatures)) 93 geiser-autodoc--cached-signatures)) 94 95 (defun geiser-autodoc--sanitize-args (args) 96 (cond ((null args) nil) 97 ((listp args) 98 (cons (car args) (geiser-autodoc--sanitize-args (cdr args)))) 99 (t '("...")))) 100 101 (defun geiser-autodoc--format-arg (a) 102 (cond ((and (listp a) (geiser-syntax--keywordp (car a))) 103 (if (and (cdr a) (listp (cdr a))) 104 (format "(#%s %s)" (car a) (geiser-syntax--display (cadr a))) 105 (format "(#%s)" (car a)))) 106 (t (geiser-syntax--display a)))) 107 108 (defvar geiser-autodoc--arg-face 'geiser-font-lock-autodoc-current-arg) 109 110 (defun geiser-autodoc--insert-arg-group (args current &optional pos) 111 (when args (insert " ")) 112 (dolist (a (geiser-autodoc--sanitize-args args)) 113 (let ((p (point))) 114 (insert (geiser-autodoc--format-arg a)) 115 (when (or (and (numberp pos) 116 (numberp current) 117 (setq current (1+ current)) 118 (= (1+ pos) current)) 119 (and (geiser-syntax--keywordp current) 120 (listp a) 121 (geiser-syntax--symbol-eq current (car a)))) 122 (put-text-property p (point) 'face geiser-autodoc--arg-face) 123 (setq pos nil current nil))) 124 (insert " ")) 125 (when args (backward-char)) 126 current) 127 128 (defun geiser-autodoc--insert-args (args pos prev) 129 (let ((cpos 1) 130 (reqs (cdr (assoc "required" args))) 131 (opts (mapcar (lambda (a) 132 (if (and (symbolp a) 133 (not (equal (symbol-name a) "..."))) 134 (list a) 135 a)) 136 (cdr (assoc "optional" args)))) 137 (keys (cdr (assoc "key" args)))) 138 (setq cpos 139 (geiser-autodoc--insert-arg-group reqs 140 cpos 141 (and (not (zerop pos)) pos))) 142 (setq cpos (geiser-autodoc--insert-arg-group opts cpos pos)) 143 (geiser-autodoc--insert-arg-group keys prev nil))) 144 145 (defsubst geiser-autodoc--id-name (proc module) 146 (let ((str (if (and module geiser-autodoc-display-module) 147 (format geiser-autodoc-identifier-format module proc) 148 (format "%s" proc)))) 149 (propertize str 'face 'geiser-font-lock-autodoc-identifier))) 150 151 (defun geiser-autodoc--str* (full-signature) 152 (let ((geiser-autodoc--arg-face 'default) 153 (sign (if (listp full-signature) full-signature (list full-signature)))) 154 (geiser-autodoc--str (list (car sign)) sign))) 155 156 (defsubst geiser-autodoc--value-str (proc module value) 157 (let ((name (geiser-autodoc--id-name proc module))) 158 (if value (format "%s => %s" name value) name))) 159 160 (defun geiser-autodoc--str (desc signature) 161 (let ((proc (car desc)) 162 (args (cdr (assoc "args" signature))) 163 (module (cdr (assoc "module" signature)))) 164 (if (not args) 165 (geiser-autodoc--value-str proc module (cdr (assoc "value" signature))) 166 (save-current-buffer 167 (set-buffer (geiser-syntax--font-lock-buffer)) 168 (erase-buffer) 169 (insert (format "(%s" (geiser-autodoc--id-name proc module))) 170 (let ((pos (or (cadr desc) 0)) 171 (prev (car (cddr desc)))) 172 (dolist (a args) 173 (when (not (member a (cdr (member a args)))) 174 (geiser-autodoc--insert-args a pos prev) 175 (insert " |")))) 176 (delete-char -2) 177 (insert ")") 178 (buffer-substring (point-min) (point)))))) 179 180 (defun geiser-autodoc--autodoc (path callback &optional signs) 181 (let ((signs (or signs 182 (geiser-autodoc--get-signatures (mapcar 'car path) callback)))) 183 (or (and callback t) 184 (let ((p (car path)) 185 (s)) 186 (while (and p (not s)) 187 (setq s (or (cdr (assoc (car p) signs)) 188 (and (bound-and-true-p geiser-mode) 189 (cdr (geiser-edit--find-def (car p) t))))) 190 (unless s (setq p (car path) path (cdr path)))) 191 (cond ((stringp s) s) 192 (s (geiser-autodoc--str p s))))))) 193 194 195 ;;; Autodoc functions: 196 197 (defvar-local geiser-autodoc--inhibit-function nil) 198 199 (defsubst geiser-autodoc--inhibit () 200 (and geiser-autodoc--inhibit-function 201 (funcall geiser-autodoc--inhibit-function))) 202 203 (defsubst geiser-autodoc--inhibit-autodoc () 204 (setq geiser-autodoc--inhibit-function (lambda () t))) 205 206 (defsubst geiser-autodoc--disinhibit-autodoc () 207 (setq geiser-autodoc--inhibit-function nil)) 208 209 (defsubst geiser-autodoc--autodoc-at-point (callback) 210 (geiser-autodoc--autodoc (geiser-syntax--scan-sexps) callback)) 211 212 (defun geiser-autodoc--eldoc-function (&optional callback) 213 (ignore-errors 214 (when (not (geiser-autodoc--inhibit)) 215 (geiser-autodoc--autodoc-at-point (or callback 'eldoc-message))))) 216 217 (defun geiser-autodoc-show () 218 "Show the signature or value of the symbol at point in the echo area." 219 (interactive) 220 (message (geiser-autodoc--autodoc-at-point nil))) 221 222 223 ;;; Autodoc mode: 224 225 (defvar-local geiser-autodoc-mode-string " A" 226 "Modeline indicator for geiser-autodoc-mode") 227 228 (define-minor-mode geiser-autodoc-mode 229 "Toggle Geiser's Autodoc mode. 230 With no argument, this command toggles the mode. 231 Non-null prefix argument turns on the mode. 232 Null prefix argument turns off the mode. 233 234 When Autodoc mode is enabled, a synopsis of the word at point is 235 displayed in the minibuffer." 236 :init-value nil 237 :lighter geiser-autodoc-mode-string 238 :group 'geiser-autodoc 239 240 (if (boundp 'eldoc-documentation-functions) 241 (if geiser-autodoc-mode 242 (add-hook 'eldoc-documentation-functions 243 #'geiser-autodoc--eldoc-function nil t) 244 (remove-hook 'eldoc-documentation-functions 245 #'geiser-autodoc--eldoc-function t)) 246 (set (make-local-variable 'eldoc-documentation-function) 247 (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function))) 248 (set (make-local-variable 'eldoc-minor-mode-string) nil) 249 (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay) 250 (eldoc-mode (if geiser-autodoc-mode 1 -1)) 251 (when (called-interactively-p nil) 252 (message "Geiser Autodoc %s" 253 (if geiser-autodoc-mode "enabled" "disabled")))) 254 255 256 (provide 'geiser-autodoc)