Support for implementation-specific font lock keywords

Spinning up from correct fontification of [else in this brave Racket
world.

I'm keeping the list of extra keywords lean and mean, but making it
customizable in both Racket and Guile.

7 files changed, 51 insertions, 11 deletions

diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el
index a53395d..865c7fc 100644
--- a/elisp/geiser-guile.el
+++ b/elisp/geiser-guile.el
@@ -87,6 +87,11 @@ effect on new REPLs. For existing ones, use the command
                  (repeat :tag "Custom" symbol))
   :group 'geiser-guile)
 
+(geiser-custom--defcustom geiser-guile-extra-keywords nil
+  "Extra keywords highlighted in Guile scheme buffers."
+  :type '(repeat string)
+  :group 'geiser-guile)
+
 
 ;;; REPL support:
 
@@ -207,6 +212,13 @@ This function uses `geiser-guile-init-file' if it exists."
     (re-search-forward geiser-guile--guess-re nil t)))
 
 
+;;; Keywords
+(defun geiser-guile--keywords ()
+  (when geiser-guile-extra-keywords
+    `((,(format "[[(]%s\\>" (regexp-opt geiser-guile-extra-keywords 1))
+       . 1))))
+
+
 ;;; Compilation shell regexps
 
 (defconst geiser-guile--path-rx "^In \\([^:\n ]+\\):\n")
@@ -284,7 +296,8 @@ it spawn a server thread."
   (find-symbol-begin geiser-guile--symbol-begin)
   (display-error geiser-guile--display-error)
   (display-help)
-  (check-buffer geiser-guile--guess))
+  (check-buffer geiser-guile--guess)
+  (keywords geiser-guile--keywords))
 
 (geiser-impl--add-to-alist 'regexp "\\.scm$" 'guile nil)
 
diff --git a/elisp/geiser-mode.el b/elisp/geiser-mode.el
index 8f8b7fe..fe7936f 100644
--- a/elisp/geiser-mode.el
+++ b/elisp/geiser-mode.el
@@ -21,6 +21,7 @@
 (require 'geiser-edit)
 (require 'geiser-autodoc)
 (require 'geiser-debug)
+(require 'geiser-syntax)
 (require 'geiser-impl)
 (require 'geiser-eval)
 (require 'geiser-popup)
@@ -244,7 +245,8 @@ interacting with the Geiser REPL is at your disposal.
   (when geiser-mode-autodoc-p
     (geiser-autodoc-mode (if geiser-mode 1 -1)))
   (when geiser-mode-smart-tab-p
-    (geiser-smart-tab-mode (if geiser-mode 1 -1))))
+    (geiser-smart-tab-mode (if geiser-mode 1 -1)))
+  (geiser-syntax--add-kws))
 
 (defun turn-on-geiser-mode ()
   "Enable `geiser-mode' (in a Scheme buffer)."
diff --git a/elisp/geiser-racket.el b/elisp/geiser-racket.el
index b348732..ac2e1f6 100644
--- a/elisp/geiser-racket.el
+++ b/elisp/geiser-racket.el
@@ -56,6 +56,11 @@ This executable is used by `run-gracket', and, if
   :type 'boolean
   :group 'geiser-racket)
 
+(geiser-custom--defcustom geiser-racket-extra-keywords
+    '("define-syntax-rule" "unless" "when" "with-handlers")
+  "Extra keywords highlighted in Racket buffers."
+  :type '(repeat string)
+  :group 'geiser-racket)
 
 
 ;;; REPL support:
@@ -223,6 +228,13 @@ This function uses `geiser-racket-init-file' if it exists."
       (geiser-racket--explicit-module)))
 
 
+;;; Keywords
+(defun geiser-racket--keywords ()
+  (when geiser-racket-extra-keywords
+    `((,(format "[[(]%s\\>" (regexp-opt geiser-racket-extra-keywords 1))
+       . 1))))
+
+
 ;;; Remote REPLs
 
 (defun connect-to-racket ()
@@ -251,6 +263,7 @@ using start-geiser, a procedure in the geiser/server module."
   (display-error geiser-racket--display-error)
   (display-help geiser-racket--external-help)
   (check-buffer geiser-racket--guess)
+  (keywords geiser-racket--keywords)
   (binding-forms geiser-racket--binding-forms)
   (binding-forms* geiser-racket--binding-forms*))
 
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index f134ea4..40f2def 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -85,6 +85,22 @@
  (with-syntax 1))
 
 
+;;; Extra syntax keywords
+(defconst geiser-syntax--keywords
+  '(("\\[\\(else\\)\\>" . 1)
+    ("(\\(parameterize\\)\\>" . 1)))
+
+(font-lock-add-keywords 'scheme-mode geiser-syntax--keywords)
+
+(geiser-impl--define-caller geiser-syntax--impl-kws keywords ()
+  "A variable (or thunk returning a value) giving additional,
+implementation-specific entries for font-lock-keywords.")
+
+(defun geiser-syntax--add-kws ()
+  (let ((kw (geiser-syntax--impl-kws geiser-impl--implementation)))
+    (when kw (font-lock-add-keywords nil kw))))
+
+
 ;;; A simple scheme reader
 
 (defvar geiser-syntax--read/buffer-limit nil)
diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt
index 9eaec15..ce6553f 100644
--- a/scheme/racket/geiser/autodoc.rkt
+++ b/scheme/racket/geiser/autodoc.rkt
@@ -187,5 +187,3 @@
                             '(define-syntax-rule struct
                                define-syntax define set! define-struct)))))
     (hash-remove! signatures path)))
-
-;;; autodoc.rkt ends here
diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt
index c406aae..12c77ae 100644
--- a/scheme/racket/geiser/eval.rkt
+++ b/scheme/racket/geiser/eval.rkt
@@ -77,5 +77,3 @@
   (lambda ()
     (last-namespace (current-namespace))
     (reader)))
-
-;;; eval.rkt ends here
diff --git a/scheme/racket/geiser/user.rkt b/scheme/racket/geiser/user.rkt
index e379946..4508468 100644
--- a/scheme/racket/geiser/user.rkt
+++ b/scheme/racket/geiser/user.rkt
@@ -24,15 +24,15 @@
 (define top-namespace (current-namespace))
 
 (define (enter! mod stx)
-  (cond ((not mod) (current-namespace top-namespace))
-        ((module-path? mod)
+  (cond [(not mod) (current-namespace top-namespace)]
+        [(module-path? mod)
          (enter-module mod)
-         (current-namespace (module->namespace mod)))
-        (else (raise-syntax-error
+         (current-namespace (module->namespace mod))]
+        [else (raise-syntax-error
                #f
                "not a valid module path, and not #f"
                stx
-               mod))))
+               mod)]))
 
 (define orig-loader (current-load/use-compiled))
 (define geiser-loader (module-loader orig-loader))