elisp/geiser-autodoc.el

   1 ;; geiser-autodoc.el -- autodoc mode
   2
   3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
   4
   5 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
   6 ;; Start date: Sun Feb 08, 2009 19:44
   7
   8 ;; This file is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This file is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Comentary:
  22
  23 ;; A minor mode that echoes information about procedures and variables
  24 ;; near point at the minibuffer.
  25
  26 ;;; Code:
  27
  28 (require 'geiser-eval)
  29 (require 'geiser-syntax)
  30 (require 'geiser-custom)
  31 (require 'geiser-base)
  32
  33 (require 'eldoc)
  34
  35 \f
  36 ;;; Customization:
  37
  38 (defgroup geiser-autodoc nil
  39   "Options for displaying autodoc strings in the echo area."
  40   :group 'geiser)
  41
  42 (geiser-custom--defface autodoc-current-arg
  43   'bold geiser-autodoc "highlighting current argument in autodoc messages")
  44
  45 (geiser-custom--defface autodoc-procedure-name
  46   'font-lock-function-name-face
  47   geiser-autodoc "highlighting procedure name in autodoc messages")
  48
  49 (defcustom geiser-autodoc-delay 0.3
  50   "Delay before autodoc messages are fetched and displayed, in seconds."
  51   :type 'number
  52   :group 'geiser-autodoc)
  53
  54 (defcustom geiser-autodoc-display-module-p t
  55   "Whether to display procedure module in autodoc strings."
  56   :type 'boolean
  57   :group 'geiser-autodoc)
  58
  59 (defcustom geiser-autodoc-procedure-name-format "%s:%s"
  60   "Format for displaying module and procedure name, in that order,
  61 when `geiser-autodoc-display-module-p' is on."
  62   :type 'string
  63   :group 'geiser-autodoc)
  64
  65 \f
  66 ;;; Procedure arguments:
  67
  68 (make-variable-buffer-local
  69  (defvar geiser-autodoc--cached-signatures nil))
  70
  71 (defun geiser-autodoc--get-signatures (funs &optional keep-cached)
  72   (when funs
  73     (let ((fs (assq (car funs) geiser-autodoc--cached-signatures)))
  74       (unless fs
  75         (let ((missing) (cached))
  76           (if (not geiser-autodoc--cached-signatures)
  77               (setq missing funs)
  78             (dolist (f funs)
  79               (let ((cf (assq f geiser-autodoc--cached-signatures)))
  80                 (if cf (push cf cached)
  81                   (push f missing)))))
  82           (unless (or cached keep-cached)
  83             (setq geiser-autodoc--cached-signatures nil))
  84           (when missing
  85             (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc)
  86                                                           (quote ,missing)))
  87                                                  500)))
  88               (when res
  89                 (setq geiser-autodoc--cached-signatures
  90                       (append res (if keep-cached
  91                                       geiser-autodoc--cached-signatures
  92                                     cached))))))))
  93       geiser-autodoc--cached-signatures)))
  94
  95 (defun geiser-autodoc--insert-args (args current &optional pos)
  96   (dolist (a args)
  97     (let ((p (point)))
  98       (insert (format "%s" a))
  99       (when (or (and (numberp pos)
 100                      (numberp current)
 101                      (setq current (1+ current))
 102                      (= (1+ pos) current))
 103                 (and (symbolp current)
 104                      (listp a)
 105                      (eq current (car a))))
 106         (put-text-property p (point) 'face 'geiser-font-lock-autodoc-current-arg)
 107         (setq pos nil current nil)))
 108     (insert " "))
 109   (when args (backward-char))
 110   current)
 111
 112 (defsubst geiser-autodoc--proc-name (proc module)
 113   (let ((str (if module
 114                  (format geiser-autodoc-procedure-name-format module proc)
 115                proc)))
 116     (propertize str 'face 'geiser-font-lock-autodoc-procedure-name)))
 117
 118 (defun geiser-autodoc--str (desc signature)
 119   (let ((proc (car desc))
 120         (args (cdr (assoc 'args signature)))
 121         (module (cdr (assoc 'module signature))))
 122     (if (not args) (geiser-autodoc--proc-name proc module)
 123       (let ((cpos 1)
 124             (pos (or (cadr desc) 0))
 125             (prev (caddr desc))
 126             (reqs (cdr (assoc 'required args)))
 127             (opts (cdr (assoc 'optional args)))
 128             (keys (cdr (assoc 'key args))))
 129         (save-current-buffer
 130           (set-buffer (geiser-syntax--font-lock-buffer))
 131           (erase-buffer)
 132           (insert (format "(%s" (geiser-autodoc--proc-name proc module)))
 133           (when reqs
 134             (insert " ")
 135             (setq cpos
 136                   (geiser-autodoc--insert-args reqs
 137                                                cpos
 138                                                (and (not (zerop pos)) pos))))
 139           (when opts
 140             (insert " [")
 141             (setq cpos (geiser-autodoc--insert-args opts cpos pos))
 142             (when keys
 143               (insert " [")
 144               (geiser-autodoc--insert-args keys prev nil)
 145               (insert "]"))
 146             (insert "]"))
 147           (insert ")")
 148           (buffer-string))))))
 149
 150 (defun geiser-autodoc--autodoc (path &optional keep-cached)
 151   (let ((signs (geiser-autodoc--get-signatures (mapcar 'car path) keep-cached))
 152         (p (car path))
 153         (s))
 154     (while (and path (not s))
 155       (unless (setq s (cdr (assq (car p) signs)))
 156         (setq p (car path))
 157         (setq path (cdr path))))
 158     (when s (geiser-autodoc--str p s))))
 159
 160 \f
 161 ;;; Autodoc function:
 162
 163 (make-variable-buffer-local
 164  (defvar geiser-autodoc--inhibit-flag nil))
 165
 166 (defun geiser-autodoc--eldoc-function ()
 167   (condition-case e
 168       (and (not geiser-autodoc--inhibit-flag)
 169            (geiser-autodoc--autodoc (geiser-syntax--scan-sexps)))
 170     (error (format "Autodoc not available (%s)" (error-message-string e)))))
 171
 172 \f
 173 ;;; Autodoc mode:
 174
 175 (make-variable-buffer-local
 176  (defvar geiser-autodoc-mode-string " A"
 177    "Modeline indicator for geiser-autodoc-mode"))
 178
 179 (define-minor-mode geiser-autodoc-mode
 180   "Toggle Geiser's Autodoc mode.
 181 With no argument, this command toggles the mode.
 182 Non-null prefix argument turns on the mode.
 183 Null prefix argument turns off the mode.
 184
 185 When Autodoc mode is enabled, a synopsis of the word at point is
 186 displayed in the minibuffer."
 187   :init-value nil
 188   :lighter geiser-autodoc-mode-string
 189   :group 'geiser-autodoc
 190
 191   (set (make-local-variable 'eldoc-documentation-function)
 192        (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function))
 193   (set (make-local-variable 'eldoc-minor-mode-string) nil)
 194   (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay)
 195   (eldoc-mode geiser-autodoc-mode)
 196   (message "Geiser Autodoc %s" (if geiser-autodoc-mode "enabled" "disabled")))
 197
 198 \f
 199 (provide 'geiser-autodoc)
 200 ;;; geiser-autodoc.el ends here