summaryrefslogtreecommitdiff
path: root/elisp/geiser-doc.el
diff options
context:
space:
mode:
Diffstat (limited to 'elisp/geiser-doc.el')
-rw-r--r--elisp/geiser-doc.el101
1 files changed, 80 insertions, 21 deletions
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index ef20938..f6ef1e2 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -11,6 +11,7 @@
+(require 'geiser-edit)
(require 'geiser-impl)
(require 'geiser-completion)
(require 'geiser-autodoc)
@@ -35,6 +36,9 @@
(geiser-custom--defface doc-link
'link geiser-doc "links in documentation buffers")
+(geiser-custom--defface doc-button
+ 'button geiser-doc "buttons in documentation buffers")
+
;;; Documentation browser history:
@@ -49,22 +53,30 @@
(car geiser-doc--history))
(defun geiser-doc--history-push (link)
- (unless (or (null link) (equal link (car geiser-doc--history)))
- (let ((next (geiser-doc--history-next)))
- (unless (equal link next)
- (when next (geiser-doc--history-previous))
- (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history))
- (setcar geiser-doc--history link))))
+ (unless (or (null link) (equal link (geiser-doc--history-current)))
+ (when (not (null (geiser-doc--history-current)))
+ (let ((next (geiser-doc--history-next)))
+ (unless (equal link next)
+ (when next (geiser-doc--history-previous))
+ (ring-insert (nth 1 geiser-doc--history)
+ (car geiser-doc--history)))))
+ (setcar geiser-doc--history link))
link)
+(defsubst geiser-doc--history-next-p ()
+ (not (ring-empty-p (nth 2 geiser-doc--history))))
+
(defun geiser-doc--history-next (&optional forget-current)
- (when (not (ring-empty-p (nth 2 geiser-doc--history)))
+ (when (geiser-doc--history-next-p)
(when (and (car geiser-doc--history) (not forget-current))
(ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history)))
(setcar geiser-doc--history (ring-remove (nth 2 geiser-doc--history) 0))))
+(defsubst geiser-doc--history-previous-p ()
+ (not (ring-empty-p (nth 1 geiser-doc--history))))
+
(defun geiser-doc--history-previous (&optional forget-current)
- (when (not (ring-empty-p (nth 1 geiser-doc--history)))
+ (when (geiser-doc--history-previous-p)
(when (and (car geiser-doc--history) (not forget-current))
(ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history)))
(setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0))))
@@ -97,6 +109,12 @@
(geiser-doc-module module impl)
(geiser-doc-symbol target module impl))))))
+(make-variable-buffer-local
+ (defvar geiser-doc--buffer-link nil))
+
+(defsubst geiser-doc--implementation ()
+ (geiser-doc--link-impl geiser-doc--buffer-link))
+
(defun geiser-doc--button-action (button)
(let ((link (button-get button 'geiser-link)))
(when link (geiser-doc--follow-link link))))
@@ -117,10 +135,48 @@
'geiser-link link
'help-echo help)))
+(defun geiser-doc--xbutton-action (button)
+ (when geiser-doc--buffer-link
+ (let ((kind (or (button-get button 'x-kind) 'source))
+ (target (geiser-doc--link-target geiser-doc--buffer-link))
+ (module (geiser-doc--link-module geiser-doc--buffer-link))
+ (impl (geiser-doc--link-impl geiser-doc--buffer-link)))
+ (with--geiser-implementation impl
+ (if (eq kind 'source)
+ (if target (geiser-edit-symbol target nil (point-marker))
+ (geiser-edit-module module)))))))
+
+(define-button-type 'geiser-doc--xbutton
+ 'action 'geiser-doc--xbutton-action
+ 'face 'geiser-font-lock-doc-button
+ 'follow-link t)
+
+(defun geiser-doc--insert-xbutton (&optional manual)
+ (insert-text-button (if manual "[manual]" "[source]")
+ :type 'geiser-doc--xbutton
+ 'x-kind (if manual 'manual 'source)))
+
+(defun geiser-doc--insert-xbuttons ()
+ (geiser-doc--insert-xbutton))
+
+(defun geiser-doc--insert-footer ()
+ (newline)
+ (when (geiser-doc--history-previous-p)
+ (insert-text-button "[back]"
+ 'action '(lambda (b) (geiser-doc-previous))
+ 'face 'geiser-font-lock-doc-button
+ 'follow-link t)
+ (insert " "))
+ (when (geiser-doc--history-next-p)
+ (insert-text-button "[forward]"
+ 'action '(lambda (b) (geiser-doc-next))
+ 'face 'geiser-font-lock-doc-button
+ 'follow-link t)))
+
;;; Auxiliary functions:
-(defun geiser-doc--insert-title (title)
+(defun geiser-doc--insert-title (title &optional top)
(let ((p (point)))
(if (not (listp title))
(insert (format "%s" title))
@@ -129,6 +185,12 @@
(insert " " (if (eq a '\#:rest) "." (format "%s" a))))
(insert ")"))
(put-text-property p (point) 'face 'geiser-font-lock-doc-title)
+ (when top
+ (let ((len (max 1 (- (window-width)
+ (- (point) (line-beginning-position))
+ 10))))
+ (insert (make-string len ?\ ))
+ (geiser-doc--insert-xbuttons)))
(newline)))
(defun geiser-doc--insert-list (title lst module impl)
@@ -143,12 +205,6 @@
(newline))
(newline)))
-(make-variable-buffer-local
- (defvar geiser-doc--buffer-link nil))
-
-(defsubst geiser-doc--implementation ()
- (geiser-doc--link-impl geiser-doc--buffer-link))
-
;;; Commands:
@@ -178,13 +234,15 @@ help (e.g. browse an HTML page) implementing this method.")
(erase-buffer)
(geiser-doc--insert-title
(geiser-autodoc--str (list (symbol-name symbol) 0)
- (cdr (assoc 'signature ds))))
+ (cdr (assoc 'signature ds)))
+ t)
(newline)
(insert (or (cdr (assoc 'docstring ds)) ""))
- (goto-char (point-min))
(setq geiser-doc--buffer-link
(geiser-doc--history-push
- (geiser-doc--make-link symbol module impl))))
+ (geiser-doc--make-link symbol module impl)))
+ (geiser-doc--insert-footer)
+ (goto-char (point-min)))
(geiser-doc--pop-to-buffer))))))
(defun geiser-doc-symbol-at-point (&optional arg)
@@ -207,7 +265,7 @@ With prefix argument, ask for symbol (with completion)."
(message "No information available for %s" module)
(geiser-doc--with-buffer
(erase-buffer)
- (geiser-doc--insert-title (format "%s" module))
+ (geiser-doc--insert-title (format "%s" module) t)
(newline)
(dolist (g '(("Procedures:" . procs)
("Variables:" . vars)
@@ -220,10 +278,11 @@ With prefix argument, ask for symbol (with completion)."
(cdr (assoc 'modules exports))
nil
impl)
- (goto-char (point-min))
(setq geiser-doc--buffer-link
(geiser-doc--history-push
- (geiser-doc--make-link nil module impl))))
+ (geiser-doc--make-link nil module impl)))
+ (geiser-doc--insert-footer)
+ (goto-char (point-min)))
(geiser-doc--pop-to-buffer))))
(defun geiser-doc-next (&optional forget-current)