commit 8d89cdfcd21ffbd45a67c27629e5c4ff6ee38122
parent 878e262e9ae092e5844c3ac17417add990aba833
Author: Georges Dupéron <georges.duperon@gmail.com>
Date: Thu, 23 Mar 2017 02:47:25 +0100
TeX stuff, included some of the literate programming as appendices.
Diffstat:
3 files changed, 184 insertions(+), 12 deletions(-)
diff --git a/info.rkt b/info.rkt
@@ -7,7 +7,28 @@
"typed-racket-lib"
"at-exp-lib"
"scribble-enhanced"
- "scribble-math"))
+ "scribble-math"
+ "phc-toolkit"
+ ;; Literate programming dependencies:
+ ;; phc-graph:
+ "aful"
+ "delay-pure"
+ "phc-adt-doc"
+ "phc-graph"
+ "stxparse-info"
+ "subtemplate"
+ "type-expander"
+ "typed-racket-doc"
+ ;; phc-adt:
+ "alexis-util"
+ "extensible-parser-specifications"
+ "multi-id"
+ "remember"
+ "threading-doc"
+ "trivial"
+ "typed-struct-props"
+ "xlist"
+ ))
(define scribblings '(("scribblings/phc-thesis.scrbl" ())))
(define pkg-desc "Description Here")
(define version "0.0")
diff --git a/scribblings/phc-thesis.scrbl b/scribblings/phc-thesis.scrbl
@@ -4,7 +4,8 @@
scriblib/render-cond
racket/system
racket/port
- racket/string]
+ racket/string
+ scribble/core]
@(use-mathjax)
@title[#:style (with-html5 manual-doc-style)
@@ -16,14 +17,58 @@
@(cond-element
[html (list "Download a "
@hyperlink["../pdf/phc-thesis.pdf"]{PDF version}
- ".")]
+ " of this document.")]
[latex
(list "HTML version available at "
@hyperlink["https://jsmaniac.github.io/phc-thesis/phc-thesis/"
]{https://jsmaniac.github.io/phc-thesis/phc-thesis/}
- ".")]
+ ".")]
[else ""])
-@include-section{state-of-the-art.scrbl}
+@(table-of-contents)
-@(generate-bibliography-section)
-\ No newline at end of file
+@include-section*{state-of-the-art.scrbl}
+@;{@(struct-update part
+ (include-section* "state-of-the-art.scrbl")
+ [style (λ (s)
+ (struct-update style s
+ [properties (λ (p) (cons 'unnumbered p))]))])}
+@;@include-asection{state-of-the-art.scrbl}
+
+@;@(generate-bibliography-section)
+@; Generate the bibliography with a numbered section:
+@(part-style-update (generate-bibliography-section)
+ (λ (p) (remove 'unnumbered p)))
+
+@(define default-nb
+ (make-numberer (λ (a b)
+ (eprintf "(my-nb ~s ~s)\n" a b)
+ (values (string-join (append b (list (number->string a)))
+ ".")
+ (add1 a)))
+ 1))
+
+@; experiments:
+@;{
+ @aappendix{
+ @asection{
+ @atitle{Fu}}
+ @include-asection[
+ (lib "phc-graph/scribblings/phc-graph-implementation.scrbl")]
+ @asection{
+ @atitle{Bar}
+ @asection{
+ @atitle[#:style (style #f (list default-nb))]{One}}
+ @asection{
+ @atitle[#:style (style #f (list default-nb))]{Two}}}
+
+ @asection{
+ @atitle{Hello world}
+ Hi there!}
+ }
+}
+
+@aappendix{
+ @include-asection[(lib "phc-graph/scribblings/phc-graph-implementation.scrbl")]
+ @include-asection[(lib "phc-adt/scribblings/phc-adt-implementation.scrbl")]
+}
+\ No newline at end of file
diff --git a/scribblings/util.rkt b/scribblings/util.rkt
@@ -15,7 +15,12 @@
define-footnote ;; TODO: does not use the (superscript …)
(all-from-out "abbreviations.rkt")
(all-from-out scribble-math)
- version-text)
+ version-text
+ aappendix
+ include-section*
+ include-asection
+ struct-update
+ part-style-update)
(require racket/stxparam
racket/splicing
@@ -27,14 +32,39 @@
racket/runtime-path
scribble-enhanced/math
scribble/latex-properties
+ scribble/decode
scribble-math
- "abbreviations.rkt")
+ phc-toolkit/untyped/meta-struct
+ "abbreviations.rkt"
+ (for-syntax syntax/parse))
(use-mathjax)
+(define-syntax struct-update
+ (syntax-parser
+ [(_ struct-type:id v:expr [field:id updater:expr] ...)
+ #'(let ([vv v])
+ (struct-copy struct-type
+ vv
+ [field (updater ((struct-accessor struct-type field) vv))]
+ ...))]))
+
+
(define (tex-header tex)
(elem #:style (style #f (list (tex-addition (string->bytes/utf-8 tex))))))
+(define scribble-tex-commands-addition
+ (tex-addition
+ (string->bytes/utf-8 "\\newcommand{\\scribbleTeXCommands}[1]{#1}")))
+
+(define (tex-code code)
+ (cond-element
+ [latex (elem #:style (style "scribbleTeXCommands"
+ (list 'exact-chars
+ scribble-tex-commands-addition))
+ code)]
+ [else (list)]))
+
(define (my-author+email author email)
(cond-element
[html (author+email author email)]
@@ -125,18 +155,95 @@
#'asection-current-level))])
. body))
+(define-syntax-parameter asection-current-is-appendix #f)
+(define-syntax-rule (aappendix . body)
+ (splicing-syntax-parameterize ([asection-current-is-appendix #t])
+ (appendix)
+ . body))
+
+
+;; Alpha numbering of appendices in HTML and TeX
+(define (num->alpha current parents)
+ (eprintf "(num->alpha ~s ~s)\n" current parents)
+
+ (define letters
+ (vector->immutable-vector
+ (vector-map
+ symbol->string
+ #(A B C D E F G H I J K L M N O P Q R S T U V W X Y Z))))
+
+ (define cur (sub1 current))
+
+ (define-values (oldlimit len)
+ (let loop ([oldlimit 0]
+ [limit 26]
+ [len 1])
+ (if (< cur limit)
+ (values oldlimit len)
+ (loop limit (+ (* limit 26) 26) (add1 len)))))
+
+ (let-values ([(_ ans) (for/fold ([v (- cur oldlimit)]
+ [ans '()])
+ ([i (in-range len)])
+ (define-values (q r) (quotient/remainder v 26))
+ (values q
+ (cons (vector-ref letters r) ans)))])
+ (values (string-join ans "")
+ (add1 current))))
+(define appendix-numberer
+ (make-numberer num->alpha
+ 1))
+
+(define (part-style-update p updater)
+ (define (style-updater old-style)
+ (struct-update
+ style
+ old-style
+ [properties updater]))
+ (if (part-start? p)
+ (struct-update part-start p [style style-updater])
+ (struct-update part p [style style-updater])))
+
+;; make-appendix-section must be called by @atitle below
+(define (make-appendix-section p)
+ (part-style-update p (λ (old-props)
+ (cons appendix-numberer
+ old-props))))
+(define (appendix)
+ (list
+ (section #:style (style #f (list 'hidden 'toc-hidden 'unnumbered)))
+ (tex-code "\\appendix")))
+
(define-syntax (atitle stx)
(syntax-case stx ()
[(_ . args)
(case (syntax-parameter-value #'asection-current-level)
[(0) #'(my-title . args)]
- [(1) #'(section . args)]
+ [(1) (if (syntax-parameter-value #'asection-current-is-appendix)
+ #'(make-appendix-section (section . args))
+ #'(section . args))]
[(2) #'(subsection . args)]
[(3) #'(subsubsection . args)]
[else
;; TODO: log a warning here maybe?
#'(subsubsub*section . args)])]))
+(define-syntax (include-section* stx)
+ (syntax-case stx ()
+ [(_ mod)
+ (with-syntax ([doc (datum->syntax #'mod 'doc #'mod)])
+ #'(let ()
+ (local-require (only-in mod doc))
+ doc))]))
+
+(define-syntax (include-asection stx)
+ (syntax-case stx ()
+ [(_ mod)
+ (if (syntax-parameter-value #'asection-current-is-appendix)
+ #'(make-appendix-section (include-section* mod))
+ #'(include-section* mod))]))
+
+
;; hidden todo:
(define (htodo . args) (list))
@@ -159,4 +266,4 @@
(define (~cite* #:precision [precision #f] . rest)
(if precision
(list (apply ~cite rest) ", " precision)
- (apply ~cite rest)))
-\ No newline at end of file
+ (apply ~cite rest)))
