From 42adbca52765002306d46df8f660b8eb6f088a1b Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 25 Feb 2009 20:35:38 +0000
Subject: [PATCH] finished fixing multiple chunks

svn: r13841
---
 collects/games/chat-noir/README |   6 --
 collects/scribble/private/lp.ss | 107 ++++++++++++++++----------------
 2 files changed, 54 insertions(+), 59 deletions(-)

diff --git a/collects/games/chat-noir/README b/collects/games/chat-noir/README
index c595d62661..5fbbf86504 100644
--- a/collects/games/chat-noir/README
+++ b/collects/games/chat-noir/README
@@ -4,10 +4,6 @@ Games.
 
 Problems:
 
- - handling multiple chunks is broken right now, so the
-   chunkref-introducting macro (in scribble/private/lp.ss)
-   is disabled.
-
  - Need to make 'a-chunk' be a real macro, I expect. (used in
    scribble/private/lp.ss)
 
@@ -15,8 +11,6 @@ Problems:
 
  - do unbound chunk ids signal syntax errors? How about unused ones?
 
- - toc entries should not be underlined.
-
 To document:
 
   @chunk
diff --git a/collects/scribble/private/lp.ss b/collects/scribble/private/lp.ss
index 56ff51b890..b5b189b2a3 100644
--- a/collects/scribble/private/lp.ss
+++ b/collects/scribble/private/lp.ss
@@ -7,73 +7,74 @@
   ;; maps chunk identifiers to a counter, so we can distinguish multiple uses
   ;; of the same name
   (define chunk-numbers (make-free-identifier-mapping))
-  (define (get-chunk-number id install?)
-    (let ([n (add1 (free-identifier-mapping-get chunk-numbers id
-                                                (lambda () 0)))])
-      (when install?
-        (free-identifier-mapping-put! chunk-numbers id n))
-      n))
-  (define (register-chunk-name name)
-    (get-chunk-number name #t)))
+  (define (get-chunk-number id)
+    (free-identifier-mapping-get chunk-numbers id (lambda () #f)))
+  (define (inc-chunk-number id)
+    (free-identifier-mapping-put! chunk-numbers id (+ 1 (free-identifier-mapping-get chunk-numbers id))))
+  (define (init-chunk-number id)
+    (free-identifier-mapping-put! chunk-numbers id 2)))
 
 (define-syntax (chunk stx)
   (syntax-case stx ()
     [(_ name expr ...) 
      ;; no need for more error checking, using chunk for the code will do that
      (identifier? #'name)
-     (let ([n (get-chunk-number (syntax-local-introduce #'name) #f)]
-           [str (symbol->string (syntax-e #'name))])
+     (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
+            [str (symbol->string (syntax-e #'name))]
+            [tag (format "~a:~a" str (or n 1))])
+       
+       (when n
+         (inc-chunk-number (syntax-local-introduce #'name)))
        
        (syntax-local-lift-expression #'(quote-syntax (a-chunk name expr ...)))
        
-       (if (n . > . 1)
-           (let ([str
-                  (format 
-                   "need to handle secondary tags: ~a ~a\n"
-                   n 
-                   str)])
-             #`(begin
-                 (italic #,str)))
-           (with-syntax ([tag str]
-                         [str str]
-                         [((for-label-mod ...) ...)
-                          (map (lambda (expr)
-                                 (syntax-case expr (require)
-                                   [(require mod ...)
-                                    (let loop ([mods (syntax->list #'(mod ...))])
-                                      (cond
-                                        [(null? mods) null]
-                                        [else 
-                                         (syntax-case (car mods) (for-syntax)
-                                           [(for-syntax x ...)
-                                            (loop (cdr mods))
-                                            #;
-                                            (append (loop (syntax->list #'(x ...)))
-                                                    (loop (cdr mods)))]
-                                           [x
-                                            (cons #'x (loop (cdr mods)))])]))]
-                                   [else null]))
-                               (syntax->list #'(expr ...)))])
-             #`(begin
-                 (require (for-label for-label-mod ... ...))
-                 (define-syntax name (make-element-id-transformer
-                                      (lambda (stx) #'(chunkref name))))
-                 (begin-for-syntax (register-chunk-name #'name))
-                 (make-splice
-                  (list (make-toc-element
-                         #f
-                         (list (elemtag '(chunk tag)
-                                        (bold (italic (scheme name)) " ::=")))
-                         (list (smaller (elemref '(chunk tag) #:underline? #f
-                                                 str))))
-                        (schemeblock expr ...)))))))]))
+       (with-syntax ([tag tag]
+                     [str str]
+                     [((for-label-mod ...) ...)
+                      (map (lambda (expr)
+                             (syntax-case expr (require)
+                               [(require mod ...)
+                                (let loop ([mods (syntax->list #'(mod ...))])
+                                  (cond
+                                    [(null? mods) null]
+                                    [else 
+                                     (syntax-case (car mods) (for-syntax)
+                                       [(for-syntax x ...)
+                                        (append (loop (syntax->list #'(x ...)))
+                                                (loop (cdr mods)))]
+                                       [x
+                                        (cons #'x (loop (cdr mods)))])]))]
+                               [else null]))
+                           (syntax->list #'(expr ...)))]
+                     
+                     [(rest ...) (if n
+                                     #`((subscript #,(format "~a" n)))
+                                     #`())])
+         
+         #`(begin
+             (require (for-label for-label-mod ... ...))
+             #,@(if n
+                    #'()
+                    #'((define-syntax name (make-element-id-transformer
+                                            (lambda (stx) #'(chunkref name))))
+                       (begin-for-syntax (init-chunk-number #'name))))
+             (make-splice
+              (list (make-toc-element
+                     #f
+                     (list (elemtag '(chunk tag)
+                                    (bold (italic (scheme name)) " ::=")))
+                     (list (smaller (elemref '(chunk tag) #:underline? #f
+                                             str
+                                             rest ...))))
+                    (schemeblock expr ...))))))]))
 
 (define-syntax (chunkref stx)
   (syntax-case stx ()
     [(_ id)
      (identifier? #'id)
-     (with-syntax ([str (format "~a" (syntax-e #'id))])
-       #'(elemref '(chunk str) #:underline? #f str))]))
+     (with-syntax ([tag (format "~a:1" (syntax-e #'id))]
+                   [str (format "~a" (syntax-e #'id))])
+       #'(elemref '(chunk tag) #:underline? #f str))]))
 
 
 (provide (all-from-out scheme/base