summaryrefslogtreecommitdiff
path: root/elisp
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-09-07 00:23:17 +0200
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-09-07 00:23:17 +0200
commit8f5e58189692663901266dc83f2e2b4e47803b8d (patch)
treeaf04cbe37abec51cbf4106f06a497445904dc7a6 /elisp
parent61edb258a45d5ad00ee907594c6dfbcd21d93485 (diff)
parent3a80af06f2b9272db379fed3b5b659ecfeeceb70 (diff)
downloadgeiser-guile-8f5e58189692663901266dc83f2e2b4e47803b8d.tar.gz
geiser-guile-8f5e58189692663901266dc83f2e2b4e47803b8d.tar.bz2
Merge branch 'devel'
Diffstat (limited to 'elisp')
-rw-r--r--elisp/Makefile.am34
-rw-r--r--elisp/geiser-autodoc.el146
-rw-r--r--elisp/geiser-base.el21
-rw-r--r--elisp/geiser-company.el121
-rw-r--r--elisp/geiser-completion.el19
-rw-r--r--elisp/geiser-connection.el12
-rw-r--r--elisp/geiser-debug.el63
-rw-r--r--elisp/geiser-doc.el31
-rw-r--r--elisp/geiser-edit.el73
-rw-r--r--elisp/geiser-eval.el50
-rw-r--r--elisp/geiser-guile.el41
-rw-r--r--elisp/geiser-impl.el138
-rw-r--r--elisp/geiser-install.el.in5
-rw-r--r--elisp/geiser-log.el2
-rw-r--r--elisp/geiser-mode.el11
-rw-r--r--elisp/geiser-plt.el42
-rw-r--r--elisp/geiser-reload.el95
-rw-r--r--elisp/geiser-repl.el36
-rw-r--r--elisp/geiser-syntax.el242
-rw-r--r--elisp/geiser-version.el.in12
-rw-r--r--elisp/geiser.el105
21 files changed, 898 insertions, 401 deletions
diff --git a/elisp/Makefile.am b/elisp/Makefile.am
new file mode 100644
index 0000000..9f93e64
--- /dev/null
+++ b/elisp/Makefile.am
@@ -0,0 +1,34 @@
+EXTRA_DIST = geiser-install.el.in
+
+dist_lisp_LISP = \
+ geiser-autodoc.el \
+ geiser-base.el \
+ geiser-company.el \
+ geiser-compile.el \
+ geiser-completion.el \
+ geiser-connection.el \
+ geiser-custom.el \
+ geiser-debug.el \
+ geiser-doc.el \
+ geiser-edit.el \
+ geiser.el \
+ geiser-eval.el \
+ geiser-guile.el \
+ geiser-impl.el \
+ geiser-log.el \
+ geiser-mode.el \
+ geiser-plt.el \
+ geiser-popup.el \
+ geiser-reload.el \
+ geiser-repl.el \
+ geiser-syntax.el \
+ geiser-xref.el \
+ geiser-version.el
+
+lisp_LISP = geiser-install.el
+
+CLEANFILES = geiser-install.el
+
+geiser-install.el: $(srcdir)/geiser.el $(srcdir)/geiser-install.el.in
+ @sed -e "s|@SCHEME_DIR[@]|$(datarootdir)/geiser|" $(srcdir)/geiser-install.el.in >$@
+
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index f6d36a8..75f2e7c 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -46,14 +46,6 @@
'font-lock-function-name-face
geiser-autodoc "highlighting procedure name in autodoc messages")
-(geiser-custom--defface autodoc-optional-arg-marker
- 'font-lock-keyword-face
- geiser-autodoc "highlighting #:opt marker in autodoc messages")
-
-(geiser-custom--defface autodoc-key-arg-marker
- 'font-lock-keyword-face
- geiser-autodoc "highlighting #:key marker in autodoc messages")
-
(defcustom geiser-autodoc-delay 0.3
"Delay before autodoc messages are fetched and displayed, in seconds."
:type 'number
@@ -74,79 +66,107 @@ when `geiser-autodoc-display-module-p' is on."
;;; Procedure arguments:
(make-variable-buffer-local
- (defvar geiser-autodoc--last nil))
-
-(make-variable-buffer-local
- (defvar geiser-autodoc--last-result nil))
-
-(defun geiser-autodoc--function-args (form)
- (if (equal (car geiser-autodoc--last) form) (cdr geiser-autodoc--last)
- (when form
- (let ((res (geiser-eval--send/result
- `(:eval ((:ge autodoc) (quote (:scm ,form))))
- 500)))
- (when (and res (listp res))
- (unless (equalp res geiser-autodoc--last-result)
- (setq geiser-autodoc--last-result res)
- (setq geiser-autodoc--last
- (cons form
- (geiser-autodoc--str (cdr (assoc 'signature res))
- (or (cdr (assoc 'position res)) 0)
- (cdr (assoc 'module res))))))
- (cdr geiser-autodoc--last))))))
-
-(defun geiser-autodoc--insert-arg (arg current pos)
- (let ((p (point))
- (str (format "%s" (if (eq arg '\#:rest) "." arg)))
- (face (cond ((eq '\#:opt arg)
- 'geiser-font-lock-autodoc-optional-arg-marker)
- ((eq '\#:key arg)
- 'geiser-font-lock-autodoc-key-arg-marker)
- ((= current pos)
- 'geiser-font-lock-autodoc-current-arg)
- (t nil))))
- (insert str)
- (when (listp arg)
- (save-excursion
- (replace-regexp "(quote \\(.*\\))" "'\\1" nil p (point))
- (replace-string "nil" "()" t p (point))))
- (when face (put-text-property p (point) 'face face))))
+ (defvar geiser-autodoc--cached-signatures nil))
+
+(defun geiser-autodoc--get-signatures (funs &optional keep-cached)
+ (when funs
+ (let ((fs (assq (car funs) geiser-autodoc--cached-signatures)))
+ (unless fs
+ (let ((missing) (cached))
+ (if (not geiser-autodoc--cached-signatures)
+ (setq missing funs)
+ (dolist (f funs)
+ (let ((cf (assq f geiser-autodoc--cached-signatures)))
+ (if cf (push cf cached)
+ (push f missing)))))
+ (unless (or cached keep-cached)
+ (setq geiser-autodoc--cached-signatures nil))
+ (when missing
+ (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc)
+ (quote ,missing)))
+ 500)))
+ (when res
+ (setq geiser-autodoc--cached-signatures
+ (append res (if keep-cached
+ geiser-autodoc--cached-signatures
+ cached))))))))
+ geiser-autodoc--cached-signatures)))
+
+(defun geiser-autodoc--insert-args (args current &optional pos)
+ (dolist (a args)
+ (let ((p (point)))
+ (insert (format "%s" a))
+ (when (or (and (numberp pos)
+ (numberp current)
+ (setq current (1+ current))
+ (= (1+ pos) current))
+ (and (symbolp current)
+ (listp a)
+ (eq current (car a))))
+ (put-text-property p (point) 'face 'geiser-font-lock-autodoc-current-arg)
+ (setq pos nil current nil)))
+ (insert " "))
+ (when args (backward-char))
+ current)
(defsubst geiser-autodoc--proc-name (proc module)
(let ((str (if module
(format geiser-autodoc-procedure-name-format module proc)
proc)))
- (put-text-property 0 (length str)
- 'face 'geiser-font-lock-autodoc-procedure-name
- str)
- str))
-
-(defun geiser-autodoc--str (signature pos module)
- (when (consp signature)
- (let* ((proc (car signature))
- (args (cdr signature))
- (len (if (listp args) (length args) 0))
- (current 1)
- (pos (if (> pos len) len pos)))
- (if (eq args 'variable)
- (geiser-autodoc--proc-name proc module)
+ (propertize str 'face 'geiser-font-lock-autodoc-procedure-name)))
+
+(defun geiser-autodoc--str (desc signature)
+ (let ((proc (car desc))
+ (args (cdr (assoc 'args signature)))
+ (module (cdr (assoc 'module signature))))
+ (if (not args) (geiser-autodoc--proc-name proc module)
+ (let ((cpos 1)
+ (pos (or (cadr desc) 0))
+ (prev (caddr desc))
+ (reqs (cdr (assoc 'required args)))
+ (opts (cdr (assoc 'optional args)))
+ (keys (cdr (assoc 'key args))))
(save-current-buffer
(set-buffer (geiser-syntax--font-lock-buffer))
(erase-buffer)
(insert (format "(%s" (geiser-autodoc--proc-name proc module)))
- (dolist (a args)
+ (when reqs
(insert " ")
- (geiser-autodoc--insert-arg a current pos)
- (setq current (1+ current)))
+ (setq cpos
+ (geiser-autodoc--insert-args reqs
+ cpos
+ (and (not (zerop pos)) pos))))
+ (when opts
+ (insert " [")
+ (setq cpos (geiser-autodoc--insert-args opts cpos pos))
+ (when keys
+ (insert " [")
+ (geiser-autodoc--insert-args keys prev nil)
+ (insert "]"))
+ (insert "]"))
(insert ")")
(buffer-string))))))
+(defun geiser-autodoc--autodoc (path &optional keep-cached)
+ (let ((signs (geiser-autodoc--get-signatures (mapcar 'car path) keep-cached))
+ (p (car path))
+ (s))
+ (while (and path (not s))
+ (unless (setq s (cdr (assq (car p) signs)))
+ (setq p (car path))
+ (setq path (cdr path))))
+ (when s (geiser-autodoc--str p s))))
+
;;; Autodoc function:
+(make-variable-buffer-local
+ (defvar geiser-autodoc--inhibit-flag nil))
+
(defun geiser-autodoc--eldoc-function ()
(condition-case e
- (geiser-autodoc--function-args (geiser-syntax--get-partial-sexp))
+ (and (not geiser-autodoc--inhibit-flag)
+ (geiser-autodoc--autodoc (geiser-syntax--scan-sexps)))
(error (format "Autodoc not available (%s)" (error-message-string e)))))
diff --git a/elisp/geiser-base.el b/elisp/geiser-base.el
index 362930d..fca955a 100644
--- a/elisp/geiser-base.el
+++ b/elisp/geiser-base.el
@@ -25,26 +25,10 @@
;;; Code:
-
-;;; Versioning:
-
-(defconst geiser-version-major 0
- "Geiser's major version number.")
-(defconst geiser-version-minor 1
- "Geiser's minor version number.")
-
-(defun geiser-version-string ()
- "Geiser's version as a string."
- (format "%s.%s" geiser-version-major geiser-version-minor))
-
-(defun geiser-version ()
- "Echoes Geiser's version."
- (interactive)
- (message "Geiser %s" (geiser-version-string)))
-
-
;;; Emacs compatibility:
+(require 'cl)
+
(eval-after-load "ring"
'(when (not (fboundp 'ring-member))
(defun ring-member (ring item)
@@ -55,7 +39,6 @@
(when (not (fboundp 'completion-table-dynamic))
(defun completion-table-dynamic (fun)
- (require 'cl)
(lexical-let ((fun fun))
(lambda (string pred action)
(with-current-buffer (let ((win (minibuffer-selected-window)))
diff --git a/elisp/geiser-company.el b/elisp/geiser-company.el
new file mode 100644
index 0000000..37c2196
--- /dev/null
+++ b/elisp/geiser-company.el
@@ -0,0 +1,121 @@
+;; geiser-company.el -- integration with company-mode
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Mon Aug 24, 2009 12:44
+
+;; 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/>.
+
+;;; Code:
+
+(require 'geiser-autodoc)
+(require 'geiser-completion)
+(require 'geiser-edit)
+(require 'geiser-base)
+
+
+;;; Helpers:
+
+(make-variable-buffer-local
+ (defvar geiser-company--enabled-flag nil))
+
+(make-variable-buffer-local
+ (defvar geiser-company--autodoc-flag nil))
+
+(defsubst geiser-company--candidates (prefix module)
+ (car (geiser-completion--complete prefix module)))
+
+(defsubst geiser-company--doc (id module)
+ (ignore-errors
+ (if module
+ (format "%s [module]" id)
+ (or (geiser-autodoc--autodoc (list (list (intern id) 0)) t)
+ (format "%s [local id]" id)))))
+
+(defsubst geiser-company--doc-buffer (id module)
+ nil)
+
+(defun geiser-company--location (id module)
+ (ignore-errors
+ (let ((id (intern id)))
+ (save-excursion
+ (if module
+ (geiser-edit-module id 'noselect)
+ (geiser-edit-symbol id 'noselect))))))
+
+(defun geiser-company--prefix-at-point (module)
+ (when geiser-company--enabled-flag
+ (cond ((nth 8 (syntax-ppss)) 'stop)
+ ((looking-at-p "\\_>") (geiser-completion--prefix module))
+ (module 'stop)
+ (t nil))))
+
+
+;;; Activation
+
+(defun geiser-company--setup (enable)
+ (setq geiser-company--enabled-flag enable)
+ (when (fboundp 'geiser-company--setup-company)
+ (geiser-company--setup-company enable)))
+
+(defun geiser-company--inhibit-autodoc (ignored)
+ (when (setq geiser-company--autodoc-flag geiser-autodoc-mode)
+ (geiser-autodoc-mode -1)))
+
+(defun geiser-company--restore-autodoc (&optional ignored)
+ (when geiser-company--autodoc-flag
+ (geiser-autodoc-mode 1)))
+
+
+;;; Backends:
+(defmacro geiser-company--make-backend (name mod)
+ `(defun ,name (command &optional arg &rest ignored)
+ "A `company-mode' completion back-end for `geiser-mode'."
+ (interactive (list 'interactive))
+ (case command
+ ('interactive (company-begin-backend ',name))
+ ('prefix (geiser-company--prefix-at-point ,mod))
+ ('candidates (geiser-company--candidates arg ,mod))
+ ('meta (geiser-company--doc arg ,mod))
+ ('doc-buffer (geiser-company--doc-buffer arg ,mod))
+ ('location (geiser-company--location arg ,mod))
+ ('sorted t))))
+
+(defvar geiser-company--backend '(company-geiser-ids company-geiser-modules))
+
+(eval-after-load "company"
+ '(progn
+ (defun geiser-company--setup-company (enable)
+ (set (make-local-variable 'company-default-lighter) "/C")
+ (set (make-local-variable 'company-echo-delay) 0.01)
+ (company-mode nil)
+ (when enable (company-mode enable)))
+ (geiser-company--make-backend company-geiser-ids nil)
+ (geiser-company--make-backend company-geiser-modules t)
+ (add-to-list 'company-backends geiser-company--backend)
+ (add-hook 'company-completion-finished-hook 'geiser-company--restore-autodoc)
+ (add-hook 'company-completion-cancelled-hook 'geiser-company--restore-autodoc)
+ (add-hook 'company-completion-started-hook 'geiser-company--inhibit-autodoc)))
+
+
+;;; Reload support:
+
+(defun geiser-company-unload-function ()
+ (when (boundp 'company-backends)
+ (setq company-backends (remove geiser-company--backend company-backends))))
+
+
+(provide 'geiser-company)
+;;; geiser-company.el ends here
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 799280e..e3bd74b 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -29,7 +29,7 @@
(require 'geiser-syntax)
(require 'geiser-base)
-(eval-when-compile (require 'cl))
+(require 'cl)
;;; Completions window handling, heavily inspired in slime's:
@@ -84,7 +84,7 @@ terminates a current completion."
(remove-hook 'pre-command-hook
'geiser-completion--maybe-restore-window-cfg)
(condition-case err
- (cond ((find last-command-char "()\"'`,# \r\n:")
+ (cond ((find last-command-event "()\"'`,# \r\n:")
(geiser-completion--restore-window-cfg))
((not (geiser-completion--window-active-p))
(geiser-completion--forget-window-cfg))
@@ -146,11 +146,10 @@ terminates a current completion."
;;; Completion functionality:
-(defsubst geiser-completion--symbol-list (prefix)
+(defun geiser-completion--symbol-list (prefix)
(delete-duplicates
- (geiser-eval--send/result
- `(:eval ((:ge completions) ,prefix
- (quote (:scm ,(or (geiser-syntax--get-partial-sexp) "()"))))))
+ (append (mapcar (lambda (s) (format "%s" s)) (geiser-syntax--locals-around-point))
+ (geiser-eval--send/result `(:eval ((:ge completions) ,prefix))))
:test 'string=))
(defsubst geiser-completion--module-list (prefix)
@@ -205,14 +204,16 @@ terminates a current completion."
(funcall geiser-completion--symbol-begin-function module))
(save-excursion (skip-syntax-backward "^-()>") (point))))
+(defsubst geiser-completion--prefix (module)
+ (buffer-substring-no-properties (point)
+ (geiser-completion--symbol-begin module)))
+
(defun geiser-completion--complete-symbol (&optional arg)
"Complete the symbol at point.
Perform completion similar to Emacs' complete-symbol.
With prefix, complete module name."
(interactive "P")
- (let* ((end (point))
- (beg (geiser-completion--symbol-begin arg))
- (prefix (buffer-substring-no-properties beg end))
+ (let* ((prefix (geiser-completion--prefix arg))
(result (geiser-completion--complete prefix arg))
(completions (car result))
(partial (cdr result)))
diff --git a/elisp/geiser-connection.el b/elisp/geiser-connection.el
index 33579f6..4f8592b 100644
--- a/elisp/geiser-connection.el
+++ b/elisp/geiser-connection.el
@@ -160,11 +160,15 @@
(defun geiser-con--comint-buffer-form ()
(with-current-buffer (geiser-con--comint-buffer)
- (geiser-syntax--prepare-scheme-for-elisp-reader)
(condition-case nil
- (let ((form (read (current-buffer))))
- (if (listp form) form (error)))
- (error `((error (key . geiser-con-error) (msg . ,(buffer-string))))))))
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "((\\(result\\|error\\)\\>")
+ (goto-char (match-beginning 0))
+ (let ((form (read (current-buffer))))
+ (if (listp form) form (error))))
+ (error `((error (key . geiser-con-error))
+ (output . ,(buffer-string)))))))
(defun geiser-con--process-next (con)
(when (not (geiser-con--connection-current-request con))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 7ebd0b5..6d795df 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -25,6 +25,7 @@
;;; Code:
+(require 'geiser-impl)
(require 'geiser-eval)
(require 'geiser-popup)
(require 'geiser-base)
@@ -32,15 +33,23 @@
;;; Debug buffer mode:
-(defconst geiser-debug--error-alist
- '(("^\\(In file +\\| +\\)\\([^ \n]+\\):\\([0-9]+\\):\\([0-9]+\\)" 2 3 4)
- ("^Error.+$" nil nil nil 0)))
+(defvar geiser-debug-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (set-keymap-parent map button-buffer-map)
+ map))
-(define-derived-mode geiser-debug-mode compilation-mode "Geiser Dbg"
+(defun geiser-debug-mode ()
"A major mode for displaying Scheme compilation and evaluation results.
\\{geiser-debug-mode-map}"
- (set (make-local-variable 'compilation-error-regexp-alist)
- geiser-debug--error-alist))
+ (interactive)
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (use-local-map geiser-debug-mode-map)
+ (set-syntax-table scheme-mode-syntax-table)
+ (setq mode-name "Geiser DBG")
+ (setq major-mode 'geiser-debug-mode)
+ (setq buffer-read-only t))
;;; Buffer for displaying evaluation results:
@@ -50,42 +59,25 @@
;;; Displaying retorts
-(defun geiser-debug--display-retort (what ret)
+(defun geiser-debug--display-retort (what ret &optional res)
(let* ((err (geiser-eval--retort-error ret))
+ (key (geiser-eval--error-key err))
(output (geiser-eval--retort-output ret))
- (stack (geiser-eval--retort-stack ret)))
+ (impl geiser-impl--implementation)
+ (module (geiser-eval--get-module)))
(geiser-debug--with-buffer
(erase-buffer)
(insert what)
(newline 2)
- (when err (insert (geiser-eval--error-str err) "\n\n"))
- (when output (insert output "\n\n"))
- (when stack (geiser-debug--display-stack stack))
+ (when res
+ (insert res)
+ (newline 2))
+ (unless (geiser-impl--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)))
(when err (geiser-debug--pop-to-buffer))))
-(defsubst geiser-debug--frame-proc (frame) (cdr (assoc 'procedure frame)))
-(defsubst geiser-debug--frame-desc (frame) (cdr (assoc 'description frame)))
-(defsubst geiser-debug--frame-source (frame) (cdr (assoc 'source frame)))
-(defsubst geiser-debug--frame-source-file (src) (car src))
-(defsubst geiser-debug--frame-source-line (src) (or (cadr src) 1))
-(defsubst geiser-debug--frame-source-column (src) (or (caddr src) 0))
-
-(defun geiser-debug--display-stack (stack)
- (mapc 'geiser-debug--display-stack-frame (reverse (cdr stack))))
-
-(defun geiser-debug--display-stack-frame (frame)
- (let ((procedure (geiser-debug--frame-proc frame))
- (source (geiser-debug--frame-source frame))
- (description (geiser-debug--frame-desc frame)))
- (if source
- (insert (format "In file %s:%s:%s\n"
- (geiser-debug--frame-source-file source)
- (geiser-debug--frame-source-line source)
- (1+ (geiser-debug--frame-source-column source))))
- (insert "In expression:\n"))
- (insert (format "%s\n" description))))
-
(defsubst geiser-debug--wrap-region (str)
(format "(begin %s)" str))
@@ -99,10 +91,11 @@
(wrapped (if wrap (geiser-debug--wrap-region str) str))
(code `(,(if compile :comp :eval) (:scm ,wrapped)))
(ret (geiser-eval--send/wait code))
+ (res (geiser-eval--retort-result-str ret))
(err (geiser-eval--retort-error ret)))
(when and-go (funcall and-go))
- (when (not err) (message (format "=> %s" (geiser-eval--retort-result ret))))
- (geiser-debug--display-retort str ret)))
+ (when (not err) (message "%s" res))
+ (geiser-debug--display-retort str ret res)))
(defun geiser-debug--expand-region (start end all wrap)
(let* ((str (buffer-substring-no-properties start end))
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index 8024239..29f0de2 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -24,7 +24,9 @@
;;; Code:
+(require 'geiser-impl)
(require 'geiser-completion)
+(require 'geiser-autodoc)
(require 'geiser-eval)
(require 'geiser-syntax)
(require 'geiser-popup)
@@ -157,32 +159,27 @@
;;; Commands:
-(make-variable-buffer-local
- (defvar geiser-doc--external-help-function nil))
-
-(defun geiser-doc--external-help (symbol module)
- (and geiser-doc--external-help-function
- (funcall geiser-doc--external-help-function symbol module)))
-
(defun geiser-doc--get-docstring (symbol module)
- (geiser-eval--send/result `(:eval ((:ge symbol-documentation) ',symbol) ,module)))
+ (geiser-eval--send/result
+ `(:eval ((:ge symbol-documentation) ',symbol) ,module)))
(defun geiser-doc--get-module-exports (module)
(geiser-eval--send/result `(:eval ((:ge module-exports) (:module ,module)))))
(defun geiser-doc-symbol (symbol &optional module impl)
- (let ((module (or module (geiser-eval--get-module))))
- (unless (geiser-doc--external-help symbol module)
- (let ((impl (or impl geiser-impl--implementation))
- (ds (geiser-doc--get-docstring symbol module)))
+ (let ((module (or module (geiser-eval--get-module)))
+ (impl (or impl geiser-impl--implementation)))
+ (unless (geiser-impl--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)
(geiser-doc--with-buffer
(erase-buffer)
- (geiser-doc--insert-title (cdr (assoc 'signature ds)))
+ (geiser-doc--insert-title (geiser-autodoc--str (list (format "%s" symbol) 0)
+ (cdr (assoc 'signature ds))))
(newline)
(insert (or (cdr (assoc 'docstring ds)) ""))
- (goto-line (point-min))
+ (goto-char (point-min))
(setq geiser-doc--buffer-link
(geiser-doc--history-push
(geiser-doc--make-link symbol module impl))))
@@ -193,7 +190,8 @@
With prefix argument, ask for symbol (with completion)."
(interactive "P")
(let ((symbol (or (and (not arg) (symbol-at-point))
- (geiser-completion--read-symbol "Symbol: " (symbol-at-point)))))
+ (geiser-completion--read-symbol "Symbol: "
+ (symbol-at-point)))))
(when symbol (geiser-doc-symbol symbol))))
@@ -219,7 +217,8 @@ With prefix argument, ask for symbol (with completion)."
impl))
(goto-char (point-min))
(setq geiser-doc--buffer-link
- (geiser-doc--history-push (geiser-doc--make-link nil module impl))))
+ (geiser-doc--history-push
+ (geiser-doc--make-link nil module impl))))
(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 986099e..0ec1669 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -44,7 +44,11 @@
(geiser-edit--define-custom-visit
geiser-edit-symbol-method geiser-mode
- "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point].")
+ "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point]
+or following links in error buffers.")
+
+(geiser-custom--defface error-link
+ 'link geiser-debug "links in error buffers")
;;; Auxiliar functions:
@@ -52,6 +56,7 @@
(defun geiser-edit--visit-file (file method)
(cond ((eq method 'window) (find-file-other-window file))
((eq method 'frame) (find-file-other-frame file))
+ ((eq method 'noselect) (find-file-noselect file t))
(t (find-file file))))
(defsubst geiser-edit--location-name (loc)
@@ -60,8 +65,18 @@
(defsubst geiser-edit--location-file (loc)
(cdr (assoc 'file loc)))
+(defsubst geiser-edit--to-number (x)
+ (cond ((numberp x) x)
+ ((stringp x) (string-to-number x))))
+
(defsubst geiser-edit--location-line (loc)
- (cdr (assoc 'line loc)))
+ (geiser-edit--to-number (cdr (assoc 'line loc))))
+
+(defsubst geiser-edit--location-column (loc)
+ (geiser-edit--to-number (cdr (assoc 'column loc))))
+
+(defsubst geiser-edit--make-location (name file line column)
+ `((name . ,name) (file . ,file) (line . ,line) (column . ,column)))
(defconst geiser-edit--def-re
(regexp-opt '("define"
@@ -92,8 +107,9 @@
(format "\\_<%s\\_>" (regexp-quote (format "%s" thing))))
(defun geiser-edit--goto-line (symbol line)
+ (goto-char (point-min))
(if (numberp line)
- (goto-line line)
+ (forward-line (max 0 (1- line)))
(goto-char (point-min))
(when (or (re-search-forward (geiser-edit--def-re symbol) nil t)
(re-search-forward (geiser-edit--def-re* symbol) nil t)
@@ -103,26 +119,51 @@
(defun geiser-edit--try-edit-location (symbol loc &optional method)
(let ((symbol (or (geiser-edit--location-name loc) symbol))
(file (geiser-edit--location-file loc))
- (line (geiser-edit--location-line loc)))
+ (line (geiser-edit--location-line loc))
+ (col (geiser-edit--location-column loc)))
(unless file (error "Couldn't find edit location for '%s'" symbol))
(unless (file-readable-p file) (error "Couldn't open '%s' for read" file))
(geiser-edit--visit-file file (or method geiser-edit-symbol-method))
- (geiser-edit--goto-line symbol line)))
+ (geiser-edit--goto-line symbol line)
+ (when col
+ (beginning-of-line)
+ (forward-char col))
+ (cons (current-buffer) (point))))
-(defsubst geiser-edit--try-edit (symbol ret)
- (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret)))
+(defsubst geiser-edit--try-edit (symbol ret &optional method)
+ (geiser-edit--try-edit-location symbol (geiser-eval--retort-result ret) method))
+
+
+;;; Links
+
+(define-button-type 'geiser-edit--button
+ 'action 'geiser-edit--button-action
+ 'face 'geiser-font-lock-error-link
+ 'follow-link t)
+
+(defun geiser-edit--button-action (button)
+ (let ((loc (button-get button 'geiser-location)))
+ (when loc (geiser-edit--try-edit-location nil loc))))
+
+(defun geiser-edit--make-link (beg end file line col)
+ (make-button beg end
+ :type 'geiser-edit--button
+ 'geiser-location
+ (geiser-edit--make-location 'error file line col)
+ 'help-echo "Go to error location"))
;;; Commands:
-(defun geiser-edit-symbol ()
+(defvar geiser-edit--symbol-history nil)
+
+(defun geiser-edit-symbol (symbol &optional method)
"Asks for a symbol to edit, with completion."
- (interactive)
- (let* ((symbol (geiser-completion--read-symbol "Edit symbol: "
- nil
- geiser-edit--symbol-history))
- (cmd `(:eval ((:ge symbol-location) ',symbol))))
- (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd))))
+ (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)))
(defun geiser-edit-symbol-at-point (&optional arg)
"Opens a new window visiting the definition of the symbol at point.
@@ -142,11 +183,11 @@ With prefix, asks for the symbol to edit."
(pop-tag-mark)
(error "No previous location for find symbol invocation")))
-(defun geiser-edit-module (module)
+(defun geiser-edit-module (module &optional method)
"Asks for a module and opens it in a new buffer."
(interactive (list (geiser-completion--read-module)))
(let ((cmd `(:eval ((:ge module-location) (:module ,module)))))
- (geiser-edit--try-edit module (geiser-eval--send/wait cmd))))
+ (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method)))
(provide 'geiser-edit)
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index c493092..1c8cbfe 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -54,25 +54,6 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
;;; Code formatting:
-(defun geiser-eval--scheme-str (code)
- (cond ((null code) "'()")
- ((eq code :f) "#f")
- ((eq code :t) "#t")
- ((listp code)
- (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code)))
- ((eq (car code) :comp) (geiser-eval--comp (cdr code)))
- ((eq (car code) :load-file)
- (geiser-eval--load-file (cadr code)))
- ((eq (car code) :comp-file)
- (geiser-eval--comp-file (cadr code)))
- ((eq (car code) :module) (geiser-eval--module (cadr code)))
- ((eq (car code) :ge) (geiser-eval--ge (cadr code)))
- ((eq (car code) :scm) (cadr code))
- (t (concat "("
- (mapconcat 'geiser-eval--scheme-str code " ") ")"))))
- ((symbolp code) (format "%s" code))
- (t (format "%S" code))))
-
(defsubst geiser-eval--eval (code)
(geiser-eval--scheme-str
`(,(geiser-eval--form 'eval) (quote ,(nth 0 code))
@@ -99,6 +80,25 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
(defsubst geiser-eval--ge (proc)
(geiser-eval--scheme-str (geiser-eval--form proc)))
+(defun geiser-eval--scheme-str (code)
+ (cond ((null code) "'()")
+ ((eq code :f) "#f")
+ ((eq code :t) "#t")
+ ((listp code)
+ (cond ((eq (car code) :eval) (geiser-eval--eval (cdr code)))
+ ((eq (car code) :comp) (geiser-eval--comp (cdr code)))
+ ((eq (car code) :load-file)
+ (geiser-eval--load-file (cadr code)))
+ ((eq (car code) :comp-file)
+ (geiser-eval--comp-file (cadr code)))
+ ((eq (car code) :module) (geiser-eval--module (cadr code)))
+ ((eq (car code) :ge) (geiser-eval--ge (cadr code)))
+ ((eq (car code) :scm) (cadr code))
+ (t (concat "("
+ (mapconcat 'geiser-eval--scheme-str code " ") ")"))))
+ ((symbolp code) (format "%s" code))
+ (t (format "%S" code))))
+
;;; Code sending:
@@ -145,11 +145,17 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
(defun geiser-eval--retort-result (ret)
(let ((values (cdr (assoc 'result ret))))
- (if (> (length values) 1) (cons :values values) (car values))))
+ (and (stringp (car values))
+ (ignore-errors (car (read-from-string (car values)))))))
+
+(defun geiser-eval--retort-result-str (ret)
+ (let ((values (cdr (assoc 'result ret))))
+ (if values
+ (concat "=> " (mapconcat 'identity values "\n=> "))
+ "(No value)")))
(defsubst geiser-eval--retort-output (ret) (cdr (assoc 'output ret)))
(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret)))
-(defsubst geiser-eval--retort-stack (ret) (cdr (assoc 'stack ret)))
(defsubst geiser-eval--error-key (err) (cdr (assoc 'key err)))
(defsubst geiser-eval--error-subr (err) (cdr (assoc 'subr err)))
@@ -160,7 +166,7 @@ EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be supported."))
(let* ((key (geiser-eval--error-key err))
(key-str (if key (format ": %s" key) ":"))
(subr (geiser-eval--error-subr err))
- (subr-str (if subr (format " (%s):" subr) ":"))
+ (subr-str (if subr (format " (%s):" subr) ""))
(msg (geiser-eval--error-msg err))
(msg-str (if msg (format "\n %s" msg) ""))
(rest (geiser-eval--error-rest err))
diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index 44a4e9f..ed14e87 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -27,6 +27,9 @@
(require 'geiser-syntax)
(require 'geiser-custom)
(require 'geiser-base)
+(require 'geiser-eval)
+(require 'geiser-edit)
+(require 'geiser)
;;; Customization:
@@ -121,6 +124,44 @@ This function uses `geiser-guile-init-file' if it exists."
(save-excursion (skip-syntax-backward "^-()>") (point))))
+;;; Error display
+(defvar geiser-guile--file-cache (make-hash-table :test 'equal))
+
+(defun geiser-guile--resolve-file (file)
+ (when (and (stringp file) (not (string-equal file "unknown file")))
+ (if (file-name-absolute-p file) file
+ (or (gethash file geiser-guile--file-cache)
+ (puthash file
+ (geiser-eval--send/result `(:eval ((:ge find-file) ,file)))
+ geiser-guile--file-cache)))))
+
+(defconst geiser-guile--file-rx
+ "^In \\([^\n:]+\\):\n *\\([[:digit:]]+\\|\\?\\):")
+
+(defun geiser-guile--find-files ()
+ (save-excursion
+ (while (re-search-forward geiser-guile--file-rx nil t)
+ (let ((file (match-string 1))
+ (beg (match-beginning 1))
+ (end (match-end 1))
+ (line (string-to-number (or (match-string 2) "0"))))
+ (let ((file (geiser-guile--resolve-file file)))
+ (when file
+ (geiser-edit--make-link beg end file line 0)))))))
+
+(defun geiser-guile-display-error (module key msg)
+ (when key
+ (insert "Error: ")
+ (geiser--insert-with-face (format "%s" key) 'bold)
+ (newline 2))
+ (when msg
+ (let ((p (point)))
+ (insert msg)
+ (goto-char p)
+ (geiser-guile--find-files)))
+ t)
+
+
;;; Trying to ascertain whether a buffer is Guile Scheme:
(defun geiser-guile-guess ()
diff --git a/elisp/geiser-impl.el b/elisp/geiser-impl.el
index 6bc4e79..00fa1ef 100644
--- a/elisp/geiser-impl.el
+++ b/elisp/geiser-impl.el
@@ -27,7 +27,6 @@
(require 'geiser-eval)
(require 'geiser-base)
-(require 'geiser-doc)
(require 'geiser-completion)
@@ -47,16 +46,63 @@
:type '(repeat symbol)
:group 'geiser-impl)
+(defcustom geiser-impl-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
+determine its scheme flavour."
+ :type '(repeat (list (choice (group :tag "Regular expression"
+ (const regexp) regexp)
+ (group :tag "Directory"
+ (const dir) directory))
+ symbol))
+ :group 'geiser-impl)
+
+
+;;; Auxiliary functions:
+(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)))
+
+(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)
+(make-variable-buffer-local
+ (defvar geiser-impl--implementation nil))
+
(defun geiser-impl--register (impl)
- (add-to-list 'geiser-impl--impls 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)))
+ (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)
@@ -74,9 +120,6 @@
;;; Installing Scheme implementations:
-(make-variable-buffer-local
- (defvar geiser-impl--implementation nil))
-
(defvar geiser-impl--impl-prompt-history nil)
(defun geiser-impl--read-impl (&optional prompt impls non-req)
@@ -97,37 +140,12 @@
(geiser-impl--install-vars 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)))
-
(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--external-help-function (impl)
- (let ((f (geiser-impl--sym impl "external-help")))
- (and (fboundp f) f)))
-
(defsubst geiser-impl--symbol-begin (impl)
(geiser-impl--sym impl "symbol-begin"))
@@ -136,8 +154,6 @@
(geiser-impl--module-function impl))
(setq geiser-eval--geiser-procedure-function
(geiser-impl--geiser-procedure-function impl))
- (setq geiser-doc--external-help-function
- (geiser-impl--external-help-function impl))
(setq geiser-completion--symbol-begin-function
(geiser-impl--symbol-begin impl)))
@@ -150,8 +166,6 @@
(geiser-impl--module-function imp))
(geiser-eval--geiser-procedure-function
(geiser-impl--geiser-procedure-function imp))
- (geiser-doc--external-help-function
- (geiser-impl--external-help-function imp))
(geiser-completion--symbol-begin-function
(geiser-impl--symbol-begin imp)))
(funcall thunk)))
@@ -171,7 +185,8 @@
(geiser-impl--call-if-bound (geiser-impl--default-implementation)
"geiser-procedure"
proc))
-(set-default 'geiser-eval--geiser-procedure-function 'geiser-impl-geiser-procedure)
+(set-default 'geiser-eval--geiser-procedure-function
+ 'geiser-impl-geiser-procedure)
;;; Access to implementation specific execution parameters:
@@ -191,6 +206,12 @@
(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))
+
+(defsubst geiser-impl--display-error (impl module key msg)
+ (geiser-impl--call-if-bound impl "display-error" module key msg))
+
;;; Access to implementation guessing function:
@@ -199,22 +220,58 @@
"Set this buffer local variable to specify the Scheme
implementation to be used by Geiser."))
+(defun geiser-impl--match-impl (desc bn)
+ (let ((rx (if (eq (car desc) 'regexp)
+ (cadr desc)
+ (format "^%s" (regexp-quote (cadr desc))))))
+ (and rx (string-match-p rx bn))))
+
(defun geiser-impl--guess ()
(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)
+ (throw 'impl (cadr x))))))
(dolist (impl geiser-impl--impls)
(when (geiser-impl--call-if-bound impl "guess")
(throw 'impl impl))))
(geiser-impl--default-implementation)))
+;;; 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)))))
+
+
;;; Unload support
(defun geiser-impl-unload-function ()
(dolist (imp (mapcar 'geiser-impl--impl-feature geiser-impl--impls))
- (when (featurep imp) (unload-feature imp)))
- t)
+ (when (featurep imp) (unload-feature imp t))))
(defun geiser-impl--reload-implementations (impls)
(dolist (impl impls)
@@ -223,8 +280,11 @@ implementation to be used by Geiser."))
;;; Initialization:
-(mapc 'geiser-impl--register geiser-impl-installed-implementations)
+(eval-after-load 'geiser-impl
+ '(mapc 'geiser-impl--register
+ (or geiser-impl-installed-implementations '(guile plt))))
(provide 'geiser-impl)
+
;;; geiser-impl.el ends here
diff --git a/elisp/geiser-install.el.in b/elisp/geiser-install.el.in
new file mode 100644
index 0000000..da9f28f
--- /dev/null
+++ b/elisp/geiser-install.el.in
@@ -0,0 +1,5 @@
+(require 'geiser)
+
+(setq geiser-scheme-dir "@SCHEME_DIR@")
+
+(provide 'geiser-install)
diff --git a/elisp/geiser-log.el b/elisp/geiser-log.el
index 68e0fae..27a485a 100644
--- a/elisp/geiser-log.el
+++ b/elisp/geiser-log.el
@@ -28,6 +28,8 @@
(require 'geiser-popup)
(require 'geiser-base)
+(require 'comint)
+
;;; Customization:
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index e19cb68..fa686ec 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -28,6 +28,7 @@
(require 'geiser-doc)
(require 'geiser-compile)
(require 'geiser-completion)
+(require 'geiser-company)
(require 'geiser-xref)
(require 'geiser-edit)
(require 'geiser-autodoc)
@@ -52,6 +53,11 @@
:group 'geiser-autodoc
:type 'boolean)
+(defcustom geiser-mode-company-p t
+ "Whether to use company-mode for completion, if available."
+ :group 'geiser-mode
+ :type 'boolean)
+
(defcustom geiser-mode-smart-tab-p nil
"Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers."
:group 'geiser-mode
@@ -188,6 +194,7 @@ interacting with the Geiser REPL is at your disposal.
(when geiser-mode (geiser-impl--set-buffer-implementation))
(setq geiser-autodoc-mode-string "/A")
(setq geiser-smart-tab-mode-string "/T")
+ (geiser-company--setup (and geiser-mode geiser-mode-company-p))
(when geiser-mode-autodoc-p (geiser-autodoc-mode geiser-mode))
(when geiser-mode-smart-tab-p (geiser-smart-tab-mode geiser-mode)))
@@ -261,6 +268,10 @@ interacting with the Geiser REPL is at your disposal.
(geiser-mode 1)
(when (cdr b) (geiser-impl--set-buffer-implementation (cdr b))))))
+(defun geiser-mode-unload-function ()
+ (dolist (b (geiser-mode--buffers))
+ (with-current-buffer (car b) (geiser-mode nil))))
+
(provide 'geiser-mode)
;;; geiser-mode.el ends here
diff --git a/elisp/geiser-plt.el b/elisp/geiser-plt.el
index 44312b9..8810250 100644
--- a/elisp/geiser-plt.el
+++ b/elisp/geiser-plt.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'geiser-edit)
+(require 'geiser-doc)
(require 'geiser-eval)
(require 'geiser-syntax)
(require 'geiser-custom)
@@ -109,7 +111,7 @@ This function uses `geiser-plt-init-file' if it exists."
:f)))
(defun geiser-plt-get-module (&optional module)
- (cond ((and (null module) (geiser-plt--explicit-module)))
+ (cond ((and (null module) (buffer-file-name))) ;; (geiser-plt--explicit-module)
((null module) (geiser-plt--implicit-module))
((symbolp module) module)
((and (stringp module) (file-name-absolute-p module)) module)
@@ -121,13 +123,47 @@ This function uses `geiser-plt-init-file' if it exists."
;;; External help
+
(defun geiser-plt-external-help (symbol module)
(message "Requesting help for '%s'..." symbol)
- (geiser-eval--send/wait `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc))
+ (geiser-eval--send/wait
+ `(:eval (get-help ',symbol (:module ,module)) geiser/autodoc))
(minibuffer-message "%s done" (current-message))
t)
+;;; Error display
+
+(defconst geiser-plt--file-rxs '("^\\([^:\n\"]+\\):\\([0-9]+\\):\\([0-9]+\\)"
+ "path:\"?\\([^>\"\n]+\\)\"?>"
+ "module: \"\\([^>\"\n]+\\)\""))
+
+(defun geiser-plt--find-files (rx)
+ (save-excursion
+ (while (re-search-forward rx nil t)
+ (geiser-edit--make-link (match-beginning 1)
+ (match-end 1)
+ (match-string 1)
+ (match-string 2)
+ (match-string 3)))))
+
+(defun geiser-plt-display-error (module key msg)
+ (when key
+ (insert "Error: ")
+ (geiser-doc--insert-button key nil 'plt)
+ (newline 2))
+ (when msg
+ (let ((p (point)))
+ (insert msg)
+ (let ((end (point)))
+ (goto-char p)
+ (mapc 'geiser-plt--find-files geiser-plt--file-rxs)
+ (goto-char end)
+ (fill-region p end)
+ (newline))))
+ t)
+
+
;;; Trying to ascertain whether a buffer is mzscheme scheme:
(defun geiser-plt-guess ()
@@ -135,7 +171,7 @@ This function uses `geiser-plt-init-file' if it exists."
(goto-char (point-min))
(re-search-forward "#lang " nil t))
(geiser-plt--explicit-module)
- (string-equal (file-name-extension (buffer-file-name)) "ss")))
+ (string-equal (file-name-extension (or (buffer-file-name) "")) "ss")))
(provide 'geiser-plt)
diff --git a/elisp/geiser-reload.el b/elisp/geiser-reload.el
new file mode 100644
index 0000000..5a30e1f
--- /dev/null
+++ b/elisp/geiser-reload.el
@@ -0,0 +1,95 @@
+;; geiser-reload.el -- unload/load geiser packages
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Aug 22, 2009 23:04
+
+;; 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/>.
+
+;;; Code:
+
+(require 'geiser-impl)
+(require 'geiser-repl)
+(require 'geiser-mode)
+(require 'geiser-base)
+(require 'geiser)
+
+
+;;; Reload:
+
+(defmacro geiser--features-list ()
+ (quote '(
+ geiser-mode
+ geiser-repl
+ geiser-xref
+ geiser-edit
+ geiser-doc
+ geiser-debug
+ geiser-impl
+ geiser-company
+ geiser-completion
+ geiser-autodoc
+ geiser-compile
+ geiser-eval
+ geiser-connection
+ geiser-syntax
+ geiser-log
+ geiser-custom
+ geiser-base
+ geiser-popup
+ geiser-install
+ geiser
+ geiser-version
+ )))
+
+(defun geiser-unload ()
+ "Unload all Geiser modules."
+ (interactive)
+ (let ((fs (geiser--features-list)))
+ (unload-feature 'geiser-reload t)
+ (dolist (f fs)
+ (when (featurep f) (unload-feature f t)))))
+
+(defun geiser-reload (&optional arg)
+ "Reload Geiser.
+With prefix arg, prompts for the DIRECTORY from which Geiser should be
+loaded again."
+ (interactive "P")
+ (let* ((old-dir geiser-elisp-dir)
+ (dir (or (and arg (read-directory-name "New Geiser elisp dir: "
+ old-dir old-dir t old-dir))
+ old-dir)))
+ (unless (or (file-exists-p (expand-file-name "geiser-reload.el" dir))
+ (file-exists-p (expand-file-name "geiser-reload.elc" dir)))
+ (error "%s does not contain Geiser!" dir))
+ (let ((installed (featurep 'geiser-install))
+ (installed-impls geiser-impl-installed-implementations)
+ (impls geiser-impl--impls)
+ (repls (geiser-repl--repl-list))
+ (buffers (geiser-mode--buffers)))
+ (geiser-unload)
+ (setq load-path (remove old-dir load-path))
+ (add-to-list 'load-path dir)
+ (setq geiser-impl-installed-implementations installed-impls)
+ (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!"))))
+
+
+(provide 'geiser-reload)
+;;; geiser-reload.el ends here
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index f4d85dc..4ea1bb7 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -24,6 +24,7 @@
;;; Code:
+(require 'geiser-company)
(require 'geiser-autodoc)
(require 'geiser-edit)
(require 'geiser-impl)
@@ -70,6 +71,11 @@ implementation name gets appended to it."
:type 'boolean
:group 'geiser-repl)
+(defcustom geiser-repl-company-p t
+ "Whether to use company-mode for completion, if available."
+ :group 'geiser-mode
+ :type 'boolean)
+
(defcustom geiser-repl-read-only-prompt-p t
"Whether the REPL's prompt should be read-only."
:type 'boolean
@@ -141,8 +147,8 @@ implementation name gets appended to it."
(geiser-repl--history-setup)
(geiser-con--setup-connection (current-buffer) prompt-rx)
(add-to-list 'geiser-repl--repls (current-buffer))
- (geiser-impl--startup impl)
- (geiser-repl--set-this-buffer-repl (current-buffer))))
+ (geiser-repl--set-this-buffer-repl (current-buffer))
+ (geiser-impl--startup impl)))
(defun geiser-repl--process ()
(let ((buffer (geiser-repl--get-repl geiser-impl--implementation)))
@@ -152,8 +158,10 @@ implementation name gets appended to it."
(setq geiser-eval--default-proc-function 'geiser-repl--process)
(defun geiser-repl--wait-for-prompt (timeout)
- (let ((p (point)) (seen))
- (while (and (not seen) (> timeout 0))
+ (let ((p (point)) (seen) (buffer (current-buffer)))
+ (while (and (not seen)
+ (> timeout 0)
+ (get-buffer-process buffer))
(sleep-for 0.1)
(setq timeout (- timeout 100))
(goto-char p)
@@ -176,7 +184,8 @@ implementation name gets appended to it."
(interactive
(list (or (geiser-repl--only-impl-p)
(and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation)
- (geiser-repl--read-impl "Start Geiser for scheme implementation: "))))
+ (geiser-repl--read-impl
+ "Start Geiser for scheme implementation: "))))
(geiser-repl--start-repl impl))
(defun switch-to-geiser (&optional ask impl)
@@ -254,7 +263,8 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
(set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter)
(add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t)
(comint-read-input-ring t)
- (set-process-sentinel (get-buffer-process (current-buffer)) 'geiser-repl--sentinel))
+ (set-process-sentinel (get-buffer-process (current-buffer))
+ 'geiser-repl--sentinel))
;;; geiser-repl mode:
@@ -288,18 +298,22 @@ If no REPL is running, execute `run-geiser' to start a fresh one."
'geiser-repl--beginning-of-defun)
(set-syntax-table scheme-mode-syntax-table)
(setq geiser-eval--get-module-function 'geiser-repl--module-function)
- (when geiser-repl-autodoc-p (geiser-autodoc-mode 1)))
+ (when geiser-repl-autodoc-p (geiser-autodoc-mode 1))
+ (geiser-company--setup geiser-repl-company-p)
+ (compilation-shell-minor-mode 1))
(define-key geiser-repl-mode-map "\C-d" 'delete-char)
-(define-key geiser-repl-mode-map "\C-cz" 'run-geiser)
-(define-key geiser-repl-mode-map "\C-c\C-z" 'run-geiser)
+(define-key geiser-repl-mode-map "\C-ck" 'geiser-repl-nuke)
+(define-key geiser-repl-mode-map "\C-c\C-k" 'geiser-repl-nuke)
+
+(define-key geiser-repl-mode-map "\C-cz" 'switch-to-geiser)
+(define-key geiser-repl-mode-map "\C-c\C-z" 'switch-to-geiser)
(define-key geiser-repl-mode-map "\C-a" 'geiser-repl--bol)
(define-key geiser-repl-mode-map (kbd "<home>") 'geiser-repl--bol)
(define-key geiser-repl-mode-map "\C-ca" 'geiser-autodoc-mode)
(define-key geiser-repl-mode-map "\C-cd" 'geiser-doc-symbol-at-point)
(define-key geiser-repl-mode-map "\C-cm" 'geiser-repl--doc-module)
-(define-key geiser-repl-mode-map "\C-ck" 'geiser-compile-file)
(define-key geiser-repl-mode-map "\C-cl" 'geiser-load-file)
(define-key geiser-repl-mode-map "\M-p" 'comint-previous-matching-input-from-input)
@@ -326,7 +340,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 impl))))
+ (when impl (geiser nil impl))))
(defun geiser-repl-unload-function ()
(dolist (repl geiser-repl--repls)
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index 14d996c..ca218c8 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -80,87 +80,183 @@
(with-syntax 1))
+;;; A simple scheme reader
+
+(defvar geiser-syntax--read/buffer-limit nil)
+
+(defsubst geiser-syntax--read/eos ()
+ (or (eobp)
+ (and geiser-syntax--read/buffer-limit
+ (<= geiser-syntax--read/buffer-limit (point)))))
+
+(defsubst geiser-syntax--read/next-char ()
+ (unless (geiser-syntax--read/eos)
+ (forward-char)
+ (char-after)))
+
+(defsubst geiser-syntax--read/token (token)
+ (geiser-syntax--read/next-char)
+ (if (listp token) token (list token)))
+
+(defsubst geiser-syntax--read/elisp ()
+ (ignore-errors (read (current-buffer))))
+
+(defun geiser-syntax--read/matching (open close)
+ (let ((count 1)
+ (p (1+ (point))))
+ (while (and (> count 0)
+ (geiser-syntax--read/next-char))
+ (cond ((looking-at-p open) (setq count (1+ count)))
+ ((looking-at-p close) (setq count (1- count)))))
+ (buffer-substring-no-properties p (point))))
+
+(defsubst geiser-syntax--read/unprintable ()
+ (geiser-syntax--read/token
+ (cons 'unprintable (geiser-syntax--read/matching "<" ">"))))
+
+(defun geiser-syntax--read/skip-comment ()
+ (while (and (geiser-syntax--read/next-char)
+ (nth 8 (syntax-ppss))))
+ (geiser-syntax--read/next-token))
+
+(defun geiser-syntax--read/next-token ()
+ (skip-syntax-forward "->")
+ (if (geiser-syntax--read/eos) '(eob)
+ (case (char-after)
+ (?\; (geiser-syntax--read/skip-comment))
+ ((?\( ?\[) (geiser-syntax--read/token 'lparen))
+ ((?\) ?\]) (geiser-syntax--read/token 'rparen))
+ (?. (if (memq (syntax-after (1+ (point))) '(0 11 12))
+ (geiser-syntax--read/token 'dot)
+ (cons 'atom (geiser-syntax--read/elisp))))
+ (?\# (case (geiser-syntax--read/next-char)
+ ('nil '(eob))
+ (?| (geiser-syntax--read/skip-comment))
+ (?: (if (geiser-syntax--read/next-char)
+ (cons 'kwd (geiser-syntax--read/elisp))
+ '(eob)))
+ (?\\ (cons 'char (geiser-syntax--read/elisp)))
+ (?\( (geiser-syntax--read/token 'vectorb))
+ (?\< (geiser-syntax--read/unprintable))
+ (t (let ((tok (geiser-syntax--read/elisp)))
+ (if tok (cons 'atom (intern (format "#%s" tok)))
+ (geiser-syntax--read/next-token))))))
+ (?\' (geiser-syntax--read/token '(quote . quote)))
+ (?\` (geiser-syntax--read/token
+ `(backquote . ,backquote-backquote-symbol)))
+ (?, (if (eq (geiser-syntax--read/next-char) ?@)
+ (geiser-syntax--read/token
+ `(splice . ,backquote-splice-symbol))
+ `(unquote . ,backquote-unquote-symbol)))
+ (?\" (cons 'string (geiser-syntax--read/elisp)))
+ (t (cons 'atom (geiser-syntax--read/elisp))))))
+
+(defsubst geiser-syntax--read/match (&rest tks)
+ (let ((token (geiser-syntax--read/next-token)))
+ (if (memq (car token) tks) token
+ (error "Unexpected token: %s" token))))
+
+(defsubst geiser-syntax--read/try (&rest tks)
+ (let ((p (point))
+ (tk (ignore-errors (apply 'geiser-syntax--read/match tks))))
+ (unless tk (goto-char p))
+ tk))
+
+(defun geiser-syntax--read/list ()
+ (cond ((geiser-syntax--read/try 'dot)
+ (let ((tail (geiser-syntax--read)))
+ (geiser-syntax--read/match 'eob 'rparen)
+ tail))
+ ((geiser-syntax--read/try 'rparen 'eob) nil)
+ (t (cons (geiser-syntax--read)
+ (geiser-syntax--read/list)))))
+
+(defun geiser-syntax--read ()
+ (let ((token (geiser-syntax--read/next-token)))
+ (case (car token)
+ (eob nil)
+ (lparen (geiser-syntax--read/list))
+ (vectorb (apply 'vector (geiser-syntax--read/list)))
+ ((quote backquote unquote splice) (list (cdr token)
+ (geiser-syntax--read)))
+ (kwd `(:keyword . ,(cdr token)))
+ (unprintable (format "#<%s>" (cdr token)))
+ ((char string atom) (cdr token))
+ (t (error "Reading scheme syntax: unexpected token: %s" token)))))
+
+(defsubst geiser-syntax--read/keyword-value (s)
+ (and (consp s) (eq (car s) :keyword) (cdr s)))
+
+(defsubst geiser-syntax--form-after-point (&optional boundary)
+ (let ((geiser-syntax--read/buffer-limit (and (numberp boundary) boundary)))
+ (save-excursion (values (geiser-syntax--read) (point)))))
+
+
;;; Code parsing:
-(geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode)
+(defsubst geiser-syntax--skip-comment/string ()
+ (goto-char (or (nth 8 (syntax-ppss)) (point))))
-(defun geiser-syntax--prepare-scheme-for-elisp-reader ()
- (let ((end (save-excursion
- (goto-char (point-max))
- (and (re-search-backward "(output \\. \"" nil t)
- (point)))))
- (goto-char (point-min))
- (while (re-search-forward "#\<\\([^>]*?\\)\>" end t)
- (let ((from (match-beginning 1))
- (to (match-end 1)))
- (goto-char from)
- (while (re-search-forward "\\([ ;'`]\\)" to t)
- (replace-match "\\\\\\1"))
- (goto-char from)
- (while (re-search-forward "[()]" to t)
- (replace-match ""))
- (goto-char to)))
- (goto-char (point-min))
- (while (re-search-forward "#(" end t) (replace-match "(vector "))
- (goto-char (point-min))
- (while (re-search-forward "#" end t) (replace-match "\\\\#"))
- (goto-char (point-min))
- (skip-syntax-forward "^(")))
-
-(defsubst geiser-syntax--del-sexp (arg)
- (let ((p (point)))
- (forward-sexp arg)
- (delete-region p (point))))
-
-(defconst geiser-syntax--placeholder (format "___%s___" (random 100)))
-
-(defsubst geiser-syntax--beginning-of-form ()
- (memq (char-after (point)) '(?\" ?\()))
-
-(defun geiser-syntax--complete-partial-sexp (buffer begin end)
- (geiser-syntax--with-buffer
- (erase-buffer)
- (insert-buffer-substring-no-properties buffer begin end)
- (when (not (geiser-syntax--beginning-of-form))
- (skip-syntax-backward "-<>")
- (delete-region (point) (point-max)))
- (let ((p (nth 8 (syntax-ppss))))
- (when p ;; inside a comment or string
- (delete-region p (point-max))
- (insert geiser-syntax--placeholder)))
- (when (cond ((eq (char-after (1- (point))) ?\))
- (geiser-syntax--del-sexp -1) t)
- ((geiser-syntax--beginning-of-form)
- (delete-region (point) (point-max)) t)
- ((memq (char-after (1- (point))) (list ?. ?@ ?, ?\' ?\` ?\# ?\\))
- (skip-syntax-backward "^-(")
- (delete-region (point) (point-max))
- t))
- (insert geiser-syntax--placeholder))
+(defsubst geiser-syntax--nesting-level ()
+ (or (nth 0 (syntax-ppss)) 0))
+
+(defun geiser-syntax--scan-sexps ()
+ (save-excursion
+ (let* ((fst (symbol-at-point))
+ (path (and fst (list (list fst 0)))))
+ (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- (length form)))
+ (prev (and (> len-1 1) (nth (1- len-1) form)))
+ (prev (and prev
+ (geiser-syntax--read/keyword-value prev))))
+ (push `(,(car form)
+ ,len-1 ,@(and prev (symbolp prev) (list prev)))
+ path))))))
+ (nreverse path))))
+
+(defun geiser-syntax--scan-locals (form partial locals)
+ (flet ((if-symbol (x) (and (symbolp x) x))
+ (if-list (x) (and (listp x) x))
+ (normalize (vars) (mapcar (lambda (i) (if (listp i) (car i) i)) vars)))
+ (cond ((or (null form) (not (listp form))) (normalize locals))
+ ((not (memq (car form) '(define let let* letrec lambda)))
+ (geiser-syntax--scan-locals (car (last form)) partial locals))
+ (t
+ (let* ((head (car form))
+ (name (if-symbol (cadr form)))
+ (names (if name (if-list (caddr form))
+ (if-list (cadr form))))
+ (rest (if name (cdddr form) (cddr form)))
+ (use-names (or (eq head 'let*) (not partial) rest)))
+ (when name (push name locals))
+ (when use-names (dolist (n names) (push n locals)))
+ (dolist (f (butlast rest))
+ (when (eq (car f) 'define) (push (cadr f) locals)))
+ (geiser-syntax--scan-locals (car (last (or rest names)))
+ partial
+ locals))))))
+
+(defun geiser-syntax--locals-around-point ()
+ (when (eq major-mode 'scheme-mode)
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "[.@,'`#\\\\]" nil t)
- (replace-match "" nil nil))
- (goto-char (point-min))
- (while (re-search-forward "\\[" nil t)
- (replace-match "(" nil nil))
- (goto-char (point-min))
- (while (re-search-forward "\\]" nil t)
- (replace-match ")" nil nil)))
- (let ((depth (nth 0 (parse-partial-sexp (point-min) (point)))))
- (unless (zerop depth) (insert (make-string depth ?\)))))
- (when (< (point-min) (point)) (buffer-substring (point-min) (point)))))
-
-(defsubst geiser-syntax--get-partial-sexp ()
- (unless (zerop (nth 0 (syntax-ppss)))
- (let* ((end (if (geiser-syntax--beginning-of-form) (1+ (point))
- (save-excursion (skip-syntax-forward "^-\"<>()") (point))))
- (begin (save-excursion (beginning-of-defun) (point))))
- (geiser-syntax--complete-partial-sexp (current-buffer) begin end))))
+ (geiser-syntax--skip-comment/string)
+ (let ((boundary (point)))
+ (while (not (zerop (geiser-syntax--nesting-level)))
+ (backward-up-list))
+ (multiple-value-bind (form end)
+ (geiser-syntax--form-after-point boundary)
+ (geiser-syntax--scan-locals form (> end boundary) '()))))))
;;; Fontify strings as Scheme code:
+(geiser-popup--define syntax " *geiser syntax analyst*" scheme-mode)
+
(defun geiser-syntax--font-lock-buffer ()
(let ((name " *geiser font lock*"))
(or (get-buffer name)
diff --git a/elisp/geiser-version.el.in b/elisp/geiser-version.el.in
new file mode 100644
index 0000000..5b1258b
--- /dev/null
+++ b/elisp/geiser-version.el.in
@@ -0,0 +1,12 @@
+
+;;; Versioning:
+
+(defvar geiser-version-string "@PACKAGE_STRING@"
+ "Geiser's version as a string.")
+
+(defun geiser-version ()
+ "Echoes Geiser's version."
+ (interactive)
+ (message "%s" geiser-version-string))
+
+(provide 'geiser-version)
diff --git a/elisp/geiser.el b/elisp/geiser.el
index b12127c..64d4efb 100644
--- a/elisp/geiser.el
+++ b/elisp/geiser.el
@@ -27,9 +27,6 @@
;;; Locations:
-(defvar geiser-root-dir nil
- "Geiser's root directory.")
-
(defvar geiser-elisp-dir nil
"Directory containing Geiser's Elisp files.")
@@ -37,14 +34,19 @@
"Directory containing Geiser's Scheme files.")
(setq geiser-elisp-dir (file-name-directory load-file-name))
-(setq geiser-scheme-dir (expand-file-name "../scheme/" geiser-elisp-dir))
-(setq geiser-root-dir (expand-file-name "../" geiser-elisp-dir))
-
(add-to-list 'load-path geiser-elisp-dir)
+(setq geiser-scheme-dir (expand-file-name "../scheme/" geiser-elisp-dir))
+
;;; Autoloads:
+(autoload 'geiser-version "geiser-version.el" "Echo Geiser's version." t)
+
+(autoload 'geiser-unload "geiser-reload.el" "Unload all Geiser code." t)
+
+(autoload 'geiser-reload "geiser-reload.el" "Reload Geiser code." t)
+
(autoload 'geiser "geiser-repl.el"
"Start a Geiser REPL, or switch to a running one." t)
@@ -85,94 +87,15 @@
geiser-faces
geiser-mode
geiser-guile
- geiser-plt))
-
-
-;;; Scheme mode setup:
-
-(defun geiser-setup-scheme-mode ()
- (eval-after-load "scheme"
- '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode)))
-
-(defun geiser-setup-implementations (impls)
- (setq geiser-impl-installed-implementations (or impls '(guile plt))))
-
-(defsubst geiser-impl--impl-feature (impl)
- (intern (format "geiser-%s" impl)))
-
-(defun geiser-setup (&rest impls)
- (geiser-setup-implementations impls)
- (geiser-setup-scheme-mode)
- (mapc (lambda (impl)
- (require (geiser-impl--impl-feature impl) nil t))
- geiser-impl-installed-implementations))
-
-
-;;; Reload:
-
-(defmacro geiser--features-list ()
- (quote '(
- geiser-mode
- geiser-repl
- geiser-impl
- geiser-doc
- geiser-xref
- geiser-edit
- geiser-completion
- geiser-autodoc
- geiser-compile
- geiser-debug
- geiser-eval
- geiser-connection
- geiser-syntax
- geiser-log
- geiser-custom
- geiser-base
- geiser-popup
- )))
-
-(defun geiser-unload-function ()
- (dolist (feature (geiser--features-list))
- (when (featurep feature) (unload-feature feature t)))
- t)
-
-(defun geiser-unload ()
- (interactive)
- (when (featurep 'geiser) (unload-feature 'geiser)))
-
-(defun geiser-reload (&optional arg)
- "Reload Geiser.
-With prefix arg, prompts for the DIRECTORY in which Geiser should be
-loaded."
- (interactive "P")
- (let* ((dir (or (and arg (read-directory-name "New Geiser root dir: "
- geiser-root-dir
- geiser-root-dir
- t
- geiser-root-dir))
- geiser-root-dir))
- (geiser-main-file (expand-file-name "elisp/geiser.el" dir))
- (impls (and (featurep 'geiser-impl) geiser-impl--impls))
- (repls (and (featurep 'geiser-repl) (geiser-repl--repl-list)))
- (buffers (and (featurep 'geiser-mode) (geiser-mode--buffers))))
- (unless (file-exists-p geiser-main-file)
- (error "%s does not contain Geiser!" dir))
- (geiser-unload)
- (setq load-path (remove geiser-elisp-dir load-path))
- (load-file geiser-main-file)
- (geiser-setup)
- (dolist (feature (reverse (geiser--features-list)))
- (load-library (format "%s" feature)))
- (geiser-impl--reload-implementations impls)
- (geiser-repl--restore repls)
- (geiser-mode--restore buffers)
- (message "Geiser reloaded!")))
+ geiser-plt
+ geiser-impl
+ geiser-xref))
-;; Initialization:
+;;; Setup:
-(geiser-setup)
+(eval-after-load "scheme"
+ '(add-hook 'scheme-mode-hook 'turn-on-geiser-mode))
(provide 'geiser)
-;;; geiser.el ends here