elisp/geiser-autodoc.el

   1 ;; geiser-autodoc.el -- autodoc mode
   2
   3 ;; Copyright (C) 2009, 2010 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 \f
  13
  14 (require 'geiser-eval)
  15 (require 'geiser-syntax)
  16 (require 'geiser-custom)
  17 (require 'geiser-base)
  18
  19 (require 'eldoc)
  20
  21 \f
  22 ;;; Customization:
  23
  24 (defgroup geiser-autodoc nil
  25   "Options for displaying autodoc strings in the echo area."
  26   :group 'geiser)
  27
  28 (geiser-custom--defface autodoc-current-arg
  29   'bold geiser-autodoc "highlighting current argument in autodoc messages")
  30
  31 (geiser-custom--defface autodoc-identifier
  32   'font-lock-function-name-face
  33   geiser-autodoc "highlighting procedure name in autodoc messages")
  34
  35 (geiser-custom--defcustom geiser-autodoc-delay 0.3
  36   "Delay before autodoc messages are fetched and displayed, in seconds."
  37   :type 'number
  38   :group 'geiser-autodoc)
  39
  40 (geiser-custom--defcustom geiser-autodoc-display-module-p t
  41   "Whether to display procedure module in autodoc strings."
  42   :type 'boolean
  43   :group 'geiser-autodoc)
  44
  45 (geiser-custom--defcustom geiser-autodoc-identifier-format "%s:%s"
  46   "Format for displaying module and procedure or variable name, in that order,
  47 when `geiser-autodoc-display-module-p' is on."
  48   :type 'string
  49   :group 'geiser-autodoc)
  50
  51 \f
  52 ;;; Procedure arguments:
  53
  54 (make-variable-buffer-local
  55  (defvar geiser-autodoc--cached-signatures nil))
  56
  57 (defsubst geiser-autodoc--clean-cache ()
  58   (setq geiser-autodoc--cached-signatures nil))
  59
  60 (defun geiser-autodoc--get-signatures (funs &optional keep-cached)
  61   (when funs
  62     (let ((fs (assq (car funs) geiser-autodoc--cached-signatures)))
  63       (unless fs
  64         (let ((missing) (cached))
  65           (if (not geiser-autodoc--cached-signatures)
  66               (setq missing funs)
  67             (dolist (f funs)
  68               (let ((cf (assq f geiser-autodoc--cached-signatures)))
  69                 (if cf (push cf cached)
  70                   (push f missing)))))
  71           (unless (or cached keep-cached) (geiser-autodoc--clean-cache))
  72           (when missing
  73             (let ((res (geiser-eval--send/result `(:eval (:ge autodoc
  74                                                           (quote ,missing)))
  75                                                  500)))
  76               (when res
  77                 (setq geiser-autodoc--cached-signatures
  78                       (append res (if keep-cached
  79                                       geiser-autodoc--cached-signatures
  80                                     cached))))))))
  81       geiser-autodoc--cached-signatures)))
  82
  83 (defun geiser-autodoc--sanitize-args (args)
  84   (cond ((null args) nil)
  85         ((listp args)
  86          (cons (car args) (geiser-autodoc--sanitize-args (cdr args))))
  87         (t '(...))))
  88
  89 (defun geiser-autodoc--insert-arg-group (args current &optional pos)
  90   (dolist (a (geiser-autodoc--sanitize-args args))
  91     (let ((p (point)))
  92       (insert (format "%s" a))
  93       (when (or (and (numberp pos)
  94                      (numberp current)
  95                      (setq current (1+ current))
  96                      (= (1+ pos) current))
  97                 (and (keywordp current)
  98                      (listp a)
  99                      (eq current (car a))))
 100         (put-text-property p (point)
 101                            'face 'geiser-font-lock-autodoc-current-arg)
 102         (setq pos nil current nil)))
 103     (insert " "))
 104   (when args (backward-char))
 105   current)
 106
 107 (defun geiser-autodoc--insert-args (args pos prev)
 108   (let ((cpos 1)
 109         (reqs (cdr (assoc 'required args)))
 110         (opts (cdr (assoc 'optional args)))
 111         (keys (cdr (assoc 'key args))))
 112     (when reqs
 113       (insert " ")
 114       (setq cpos
 115             (geiser-autodoc--insert-arg-group reqs
 116                                               cpos
 117                                               (and (not (zerop pos)) pos))))
 118     (when opts
 119       (insert " [")
 120       (setq cpos (geiser-autodoc--insert-arg-group opts cpos pos)))
 121     (when keys
 122       (insert " [")
 123       (geiser-autodoc--insert-arg-group keys prev nil)
 124       (insert "]"))
 125     (when opts (insert "]"))))
 126
 127 (defsubst geiser-autodoc--id-name (proc module)
 128   (let ((str (if module
 129                  (format geiser-autodoc-identifier-format module proc)
 130                (format "%s" proc))))
 131     (propertize str 'face 'geiser-font-lock-autodoc-identifier)))
 132
 133 (defun geiser-autodoc--str* (full-signature)
 134   (geiser-autodoc--str (list (car full-signature)) full-signature))
 135
 136 (defsubst geiser-autodoc--value-str (proc module value)
 137   (let ((name (geiser-autodoc--id-name proc module)))
 138     (if value (format "%s => %s" name value) name)))
 139
 140 (defun geiser-autodoc--str (desc signature)
 141   (let ((proc (car desc))
 142         (args (cdr (assoc 'args signature)))
 143         (module (cdr (assoc 'module signature))))
 144     (if (not args)
 145       (geiser-autodoc--value-str proc module (cdr (assoc 'value signature)))
 146       (save-current-buffer
 147         (set-buffer (geiser-syntax--font-lock-buffer))
 148         (erase-buffer)
 149         (insert (format "(%s" (geiser-autodoc--id-name proc module)))
 150         (let ((pos (or (cadr desc) 0))
 151               (prev (car (cddr desc))))
 152           (dolist (a args)
 153             (when (not (member a (cdr (member a args))))
 154               (geiser-autodoc--insert-args a pos prev)
 155               (insert " |"))))
 156         (delete-char -2)
 157         (insert ")")
 158         (buffer-string)))))
 159
 160 (defun geiser-autodoc--autodoc (path &optional keep-cached)
 161   (let ((signs (geiser-autodoc--get-signatures (mapcar 'car path)
 162                                                keep-cached))
 163         (p (car path))
 164         (s))
 165     (while (and p (not s))
 166       (unless (setq s (cdr (assq (car p) signs)))
 167         (setq p (car path))
 168         (setq path (cdr path))))
 169     (when s (geiser-autodoc--str p s))))
 170
 171 \f
 172 ;;; Autodoc function:
 173
 174 (make-variable-buffer-local
 175  (defvar geiser-autodoc--inhibit-function nil))
 176
 177 (defsubst geiser-autodoc--inhibit ()
 178   (and geiser-autodoc--inhibit-function
 179        (funcall geiser-autodoc--inhibit-function)))
 180
 181 (defun geiser-autodoc--eldoc-function ()
 182   (condition-case e
 183       (and (not (geiser-autodoc--inhibit))
 184            (geiser-autodoc--autodoc (geiser-syntax--scan-sexps)))
 185     (error (format "Autodoc not available (%s)" (error-message-string e)))))
 186
 187 \f
 188 ;;; Autodoc mode:
 189
 190 (make-variable-buffer-local
 191  (defvar geiser-autodoc-mode-string " A"
 192    "Modeline indicator for geiser-autodoc-mode"))
 193
 194 (define-minor-mode geiser-autodoc-mode
 195   "Toggle Geiser's Autodoc mode.
 196 With no argument, this command toggles the mode.
 197 Non-null prefix argument turns on the mode.
 198 Null prefix argument turns off the mode.
 199
 200 When Autodoc mode is enabled, a synopsis of the word at point is
 201 displayed in the minibuffer."
 202   :init-value nil
 203   :lighter geiser-autodoc-mode-string
 204   :group 'geiser-autodoc
 205
 206   (set (make-local-variable 'eldoc-documentation-function)
 207        (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function))
 208   (set (make-local-variable 'eldoc-minor-mode-string) nil)
 209   (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay)
 210   (eldoc-mode geiser-autodoc-mode)
 211   (message "Geiser Autodoc %s" (if geiser-autodoc-mode "enabled" "disabled")))
 212
 213 \f
 214 (provide 'geiser-autodoc)
 215 ;;; geiser-autodoc.el ends here