(require 'slime)
|
|
(require 'url-http)
|
|
(require 'browse-url)
|
|
(eval-when-compile (require 'cl)) ; lexical-let
|
|
|
|
(defvar slime-old-documentation-lookup-function
|
|
slime-documentation-lookup-function)
|
|
|
|
(define-slime-contrib slime-hyperdoc
|
|
"Extensible C-c C-d h."
|
|
(:authors "Tobias C Rittweiler <tcr@freebits.de>")
|
|
(:license "GPL")
|
|
(:swank-dependencies swank-hyperdoc)
|
|
(:on-load
|
|
(setq slime-documentation-lookup-function 'slime-hyperdoc-lookup))
|
|
(:on-unload
|
|
(setq slime-documentation-lookup-function
|
|
slime-old-documentation-lookup-function)))
|
|
|
|
;;; TODO: `url-http-file-exists-p' is slow, make it optional behaviour.
|
|
|
|
(defun slime-hyperdoc-lookup-rpc (symbol-name)
|
|
(slime-eval-async `(swank:hyperdoc ,symbol-name)
|
|
(lexical-let ((symbol-name symbol-name))
|
|
#'(lambda (result)
|
|
(slime-log-event result)
|
|
(cl-loop with foundp = nil
|
|
for (doc-type . url) in result do
|
|
(when (and url (stringp url)
|
|
(let ((url-show-status nil))
|
|
(url-http-file-exists-p url)))
|
|
(message "Visiting documentation for %s `%s'..."
|
|
(substring (symbol-name doc-type) 1)
|
|
symbol-name)
|
|
(browse-url url)
|
|
(setq foundp t))
|
|
finally
|
|
(unless foundp
|
|
(error "Could not find documentation for `%s'."
|
|
symbol-name)))))))
|
|
|
|
(defun slime-hyperdoc-lookup (symbol-name)
|
|
(interactive (list (slime-read-symbol-name "Symbol: ")))
|
|
(if (memq :hyperdoc (slime-lisp-features))
|
|
(slime-hyperdoc-lookup-rpc symbol-name)
|
|
(slime-hyperspec-lookup symbol-name)))
|
|
|
|
(provide 'slime-hyperdoc)
|