UNFINISHED syntax extension

code/extensions/README.md

@@ -0,0 +1,20 @@
+## Reading an object in a different package
+
+Based on extension in SBCL, the syntax `PACKAGE::OBJECT` can be used
+to read an object in a package other than the current one.
+
+```lisp
+(let ((eclector.reader:*client* (make-instance 'eclector.syntax-extensions.object-in-package:object-in-package-syntax-mixin)))
+  (read-from-string "cl-user::(foo bar 1)"))
+```
+
+```lisp
+(let ((eclector.reader:*client* (make-instance 'eclector.syntax-extensions.object-in-package:object-in-package-syntax-mixin)))
+  (read-from-string "cl-user::#(foo)"))
+```
+
+```lisp
+(let ((eclector.reader:*client* (make-instance 'eclector.syntax-extensions.object-in-package:object-in-package-syntax-mixin)))
+  (read-from-string "cl-user::;foo
+bar"))
+```

code/extensions/object-in-package.lisp

@@ -0,0 +1,40 @@
+(cl:defpackage #:eclector.syntax-extensions.object-in-package
+  (:use
+   #:cl)
+
+  (:export
+   #:object-in-package-syntax-mixin))
+
+(cl:in-package #:eclector.syntax-extensions.object-in-package)
+
+(defclass object-in-package-syntax-mixin ()
+  ())
+
+(defmethod eclector.reader:check-symbol-token
+    ((client                    object-in-package-syntax-mixin)
+     (input-stream              t)
+     (token                     t)
+     (escape-ranges             t)
+     (position-package-marker-1 integer)
+     (position-package-marker-2 integer))
+  (let ((length (length token)))
+    (if (and (= position-package-marker-2 (1- length))
+             (= position-package-marker-1 (1- position-package-marker-2)))
+        (values token position-package-marker-1 position-package-marker-2)
+        (call-next-method))))
+
+(defmethod eclector.reader:interpret-symbol-token
+    ((client                    object-in-package-syntax-mixin)
+     (input-stream              t)
+     (token                     t)
+     (position-package-marker-1 integer)
+     (position-package-marker-2 integer))
+  (let ((length (length token)))
+    (if (and (= position-package-marker-2 (1- length))
+             (= position-package-marker-1 (1- position-package-marker-2)))
+        (eclector.reader:call-with-current-package
+         client
+         (lambda ()
+           (eclector.reader:read input-stream t nil t))
+         (subseq token 0 position-package-marker-1))
+        (call-next-method))))

eclector.syntax-extensions.asd

@@ -0,0 +1,27 @@
+(defsystem "eclector.syntax-extensions"
+  :description "A collection of extensions to the Common Lisp syntax."
+  :license     "BSD"
+  :author      "Jan Moringen"
+  :maintainer  "Jan Moringen"
+
+  :version     (:read-file-form "version.sexp")
+  :depends-on  ("eclector")
+
+  :components  ((:module "extensions"
+                 :pathname "code/extensions"
+                 :components ((:file "object-in-package"))))
+
+  :in-order-to ((test-op (test-op "eclector.syntax-extensions/test"))))
+
+(defsystem "eclector.syntax-extensions/test"
+  :depends-on  ("eclector.syntax-extensions"
+                (:version "fiveam" "1.4"))
+
+  :components  ((:module "extensions"
+                 :pathname "test/extensions"
+                 :serial t
+                 :components ((:file "package")
+                              (:file "object-in-package"))))
+
+  :perform     (test-op (operation component)
+                 (uiop:symbol-call '#:eclector.syntax-extensions.test '#:run-tests)))

test/extensions/object-in-package.lisp

@@ -0,0 +1,17 @@
+(defpackage #:eclector.syntax-extensions.object-in-package.test
+  (:use
+   #:cl
+   #:fiveam))
+
+(in-package #:eclector.syntax-extensions.object-in-package.test)
+
+(def-suite* :eclector.extensions.object-in-package
+  :in :eclector.extensions)
+
+(test smoke
+  "Smoke test for the object-in-package syntax extension."
+  (let ((eclector.base:*client* (make-instance 'eclector.syntax-extensions.object-in-package:object-in-package-syntax-mixin)))
+    (multiple-value-bind (value position)
+        (eclector.reader:read-from-string "cl-user::(foo bar)")
+      (is (equal '(cl-user::foo cl-user::bar) value))
+      (is (eql 18 position)))))

test/extensions/package.lisp

@@ -0,0 +1,14 @@
+(defpackage #:eclector.syntax-extensions.test
+  (:use
+   #:cl
+   #:fiveam)
+
+  (:export
+   #:run-tests))
+
+(in-package #:eclector.syntax-extensions.test)
+
+(def-suite :eclector.extensions)
+
+(defun run-tests ()
+  (run! :eclector.extensions))