diff options
Diffstat (limited to 'elisp')
| -rw-r--r-- | elisp/geiser-completion.el | 12 | ||||
| -rw-r--r-- | elisp/geiser-doc.el | 69 | ||||
| -rw-r--r-- | elisp/geiser-edit.el | 2 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 39 | ||||
| -rw-r--r-- | elisp/geiser-impl.el | 176 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 12 | ||||
| -rw-r--r-- | elisp/geiser-popup.el | 14 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 7 | ||||
| -rw-r--r-- | elisp/geiser.el | 15 |
9 files changed, 285 insertions, 61 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index e2569eb..d2991b2 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -181,11 +181,13 @@ terminates a current completion." (defun geiser-completion--read-module (&optional prompt default history) (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map)) - (completing-read (or prompt "Module name: ") - (geiser-completion--module-list) - nil nil - (or default (format "%s" (or (geiser-syntax--buffer-module) "("))) - (or history geiser-completion--module-history)))) + (geiser-eval--get-module + (completing-read (or prompt "Module name: ") + (geiser-completion--module-list) + nil nil + (or default + (format "%s" (or (geiser-syntax--buffer-module) "("))) + (or history geiser-completion--module-history))))) (defun geiser--respecting-message (format &rest format-args) "Display TEXT as a message, without hiding any minibuffer contents." diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 6d2eb40..af1e402 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -60,7 +60,7 @@ (car geiser-doc--history)) (defun geiser-doc--history-push (link) - (unless (equal link (car geiser-doc--history)) + (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)) @@ -80,13 +80,14 @@ (ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history))) (setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0)))) -(defvar geiser-doc--history (geiser-doc--make-history)) +(defvar geiser-doc--history nil) +(setq geiser-doc--history (geiser-doc--make-history)) ;;; Links -(defsubst geiser-doc--make-link (target module) - (list target module)) +(defsubst geiser-doc--make-link (target module impl) + (list target module impl)) (defsubst geiser-doc--link-target (link) (nth 0 link)) @@ -94,13 +95,19 @@ (defsubst geiser-doc--link-module (link) (nth 1 link)) +(defsubst geiser-doc--link-impl (link) + (nth 2 link)) + (defun geiser-doc--follow-link (link) (let ((target (geiser-doc--link-target link)) - (module (geiser-doc--link-module link))) - (when target - (if (symbolp target) - (geiser-doc-symbol target module) - (geiser-doc-module (format "%s" target)))))) + (module (geiser-doc--link-module link)) + (impl (or (geiser-doc--link-impl link) + (geiser-impl--default-implementation)))) + (when (and (or target module) impl) + (with--geiser-implementation impl + `(lambda () (if (null ',target) + (geiser-doc-module ',module ',impl) + (geiser-doc-symbol ',target ',module ',impl))))))) (defun geiser-doc--button-action (button) (let ((link (button-get button 'geiser-link))) @@ -111,8 +118,8 @@ 'face 'geiser-font-lock-doc-link 'follow-link t) -(defun geiser-doc--insert-button (target module) - (let ((link (geiser-doc--make-link target module)) +(defun geiser-doc--insert-button (target module impl) + (let ((link (geiser-doc--make-link target module impl)) (text (format "%s" target)) (help (if module (format "%s in module %s" target module) ""))) (insert-text-button text @@ -134,13 +141,13 @@ (put-text-property p (point) 'face 'geiser-font-lock-doc-title) (newline))) -(defun geiser-doc--insert-list (title lst module) +(defun geiser-doc--insert-list (title lst module impl) (when lst (geiser-doc--insert-title title) (newline) (dolist (w lst) (insert (format "\t- ")) - (geiser-doc--insert-button w module) + (geiser-doc--insert-button w module impl) (newline)) (newline))) @@ -154,11 +161,11 @@ (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module))) (defun geiser-doc--get-module-children (module) - (geiser-eval--send/result `(:eval ((:ge module-children) (quote (:scm ,module)))))) + (geiser-eval--send/result `(:eval ((:ge module-children) (:module ,module))))) -(defun geiser-doc-symbol (symbol &optional module) - (let* ((module (or module - (geiser-syntax--buffer-module))) +(defun geiser-doc-symbol (symbol &optional module impl) + (let* ((module (or module (geiser-eval--get-module))) + (impl (or impl geiser-impl--implementation)) (ds (geiser-doc--get-docstring symbol module))) (if (or (not ds) (not (listp ds))) (message "No documentation available for '%s'" symbol) @@ -167,9 +174,10 @@ (geiser-doc--insert-title (cdr (assoc 'signature ds))) (newline) (insert (or (cdr (assoc 'docstring ds)) "")) - (goto-line (point-min))) - (setq geiser-doc--buffer-link - (geiser-doc--history-push (geiser-doc--make-link symbol module))) + (goto-line (point-min)) + (setq geiser-doc--buffer-link + (geiser-doc--history-push + (geiser-doc--make-link symbol module impl)))) (geiser-doc--pop-to-buffer)))) (defun geiser-doc-symbol-at-point (&optional arg) @@ -181,11 +189,11 @@ With prefix argument, ask for symbol (with completion)." (when symbol (geiser-doc-symbol symbol)))) -(defun geiser-doc-module (module) +(defun geiser-doc-module (module &optional impl) "Display information about a given module." (interactive (list (geiser-completion--read-module))) (let ((children (geiser-doc--get-module-children module)) - (mod-sym (car (read-from-string module)))) + (impl (or impl geiser-impl--implementation))) (if (not children) (message "No info available for %s" module) (geiser-doc--with-buffer @@ -194,17 +202,19 @@ With prefix argument, ask for symbol (with completion)." (newline) (geiser-doc--insert-list "Procedures:" (cdr (assoc 'procs children)) - mod-sym) + module + impl) (geiser-doc--insert-list "Variables:" (cdr (assoc 'vars children)) - mod-sym) + module + impl) (geiser-doc--insert-list "Submodules:" (cdr (assoc 'modules children)) - mod-sym) - (goto-char (point-min))) - (setq geiser-doc--buffer-link - (geiser-doc--history-push (geiser-doc--make-link (car (read-from-string module)) - nil))) + module + impl) + (goto-char (point-min)) + (setq geiser-doc--buffer-link + (geiser-doc--history-push (geiser-doc--make-link nil module impl)))) (geiser-doc--pop-to-buffer)))) (defun geiser-doc-next (&optional forget-current) @@ -279,6 +289,7 @@ With prefix, the current page is deleted from history." (geiser-popup--define doc "*Geiser documentation*" geiser-doc-mode) + (provide 'geiser-doc) ;;; geiser-doc.el ends here diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index e5c30eb..6938b60 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -127,7 +127,7 @@ With prefix, asks for the symbol to edit." (defun geiser-edit-module (module) "Asks for a module and opens it in a new buffer." (interactive (list (geiser-completion--read-module))) - (let ((cmd `(:eval ((:ge module-location) (quote (:scm ,module)))))) + (let ((cmd `(:eval ((:ge module-location) ,module)))) (geiser-edit--try-edit module (geiser-eval--send/wait cmd)))) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 3e5e7aa..8574cdc 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -34,14 +34,22 @@ ;;; Plug-able functions: (make-variable-buffer-local - (defvar geiser-eval--current-module-function 'geiser-syntax--buffer-module)) + (defvar geiser-eval--get-module-function 'geiser-syntax--buffer-module + "Function used to obtain the module for current buffer. It +takes an optional argument, for cases where we want to force its value.")) -(defsubst geiser-eval--current-module-function (fun) - (setq geiser-eval--current-module-function fun)) +(defsubst geiser-eval--get-module (&optional module) + (and geiser-eval--get-module-function + (funcall geiser-eval--get-module-function module))) -(defsubst geiser-eval--current-module () - (and geiser-eval--current-module-function - (funcall geiser-eval--current-module-function))) +(make-variable-buffer-local + (defvar geiser-eval--geiser-procedure-function nil + "Translate a bare procedure symbol to one executable in Guile's +context. Return NULL for unsupported ones; at the very least, +EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported.")) + +(defsubst geiser-eval--form (proc) + (funcall geiser-eval--geiser-procedure-function proc)) ;;; Code formatting: @@ -64,28 +72,27 @@ (defsubst geiser-eval--eval (code) (geiser-eval--scheme-str - `((@ (geiser emacs) ge:eval) (quote ,(nth 0 code)) (:module ,(nth 1 code))))) + `(,(geiser-eval--form 'eval) (quote ,(nth 0 code)) (:module ,(nth 1 code))))) (defsubst geiser-eval--comp (code) (geiser-eval--scheme-str - `((@ (geiser emacs) ge:compile) (quote ,(nth 0 code)) (:module ,(nth 1 code))))) + `(,(geiser-eval--form 'compile (quote ,(nth 0 code)) (:module ,(nth 1 code)))))) (defsubst geiser-eval--load-file (file) - (geiser-eval--scheme-str `((@ (geiser emacs) ge:load-file) ,file))) + (geiser-eval--scheme-str `(,(geiser-eval--form 'load-file) ,file))) (defsubst geiser-eval--comp-file (file) - (geiser-eval--scheme-str `((@ (geiser emacs) ge:compile-file) ,file))) + (geiser-eval--scheme-str `(,(geiser-eval--form 'compile-file) ,file))) (defsubst geiser-eval--module (code) (geiser-eval--scheme-str - (cond ((or (eq code '(())) (null code)) - `(quote ,(or (geiser-eval--current-module) :f))) - ((listp code) `(quote ,code)) - ((stringp code) (:scm code)) - (t (error "Invalid module spec: %S" code))))) + (cond ((or (null code) (eq code :t) (eq code :buffer)) + (list 'quote (funcall geiser-eval--get-module-function))) + ((or (eq code :repl) (eq code :f)) :f) + (t (list 'quote (funcall geiser-eval--get-module-function code)))))) (defsubst geiser-eval--ge (proc) - (format "(@ (geiser emacs) ge:%s)" proc)) + (geiser-eval--scheme-str (geiser-eval--form proc))) ;;; Code sending: diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el new file mode 100644 index 0000000..741002a --- /dev/null +++ b/elisp/geiser-impl.el @@ -0,0 +1,176 @@ +;; geiser-impl.el -- generic support for scheme implementations + +;; Copyright (C) 2009 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Start date: Sat Mar 07, 2009 23:32 + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3 of the License, or +;; (at your option) any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Comentary: + +;; Functions to handle setup of Scheme implementations supported by +;; Geiser. + +;;; Code: + +(require 'geiser-eval) +(require 'geiser-base) + + +;;; Customization: + +(defgroup geiser-impl nil + "Generic support for multiple Scheme implementations." + :group 'geiser) + +(defcustom geiser-impl-default-implementation 'guile + "Symbol naming the default Scheme implementation." + :type 'symbol + :group 'geiser-impl) + + +;;; Registering implementations: + +(defvar geiser-impl--impls nil) + +(defun geiser-impl--register (impl) + (add-to-list 'geiser-impl--impls impl)) + +(defun geiser-impl--unregister (impl) + (remove impl geiser-impl--impls)) + +(defvar geiser-impl--default-implementation + geiser-impl-default-implementation) + +(defun geiser-impl--default-implementation (&optional new) + (when new (setq geiser-impl--default-implementation new)) + (or geiser-impl--default-implementation + geiser-impl-default-implementation + (car geiser-impl--impls))) + + +;;; Installing Scheme implementations: + +(make-local-variable + (defvar geiser-impl--implementation nil)) + +(defsubst geiser-impl--impl-feature (impl) + (intern (format "geiser-%s" impl))) + +(defun geiser-impl--set-buffer-implementation (&optional impl) + (let ((impl (or impl + (geiser-impl--guess) + (intern (read-string "Scheme implementation: "))))) + (require (geiser-impl--impl-feature impl)) + (setq geiser-impl--implementation impl) + (geiser-impl--install-eval impl) + (geiser-impl--register impl))) + + +(defsubst geiser-impl--sym (imp name) + (intern (format "geiser-%s-%s" imp name))) + +(defsubst geiser-impl--boundp (imp name) + (boundp (geiser-impl--sym imp name))) + +(defsubst geiser-impl--fboundp (imp name) + (fboundp (geiser-impl--sym imp name))) + +(defun geiser-impl--value (imp name &optional fun) + (let ((sym (geiser-impl--sym imp name))) + (unless (or (and (not fun) (boundp sym)) + (and fun (fboundp sym))) + (error "Unbound %s '%s' in Geiser Scheme implementation %s" + (if fun "function" "variable") sym imp)) + (if fun (symbol-function sym) (symbol-value sym)))) + +(defsubst geiser-impl--call-if-bound (imp name &rest args) + (when (geiser-impl--fboundp imp name) + (apply (geiser-impl--value imp name t) args))) + +(defun geiser-impl--install-eval (imp) + (setq geiser-eval--get-module-function + (geiser-impl--sym imp "get-module") + geiser-eval--geiser-procedure-function + (geiser-impl--sym imp "geiser-procedure"))) + + +;;; Evaluating Elisp in a given implementation context: + +(defun with--geiser-implementation (imp thunk) + (let ((geiser-impl--implementation imp) + (geiser-eval--get-module-function + (geiser-impl--sym imp "get-module")) + (geiser-eval--geiser-procedure-function + (geiser-impl--sym imp "geiser-procedure"))) + (funcall thunk))) + +(put 'with--geiser-implementation 'lisp-indent-function 1) + + +;;; Default evaluation environment: + +(defun geiser-impl-module (&optional module) + (geiser-impl--call-if-bound (geiser-impl--default-implementation) + "get-module" + module)) +(set-default 'geiser-eval--get-module-function 'geiser-impl-module) + +(defun geiser-impl-geiser-procedure (proc) + (geiser-impl--call-if-bound (geiser-impl--default-implementation) + "geiser-procedure" + proc)) +(set-default 'geiser-eval--geiser-procedure-function 'geiser-impl-geiser-procedure) + + +;;; Access to implementation specific execution parameters: + +(defsubst geiser-impl--binary (impl) + (or (geiser-impl--call-if-bound impl "binary") + (geiser-impl--value imp "binary"))) + +(defsubst geiser-impl--parameters (impl) + (or (geiser-impl--call-if-bound impl "parameters") + (ignore-errors (geiser-impl--value imp "parameters")))) + +(defsubst geiser-impl--prompt-regexp (impl) + (or (geiser-impl--call-if-bound impl "prompt-regexp") + (geiser-impl--value imp "prompt-regexp"))) + + +;;; Access to implementation guessing function: + +(defun geiser-impl--guess () + (catch 'impl + (dolist (impl geiser-impl--impls) + (when (geiser-impl--call-if-bound impl "guess") + (throw 'impl impl))) + (geiser-impl--default-implementation))) + + +;;; Unload support + +(defun geiser-impl-unload-function () + (dolist (imp (mapcar 'geiser-impl--impl-feature geiser-impl--impls)) + (when (featurep imp) (unload-feature imp))) + t) + +(defun geiser-impl--reload-implementations (impls) + (dolist (impl impls) + (load-library (format "geiser-%s" impl)))) + + +(provide 'geiser-impl) +;;; geiser-impl.el ends here diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index 4bb2dcf..640a7e9 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -31,6 +31,7 @@ (require 'geiser-edit) (require 'geiser-autodoc) (require 'geiser-debug) +(require 'geiser-impl) (require 'geiser-eval) (require 'geiser-repl) (require 'geiser-popup) @@ -153,6 +154,7 @@ interacting with the Geiser REPL is at your disposal. :lighter geiser-mode-string :group 'geiser-mode :keymap geiser-mode-map + (when geiser-mode (geiser-impl--set-buffer-implementation)) (setq geiser-autodoc-mode-string "/A") (setq geiser-smart-tab-mode-string "/T") (when geiser-mode-autodoc-p (geiser-autodoc-mode geiser-mode)) @@ -212,9 +214,17 @@ interacting with the Geiser REPL is at your disposal. (dolist (buffer (buffer-list)) (when (buffer-live-p buffer) (set-buffer buffer) - (when geiser-mode (push buffer buffers)))) + (when geiser-mode + (push (cons buffer geiser-impl--implementation) buffers)))) buffers)) +(defun geiser-mode--restore (buffers) + (dolist (b buffers) + (when (buffer-live-p (car b)) + (set-buffer (car b)) + (geiser-mode 1) + (when (cdr b) (geiser-impl--set-buffer-implementation (cdr b)))))) + (provide 'geiser-mode) ;;; geiser-mode.el ends here diff --git a/elisp/geiser-popup.el b/elisp/geiser-popup.el index d412029..486d1d8 100644 --- a/elisp/geiser-popup.el +++ b/elisp/geiser-popup.el @@ -58,12 +58,18 @@ '(("q" . geiser-popup--quit)) (setq buffer-read-only t)) + +;;; Support for defining popup buffers and accessors: + +(defvar geiser-popup--registry nil) + (defmacro geiser-popup--define (base name mode) (let ((get-buff (intern (format "geiser-%s--buffer" base))) (pop-buff (intern (format "geiser-%s--pop-to-buffer" base))) (with-macro (intern (format "geiser-%s--with-buffer" base))) (method (make-symbol "method"))) `(progn + (add-to-list 'geiser-popup--registry ,name) (defun ,get-buff () (or (get-buffer ,name) (with-current-buffer (get-buffer-create ,name) @@ -84,5 +90,13 @@ (put 'geiser-popup--define 'lisp-indent-function 1) +;;; Reload support: + +(defun geiser-popup-unload-function () + (dolist (name geiser-popup--registry) + (when (buffer-live-p (get-buffer name)) + (kill-buffer name)))) + + (provide 'geiser-popup) ;;; geiser-popup.el ends here diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index a5f424b..7232b99 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -26,6 +26,7 @@ (require 'geiser-autodoc) (require 'geiser-edit) +(require 'geiser-impl) (require 'geiser-eval) (require 'geiser-connection) (require 'geiser-custom) @@ -193,6 +194,8 @@ REPL buffer." (when (not (eq (char-after (point)) ?\()) (skip-syntax-forward "^(" p)))) +(defun geiser-repl--module-function (&optional ignore) :f) + (define-derived-mode geiser-repl-mode comint-mode "Geiser REPL" "Major mode for interacting with an inferior Guile repl process. \\{geiser-repl-mode-map}" @@ -203,7 +206,9 @@ REPL buffer." (set (make-local-variable 'beginning-of-defun-function) 'geiser-repl--beginning-of-defun) (set-syntax-table scheme-mode-syntax-table) - (geiser-eval--current-module-function nil) + ;;; TODO: fix this call when we add support to multiple implementations + (geiser-impl--set-buffer-implementation) + (setq geiser-eval--get-module-function 'geiser-repl--module-function) (when geiser-repl-autodoc-p (geiser-autodoc-mode 1))) (define-key geiser-repl-mode-map "\C-cz" 'run-guile) diff --git a/elisp/geiser.el b/elisp/geiser.el index 7415390..f827864 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -92,6 +92,7 @@ geiser-autodoc geiser-compile geiser-debug + geiser-impl geiser-eval geiser-connection geiser-syntax @@ -122,6 +123,7 @@ loaded." geiser-root-dir)) geiser-root-dir)) (geiser-main-file (expand-file-name "elisp/geiser.el" dir)) + (impls (and (featurep 'geiser-impl) geiser-impl--impls)) (repl (and (featurep 'geiser-repl) (geiser-repl--live-p))) (buffers (and (featurep 'geiser-mode) (geiser-mode--buffers)))) (unless (file-exists-p geiser-main-file) @@ -130,14 +132,11 @@ loaded." (geiser-unload) (load-file geiser-main-file) (geiser-setup) - (when repl - (load-library "geiser-repl") - (geiser 'repl)) - (when buffers - (load-library "geiser-mode") - (dolist (b buffers) - (set-buffer b) - (geiser-mode 1))) + (dolist (feature (geiser--features-list)) + (load-library (format "%s" feature))) + (when impls (geiser-impl--reload-implementations impls)) + (when repl (geiser 'repl)) + (when buffers (geiser-mode--restore buffers)) (message "Geiser reloaded!"))) |