From 397680acb0b22bd9b4940d67243737be1066b5a2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Georges=20Dup=C3=A9ron?= <georges.duperon@gmail.com>
Date: Fri, 30 Sep 2016 16:13:58 +0200
Subject: [PATCH] Workaround to be able to use @include-section to include
 several hyper-literate programs into a single document.

---
 private/chunks-toc-prefix.rkt    |  4 +++
 private/common.rkt               |  6 ++--
 private/lp.rkt                   | 23 +++++++++----
 scribblings/hyper-literate.scrbl | 59 ++++++++++++++++++++++++++++++--
 4 files changed, 81 insertions(+), 11 deletions(-)
 create mode 100644 private/chunks-toc-prefix.rkt

diff --git a/private/chunks-toc-prefix.rkt b/private/chunks-toc-prefix.rkt
new file mode 100644
index 00000000..85bf9062
--- /dev/null
+++ b/private/chunks-toc-prefix.rkt
@@ -0,0 +1,4 @@
+#lang racket/base
+
+(provide chunks-toc-prefix)
+(define chunks-toc-prefix (make-parameter '()))
\ No newline at end of file
diff --git a/private/common.rkt b/private/common.rkt
index 4e2244a5..575aa61b 100644
--- a/private/common.rkt
+++ b/private/common.rkt
@@ -159,7 +159,8 @@
        (let ([expanded 
               (expand `(,#'module
                         scribble-lp-tmp-name hyper-literate/private/lp
-                        (require (for-syntax racket/base
+                        (require hyper-literate/private/chunks-toc-prefix
+                                 (for-syntax racket/base
                                              hyper-literate/private/no-auto-require))
                         (begin-for-syntax (set-box! no-auto-require?
                                                     ,(if (attribute no-auto-require) #t #f)))
@@ -210,7 +211,8 @@
                                    ;; and make these identifiers exported by
                                    ;; hyper-literate
                                    (strip-context
-                                    #`((require (for-syntax racket/base
+                                    #`((require hyper-literate/private/chunks-toc-prefix
+                                                (for-syntax racket/base
                                                             hyper-literate/private/no-auto-require))
                                        (begin-for-syntax (set-box! no-auto-require?
                                                                    #,(if (attribute no-auto-require) #t #f)))
diff --git a/private/lp.rkt b/private/lp.rkt
index 49c51514..b0a1b5f8 100644
--- a/private/lp.rkt
+++ b/private/lp.rkt
@@ -40,7 +40,8 @@
       (free-identifier-mapping-put! repeat-chunk-numbers id (add1 current))
       current)))
 
-(require (for-syntax "no-auto-require.rkt"))
+(require (for-syntax "no-auto-require.rkt")
+         "chunks-toc-prefix.rkt")
 (define-for-syntax (make-chunk-code unsyntax?)
   (syntax-parser
     ;; no need for more error checking, using chunk for the code will do that
@@ -118,10 +119,13 @@
     [(_ original-name:id name:id stxn:number expr ...)
      (define n (syntax-e #'stxn))
      (define original-name:n (syntax-local-introduce
-                     (format-id #'original-name "~a:~a" #'original-name n)))
+                              (format-id #'original-name
+                                         "~a:~a"
+                                         #'original-name
+                                         n)))
      (define n-repeat (get+increment-repeat-chunk-number!
                        original-name:n))
-     (define str (string-append (symbol->string (syntax-e #'name))))
+     (define str (symbol->string (syntax-e #'name)))
      (define/with-syntax tag (format "chunk:~a:~a:~a" str n n-repeat))
      (define/with-syntax (rest ...)
        ;; if the would-be-next number for this chunk name is "2", then there is
@@ -143,9 +147,12 @@
                                                       #:underline? #f
                                                       #,str rest ...))
                                      " ::=")))
-                (list (smaller (elemref '(prefixable tag) #:underline? #f
-                                        #,str
-                                        rest ...))))
+                (list (smaller
+                       (make-link-element "plainlink"
+                                          (decode-content (list #,str rest ...))
+                                          `(elem (prefixable
+                                                  ,@(chunks-toc-prefix)
+                                                  tag))))))
                (#,racketblock expr ...))))]))
 
 (define-for-syntax (make-chunk chunk-code chunk-display)
@@ -230,4 +237,6 @@
 
 (provide (all-from-out scheme/base
                        scribble-enhanced/with-manual)
-         chunk CHUNK)
+         chunk
+         CHUNK
+         chunks-toc-prefix)
\ No newline at end of file
diff --git a/scribblings/hyper-literate.scrbl b/scribblings/hyper-literate.scrbl
index 1915604c..bcfa4bc7 100644
--- a/scribblings/hyper-literate.scrbl
+++ b/scribblings/hyper-literate.scrbl
@@ -1,6 +1,9 @@
 #lang scribble/manual
-@require[@for-label[;hyper-literate
- racket/base]]
+@require[racket/require
+         @for-label[hyper-literate
+                    racket/base
+                    (subtract-in scribble/manual hyper-literate)
+                    racket/contract]]
 
 @title{hyper-literate}
 @author{Georges Dupéron}
@@ -198,3 +201,55 @@ for the first time or not (in which case the
 @defform[(unless-preexpanding . body)]{
  Expands to @racket[(begin . body)] if the @racket[(submod "..")]
  module can be used, and expands to @racket[(begin)] otherwise.}
+
+@section{A note on literate programs as subsections of another document}
+
+To use @racket[include-section] on hyper-literate programs, a couple of
+workarounds are required to avoid issues with duplicate tags for
+identically-named chunks (like @racket[<*>], which is likely to always be
+present).
+
+@defparam[chunks-toc-prefix prefix-list (listof string?)]{
+ We give an example for two files which are part of a hypothetical
+ @elem[#:style 'tt "pkg"] package:
+
+ @itemlist[
+ @item{The main scribble file @filepath{main.scrbl} in the
+   @filepath{scribblings} sub-directory includes the hyper-literate file
+   @filepath{program.hl.rkt} located in the package's root directory, one
+   directory level above:
+  
+   @codeblock[#:keep-lang-line? #t
+ "#lang scribble/manual\n"
+ "@title{Main document title}\n"
+ "@include-section{../program.hl.rkt}\n"
+ "@; could include other hyper-literat programs here\n"]}
+ @item{To avoid issues with duplicate tag names, it is necessary to use the
+   @racket[#:tag-prefix] option on the hyper literate program's @racket[title].
+   Unfortunately, this breaks links to chunks in the table of contents, because
+   scribble does not automatically add the correct prefix to them. To ensure
+   that the links correctly work in the table of contents, it is necessary to
+   tell hyper-literate what is the chain of document includes. The whole
+   @filepath{program.hl.rkt} file will be:
+  
+   @codeblock[#:keep-lang-line? #t
+ "#lang hyper-literate racket/base\n"
+ "@title[#:tag-prefix '(lib \"pkg/program.hl.rkt\")]{Program title}\n"
+ "@(chunks-toc-prefix '(\"(lib pkg/scribblings/main.scrbl)\"\n"
+ "                      \"(lib pkg/program.hl.rkt)\"))\n"
+ "@chunk[<*>\n"
+ "       'program-code-here]\n"]
+
+   Note that the argument for the @racket[chunks-toc-prefix] parameter is a list
+   of string, and the strings are representations of module paths. The
+   occurrences of @racket[lib] above are not symbols, they are just part of the
+   string. Compare this with the following, which would be incorrect:
+
+   @codeblock[#:keep-lang-line? #t
+ "#lang hyper-literate racket/base\n"
+ "@title[#:tag-prefix '(lib \"pkg/program.hl.rkt\")]{Program title}\n"
+ "@; This is incorrect:\n"
+ "@(chunks-toc-prefix '((lib \"pkg/scribblings/main.scrbl\")\n"
+ "                      (lib \"pkg/program.hl.rkt\")))\n"
+ "@chunk[<*>\n"
+ "       'program-code-here]\n"]}]}
\ No newline at end of file