diff options
| -rw-r--r-- | elisp/geiser-completion.el | 18 | ||||
| -rw-r--r-- | elisp/geiser-custom.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-debug.el | 9 | ||||
| -rw-r--r-- | elisp/geiser-doc.el | 17 | ||||
| -rw-r--r-- | elisp/geiser-eval.el | 25 | ||||
| -rw-r--r-- | elisp/geiser-impl.el | 367 | ||||
| -rw-r--r-- | elisp/geiser-mode.el | 5 | ||||
| -rw-r--r-- | elisp/geiser-plt.el | 15 | ||||
| -rw-r--r-- | elisp/geiser-reload.el | 3 | ||||
| -rw-r--r-- | elisp/geiser-repl.el | 33 | ||||
| -rw-r--r-- | elisp/geiser.el | 2 |
11 files changed, 275 insertions, 225 deletions
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el index 99a3cfc..0752e5c 100644 --- a/elisp/geiser-completion.el +++ b/elisp/geiser-completion.el @@ -11,6 +11,7 @@ +(require 'geiser-impl) (require 'geiser-eval) (require 'geiser-log) (require 'geiser-syntax) @@ -183,13 +184,20 @@ terminates a current completion." (minibuffer-message text) (message "%s" text)))) -(make-variable-buffer-local - (defvar geiser-completion--symbol-begin-function nil)) +(defvar geiser-completion--symbol-begin-function nil) + +(defsubst geiser-completion--def-symbol-begin (module) + (save-excursion (skip-syntax-backward "^-()>") (point))) + +(geiser-impl--register-local-method + 'geiser-completion--symbol-begin-function 'find-symbol-begin + 'geiser-completion--def-symbol-begin + "An optional function finding the position of the beginning of +the identifier around point. Takes a boolean, indicating whether +we're looking for a module name.") (defsubst geiser-completion--symbol-begin (module) - (or (and geiser-completion--symbol-begin-function - (funcall geiser-completion--symbol-begin-function module)) - (save-excursion (skip-syntax-backward "^-()>") (point)))) + (funcall geiser-completion--symbol-begin-function module)) (defsubst geiser-completion--prefix (module) (buffer-substring-no-properties (point) diff --git a/elisp/geiser-custom.el b/elisp/geiser-custom.el index bdaac06..789c824 100644 --- a/elisp/geiser-custom.el +++ b/elisp/geiser-custom.el @@ -45,9 +45,12 @@ (defvar geiser-custom--memoized-vars nil) +(defun geiser-custom--memoize (name) + (add-to-list 'geiser-custom--memoized-vars name)) + (defmacro geiser-custom--defcustom (name &rest body) `(progn - (add-to-list 'geiser-custom--memoized-vars ',name) + (geiser-custom--memoize ',name) (defcustom ,name ,@body))) (defun geiser-custom--memoized-state () @@ -56,7 +59,6 @@ (when (boundp name) (push (cons name (symbol-value name)) result))))) - (provide 'geiser-custom) ;;; geiser-custom.el ends here diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el index 62b3ead..7a9f915 100644 --- a/elisp/geiser-debug.el +++ b/elisp/geiser-debug.el @@ -45,6 +45,13 @@ ;;; Displaying retorts +(geiser-impl--define-caller geiser-debug--display-error display-error (module key message) + "This method takes 3 parameters (a module name, the error key, +and the accompanying error message) and should display +(in the current buffer) a formatted version of the error. If the +error was successfully displayed, the call should evaluate to a +non-null value.") + (defun geiser-debug--display-retort (what ret &optional res) (let* ((err (geiser-eval--retort-error ret)) (key (geiser-eval--error-key err)) @@ -58,7 +65,7 @@ (when res (insert res) (newline 2)) - (unless (geiser-impl--display-error impl module key output) + (unless (geiser-debug--display-error impl module key output) (when err (insert (geiser-eval--error-str err) "\n\n")) (when output (insert output "\n\n"))) (goto-char (point-min))) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 977b074..94f0505 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -90,13 +90,12 @@ (defun geiser-doc--follow-link (link) (let ((target (geiser-doc--link-target link)) (module (geiser-doc--link-module link)) - (impl (or (geiser-doc--link-impl link) - (geiser-impl--default-implementation)))) + (impl (geiser-doc--link-impl link))) (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))))))) + (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))) @@ -146,6 +145,12 @@ ;;; Commands: +(geiser-impl--define-caller geiser-doc--external-help external-help (symbol module) + "By default, Geiser will display help about an identifier in a +help buffer, after collecting the associated signature and +docstring. You can provide an alternative function for displaying +help (e.g. browse an HTML page) implementing this method.") + (defun geiser-doc--get-docstring (symbol module) (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module))) @@ -156,7 +161,7 @@ (defun geiser-doc-symbol (symbol &optional module impl) (let ((module (or module (geiser-eval--get-module))) (impl (or impl geiser-impl--implementation))) - (unless (geiser-impl--external-help impl symbol module) + (unless (geiser-doc--external-help impl symbol module) (let ((ds (geiser-doc--get-docstring symbol module))) (if (or (not ds) (not (listp ds))) (message "No documentation available for '%s'" symbol) diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el index 5c84a57..c7b7d2c 100644 --- a/elisp/geiser-eval.el +++ b/elisp/geiser-eval.el @@ -14,6 +14,7 @@ +(require 'geiser-impl) (require 'geiser-connection) (require 'geiser-syntax) (require 'geiser-log) @@ -22,20 +23,26 @@ ;;; Plug-able functions: -(make-variable-buffer-local - (defvar geiser-eval--get-module-function nil - "Function used to obtain the module for current buffer. It -takes an optional argument, for cases where we want to force its value.")) +(defvar geiser-eval--get-module-function nil) + +(geiser-impl--register-local-method + 'geiser-eval--get-module-function 'find-module '(lambda (&rest) nil) + "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--get-module (&optional module) (and geiser-eval--get-module-function (funcall geiser-eval--get-module-function module))) -(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.")) +(defvar geiser-eval--geiser-procedure-function nil) + +(geiser-impl--register-local-method + 'geiser-eval--geiser-procedure-function 'marshall-procedure 'identity + "Function to translate a bare procedure symbol to one executable +in the Scheme 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)) diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el index e0e4a39..f7805f1 100644 --- a/elisp/geiser-impl.el +++ b/elisp/geiser-impl.el @@ -11,29 +11,27 @@ -(require 'geiser-eval) (require 'geiser-custom) (require 'geiser-base) -(require 'geiser-completion) ;;; Customization: -(defgroup geiser-impl nil +(defgroup geiser-implementation nil "Generic support for multiple Scheme implementations." :group 'geiser) -(geiser-custom--defcustom geiser-impl-default-implementation nil +(geiser-custom--defcustom geiser-default-implementation nil "Symbol naming the default Scheme implementation." :type 'symbol - :group 'geiser-impl) + :group 'geiser-implementation) -(geiser-custom--defcustom geiser-impl-installed-implementations nil - "Initial list of installed Scheme implementations." +(geiser-custom--defcustom geiser-active-implementations '(guile plt) + "List of active installed Scheme implementations." :type '(repeat symbol) - :group 'geiser-impl) + :group 'geiser-implementation) -(geiser-custom--defcustom geiser-impl-implementations-alist nil +(geiser-custom--defcustom geiser-implementations-alist nil "A map from regular expressions or directories to implementations. When opening a new file, its full path will be matched against each one of the regular expressions or directories in this map in order to @@ -43,164 +41,126 @@ determine its scheme flavour." (group :tag "Directory" (const dir) directory)) symbol)) - :group 'geiser-impl) + :group 'geiser-implementation) -;;; Auxiliary functions: -(defsubst geiser-impl--sym (imp name) - (intern (format "geiser-%s-%s" imp name))) +;;; Implementation registry: -(defsubst geiser-impl--boundp (imp name) - (boundp (geiser-impl--sym imp name))) +(defvar geiser-impl--registry nil) +(defvar geiser-impl--load-files nil) +(defvar geiser-impl--method-docs nil) +(defvar geiser-impl--local-methods nil) +(defvar geiser-impl--local-variables nil) -(defsubst geiser-impl--fboundp (imp name) - (fboundp (geiser-impl--sym imp name))) - -(defsubst geiser-impl--impl-feature (impl) - (intern (format "geiser-%s" impl))) - -(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))) - - -;;; Registering implementations: - -(defvar geiser-impl--impls nil) +(geiser-custom--memoize 'geiser-impl--load-files) (make-variable-buffer-local (defvar geiser-impl--implementation nil)) -(defun geiser-impl--register (impl) - (when (and (not (memq impl geiser-impl--impls)) - (require (geiser-impl--impl-feature impl) nil t)) - (add-to-list 'geiser-impl--impls impl))) - -(defun geiser-impl--unregister (impl) - (setq geiser-impl--impls (remove impl geiser-impl--impls)) - (ignore-errors (unload-feature (geiser-impl--impl-feature impl)))) - -(defun geiser-impl--add-to-alist (kind what impl) - (add-to-list 'geiser-impl-implementations-alist (list (list kind what) impl))) - -(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))) - (defsubst geiser-impl--impl-str (&optional impl) (let ((impl (or impl geiser-impl--implementation))) (and impl (capitalize (format "%s" impl))))) - -;;; Installing Scheme implementations: +(defsubst geiser-impl--feature (impl) + (intern (format "geiser-%s" impl))) -(defvar geiser-impl--impl-prompt-history nil) +(defsubst geiser-impl--load-impl (impl) + (require (geiser-impl--feature impl) + (cdr (assq impl geiser-impl--load-files)) + t)) -(defun geiser-impl--read-impl (&optional prompt impls non-req) - (let* ((impls (or impls geiser-impl--impls)) - (impls (mapcar (lambda (s) (format "%s" s)) impls)) - (prompt (or prompt "Scheme implementation: "))) - (intern (completing-read prompt impls nil (not non-req) nil - geiser-impl--impl-prompt-history - (and (car geiser-impl--impls) - (symbol-name (car geiser-impl--impls))))))) +(defsubst geiser-impl--methods (impl) + (cdr (assq impl geiser-impl--registry))) -(defun geiser-impl--set-buffer-implementation (&optional impl) +(defun geiser-impl--method (method &optional impl) (let ((impl (or impl - (geiser-impl--guess) - (geiser-impl--read-impl nil nil t)))) - (require (geiser-impl--impl-feature impl)) - (setq geiser-impl--implementation impl) - (geiser-impl--install-vars impl) - (geiser-impl--register impl))) - -(defsubst geiser-impl--module-function (impl) - (geiser-impl--sym impl "get-module")) - -(defsubst geiser-impl--geiser-procedure-function (impl) - (geiser-impl--sym impl "geiser-procedure")) - -(defsubst geiser-impl--symbol-begin (impl) - (geiser-impl--sym impl "symbol-begin")) - -(defun geiser-impl--install-vars (impl) - (setq geiser-eval--get-module-function - (geiser-impl--module-function impl)) - (setq geiser-eval--geiser-procedure-function - (geiser-impl--geiser-procedure-function impl)) - (setq geiser-completion--symbol-begin-function - (geiser-impl--symbol-begin impl))) - - -;;; 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--module-function imp)) - (geiser-eval--geiser-procedure-function - (geiser-impl--geiser-procedure-function imp)) - (geiser-completion--symbol-begin-function - (geiser-impl--symbol-begin imp))) - (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) + geiser-impl--implementation + geiser-default-implementation))) + (cadr (assq method (geiser-impl--methods impl))))) + +(defun geiser-impl--call-method (method impl &rest args) + (let ((fun (geiser-impl--method method impl))) + (when (functionp fun) (apply fun args)))) + +(defun geiser-impl--method-doc (method doc) + (push (cons method doc) geiser-impl--method-docs)) + +(defun geiser-impl--register-local-method (var-name method fallback doc) + (add-to-list 'geiser-impl--local-methods (list var-name method fallback)) + (geiser-impl--method-doc method doc)) + +(defun geiser-impl--register-local-variable (var-name method fallback doc) + (add-to-list 'geiser-impl--local-variables (list var-name method fallback)) + (geiser-impl--method-doc method doc)) + +(defmacro geiser-impl--define-caller (fun-name method arglist doc) + (let ((m (make-symbol "method-candidate")) + (impl (make-symbol "implementation-name"))) + `(progn + (defun ,fun-name ,(cons impl arglist) ,doc + (geiser-impl--call-method ',method ,impl ,@arglist)) + (geiser-impl--method-doc ',method ,doc)))) +(put 'geiser-impl--define-caller 'lisp-indent-function 3) + +(defun geiser-impl--register (file impl methods) + (let ((current (assq impl geiser-impl--registry))) + (if current (setcdr current methods) + (push (cons impl methods) geiser-impl--registry)) + (push (cons impl file) geiser-impl--load-files))) + +(defsubst geiser-activate-implementation (impl) + (add-to-list 'geiser-active-implementations impl)) + +(defsubst geiser-deactivate-implementation (impl) + (setq geiser-active-implementations (delq impl geiser-active-implementations))) -;;; Access to implementation specific execution parameters: - -(defsubst geiser-impl--binary (impl) - (or (geiser-impl--call-if-bound impl "binary") - (geiser-impl--value impl "binary"))) - -(defsubst geiser-impl--parameters (impl) - (or (geiser-impl--call-if-bound impl "parameters") - (ignore-errors (geiser-impl--value impl "parameters")))) - -(defsubst geiser-impl--prompt-regexp (impl) - (or (geiser-impl--call-if-bound impl "prompt-regexp") - (geiser-impl--value impl "prompt-regexp"))) - -(defsubst geiser-impl--startup (impl) - (geiser-impl--call-if-bound impl "startup")) - -(defsubst geiser-impl--external-help (impl symbol module) - (geiser-impl--call-if-bound impl "external-help" symbol module)) +;;; Defining implementations: + +(defun geiser-impl--normalize-method (m) + (when (and (listp m) + (= 2 (length m)) + (symbolp (car m)) + (symbolp (cadr m))) + (if (functionp (cadr m)) m + `(,(car m) (lambda (&rest) ,(cadr m)))))) + +(defun geiser-impl--define (file name parent methods) + (let* ((methods (mapcar 'geiser-impl--normalize-method methods)) + (methods (delq nil methods)) + (inherited-methods (and parent (geiser-impl--methods parent))) + (methods (append methods + (dolist (m methods inherited-methods) + (setq inherited-methods + (assq-delete-all m inherited-methods)))))) + (geiser-impl--register file name methods))) + +(defmacro define-geiser-implementation (name &rest methods) + (let ((name (if (listp name) (car name) name)) + (parent (and (listp name) (cadr name)))) + (unless (symbolp name) + (error "Malformed implementation name: %s" name)) + (let ((runner (intern (format "run-%s" name))) + (switcher (intern (format "switch-%s" name))) + (runner-doc (format "Start a new %s REPL." name)) + (switcher-doc (format "Switch to a running %s REPL, or start one." name))) + `(progn + (geiser-impl--define ,load-file-name ',name ',parent ',methods) + (require 'geiser-repl) + (defun ,runner () + ,runner-doc + (interactive) + (run-geiser ',name)) + (defun ,switcher (&optional ask) + (interactive "P") + (switch-to-geiser ask ',name)) + (provide ',(geiser-impl--feature name)))))) -(defsubst geiser-impl--display-error (impl module key msg) - (geiser-impl--call-if-bound impl "display-error" module key msg)) +(defun geiser-impl--add-to-alist (kind what impl) + (add-to-list 'geiser-implementations-alist (list (list kind what) impl))) -;;; Access to implementation guessing function: +;;; Trying to guess the scheme implementation: (make-variable-buffer-local (defvar geiser-scheme-implementation nil @@ -213,65 +173,96 @@ implementation to be used by Geiser.")) (format "^%s" (regexp-quote (cadr desc)))))) (and rx (string-match-p rx bn)))) -(defun geiser-impl--guess () +(defvar geiser-impl--impl-prompt-history nil) + +(defun geiser-impl--read-impl (&optional prompt impls non-req) + (let* ((impls (or impls geiser-active-implementations)) + (impls (mapcar 'symbol-name impls)) + (prompt (or prompt "Scheme implementation: "))) + (intern (completing-read prompt impls nil (not non-req) nil + geiser-impl--impl-prompt-history + (and (car impls) (car impls)))))) + +(geiser-impl--define-caller geiser-impl--check-buffer check-buffer () + "Method called without arguments that should check whether the current +buffer contains Scheme code of the given implementation.") + +(defun geiser-impl--guess (&optional prompt) (or geiser-impl--implementation geiser-scheme-implementation (catch 'impl (let ((bn (buffer-file-name))) (when bn - (dolist (x geiser-impl-implementations-alist) - (when (geiser-impl--match-impl (car x) bn) + (dolist (x geiser-implementations-alist) + (when (and (memq (cadr x) geiser-active-implementations) + (geiser-impl--match-impl (car x) bn)) (throw 'impl (cadr x)))))) - (dolist (impl geiser-impl--impls) - (when (geiser-impl--call-if-bound impl "guess") + (dolist (impl geiser-active-implementations) + (when (geiser-impl--check-buffer impl) (throw 'impl impl)))) - (geiser-impl--default-implementation))) + geiser-default-implementation + (and (null (cdr geiser-active-implementations)) + (car geiser-active-implementations)) + (and prompt (geiser-impl--read-impl)))) -;;; User commands - -(defun geiser-register-implementation () - "Register a new Scheme implementation." - (interactive) - (let ((current geiser-impl-installed-implementations) - (impl (geiser-impl--read-impl "New Scheme implementation: " nil t))) - (unless (geiser-impl--register impl) - (error "geiser-%s.el not found in load-path" impl)) - (when (and (not (memq impl current)) - (y-or-n-p "Remember this implementation using customize? ")) - (customize-save-variable - 'geiser-impl-installed-implementations (cons impl current))))) - -(defun geiser-unregister-implementation () - "Unregister an installed Scheme implementation." - (interactive) - (let* ((current geiser-impl-installed-implementations) - (impl (geiser-impl--read-impl "Forget implementation: " current))) - (geiser-impl--unregister impl) - (when (and impl - (y-or-n-p "Forget permanently using customize? ")) - (customize-save-variable - 'geiser-impl-installed-implementations (remove impl current))))) +;;; Using implementations: - -;;; Unload support +(defsubst geiser-impl--registered-method (impl method fallback) + (let ((m (geiser-impl--method method impl))) + (if (fboundp m) m + (or fallback (error "%s not defined for %s" method impl))))) -(defun geiser-impl-unload-function () - (dolist (imp (mapcar 'geiser-impl--impl-feature geiser-impl--impls)) - (when (featurep imp) (unload-feature imp t)))) +(defsubst geiser-impl--registered-value (impl method fallback) + (let ((m (geiser-impl--method method impl))) + (if (fboundp m) (funcall m) + (or fallback (error "%s not defined for %s" method impl))))) -(defun geiser-impl--reload-implementations (impls) - (dolist (impl impls) - (load-library (format "geiser-%s" impl)))) +(defun geiser-impl--set-buffer-implementation (&optional impl) + (let ((impl (or impl (geiser-impl--guess)))) + (when impl + (unless (geiser-impl--load-impl impl) + (error "Cannot find %s implementation" impl)) + (setq geiser-impl--implementation impl) + (dolist (m geiser-impl--local-methods) + (set (make-local-variable (nth 0 m)) + (geiser-impl--registered-method impl (nth 1 m) (nth 2 m)))) + (dolist (m geiser-impl--local-variables) + (set (make-local-variable (nth 0 m)) + (geiser-impl--registered-value impl (nth 1 m) (nth 2 m))))))) + +(defmacro with--geiser-implementation (impl &rest body) + (let* ((mbindings (mapcar (lambda (m) + `(,(nth 0 m) + (geiser-impl--registered-method ',impl + ',(nth 1 m) + ',(nth 2 m)))) + geiser-impl--local-methods)) + (vbindings (mapcar (lambda (m) + `(,(nth 0 m) + (geiser-impl--registered-value ',impl + ',(nth 1 m) + ',(nth 2 m)))) + geiser-impl--local-variables)) + (bindings (append mbindings vbindings))) + `(let* ,bindings ,@body))) +(put 'with--geiser-implementation 'lisp-indent-function 1) -;;; Initialization: +;;; Reload support: -(eval-after-load 'geiser-impl - '(mapc 'geiser-impl--register - (or geiser-impl-installed-implementations '(guile plt)))) +(defun geiser-impl-unload-function () + (dolist (imp (mapcar (lambda (i) + (geiser-impl--feature (car i))) + geiser-impl--registry)) + (when (featurep imp) (unload-feature imp t)))) (provide 'geiser-impl) + +;;; Initialization: +;; After providing 'geiser-impl, so that impls can use us. +(mapc 'geiser-impl--load-impl geiser-active-implementations) + ;;; geiser-impl.el ends here diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el index 571e750..d083973 100644 --- a/elisp/geiser-mode.el +++ b/elisp/geiser-mode.el @@ -251,8 +251,9 @@ interacting with the Geiser REPL is at your disposal. (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)))))) + (when (cdr b) + (geiser-impl--set-buffer-implementation (cdr b))) + (geiser-mode 1)))) (defun geiser-mode-unload-function () (dolist (b (geiser-mode--buffers)) diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el index 86073e5..aadca41 100644 --- a/elisp/geiser-plt.el +++ b/elisp/geiser-plt.el @@ -161,5 +161,20 @@ This function uses `geiser-plt-init-file' if it exists." (string-equal (file-name-extension (or (buffer-file-name) "")) "ss"))) +;;; Implementation definition: + +(define-geiser-implementation plt + (binary geiser-plt-binary) + (arglist geiser-plt-parameters) + (startup) + (prompt-regexp geiser-plt-prompt-regexp) + (marshall-procedure geiser-plt-geiser-procedure) + (find-module geiser-plt-get-module) + (find-symbol-begin geiser-plt-symbol-begin) + (display-error geiser-plt-display-error) + (display-help geiser-plt-external-help) + (check-buffer geiser-plt-guess)) + + (provide 'geiser-plt) ;;; geiser-plt.el ends here diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el index d3b62eb..d9ba4d2 100644 --- a/elisp/geiser-reload.el +++ b/elisp/geiser-reload.el @@ -11,7 +11,6 @@ -(require 'geiser-impl) (require 'geiser-repl) (require 'geiser-mode) (require 'geiser-custom) @@ -68,7 +67,6 @@ loaded again." (error "%s does not contain Geiser!" dir)) (let ((installed (featurep 'geiser-install)) (memo (geiser-custom--memoized-state)) - (impls geiser-impl--impls) (repls (geiser-repl--repl-list)) (buffers (geiser-mode--buffers))) (geiser-unload) @@ -77,7 +75,6 @@ loaded again." (mapc (lambda (x) (set (car x) (cdr x))) memo) (require 'geiser-reload) (when installed (require 'geiser-install nil t)) - (geiser-impl--reload-implementations impls) (geiser-repl--restore repls) (geiser-mode--restore buffers) (message "Geiser reloaded!")))) diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el index e8e4975..ca6064f 100644 --- a/elisp/geiser-repl.el +++ b/elisp/geiser-repl.el @@ -119,12 +119,29 @@ implementation name gets appended to it." (geiser-repl-mode) (geiser-impl--set-buffer-implementation impl)) +(geiser-impl--define-caller geiser-repl--binary binary () + "A variable or function returning the path to the scheme binary +for this implementation.") + +(geiser-impl--define-caller geiser-repl--arglist arglist () + "A function taking no arguments and returning a list of +arguments to be used when invoking the scheme binary.") + +(geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp () + "A variable (or thunk returning a value) giving the regular +expression for this implementation's scheme prompt.") + +(geiser-impl--define-caller geiser-repl--startup startup () + "Function taking no parameters that is called after the REPL +has been initialised. All Geiser functionality is available to +you at that point.") + (defun geiser-repl--start-repl (impl) (message "Starting Geiser REPL for %s ..." impl) (geiser-repl--to-repl-buffer impl) - (let ((binary (geiser-impl--binary impl)) - (args (geiser-impl--parameters impl)) - (prompt-rx (geiser-impl--prompt-regexp impl)) + (let ((binary (geiser-repl--binary impl)) + (args (geiser-repl--arglist impl)) + (prompt-rx (geiser-repl--prompt-regexp impl)) (cname (geiser-repl--repl-name impl))) (unless (and binary prompt-rx) (error "Sorry, I don't know how to start a REPL for %s" impl)) @@ -135,7 +152,7 @@ implementation name gets appended to it." (geiser-con--setup-connection (current-buffer) prompt-rx) (add-to-list 'geiser-repl--repls (current-buffer)) (geiser-repl--set-this-buffer-repl (current-buffer)) - (geiser-impl--startup impl))) + (geiser-repl--startup impl))) (defun geiser-repl--process () (let ((buffer (geiser-repl--get-repl geiser-impl--implementation))) @@ -163,8 +180,8 @@ implementation name gets appended to it." (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) (defsubst geiser-repl--only-impl-p () - (and (null (cdr geiser-impl--impls)) - (car geiser-impl--impls))) + (and (null (cdr geiser-active-implementations)) + (car geiser-active-implementations))) (defun run-geiser (impl) "Start a new Geiser REPL." @@ -271,7 +288,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (defun geiser-repl--doc-module () (interactive) (let ((geiser-eval--get-module-function - (geiser-impl--module-function geiser-impl--implementation))) + (geiser-impl--method 'find-module geiser-impl--implementation))) (geiser-doc-module))) (define-derived-mode geiser-repl-mode comint-mode "Geiser REPL" @@ -327,7 +344,7 @@ If no REPL is running, execute `run-geiser' to start a fresh one." (defun geiser-repl--restore (impls) (dolist (impl impls) - (when impl (geiser nil impl)))) + (when impl (run-geiser impl)))) (defun geiser-repl-unload-function () (dolist (repl geiser-repl--repls) diff --git a/elisp/geiser.el b/elisp/geiser.el index ea973fa..6263afd 100644 --- a/elisp/geiser.el +++ b/elisp/geiser.el @@ -73,7 +73,7 @@ geiser-mode geiser-guile geiser-plt - geiser-impl + geiser-implementation geiser-xref)) |