finished fixing multiple chunks

svn: r13841

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

collects/scribble/private/lp.ss

@@ -7,34 +7,28 @@
   ;; 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?)
+  (define (get-chunk-number id)
-    (let ([n (add1 (free-identifier-mapping-get chunk-numbers id
+    (free-identifier-mapping-get chunk-numbers id (lambda () #f)))
-                                                (lambda () 0)))])
+  (define (inc-chunk-number id)
-      (when install?
+    (free-identifier-mapping-put! chunk-numbers id (+ 1 (free-identifier-mapping-get chunk-numbers id))))
-        (free-identifier-mapping-put! chunk-numbers id n))
+  (define (init-chunk-number id)
-      n))
+    (free-identifier-mapping-put! chunk-numbers id 2)))
-  (define (register-chunk-name name)
-    (get-chunk-number name #t)))
 
 (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)]
+     (let* ([n (get-chunk-number (syntax-local-introduce #'name))]
-           [str (symbol->string (syntax-e #'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)
+       (with-syntax ([tag tag]
-           (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)
@@ -46,34 +40,41 @@
                                     [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 ...)))])
+                           (syntax->list #'(expr ...)))]
+                     
+                     [(rest ...) (if n
+                                     #`((subscript #,(format "~a" n)))
+                                     #`())])
+         
          #`(begin
              (require (for-label for-label-mod ... ...))
-                 (define-syntax name (make-element-id-transformer
+             #,@(if n
+                    #'()
+                    #'((define-syntax name (make-element-id-transformer
                                             (lambda (stx) #'(chunkref name))))
-                 (begin-for-syntax (register-chunk-name #'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))))
+                                             str
-                        (schemeblock expr ...)))))))]))
+                                             rest ...))))
+                    (schemeblock expr ...))))))]))
 
 (define-syntax (chunkref stx)
   (syntax-case stx ()
     [(_ id)
      (identifier? #'id)
-     (with-syntax ([str (format "~a" (syntax-e #'id))])
+     (with-syntax ([tag (format "~a:1" (syntax-e #'id))]
-       #'(elemref '(chunk str) #:underline? #f str))]))
+                   [str (format "~a" (syntax-e #'id))])
+       #'(elemref '(chunk tag) #:underline? #f str))]))
 
 
 (provide (all-from-out scheme/base