diff options
| -rw-r--r-- | elisp/geiser-doc.el | 101 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 5 | ||||
| -rw-r--r-- | elisp/geiser-reload.el | 4 | ||||
| -rw-r--r-- | elisp/geiser-syntax.el | 32 |
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)) |