infix: Overhaul the readtable installer.

[lisp] / infix.lisp

diff --git a/infix.lisp b/infix.lisp
index 5cdd0b918477c57037311eb491d266eb79aca0de..ea78422340db8add6c7e23398027befc5ed82991 100644 (file)
--- a/infix.lisp
+++ b/infix.lisp
@@ -717,14 +717,27 @@ (defun read-infix (&optional (*stream* *standard-input*) &key (delim eof))
       (unless (eq *token* delim)
        (error "expected ~S; found ~S" delim *token*)))))
 
-(defun install-infix-reader (&optional (char #\$))
-  "Installs a macro character `$ INFIX...  $' for translating infix notation
+(defun install-infix-reader
+    (&optional (start #\{) (end #\}) &key dispatch (readtable *readtable*))
+  "Installs a macro character `{ INFIX... }' for translating infix notation
    to Lisp forms.  You also want to (use-package :infix-keywords) if you do
    this."
-  (let ((delim (intern (string #\$) 'infix-keywords)))
-    (set-macro-character char (lambda (stream ch)
-                               (declare (ignore ch))
-                               (read-infix stream :delim delim)))))
+  (let ((delim (intern (string end) 'infix-keywords)))
+    (flet ((doit (stream &rest noise)
+            (declare (ignore noise))
+            (read-infix stream :delim delim)))
+      (if dispatch
+         (set-dispatch-macro-character dispatch start #'doit readtable)
+         (set-macro-character start #'doit nil readtable))
+      (unless (or (eql start end)
+                 (multiple-value-bind
+                     (func nontermp)
+                     (get-macro-character end readtable)
+                   (and func (not nontermp))))
+       (set-macro-character end (lambda (noise)
+                                  (declare (ignore noise))
+                                  (error "Unexpected `~C'." end))
+                            nil readtable)))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Testing things.