From 86f9de0b414bc2d0dea7357cc24353fa59a50a48 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 2 Nov 2006 03:16:19 +0000
Subject: [PATCH] fix handling of improper lists in the code macro

svn: r4746
---
 collects/texpict/code.ss | 25 ++++++++++++++++++++-----
 1 file changed, 20 insertions(+), 5 deletions(-)

diff --git a/collects/texpict/code.ss b/collects/texpict/code.ss
index 970f122b8c..0beae93a10 100644
--- a/collects/texpict/code.ss
+++ b/collects/texpict/code.ss
@@ -223,7 +223,7 @@
       (define (comment-mode? mode)
 	(eq? mode 'comment))
       
-      (define-computed dot-p (tt " . "))
+      (define-computed dot-p (tt "."))
 
       (define (mode-colorize mode type p)
 	(maybe-colorize
@@ -367,7 +367,8 @@
 			(lambda (a b) (eq? (syntax-e a) (syntax-e b)))
 	    [() (add-close (htl-append (get-open mode stx) (get-close mode stx))
 			   closes)]
-	    [code:blank (tt " ")]
+	    [code:blank (add-close (tt " ")
+                                   closes)]
 	    [$ (colorize-id "|" closes)]
 	    [(quote x)
 	     (memq 'quote (current-reader-forms))
@@ -503,9 +504,23 @@
 	     (identifier? stx)
 	     (add-close (colorize-id (symbol->string (syntax-e stx)) mode) closes)]
 	    [(a . b)
-	     (code-hbl-append (mode-colorize mode #f open-paren-p) (loop #'a null mode)
-			      (mode-colorize mode #f dot-p)
-			      (loop #'b (cons (cons mode stx) closes) mode))]
+             ;; Build a list that makes the "." explicit.
+             (let ([p (let loop ([a (syntax-e stx)])
+                        (cond
+                         [(pair? a) (cons (car a) (loop (cdr a)))]
+                         [else (list (datum->syntax-object #f
+                                                           (mode-colorize mode #f dot-p)
+                                                           (list (syntax-source a)
+                                                                 (syntax-line a)
+                                                                 (- (syntax-column a) 2)
+                                                                 (- (syntax-position a) 2)
+                                                                 1))
+                                     a)]))])
+               (loop (datum->syntax-object stx
+                                           p
+                                           stx)
+                     closes
+                     mode))]
 	    [else
 	     (add-close (if (pict? (syntax-e stx))
 			    (syntax-e stx)