summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-12 00:03:28 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-06-12 00:03:28 +0200
commit31df91e17edf9e8eea742b5a6f674a20868ec827 (patch)
tree29737fd3d078dd9d761743c1ac572764a916dcd3 /elisp
parent4428e92f1ea97ac1443740c97e0ad8db6d0259fa (diff)
downloadgeiser-chez-31df91e17edf9e8eea742b5a6f674a20868ec827.tar.gz
geiser-chez-31df91e17edf9e8eea742b5a6f674a20868ec827.tar.bz2
New buttons (source, forward/backward) in document browser.
Diffstat (limited to 'elisp')
-rw-r--r--elisp/geiser-doc.el101
-rw-r--r--elisp/geiser-edit.el5
-rw-r--r--elisp/geiser-reload.el4
-rw-r--r--elisp/geiser-syntax.el32
4 files changed, 102 insertions, 40 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)
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index 7a62a5c..8d25133 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -145,14 +145,15 @@ or following links in error buffers.")
(defvar geiser-edit--symbol-history nil)
-(defun geiser-edit-symbol (symbol &optional method)
+(defun geiser-edit-symbol (symbol &optional method marker)
"Asks for a symbol to edit, with completion."
(interactive
(list (geiser-completion--read-symbol "Edit symbol: "
nil
geiser-edit--symbol-history)))
(let ((cmd `(:eval ((:ge symbol-location) ',symbol))))
- (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method)))
+ (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method)
+ (when marker (ring-insert find-tag-marker-ring marker))))
(defun geiser-edit-symbol-at-point (&optional arg)
"Opens a new window visiting the definition of the symbol at point.
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
index d9ba4d2..f01cacf 100644
--- a/elisp/geiser-reload.el
+++ b/elisp/geiser-reload.el
@@ -1,6 +1,6 @@
;; geiser-reload.el -- unload/load geiser packages
-;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the Modified BSD License. You should
@@ -25,11 +25,11 @@
geiser-mode
geiser-repl
geiser-xref
- geiser-edit
geiser-doc
geiser-debug
geiser-impl
geiser-company
+ geiser-edit
geiser-completion
geiser-autodoc
geiser-compile
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index e0d9634..040e122 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -205,23 +205,25 @@
(defsubst geiser-syntax--pair-length (p)
(if (cdr (last p)) (1+ (safe-length p)) (length p)))
-(defun geiser-syntax--scan-sexps ()
+(defun geiser-syntax--scan-sexps (&optional begin)
(let ((path))
(save-excursion
- (geiser-syntax--skip-comment/string)
- (while (not (zerop (geiser-syntax--nesting-level)))
- (let ((boundary (1+ (point))))
- (backward-up-list)
- (let ((form
- (nth-value 0 (geiser-syntax--form-after-point boundary))))
- (when (and (listp form) (car form) (symbolp (car form)))
- (let* ((len-1 (1- (geiser-syntax--pair-length form)))
- (prev (and (> len-1 1) (nth (1- len-1) form)))
- (prev (and (keywordp prev) (list prev))))
- (push `(,(car form) ,len-1 ,@prev) path)))))))
- (if path (nreverse path)
- (let ((fst (symbol-at-point)))
- (and fst `((,fst 0)))))))
+ (save-restriction
+ (narrow-to-region (or begin (point-min)) (1+ (point)))
+ (geiser-syntax--skip-comment/string)
+ (while (not (zerop (geiser-syntax--nesting-level)))
+ (let ((boundary (1+ (point))))
+ (backward-up-list)
+ (let ((form
+ (nth-value 0 (geiser-syntax--form-after-point boundary))))
+ (when (and (listp form) (car form) (symbolp (car form)))
+ (let* ((len-1 (1- (geiser-syntax--pair-length form)))
+ (prev (and (> len-1 1) (nth (1- len-1) form)))
+ (prev (and (keywordp prev) (list prev))))
+ (push `(,(car form) ,len-1 ,@prev) path))))))
+ (if path (nreverse path)
+ (let ((fst (symbol-at-point)))
+ (and fst `((,fst 0)))))))))
(defsubst geiser-syntax--binding-form-p (bfs sbfs f)
(or (memq f '(define define* lambda let let* letrec))