texi-docstring-magic/texi-docstring-magic-geiser.el

;; texi-docstring-magic-geiser.el --- geiser docstrins to texi -*- lexical-binding: t; -*-
;;
;; Copyright (C) 1998 David Aspinall
;; Copyright (C) 2018 Jelle Licht <jlicht@fsfe.org>

;; Author: Jelle Licht <jlicht@fsfe.org>
;; URL: https://github.com/emacs-evil/evil-collection
;; Package-Requires: ((emacs "25.2") (geiser "0.10"))
;; Keywords: geiser, docstring

(require 'texi-docstring-magic)
(require 'geiser-doc)
(require 'geiser-repl)
(require 'geiser-impl)

;; 
;; (defun geiser-repl--connection ()
;;   (or (geiser-repl--connection*)
;;       (error "No Geiser REPL for this buffer (try M-x run-geiser)")))

(defconst texi-docstring-magic-comment-geiser
  "@c TEXI DOCSTRING MAGIC:GEISER:"
  "Magic string in a texi buffer expanded into @deffn.")

(defconst texi-docstring-magic-comment-geiser-impl
  "\\(\\w+\\):")

(defun unwrap (geiser-result)
  (pcase geiser-result
    (`"#<unspecified>" nil)
    (`(("signature" ,_ ("args" ,arglist))
       ("docstring" . ,docstring))
     (list arglist docstring))
    (_ nil)))

(defvar geiser-buffer-curr nil)

;;;###autoload
(defun get-geiser-buffer (&optional ask impl)
  "Retrieve running or new Geiser REPL.

With prefix argument, ask for which one if more than one is running.
If no REPL is running, execute `run-geiser' to start a fresh one."
  (interactive "P")
  (let* ((impl (or impl geiser-impl--implementation))
         (in-repl (eq major-mode 'geiser-repl-mode))
         (in-live-repl (and in-repl (get-buffer-process (current-buffer))))
         (repl (unless ask
                 (if impl
                     (geiser-repl--repl/impl impl)
                   (or geiser-repl--repl (car geiser-repl--repls))))))
    (cond (in-live-repl
           (current-buffer))
          (repl
           repl)
          (impl (run-geiser impl))
          (t (call-interactively 'run-geiser))
          )))

;;;###autoload
(defun geiser/register-buffer ()
  (interactive)
  (setq geiser-buffer-curr
        (or (get-geiser-buffer)
            (current-buffer))))

(defun texi-docstring-magic-geiser-def (symbol)
  (when geiser-buffer-curr
    (with-current-buffer geiser-buffer-curr
      (let ((x (geiser-doc--get-docstring symbol 'guile)))
        (unwrap x)))))

(defun geiser/def->docstring (def)
  (pcase def
    (`(,arglist ,(and (pred stringp) docstring)) docstring)
    (_ nil)))

(defun geiser/def->argsyms (def)
  (pcase def
    (`(,arglist ,_ )
     (apply #'append (mapcar 'cdr arglist)))
    (_ nil)))

(defun wrap-arg (arg)
  arg
  ;; (concat "@var{" arg "}")
  )

(defun texi-docstring-magic-texi-geiser (symbol impl &optional noerror)
  (let* ((function  symbol)
         (name      (symbol-name function))
         (def       (texi-docstring-magic-geiser-def function))
         (docstring (or (geiser/def->docstring def)
                        "Not documented."))
         (argsyms   (geiser/def->argsyms def))
         (args      (mapcar #'symbol-name argsyms)))
    (texi-docstring-magic-texi "fn" "{Scheme Procedure}" name docstring (mapcar 'wrap-arg args))))

;; @c GEISER TEXI DOCSTRING MAGIC: gt
;;;###autoload
(defun texi-docstring-magic-geiser (&optional noerror)
  "Update all texi docstring magic annotations in buffer.
With prefix arg, no errors on unknown symbols.  (This results in
@def .. @end being deleted if not known)."
  (interactive "P")
  (save-excursion
    (goto-char (point-min))
    (let ((magic (concat "^"
                         (regexp-quote texi-docstring-magic-comment-geiser)
                         texi-docstring-magic-comment-geiser-impl      
                         "\\s-*\\(\\(\\w\\|\\-\\)+\\)[ \t]*$"))
          p
          symbol
          impl
          deleted)
      (while (re-search-forward magic nil t)
        (setq impl (intern (match-string 1)))
        (setq symbol (intern (match-string 2)))
        (forward-line)
        (setq p (point))
        ;; delete any whitespace following magic comment
        (skip-chars-forward " \n\t")
        (delete-region p (point))
        ;; If comment already followed by an environment, delete it.
        (if (and
             (looking-at "@def\\(\\w+\\)\\s-")
             (search-forward (concat "@end def" (match-string 1)) nil t))
            (progn
              (forward-line)
              (delete-region p (point))
              (setq deleted t)))
        (insert
         (texi-docstring-magic-texi-geiser symbol impl noerror))
        (unless deleted
          ;; Follow newly inserted @def with a single blank.
          (insert "\n"))))))

(provide 'texi-docstring-magic-geiser)