From e88f86efe43e17ecabbf67ee2b3c1f5317c3c2ca Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 8 May 2011 22:13:22 -0500
Subject: [PATCH] a start on the scribble/lncs language

---
 collects/scribble/lncs/lang.rkt        | 107 +++++++++++++++++++++++++
 collects/scribble/lncs/lang/reader.rkt |   3 +
 collects/scribble/lncs/lncs.tex        |   0
 collects/scribble/lncs/style.tex       |   3 +
 4 files changed, 113 insertions(+)
 create mode 100644 collects/scribble/lncs/lang.rkt
 create mode 100644 collects/scribble/lncs/lang/reader.rkt
 create mode 100644 collects/scribble/lncs/lncs.tex
 create mode 100644 collects/scribble/lncs/style.tex

diff --git a/collects/scribble/lncs/lang.rkt b/collects/scribble/lncs/lang.rkt
new file mode 100644
index 0000000000..c2e6d959e8
--- /dev/null
+++ b/collects/scribble/lncs/lang.rkt
@@ -0,0 +1,107 @@
+#lang racket/base
+(require scribble/doclang
+         scribble/core
+         (except-in scribble/base author)
+         scribble/decode
+         "../private/defaults.ss"
+         (for-syntax racket/base racket/list)
+         setup/main-collects
+         scribble/html-properties
+         scribble/latex-properties)
+
+(provide (except-out (all-from-out scribble/doclang) #%module-begin)
+         (all-from-out scribble/base)
+         (rename-out [module-begin #%module-begin])
+         abstract include-abstract
+         authors author
+         affiliation affiliation-mark affiliation-sep
+         maketitle)
+
+;; No options, currently, but keep in case we want to support some:
+(define-syntax (module-begin stx)
+  (syntax-case* stx () (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
+    [(_ id ws . body)
+     ;; Skip intraline whitespace to find options:
+     (and (string? (syntax-e #'ws))
+          (regexp-match? #rx"^ *$" (syntax-e #'ws)))
+     #'(module-begin id . body)]
+    [(_ id . body)
+     #'(#%module-begin id (post-process) () . body)]))
+
+(define ((post-process) doc)
+  (add-defaults doc
+                (string->bytes/utf-8
+                 "\\documentclass{llncs}\n") ; (format "\\documentclass{llncs}\n\\usepackage{times}\n\\usepackage{qcourier}\n"))
+                (scribble-file "lncs/style.tex")
+                (list (scribble-file "lncs/llncs.cls"))
+                #f))
+
+
+(define jfp-extras
+  (let ([abs (lambda (s)
+               (path->main-collects-relative
+                (collection-file-path s "scribble" "lncs")))])
+    (list
+     (make-css-addition (abs "lncs.css"))
+     (make-tex-addition (abs "lncs.tex")))))
+
+;; ----------------------------------------
+;; Abstracts:
+
+(define abstract-style (make-style "abstract" jfp-extras))
+
+(define (abstract . strs)
+  (make-nested-flow
+   abstract-style
+   (decode-flow strs)))
+
+(define (extract-abstract p)
+  (unless (part? p)
+    (error 'include-abstract "doc binding is not a part: ~e" p))
+  (unless (null? (part-parts p))
+    (error 'include-abstract "abstract part has sub-parts: ~e" (part-parts p)))
+  (when (part-title-content p)
+    (error 'include-abstract "abstract part has title content: ~e" (part-title-content p)))
+  (part-blocks p))
+
+(define-syntax-rule (include-abstract mp)
+  (begin
+    (require (only-in mp [doc abstract-doc]))
+    (make-nested-flow abstract-style (extract-abstract abstract-doc))))
+
+;; ----------------------------------------
+;; Author
+
+(define-syntax (author stx)
+  (raise-syntax-error 'author "can only be used inside 'authors'" stx))
+(define-syntax (authors stx)
+  (syntax-case stx (author)
+    [(_ (author . args) ...)
+     #`(make-element (style "author" '())
+                     (decode-content
+                      (list
+                       #,@(apply 
+                           append
+                           (add-between
+                            (for/list ([stx (in-list (syntax->list #'(args ...)))])
+                              (syntax-case stx ()
+                                [(#:inst string rest ...)
+                                 (append (syntax->list #'(rest ...))
+                                         (list #'(element (style "inst" '()) (decode-content (list string)))))]
+                                [(rest ...)
+                                 (syntax->list #'(rest ...))]))
+                            (list #'(element (style "and" '()) '())))))))]
+    [(_ . rest)
+     (raise-syntax-error 'authors "expected a sequence of authors" stx)]))
+
+(define (maketitle)
+  (element (style "maketitle" jfp-extras) '()))
+
+(define (affiliation . txt)
+  (make-element (make-style "Affiliation" jfp-extras) (decode-content txt)))
+
+(define (affiliation-mark . txt)
+  (make-element (make-style "MarkSuperscript" jfp-extras) (decode-content txt)))
+
+(define (affiliation-sep)
+  (hspace 2))
diff --git a/collects/scribble/lncs/lang/reader.rkt b/collects/scribble/lncs/lang/reader.rkt
new file mode 100644
index 0000000000..6bac48ba2c
--- /dev/null
+++ b/collects/scribble/lncs/lang/reader.rkt
@@ -0,0 +1,3 @@
+#lang s-exp scribble/base/reader
+scribble/lncs/lang
+#:wrapper1 (lambda (t) (cons 'doc (t)))
diff --git a/collects/scribble/lncs/lncs.tex b/collects/scribble/lncs/lncs.tex
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/collects/scribble/lncs/style.tex b/collects/scribble/lncs/style.tex
new file mode 100644
index 0000000000..9d57aab1e4
--- /dev/null
+++ b/collects/scribble/lncs/style.tex
@@ -0,0 +1,3 @@
+
+\renewcommand{\titleAndVersionAndAuthors}[3]{\title{#1}\titlerunning{#2}#3\maketitle}
+\renewcommand{\titleAndEmptyVersionAndAuthors}[3]{\titleAndVersionAndAuthors{#1}{#1}{#3}}