\n")
;; the children
(for-each (lambda (n) (toc-entry n (+ 1 level))) ch)))
(let* ((c (markup-option n :chapter))
(s (markup-option n :section))
(ss (markup-option n :subsection))
(sss (markup-option n :subsubsection))
(b (markup-body n))
(bb (if (handle? b)
(handle-ast b)
b)))
(if (not (container? bb))
(error 'toc
"Illegal body (container expected)"
(if (markup? bb)
(markup-markup bb)
"???"))
(let ((lst (find-down (lambda (x)
(and (markup? x)
(markup-option x :toc)
(or (and sss (is-markup? x 'subsubsection))
(and ss (is-markup? x 'subsection))
(and s (is-markup? x 'section))
(and c (is-markup? x 'chapter))
(markup-option n (symbol->keyword
(markup-markup x))))))
(container-body bb))))
;; avoid to produce an empty table
(unless (null? lst)
(display "
\n\n")
(for-each (lambda (n) (toc-entry n 0)) lst)
(display "\n
\n")))))))
(define (section-in-separate-file? n e)
;; Return true if N, a node (chapter, section, etc.), is to be put in a
;; separate file, according to the customs of engine E.
(and (container? n)
(not (document? n))
(or (markup-option n :file)
(let ((kind (markup-markup n)))
(engine-custom e (string->symbol
(string-append (symbol->string kind)
"-file")))))))
(define (section-in-current-file? n e)
;; Return true if N is to be output in the current file, or in the main
;; file.
(and (container? n)
(not (section-in-separate-file? n e))))
;*---------------------------------------------------------------------*/
;* &html-generic-document ... */
;*---------------------------------------------------------------------*/
(define (&html-generic-document n title e)
(define (set-output-encoding)
(cond-expand
(guile-2
;; Make sure the output is suitably encoded.
(and=> (engine-custom e 'charset)
(lambda (charset)
(set-port-encoding! (current-output-port) charset)
(set-port-conversion-strategy! (current-output-port) 'error))))
(else #t)))
(let* ((id (markup-ident n))
(header (new markup
(markup '&html-chapter-header)
(ident (string-append id "-header"))
(class (markup-class n))
(parent n)
(body (html-browser-title n))))
(meta (new markup
(markup '&html-meta)
(ident (string-append id "-meta"))
(class (markup-class n))
(parent n)
(body (markup-option (ast-document n) :keywords))))
(head (new markup
(markup '&html-head)
(ident (string-append id "-head"))
(class (markup-class n))
(parent n)
(body (list header meta))))
(ftnote (new markup
(markup '&html-footnotes)
(ident (string-append id "-footnote"))
(class (markup-class n))
(parent n)
(body
;; Collect the footnotes of all the sub-containers that
;; are to be output in the same file.
(match (find-down (lambda (s)
(section-in-current-file? s e))
n)
((containers ...)
(reverse
(let loop ((subsections containers)
(footnotes '()))
(match subsections
((subsections ...)
(fold loop footnotes subsections))
(container
(append footnotes
(or (container-env-get container
'footnote-env)
'())))))))
(_ #f)))))
(page (new markup
(markup '&html-page)
(ident (string-append id "-page"))
(class (markup-class n))
(parent n)
(body (list (markup-body n) ftnote))))
(ending (new markup
(markup '&html-ending)
(ident (string-append id "-ending"))
(class (markup-class n))
(parent n)
(body (or (markup-option n :ending)
(let ((p (ast-document n)))
(and p (markup-option p :ending)))))))
(body (new markup
(markup '&html-body)
(ident (string-append id "-body"))
(class (markup-class n))
(parent n)
(body (list title page ending))))
(html (new markup
(markup '&html-html)
(ident (string-append id "-html"))
(class (markup-class n))
(parent n)
(body (list head body)))))
;; No file must be opened for documents. These files are
;; directly opened by Skribe
(if (document? n)
(begin
(set-output-encoding)
(output html e))
(parameterize ((*destination-file* (html-file n e)))
(with-output-to-file (*destination-file*)
(lambda ()
(set-output-encoding)
(output html e)))))))
;*---------------------------------------------------------------------*/
;* &html-generic-subdocument ... */
;*---------------------------------------------------------------------*/
(define (&html-generic-subdocument n e)
(let* ((p (ast-document n))
(id (markup-ident n))
(ti (let* ((nb (html-container-number n e))
(tc (markup-option n :title))
(ti (if (document? p)
(list (markup-option p :title)
(engine-custom e 'file-title-separator)
tc)
tc))
(sep (engine-custom
e
(symbol-append (markup-markup n)
'-title-number-separator)))
(nti (and tc
(if (and nb (not (equal? nb "")))
(list nb
(if (unspecified? sep) ". " sep)
ti)
ti))))
(new markup
(markup (symbol-append '&html- (markup-markup n) '-title))
(ident (string-append id "-title"))
(parent n)
(options '((author ())))
(body nti)))))
(case (markup-markup n)
((chapter)
(skribe-message " [~s chapter: ~a]\n" (engine-ident e) id))
((section)
(skribe-message " [~s section: ~a]\n" (engine-ident e) id)))
(&html-generic-document n ti e)))
;*---------------------------------------------------------------------*/
;* chapter ... @label chapter@ */
;*---------------------------------------------------------------------*/
(markup-writer 'chapter
:options '(:title :number :file :toc :html-title :env)
:before (lambda (n e)
(let ((title (markup-option n :title))
(ident (markup-ident n)))
(display "\n")
(display "")
(display "
")
(output (html-container-number n e) e)
(display " ")
(output (markup-option n :title) e)
(display "
")))
:after " ")
;; This writer is invoked only for chapters rendered inside separate files!
(markup-writer 'chapter
:options '(:title :number :file :toc :html-title :env)
:predicate (lambda (n e)
(or (markup-option n :file)
(engine-custom e 'chapter-file)))
:action &html-generic-subdocument)
;*---------------------------------------------------------------------*/
;* html-section-title ... */
;*---------------------------------------------------------------------*/
(define (html-section-title n e)
(let* ((title (markup-option n :title))
(number (markup-option n :number))
(c (markup-class n))
(ident (markup-ident n))
(kind (markup-markup n))
(tbg (engine-custom e (symbol-append kind '-title-background)))
(tfg (engine-custom e (symbol-append kind '-title-foreground)))
(tstart (engine-custom e (symbol-append kind '-title-start)))
(tstop (engine-custom e (symbol-append kind '-title-stop)))
(nsep (engine-custom e (symbol-append kind '-title-number-separator))))
;; the section header
(display "\n")
(display "")
(if c
(format #t "