branch: elpa/geiser-kawa
commit e349b4b5bbe550a936dfd85f7b19737dc28286d6
Author: spellcard199 <spellcard...@protonmail.com>
Commit: spellcard199 <spellcard...@protonmail.com>
Refactor+Fix+Style: many changes in preparation for melpa submission.
---
README.org | 2 +-
elisp/geiser-kawa-arglist.el | 95 ++++++++++++
elisp/geiser-kawa-deps.el | 108 +++++++++++++
elisp/geiser-kawa-devutil-complete.el | 63 ++++++--
elisp/geiser-kawa-devutil-exprtree.el | 15 +-
elisp/geiser-kawa-ext-help.el | 123 +++++++++++++++
elisp/geiser-kawa-util.el | 23 ++-
elisp/geiser-kawa.el | 279 +++++++---------------------------
elisp/tests/test-geiser-kawa.el | 5 +-
quickstart.el | 2 +-
10 files changed, 463 insertions(+), 252 deletions(-)
diff --git a/README.org b/README.org
index 1eff91b..fb96192 100644
--- a/README.org
+++ b/README.org
@@ -61,7 +61,7 @@ Only versions of Kawa > 3.1 are supported, mostly due to the
fact that before th
To try geiser-kawa you need neither Maven nor Kawa:
- =mvnw= ([[https://github.com/takari/maven-wrapper][maven-wrapper]]) takes
care of downloading a project-specific Maven version
-- kawa-geiser has [[https://gitlab.com/groups/kashell/][Kawa's master branch]]
as one of its dependencies. When =quickstart.el= calls =./mvnw package=
(wrapped by =geiser-kawa-deps-mvn-package=), it produces a jar that includes
kawa-geiser and all its dependencies, including Kawa itself.
+- kawa-geiser has [[https://gitlab.com/groups/kashell/][Kawa's master branch]]
as one of its dependencies. When =quickstart.el= calls =./mvnw package=
(wrapped by =geiser-kawa-deps-mvnw-package=), it produces a jar that includes
kawa-geiser and all its dependencies, including Kawa itself.
** About completion for java's fields, methods and packages
:PROPERTIES:
diff --git a/elisp/geiser-kawa-arglist.el b/elisp/geiser-kawa-arglist.el
new file mode 100644
index 0000000..2dd4c25
--- /dev/null
+++ b/elisp/geiser-kawa-arglist.el
@@ -0,0 +1,95 @@
+;;; geiser-kawa-arglist.el --- Command-line arguments for Geiser support in
Kawa -*- lexical-binding: t -*-
+
+;;; Commentary:
+;; Code for handling command line executable and arguments to obtain
+;; geiser support in Kawa.
+;; Since `kawa-geiser', the java package `geiser-kawa' depends on,
+;; includes a version of Kawa, running Kawa without having downloaded
+;; it is also supported by setting to non-nil the variable
+;; `geiser-kawa-user-included-kawa'.
+
+;;; Code:
+
+(defvar geiser-kawa--arglist
+ `(;; jline "invisibly" echoes user input and prints ansi chars that
+ ;; makes harder detecting end of output and finding the correct
+ ;; prompt regexp.
+ "console:use-jline=no"
+ "-e"
+ "(require <kawageiser.Geiser>)"
+ "--")
+ "Variable containing the parameters to pass to Kawa at startup.
+If you really want to customize this, note that the default ones
+are all required for `geiser-kawa' to work.")
+
+(defun geiser-kawa--binary ()
+ "Return the binary to call to start Kawa.
+If `geiser-kawa-included-kawa' is non-nil, we need to call the Kawa
+initialization method included in the jar file produced by
+`geiser-kawa-deps-mvnw-package', so we need `java', not `kawa' as our
+binary.
+If `geiser-kawa-binary' is a list, take the first and ignore
+`geiser-kawa-use-included-kawa'.
+If `geiser-kawa-binary' is a string, just return it."
+ (if geiser-kawa-use-included-kawa
+ "java"
+ (if (listp geiser-kawa-binary)
+ (car geiser-kawa-binary)
+ geiser-kawa-binary)))
+
+(cl-defun geiser-kawa-arglist--make-classpath
+ (&optional (geiser-kawa-use-included-kawa
+ geiser-kawa-use-included-kawa)
+ (geiser-kawa-binary
+ geiser-kawa-binary)
+ (geiser-kawa-deps-jar-path
+ geiser-kawa-deps-jar-path))
+ "If the following conditions are true...:
+- `geiser-kawa-use-included-kawa' is nil
+- `geiser-kawa-binary' filepath exists
+- the `lib' dir under `geiser-kawa-binary's parent dir exists
+... then: add to classpath at repl startup:
+- the 4 .jar files under the `lib' dir
+- fat jar with `geiser-kawa' dependencies
+... else: add to the classpath just:
+- fat jar with `geiser-kawa' dependencies"
+ (let ((jars
+ (append
+ (if (and
+ (not geiser-kawa-use-included-kawa)
+ (executable-find geiser-kawa-binary))
+ (let ((lib-dir (expand-file-name
+ "../lib/"
+ (file-name-directory
+ (executable-find geiser-kawa-binary)))))
+ (if (file-directory-p lib-dir)
+ (list
+ (concat lib-dir "kawa.jar")
+ (concat lib-dir "servlet.jar")
+ (concat lib-dir "domterm.jar")
+ (concat lib-dir "jline.jar"))
+ nil))
+ nil)
+ (list geiser-kawa-deps-jar-path))))
+ (mapconcat #'identity jars ":")))
+
+(defun geiser-kawa-arglist--make-classpath-arg (classpath)
+ "Make -Djava.class.path argument from CLASSPATH.
+Argument CLASSPATH is a string containing the classpath."
+ (format "-Djava.class.path=%s" classpath))
+
+(defun geiser-kawa-arglist ()
+ "Return a list with all parameters needed to start Kawa Scheme."
+ ;; Using append instead of semiquote so that if
+ ;; `geiser-kawa-use-included-kawa' is `nil' it doesn't appear as
+ ;; `nil' in the resulting arglist
+ (append
+ (list (geiser-kawa-arglist--make-classpath-arg
+ (geiser-kawa-arglist--make-classpath)))
+ (if geiser-kawa-use-included-kawa
+ (list "kawa.repl"))
+ geiser-kawa--arglist))
+
+(provide 'geiser-kawa-arglist)
+
+;;; geiser-kawa-arglist.el ends here
diff --git a/elisp/geiser-kawa-deps.el b/elisp/geiser-kawa-deps.el
new file mode 100644
index 0000000..9411fd7
--- /dev/null
+++ b/elisp/geiser-kawa-deps.el
@@ -0,0 +1,108 @@
+;;; geiser-kawa-deps.el --- Manage geiser-kawa's java dependencies -*-
lexical-binding:t -*-
+
+;;; Commentary:
+;; This file contains code related to the download, compilation
+;; and packaging of `kawa-geiser', the java dependency (with its
+;; recursive dependencies) that `geiser-kawa' depends on.
+;; The functions here provide utilities around the command
+;; `mvnw package', which uses the pom.xml for the `kawa-geiser'
+;; project, included in the `geiser-kawa-dir' directory.
+
+;;; Code:
+
+(require 'cl)
+
+(cl-defun geiser-kawa-deps--jar-path
+ (&optional (geiser-kawa-dir geiser-kawa-dir))
+ (expand-file-name
+ "./target/kawa-geiser-0.1-SNAPSHOT-jar-with-dependencies.jar"
+ geiser-kawa-dir))
+
+(defun geiser-kawa-deps-mvnw-package (geiser-kawa-dir)
+ "Download, Compile and Package `geiser-kawa's java dependencies.
+When called, this function runs `mvnw package' from the path specified
+by the variable `GEISER-KAWA-DIR'.
+The result is a fat jar that is added to the java classpath of Kawa
+at REPL startup."
+ ;; Using `mvn package' from the pom.xml's directory should produce a
+ ;; jar containing all the java dependencies.
+ (interactive)
+ (let* ((default-directory geiser-kawa-dir)
+ (mvn-buf (compile "./mvnw package")))
+ (when mvn-buf
+ (let ((save-buf (current-buffer)))
+ (switch-to-buffer-other-window mvn-buf)
+ (end-of-buffer)
+ (switch-to-buffer-other-window save-buf)))))
+
+
+;;; Manage the `geiser-kawa-deps--run-kawa--advice' advice for
+;;; `run-kawa'.
+;; `run-kawa' is adviced at the end of `geiser.kawa.el' by calling
+;; `geiser-kawa-deps--run-kawa--advice-add' after `run-kawa' has been
+;; defined by `define-geiser-implementation'.
+;; `geiser-kawa-deps--run-kawa--advice' prompts the user for running
+;; `mvnw package' when:
+;; 1. the user uses `run-kawa'
+;; 2. the fat .jar file that `geiser-kawa' depends on is not found.
+
+(defun geiser-kawa-deps--run-kawa--advice-add()
+ "Add our advice to `run-kawa'."
+ (add-function :override
+ (symbol-function 'run-kawa)
+ #'geiser-kawa-deps--run-kawa--advice))
+
+(defun geiser-kawa-deps--run-kawa--advice-remove()
+ "Remove our advice from `run-kawa'."
+ (remove-function (symbol-function 'run-kawa)
+ #'geiser-kawa-deps--run-kawa--advice))
+
+(defun geiser-kawa-deps--run-kawa-unadviced()
+ "Call `run-kawa' without triggering our advice."
+ (geiser-kawa-deps--run-kawa--advice-remove)
+ (run-kawa)
+ (geiser-kawa-deps--run-kawa--advice-add))
+
+(defun geiser-kawa-deps--run-kawa--add-compil-hook()
+ "Run `run-kawa' unadviced the next time a compilation finishes."
+ ;; The added hook auto-removes itself after being called once.
+ (add-hook 'compilation-finish-functions
+ #'geiser-kawa-deps--run-kawa--remove-compil-hook))
+
+(defun geiser-kawa-deps--run-kawa--remove-compil-hook(buf desc)
+ "Hook called when compilation finishes.
+Runs `run-kawa' without the `geiser-kawa-deps--run-kawa--advice'
+advice and removes itself from `compilation-finish-functions',
+effectively running `run-kawa' unadviced only for one compilation.
+Argument BUF passed by Emacs when compilation finishes.
+Argument DESC passed by Emacs when compilation finishes."
+ (geiser-kawa-deps--run-kawa-unadviced)
+ (remove-hook 'compilation-finish-functions
+ #'geiser-kawa-deps--run-kawa--remove-compil-hook))
+
+(defun geiser-kawa-deps--run-kawa--advice(&optional install-if-absent)
+ "Actual advicing function for `run-kawa'.
+
+If the `geiser-kawa-deps-jar-path' path:
+- exists: just run unadviced `run-kawa'
+- does not exist:
+ 1. ask user for permission to run `mvnw package'
+ 2. if user answers `yes':
+ 1. download, compile, package `kawa-geiser'
+ 2. run `run-kawa' after compilation finishes
+
+Optional argument INSTALL-IF-ABSENT: when non-nil, always prompt and
+recompile kawa-geiser, ignoring existing jar."
+ (if (file-exists-p geiser-kawa-deps-jar-path)
+ (geiser-kawa-deps--run-kawa-unadviced)
+ (when (or install-if-absent
+ (y-or-n-p
+ (concat
+ "geiser-kawa depends on additional java libraries. "
+ "Do you want to download and compile them now?")))
+ (geiser-kawa-deps--run-kawa--add-compil-hook)
+ (geiser-kawa-deps-mvnw-package geiser-kawa-dir))))
+
+(provide 'geiser-kawa-deps)
+
+;;; geiser-kawa-deps.el ends here
diff --git a/elisp/geiser-kawa-devutil-complete.el
b/elisp/geiser-kawa-devutil-complete.el
index e08e081..7e01006 100644
--- a/elisp/geiser-kawa-devutil-complete.el
+++ b/elisp/geiser-kawa-devutil-complete.el
@@ -7,20 +7,38 @@
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+
+;;; Commentary:
+;; Provide completions using kawa-devutil. Compared to the way plain
+;; geiser provides completion this has advantages and disadvantages.
+;; - disadvantages:
+;; - _code sent must be syntactically correct_
+;; - often just doesn't find completions
+;; - slower
+;; - just 1 advantage: can complete also (when it works):
+;; - members of classes (Methods, Fields)
+;; - members of packages (Classes, other Packages)
+
(require 'subr-x)
(require 'geiser-kawa-devutil-exprtree)
(require 'geiser-kawa-util)
+;;; Code:
+
(defvar geiser-kawa-devutil-complete-add-missing-parentheses
nil
- "If true, when completing with kawa-devutil we don't check
-for missing parentheses and just let kawa-devutil append them
-at the end.")
+ "Silence error when missing parentheses or not.
+If true just let kawa-devutil append missing parentheses at the end.")
(defun geiser-kawa-devutil-complete--get-data (code-str cursor-index)
- "`code' is a string containing the code. It must be syntatically
- scheme, including balanced parentheses.
-`cursor' is an integer representing where the cursor is in that code."
+ "Get completion data.
+Argument CODE-STR is a string containing the code where completion
+must happen. It must be syntactically correct Kawa scheme.
+Argument CURSOR-INDEX is an integer representing where the cursor is
+inside `CURSOR-STR'."
+ ;; "`code-str' is a string containing the code.
+;; It must be syntatically scheme, including balanced parentheses.
+;; `cursor-index' is an integer representing where the cursor is in that code."
(let* ((geiser-question
;; this formatting hell is caused by the fact geiser:eval
;; takes a string instead of a form.
@@ -43,7 +61,10 @@ at the end.")
(defun geiser-kawa-devutil-complete--user-choice-classmembers
(classmember-data)
+ "Read completion choice for members of class (Methods and Fields).
+Argument CLASSMEMBER-DATA is completion data for members of class as
+returned by kawa-geiser."
(let* ((completion-type
(cadr (assoc "completion-type" classmember-data)))
(before-cursor
@@ -62,13 +83,16 @@ at the end.")
(string-join modifiers " ") " " completion-type
") "
owner-class ".")))
-
(completing-read prompt names
nil nil
before-cursor)))
(defun geiser-kawa-devutil-complete--user-choice-symbols-plus-packagemembers
(syms-plus-pkgmembers-data)
+ "Read completion choice for members of class (Methods and Fields).
+
+Argument SYMS-PLUS-PKGMEMBERS-DATA is completion data for symbols and
+members of package as returned by kawa-geiser."
(let* ((completion-type
(cadr (assoc "completion-type" syms-plus-pkgmembers-data)))
(before-cursor
@@ -107,6 +131,7 @@ at the end.")
(defun geiser-kawa-devutil-complete--user-choice-dispatch
(compl-data)
+ "Dispatch COMPL-DATA to appropriate function based on \"completion-type\"."
(let ((completion-type
(cadr (assoc "completion-type" compl-data))))
(cond ((or (equal completion-type "METHODS")
@@ -119,10 +144,10 @@ at the end.")
(message "No completions found.")
"")
(t (error (format "[Unexpected `completion-type' value]
completion-type: %s"
- (prin1-to-string completion-type))))
- )))
+ (prin1-to-string completion-type)))))))
(defun geiser-kawa-devutil-complete--code-point-from-toplevel ()
+ "Return an association list of data needed for completion."
(let* (reg-beg
reg-end
code-str
@@ -169,8 +194,10 @@ at the end.")
`("cursor-index" . ,cursor-index))))
(defun geiser-kawa-devutil-complete-at-point ()
+ "Complete at point using `kawa-devutil'.
+`kawa-devutil' is a java dependency of `kawa-geiser', itself a java
+dependency of `geiser-kawa'."
(interactive)
- "Complete at point using kawa-devutil's completion."
(let* ((code-and-point-data
(geiser-kawa-devutil-complete--code-point-from-toplevel))
@@ -187,7 +214,7 @@ at the end.")
(kill-word 1)
(kill-word -1)))
(insert user-choice)
- ;; (when (not (equal (word-at-point) user-choice))
+ ;; (unless (equal (word-at-point) user-choice)
;; (kill-word 1)
))
@@ -195,12 +222,26 @@ at the end.")
;;;; java completions. Useful when debugging why java completion fails.
(defun geiser-kawa-devutil-complete--exprtree (code-str cursor-index)
+ "Return Expression tree for kawa-devutil completion.
+
+To find completions kawa-devutil modifies slightly the code you send
+to it and then uses a simple pattern matching mechanism on the
+Expression tree that Kawa compiler generates. Sometimes things don't
+work and you may wonder why and viewing the generated Expression tree
+can help understand wether the problem is your code or kawa-devutil
+itself (I mostly use this to find problems in kawa-devutil itself).
+
+Argument CODE-STR is a string containing the code where completion
+must happen. It must be syntactically correct Kawa scheme.
+Argument CURSOR-INDEX is an integer representing where the cursor is
+inside `CURSOR-STR'."
(geiser-kawa-util--eval-to-res
`(geiser:kawa-devutil-complete-expr-tree
,code-str
,cursor-index)))
(defun geiser-kawa-devutil-complete-expree-at-point ()
+ "View Expression tree for kawa-devutil completion at point."
(interactive)
(let* ((code-and-point-data
(geiser-kawa-devutil-complete--code-point-from-toplevel))
diff --git a/elisp/geiser-kawa-devutil-exprtree.el
b/elisp/geiser-kawa-devutil-exprtree.el
index 5de1960..6cb2728 100644
--- a/elisp/geiser-kawa-devutil-exprtree.el
+++ b/elisp/geiser-kawa-devutil-exprtree.el
@@ -7,12 +7,22 @@
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+;;; Commentary:
+;; The Kawa language framework compilation works producing converting
+;; code into an Expression tree and then compiling the latter into
+;; Java bytecode.
+;; Here are some functions for getting and viewing the Expression tree
+;; that Kawa produces for some given code.
+
(require 'geiser-kawa-util)
+;;; Code:
+
(defvar geiser-kawa-devutil-exprtree-buffer "*kawa exprtree*"
- "Buffer where Expression tree is showed")
+ "Buffer where Expression tree is showed.")
(defun geiser-kawa-devutil-exprtree--view (expr-tree)
+ "View EXPR-TREE in a buffer in View-mode."
(with-current-buffer (get-buffer-create
geiser-kawa-devutil-exprtree-buffer)
(View-quit)
@@ -24,12 +34,13 @@
geiser-kawa-devutil-exprtree-buffer))
(defun geiser-kawa-devutil-exprtree--for-expression (code-str)
+ "Get the Expression tree CODE-STR."
(geiser-kawa-util--eval-to-res
`(geiser:kawa-devutil-expr-tree-formatted ,code-str)))
(defun geiser-kawa-devutil-exprtree-sexp ()
- (interactive)
"If region is active send region, otherwise send last expression."
+ (interactive)
(let* ((code-str
(if (region-active-p)
(buffer-substring-no-properties (region-beginning)
diff --git a/elisp/geiser-kawa-ext-help.el b/elisp/geiser-kawa-ext-help.el
new file mode 100644
index 0000000..8771eee
--- /dev/null
+++ b/elisp/geiser-kawa-ext-help.el
@@ -0,0 +1,123 @@
+;;; geiser-kawa-ext-help.el --- Support for the "external-help" geiser feature
-*- lexical-binding:t -*-
+
+;;; Commentary:
+;; Functions for providing the "external-help" Geiser feature.
+;; Currently, the external help for Kawa is the kawa manual in either
+;; its .info or .epub format. For the feature to work
+;; `geiser-kawa-manual-path' must point to where the .info or .epub
+;; Kawa manual is located.
+
+;;; Code:
+
+;; Support for manual in .epub format
+
+(cl-defun geiser-kawa-manual--epub-unzip-to-tmpdir
+ (&optional (epub-path geiser-kawa-manual-path))
+ "Unzip the .epub file using kawa/java.
+
+Rationale for using java instead of emacs:
+- kawa is already a dependency
+- kawa/java is more portable that using emacs' `arc-mode', which relies
+ on external executables being installed"
+ (with-temp-buffer
+ (with--geiser-implementation
+ 'kawa
+ (geiser-eval--send/result
+ (format
+ "(geiser:eval (interaction-environment) %S)"
+ (format "(geiser:manual-epub-unzip-to-tmp-dir %S)"
+ epub-path))))))
+
+(defvar geiser-kawa-manual--epub-cached-overall-index
+ nil
+ "Since `eww-open-file' is slow we use it just the first time.
+Then we cache the result in this variable so that future lookups in
+the manual are more responsive.")
+
+(cl-defun geiser-kawa-manual--epub-search
+ (needle &optional (epub-path geiser-kawa-manual-path))
+ ;; Validate args
+ (assert (stringp needle) nil (type-of needle))
+ (assert (stringp epub-path) nil (type-of epub-path))
+ (assert (string-suffix-p ".epub" epub-path) nil epub-path)
+ (assert (file-exists-p epub-path) nil epub-path)
+
+ (with-current-buffer (get-buffer-create
+ " *geiser-kawa-epub-manual*")
+ (eww-mode)
+ (if geiser-kawa-manual--epub-cached-overall-index
+ (progn
+ (read-only-mode -1)
+ (delete-region (point-min) (point-max))
+ (insert geiser-kawa-manual--epub-cached-overall-index))
+ (let* ((unzipped-epub-dir
+ ;; Ask kawa to unzip epub: more portable than unzipping
+ ;; with emacs' `arc-mode'.
+ (geiser-kawa-manual--epub-unzip-to-tmpdir epub-path))
+ (overall-index-file
+ (format "%s/OEBPS/Overall-Index.xhtml" unzipped-epub-dir))
+ (epub-man-buffer
+ (get-buffer-create "*geiser-kawa-epub-manual*")))
+ (unless unzipped-epub-dir
+ (error "Can't open manual: Kawa did not unzip the epub when asked"))
+ (eww-open-file overall-index-file)
+ ;; Store overall index page in a variable to be used as cache.
+ (setq geiser-kawa-manual--epub-cached-overall-index (buffer-string))))
+ ;; At this point the "Overall Index" page should be opened.
+ (goto-char (point-min))
+ (if (search-forward (concat "\n" needle ": ") nil t) ;; Search
+ (progn
+ (backward-char 3) ;; Move point over link
+ (eww-browse-url (car (eww-links-at-point))) ;; Follow link
+ (recenter-top-bottom 'top))
+ (message (format "No match for `%s' found in Kawa's epub manual."
needle)))))
+
+
+;; Support for manual in .info format
+
+(cl-defun geiser-kawa-manual--info-search
+ (needle &optional (info-path geiser-kawa-manual-path))
+ ;; Validate args
+ (assert (stringp needle) nil (type-of needle))
+ (assert (stringp info-path) nil (type-of info-path))
+ (assert (string-suffix-p ".info" info-path) nil info-path)
+ (assert (file-exists-p info-path) nil info-path)
+
+ (with-current-buffer (get-buffer-create "*geiser-kawa-info-manual*")
+ (info info-path (current-buffer))
+ (Info-goto-node "Overall Index")
+ (if (search-forward (concat "\n* " needle) nil t)
+ (progn
+ (Info-follow-nearest-node)
+ (recenter-top-bottom 'top))
+ (progn
+ (quit-window)
+ (message (format "No match for `%s' found in Kawa's info manual."
+ needle))))))
+
+;;;; Dispatch to epub or info manual function based on
+;;;; `geiser-kawa-manual-path's file extension.
+(defun geiser-kawa-manual--look-up (id mod)
+ "Use epub or info manual depending on `geiser-kawa-manual-path'.
+
+Argument ID is the symbol to look for in the manual.
+Argument MOD is passed by geiser, but it's not used here."
+ (assert (file-exists-p geiser-kawa-manual-path)
+ nil (format
+ (concat
+ "Kawa's manual file specified by "
+ "`geiser-kawa-manual-path' does not exist: \"%s\"")
+ geiser-kawa-manual-path))
+ (cond
+ ((string-suffix-p ".epub" geiser-kawa-manual-path)
+ (geiser-kawa-manual--epub-search (symbol-name id)
+ geiser-kawa-manual-path))
+ ((string-suffix-p ".info" geiser-kawa-manual-path)
+ (geiser-kawa-manual--info-search (symbol-name id)
+ geiser-kawa-manual-path))
+ (t (error "Supported formats for `geiser-kawa-manual-path' are only
+ `.epub' and `.info'"))))
+
+(provide 'geiser-kawa-ext-help)
+
+;;; geiser-kawa-ext-help.el ends here
diff --git a/elisp/geiser-kawa-util.el b/elisp/geiser-kawa-util.el
index d62bff5..5de575f 100644
--- a/elisp/geiser-kawa-util.el
+++ b/elisp/geiser-kawa-util.el
@@ -7,17 +7,25 @@
;; have received a copy of the license along with this program. If
;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
+;;; Commentary:
+;; Some general utility functions used by the `geiser-kawa' package.
+
(require 'geiser-syntax)
(require 'geiser-eval)
;; Utility functions used by other parts of `geiser-kawa'.
+;;; Code:
+
(defun geiser-kawa-util--eval-to-res (sexp)
+ "Alternative to geiser-eval--send/eval with custom behavior.
+If a Throwable has been raised while running in Kawa an error is
+signalled.
+Argument SEXP is a sexp to evaluate in Kawa."
(let* ((question
(format "(geiser:eval (interaction-environment) %S)"
(format "%S" sexp)))
(answer (geiser-eval--send/wait question)))
-
(if (assoc 'error answer)
(signal 'peculiar-error
(list (string-trim
@@ -29,15 +37,15 @@
(cadr (car answer)))))
(defun geiser-kawa-util--retort-result (ret)
- ;; This skips the reading `geiser-eval--retort-result'
- ;; does, but doesn't have the variable binding depth
- ;; limit that `geiser-eval--retort-result' has.
- ;; We use this when we need to read strings longer
- ;; than what `geiser-eval--retort-result' allows.
- ;; Drawback is that `ret' must be valid elisp.
+ "Function that skips the reading `geiser-eval--retort-result' does.
+Differently from `geiser-eval--retort-result', this function doesn't
+have a variable binding depth limit. We use this when we need to read
+strings longer than what `geiser-eval--retort-result' allows.
+Drawback is that `RET' must be valid elisp."
(car (read-from-string (cadr (assoc 'result ret)))))
(defun geiser-kawa-util--repl-point-after-prompt ()
+ "If in a Kawa REPL buffer, get point after prompt."
(save-excursion
(and (string-prefix-p
(geiser-repl-buffer-name 'kawa)
@@ -46,6 +54,7 @@
(re-search-forward geiser-kawa--prompt-regexp nil t))))
(defun geiser-kawa-util--point-is-at-toplevel-p ()
+ "Return non-nil if point is at toplevel (not inside a sexp)."
(equal (point)
(save-excursion
(geiser-syntax--pop-to-top)
diff --git a/elisp/geiser-kawa.el b/elisp/geiser-kawa.el
index 3b026e0..d253377 100644
--- a/elisp/geiser-kawa.el
+++ b/elisp/geiser-kawa.el
@@ -36,8 +36,11 @@
(require 'info-look)
(require 'cl)
+(require 'geiser-kawa-deps)
(require 'geiser-kawa-devutil-complete)
(require 'geiser-kawa-devutil-exprtree)
+(require 'geiser-kawa-arglist)
+(require 'geiser-kawa-ext-help)
;;; Code:
@@ -56,7 +59,7 @@
(if (string-suffix-p "elisp/" geiser-kawa-elisp-dir)
(expand-file-name "../" geiser-kawa-elisp-dir)
geiser-kawa-elisp-dir)
- "geiser-kawa's directory.")
+ "Directory where geiser-kawa is located.")
;; Adapted from geiser.el
(custom-add-load 'geiser-kawa (symbol-name 'geiser-kawa))
@@ -76,66 +79,6 @@
;; End of adaptations for making this package separate from geiser
-;; Using `mvn package' from the pom.xml's directory should produce a
-;; jar containing all the java dependencies.
-(defcustom geiser-kawa-deps-jar-path
- (expand-file-name
- "./target/kawa-geiser-0.1-SNAPSHOT-jar-with-dependencies.jar"
- geiser-kawa-dir)
- "Path to the kawa-geiser fat jar."
- :type 'string
- :group 'geiser-kawa)
-
-;; Download, compile and package "kawa-geiser" and its recursive
-;; dependencies into a fat jar.
-(defun geiser-kawa-deps-mvn-package()
- (interactive)
- (let* ((default-directory geiser-kawa-dir)
- (mvn-buf (compile "./mvnw package")))
- (when mvn-buf
- (let ((save-buf (current-buffer)))
- (switch-to-buffer-other-window mvn-buf)
- (end-of-buffer)
- (switch-to-buffer-other-window save-buf)))))
-
-(defun geiser-kawa--deps-run-kawa--advice-add()
- (add-function :override
- (symbol-function 'run-kawa)
- #'geiser-kawa--deps-run-kawa-advice))
-
-(defun geiser-kawa--deps-run-kawa--advice-remove()
- (remove-function (symbol-function 'run-kawa)
- #'geiser-kawa--deps-run-kawa-advice))
-
-(defun geiser-kawa--deps-run-kawa-unadviced()
- (geiser-kawa--deps-run-kawa--advice-remove)
- (run-kawa)
- (geiser-kawa--deps-run-kawa--advice-add))
-
-(defun geiser-kawa--deps-run-kawa--add-compil-hook()
- ;; The added hook auto-removes itself after being called once.
- (add-hook 'compilation-finish-functions
- #'geiser-kawa--deps-run-kawa-remove-compil-hook))
-
-(defun geiser-kawa--deps-run-kawa-remove-compil-hook(buf desc)
- ;; Removes itself from `compilation-finish-functions'
- ;; when called.
- (geiser-kawa--deps-run-kawa-unadviced)
- (remove-hook 'compilation-finish-functions
- #'geiser-kawa--deps-run-kawa-remove-compil-hook))
-
-(defun geiser-kawa--deps-run-kawa-advice(&optional install-if-absent)
- (if (file-exists-p geiser-kawa-deps-jar-path)
- (geiser-kawa--deps-run-kawa-unadviced)
- (when (or install-if-absent
- (y-or-n-p
- (concat
- "geiser-kawa depends on additional java libraries. "
- "Do you want to download and compile them now?")))
- (geiser-kawa--deps-run-kawa--add-compil-hook)
- (geiser-kawa-deps-mvn-package))))
-
-
;;; Customization:
(defgroup geiser-kawa nil
@@ -160,67 +103,31 @@
:type 'string
:group 'geiser-kawa)
+(defcustom geiser-kawa-deps-jar-path
+ (geiser-kawa-deps--jar-path geiser-kawa-dir)
+ "Path to the kawa-geiser fat jar."
+ :type 'string
+ :group 'geiser-kawa)
+
(defcustom geiser-kawa-use-included-kawa
nil
- "Instead of downloading kawa yourself, you can use the Kawa version
- included in geiser-kawa, which is the head of Kawa's master branch."
+ "Use the Kawa included with `geiser-kawa' instead of the `kawa' binary.
+
+Instead of downloading kawa yourself, you can use the Kawa version
+included in `geiser-kawa'."
:type 'boolean
:group 'geiser-kawa)
;;; REPL support:
-(defun geiser-kawa--binary ()
- ". If `geiser-kawa-binary' is a list, take the first and ignore
- `geiser-kawa-use-included-kawa'."
- (if geiser-kawa-use-included-kawa
- "java"
- (if (listp geiser-kawa-binary)
- (car geiser-kawa-binary)
- geiser-kawa-binary)))
-
-(defun geiser-kawa--make-classpath ()
- (let ((jars
- (append
- (if (and
- (not geiser-kawa-use-included-kawa)
- (executable-find geiser-kawa-binary))
- (let ((lib-dir (expand-file-name
- "../lib/"
- (file-name-directory
- (executable-find geiser-kawa-binary)))))
- (if (file-directory-p lib-dir)
- (list
- (concat lib-dir "kawa.jar")
- (concat lib-dir "servlet.jar")
- (concat lib-dir "domterm.jar")
- (concat lib-dir "jline.jar"))
- nil))
- nil)
- (list geiser-kawa-deps-jar-path))))
- (mapconcat #'identity jars ":")))
-
-(defvar geiser-kawa--arglist
- `(;; jline "invisibly" echoes user input and prints ansi chars that
- ;; makes harder detecting end of output and finding the correct
- ;; prompt regexp.
- "console:use-jline=no"
- "-e"
- "(require <kawageiser.Geiser>)"
- "--"))
-
-(defun geiser-kawa--parameters ()
- "Return a list with all parameters needed to start Kawa Scheme."
- (append
- (list (format "-Djava.class.path=%s" (geiser-kawa--make-classpath)))
- (if geiser-kawa-use-included-kawa
- (list "kawa.repl"))
- geiser-kawa--arglist))
-
(defconst geiser-kawa--prompt-regexp
"#|kawa:[0-9]+|# ")
(defun geiser-kawa--geiser-procedure (proc &rest args)
+ "Geiser's marshall-procedure for `geiser-kawa'.
+Argument PROC passed by Geiser.
+Optional argument ARGS passed by Geiser."
(case proc
((eval compile)
@@ -248,27 +155,48 @@
;; (save-excursion (skip-syntax-backward "^|#") (point)))
;; TODO: see if it needs improvements.
(defun geiser-kawa--symbol-begin (module)
- ;; Needed for completion. Copied from geiser-chibi.el,
- ;; geiser-guile.el, which are identical to each other.
+ "Needed for completion.
+Copied from geiser-chibi.el, geiser-guile.el, which are identical to
+each other.
+Argument MODULE argument passed by Geiser."
(if module
(max (save-excursion (beginning-of-line) (point))
(save-excursion (skip-syntax-backward "^(>") (1- (point))))
(save-excursion (skip-syntax-backward "^'-()>") (point))))
(defun geiser-kawa--import-command (module)
+ "Return command used to import MODULEs."
(format "(import %s)" module))
(defun geiser-kawa--exit-command ()
+ "Command to send to exit from Kawa REPL."
"(exit 0)")
;;; REPL startup
(defun geiser-kawa--version-command (binary)
- (let ((prog+vers (car (process-lines binary "--version"))))
- (cadr (split-string prog+vers " "))))
+ "Return command to get kawa version.
+Argument BINARY argument passed by Geiser."
+ (let* ((program (if geiser-kawa-use-included-kawa
+ "java"
+ "kawa"))
+ (args (if geiser-kawa-use-included-kawa
+ (list (geiser-kawa-arglist--make-classpath-arg
+ geiser-kawa-deps-jar-path)
+ "kawa.repl"
+ "--version")
+ (list "--version")))
+ (output (apply #'process-lines
+ (cons program args)))
+ (progname-plus-version (car output)))
+ ;; `progname-plus-version' is something like:
+ ;; "Kawa 3.1.1"
+ (cadr (split-string progname-plus-version " "))))
(defun geiser-kawa--repl-startup (remote)
+ "Geiser's repl-startup.
+Argument REMOTE passed by Geiser."
(let ((geiser-log-verbose-p t))
(compilation-setup t)))
@@ -276,126 +204,21 @@
;;; Error display
;; TODO
-(defun geiser-kawa--enter-debugger ())
+(defun geiser-kawa--enter-debugger ()
+ "TODO.")
(defun geiser-kawa--display-error (module key msg)
- ;; Needed to show output (besides result). Modified from
- ;; geiser-guile.el.
+ "Needed to show output (besides result).
+Modified from geiser-guile.el.
+Argument MODULE passed by Geiser.
+Argument KEY passed by Geiser.
+Argument MSG passed by Geiser."
(when (stringp msg)
(save-excursion (insert msg))
(geiser-edit--buttonize-files))
(and (not key) (not (zerop (length msg))) msg))
-;;; Manual lookup
-
-;;;; Support for manual in .epub format
-
-(cl-defun geiser-kawa--manual-epub-unzip-to-tmpdir
- (&optional (epub-path geiser-kawa-manual-path))
- "Unzip the .epub file with kawa/java, since:
-- kawa is already a dependency
-- kawa/java is more portable that using emacs' arc-mode, which relies
- on external executables installed"
- (with-temp-buffer
- (with--geiser-implementation
- 'kawa
- (geiser-eval--send/result
- (format
- "(geiser:eval (interaction-environment) %S)"
- (format "(geiser:manual-epub-unzip-to-tmp-dir %S)"
- epub-path))))))
-
-(defvar geiser-kawa--manual-epub-cached-overall-index
- nil
- "Since `eww-open-file' is slow we use it just the first time.
-Then we cache the result in this variable so that future lookups in
-the manual are more responsive.")
-
-(cl-defun geiser-kawa--manual-epub-search
- (needle &optional (epub-path geiser-kawa-manual-path))
- ;; Validate args
- (assert (stringp needle) nil (type-of needle))
- (assert (stringp epub-path) nil (type-of epub-path))
- (assert (string-suffix-p ".epub" epub-path) nil epub-path)
- (assert (file-exists-p epub-path) nil epub-path)
-
- (with-current-buffer (get-buffer-create
- " *geiser-kawa-epub-manual*")
- (eww-mode)
- (if geiser-kawa--manual-epub-cached-overall-index
- (progn
- (read-only-mode -1)
- (delete-region (point-min) (point-max))
- (insert geiser-kawa--manual-epub-cached-overall-index))
- (let* ((unzipped-epub-dir
- ;; Ask kawa to unzip epub: more portable than unzipping
- ;; with emacs' `arc-mode'.
- (geiser-kawa--manual-epub-unzip-to-tmpdir epub-path))
- (overall-index-file
- (format "%s/OEBPS/Overall-Index.xhtml" unzipped-epub-dir))
- (epub-man-buffer
- (get-buffer-create "*geiser-kawa-epub-manual*")))
- (when (not unzipped-epub-dir)
- (error "Can't open manual: Kawa did not unzip the epub when asked."))
- (eww-open-file overall-index-file)
- ;; Store overall index page in a variable to be used as cache.
- (setq geiser-kawa--manual-epub-cached-overall-index (buffer-string))))
-
- ;; At this point the Overall Index page should be opened.
- (goto-char (point-min))
- (if (search-forward (concat "\n" needle ": ") nil t) ;; Search
- (progn
- (backward-char 3) ;; Move point over link
- (eww-browse-url (car (eww-links-at-point))) ;; Follow link
- (recenter-top-bottom 'top))
- (message (format "No match for `%s' found in Kawa's epub manual."
needle)))))
-
-;;;; Support for manual in .info format
-(cl-defun geiser-kawa--manual-info-search
- (needle &optional (info-path geiser-kawa-manual-path))
-
- ;; Validate args
- (assert (stringp needle) nil (type-of needle))
- (assert (stringp info-path) nil (type-of info-path))
- (assert (string-suffix-p ".info" info-path) nil info-path)
- (assert (file-exists-p info-path) nil info-path)
-
- (with-current-buffer (get-buffer-create "*geiser-kawa-info-manual*")
- (info info-path (current-buffer))
- (Info-goto-node "Overall Index")
- (if (search-forward (concat "\n* " needle) nil t)
- (progn
- (Info-follow-nearest-node)
- (recenter-top-bottom 'top))
- (progn
- (quit-window)
- (message (format "No match for `%s' found in Kawa's info manual."
- needle))))))
-
-;;;; Dispatch to epub or info manual function based on
-;;;; `geiser-kawa-manual-path's file extension.
-(defun geiser-kawa--manual-look-up (id mod)
- "Use epub or info manual depending on `geiser-kawa-manual-path'.
-
-Argument ID is the symbol to look for in the manual.
-Argument MOD is passed by geiser, but it's not used here."
- (assert (file-exists-p geiser-kawa-manual-path)
- nil (format
- (concat
- "Kawa's manual file specified by "
- "`geiser-kawa-manual-path' does not exist: \"%s\"")
- geiser-kawa-manual-path))
- (cond
- ((string-suffix-p ".epub" geiser-kawa-manual-path)
- (geiser-kawa--manual-epub-search (symbol-name id)
- geiser-kawa-manual-path))
- ((string-suffix-p ".info" geiser-kawa-manual-path)
- (geiser-kawa--manual-info-search (symbol-name id)
- geiser-kawa-manual-path))
- (t (error "Supported formats for `geiser-kawa-manual-path' are only `.epub'
and `.info'"))))
-
-
;;; Implementation definition:
(define-geiser-implementation kawa
@@ -408,7 +231,7 @@ Argument MOD is passed by geiser, but it's not used here."
callees
generic-methods))
(binary geiser-kawa--binary)
- (arglist geiser-kawa--parameters)
+ (arglist geiser-kawa-arglist)
(version-command geiser-kawa--version-command)
(repl-startup geiser-kawa--repl-startup)
(prompt-regexp geiser-kawa--prompt-regexp)
@@ -427,7 +250,7 @@ Argument MOD is passed by geiser, but it's not used here."
(geiser-impl--add-to-alist 'regexp "\\.sld$" 'kawa t)
;; Check for kawa-geiser jar each time `run-kawa' is called.
-(geiser-kawa--deps-run-kawa--advice-add)
+(geiser-kawa-deps--run-kawa--advice-add)
(provide 'geiser-kawa)
diff --git a/elisp/tests/test-geiser-kawa.el b/elisp/tests/test-geiser-kawa.el
index b2207bd..62e593a 100644
--- a/elisp/tests/test-geiser-kawa.el
+++ b/elisp/tests/test-geiser-kawa.el
@@ -24,7 +24,7 @@
(print "[test-geiser-kawa.el] Running `mvnw package'...")
- (let ((mvn-buf (geiser-kawa-deps-mvn-package)))
+ (let ((mvnw-buf (geiser-kawa-deps-mvnw-package geiser-kawa-dir)))
(while compilation-in-progress
(sleep-for 0 250)))
@@ -44,7 +44,8 @@
(it "can `run-kawa'"
(expect
- (get-buffer "* Kawa REPL *")))
+ (process-live-p (get-buffer-process
+ (get-buffer "* Kawa REPL *")))))
(it "can `geiser-eval-buffer'"
(expect
diff --git a/quickstart.el b/quickstart.el
index 1351f5a..6eb5f40 100644
--- a/quickstart.el
+++ b/quickstart.el
@@ -19,4 +19,4 @@
(add-hook 'compilation-finish-functions
#'run-kawa-after-compilation-finishes)
-(geiser-kawa-deps-mvn-package)
+(geiser-kawa-deps-mvnw-package)
