From 93bf0cd663070e5b6df4cda8377be9f7f8f5463f Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 15 Feb 2013 10:28:49 -0600
Subject: [PATCH] fix 2d lexer for the case when the #2d expression isn't in
 the leftmost column

---
 collects/tests/unstable/2d/lexer-test.rkt | 31 ++++++++++++++++++++++-
 collects/unstable/2d/private/lexer.rkt    | 16 +++++-------
 2 files changed, 37 insertions(+), 10 deletions(-)

diff --git a/collects/tests/unstable/2d/lexer-test.rkt b/collects/tests/unstable/2d/lexer-test.rkt
index a0d729514b..ed5455cda8 100644
--- a/collects/tests/unstable/2d/lexer-test.rkt
+++ b/collects/tests/unstable/2d/lexer-test.rkt
@@ -24,7 +24,6 @@
             [(equal? tok 'eof) '()]
             [else (loop new-mode)]))))
 
-
 (check-equal?
  @run-lexer{#2d
             ╔══╦═══╗
@@ -145,3 +144,33 @@
    ("\"║\n╠══╬═══╣\n║34║\"b\"║\n╚══╩═══╝" error #f 21 50 21)
    (,eof eof #f #f #f 0)))
 
+(check-equal?
+ (run-lexer "   #2d\n"
+            "   ╔═╦═╗\n"
+            "   ║1║2║\n"
+            "   ╠═╬═╣\n"
+            "   ║3║4║\n"
+            "   ╚═╩═╝\n")
+  `(("   " white-space #f 1 4 0)
+    ("#2d" hash-colon-keyword #f 4 7 0)
+    ("\n" white-space #f 7 8 7)
+    ("   " white-space #f 8 11 8)
+    ("╔═╦═╗" parenthesis #f 11 16 11)
+    ("    " white-space #f 16 20 16)
+    ("║" parenthesis #f 20 21 20)
+    ("1" constant #f 21 22 21)
+    ("║" parenthesis #f 22 23 22)
+    ("2" constant #f 23 24 23)
+    ("║" parenthesis #f 24 25 24)
+    ("    " white-space #f 25 29 25)
+    ("╠═╬═╣" parenthesis #f 29 34 29)
+    ("    " white-space #f 34 38 34)
+    ("║" parenthesis #f 38 39 38)
+    ("3" constant #f 39 40 39)
+    ("║" parenthesis #f 40 41 40)
+    ("4" constant #f 41 42 41)
+    ("║" parenthesis #f 42 43 42)
+    ("    " white-space #f 43 47 43) ("╚═╩═╝" parenthesis #f 47 52 47)
+    ("\n" white-space #f 52 53 0)
+    (,eof eof #f #f #f 0)))
+
diff --git a/collects/unstable/2d/private/lexer.rkt b/collects/unstable/2d/private/lexer.rkt
index 7f030a69c2..ad119b602c 100644
--- a/collects/unstable/2d/private/lexer.rkt
+++ b/collects/unstable/2d/private/lexer.rkt
@@ -115,14 +115,12 @@ todo:
              0
              a-2d-lexer-state)]
     [else
-     (define port->peek-port-delta
-       (let-values ([(_1 _2 c-pos) (port-next-location port)])
-         c-pos))
      (define base-position
        ;; one might think that this should depend on the length of eol-string
        ;; but ports that have port-count-lines! enabled count the \r\n combination
-       ;; as a single position in the port, not 2.
-       (+ pos port->peek-port-delta -1))
+       ;; as a single position in the port, not two.
+       (let-values ([(_1 _2 c-pos) (port-next-location port)])
+         c-pos))
      (define peek-port (peeking-input-port port))
      ;; pull the newline out of the peek-port
      (for ([x (in-range (string-length eol-string))]) (read-char peek-port))
@@ -154,7 +152,7 @@ todo:
        (cond
          [(exn:fail:read? failed)
           (define error-pos (- (srcloc-position (car (exn:fail:read-srclocs failed)))
-                               port->peek-port-delta)) ;; account for the newline
+                               base-position)) ;; account for the newline
           (define peek-port2 (peeking-input-port port))
           (port-count-lines! peek-port2)
           
@@ -261,8 +259,8 @@ todo:
           ;; outermost rectangle (at a minimum, newlines); this fills those 
           ;; in with whitespace tokens
           (define cracks-filled-in-tokens
-            (let loop ([fst (car sorted-tokens)]
-                       [tokens (cdr sorted-tokens)])
+            (let loop ([fst newline-token]
+                       [tokens sorted-tokens])
               (cond
                 [(null? tokens) (list fst)]
                 [else
@@ -283,7 +281,7 @@ todo:
                             new-start
                             new-end)
                            (loop snd (cdr tokens)))])])))
-          (cons newline-token cracks-filled-in-tokens)]))
+          cracks-filled-in-tokens]))
      
      (values first-tok-string 'hash-colon-keyword #f
              pos (+ pos (string-length first-tok-string))