summaryrefslogtreecommitdiff
path: root/skr
diff options
context:
space:
mode:
Diffstat (limited to 'skr')
-rw-r--r--skr/Makefile43
-rw-r--r--skr/acmproc.skr155
-rw-r--r--skr/french.skr19
-rw-r--r--skr/jfp.skr317
-rw-r--r--skr/letter.skr146
-rw-r--r--skr/lncs.skr147
-rw-r--r--skr/scribe.skr229
-rw-r--r--skr/sigplan.skr155
-rw-r--r--skr/skribe.skr76
-rw-r--r--skr/slide.skr664
-rw-r--r--skr/web-article.skr230
-rw-r--r--skr/web-book.skr107
12 files changed, 0 insertions, 2288 deletions
diff --git a/skr/Makefile b/skr/Makefile
deleted file mode 100644
index dcc3e77..0000000
--- a/skr/Makefile
+++ /dev/null
@@ -1,43 +0,0 @@
-#*=====================================================================*/
-#* serrano/prgm/project/skribe/skr/Makefile */
-#* ------------------------------------------------------------- */
-#* Author : Manuel Serrano */
-#* Creation : Sat Oct 25 08:21:20 2003 */
-#* Last change : Wed May 18 15:34:21 2005 (serrano) */
-#* Copyright : 2003-05 Manuel Serrano */
-#* ------------------------------------------------------------- */
-#* The Skribe SKR Makefile */
-#*=====================================================================*/
-include ../etc/Makefile.config
-include ../etc/$(SYSTEM)/Makefile.skb
-
-#*---------------------------------------------------------------------*/
-#* POPULATION */
-#*---------------------------------------------------------------------*/
-POPULATION= acmproc.skr sigplan.skr jfp.skr \
- slide.skr web-book.skr web-article.skr \
- base.skr latex.skr scribe.skr xml.skr \
- html.skr html4.skr lncs.skr skribe.skr \
- letter.skr french.skr latex-simple.skr context.skr Makefile
-
-#*---------------------------------------------------------------------*/
-#* pop */
-#*---------------------------------------------------------------------*/
-.PHONY: pop
-
-pop:
- @ echo $(POPULATION:%=skr/%)
-
-#*---------------------------------------------------------------------*/
-#* Install/Uinstall */
-#*---------------------------------------------------------------------*/
-.PHONY: install uninstall
-
-install: $(DESTDIR)$(INSTALL_SKRDIR)
- cp *.skr $(DESTDIR)$(INSTALL_SKRDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_SKRDIR)/*
-
-uninstall:
-
-$(DESTDIR)$(INSTALL_SKRDIR):
- mkdir -p $(DESTDIR)$(INSTALL_SKRDIR) && chmod a+rx $(DESTDIR)$(INSTALL_SKRDIR)
-
diff --git a/skr/acmproc.skr b/skr/acmproc.skr
deleted file mode 100644
index 4accc7c..0000000
--- a/skr/acmproc.skr
+++ /dev/null
@@ -1,155 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/acmproc.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Sun Sep 28 14:40:38 2003 */
-;* Last change : Thu Jun 2 10:55:39 2005 (serrano) */
-;* Copyright : 2003-05 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe style for ACMPROC articles. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* LaTeX global customizations */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le
- 'documentclass
- "\\documentclass[letterpaper]{acmproc}")
- ;; &latex-author
- (markup-writer '&latex-author le
- :before (lambda (n e)
- (let ((body (markup-body n)))
- (printf "\\numberofauthors{~a}\n\\author{\n"
- (if (pair? body) (length body) 1))))
- :action (lambda (n e)
- (let ((body (markup-body n)))
- (for-each (lambda (a)
- (display "\\alignauthor\n")
- (output a e))
- (if (pair? body) body (list body)))))
- :after "}\n")
- ;; author
- (let ((old-author (markup-writer-get 'author le)))
- (markup-writer 'author le
- :options (writer-options old-author)
- :action (writer-action old-author)))
- ;; ACM category, terms, and keywords
- (markup-writer '&acm-category le
- :options '(:index :section :subsection)
- :before (lambda (n e)
- (display "\\category{")
- (display (markup-option n :index))
- (display "}")
- (display "{")
- (display (markup-option n :section))
- (display "}")
- (display "{")
- (display (markup-option n :subsection))
- (display "}\n["))
- :after "]\n")
- (markup-writer '&acm-terms le
- :before "\\terms{"
- :after "}")
- (markup-writer '&acm-keywords le
- :before "\\keywords{"
- :after "}")
- (markup-writer '&acm-copyright le
- :action (lambda (n e)
- (display "\\conferenceinfo{")
- (output (markup-option n :conference) e)
- (display ",} {")
- (output (markup-option n :location) e)
- (display "}\n")
- (display "\\CopyrightYear{")
- (output (markup-option n :year) e)
- (display "}\n")
- (display "\\crdata{")
- (output (markup-option n :crdata) e)
- (display "}\n"))))
-
-;*---------------------------------------------------------------------*/
-;* HTML global customizations */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (markup-writer '&html-acmproc-abstract he
- :action (lambda (n e)
- (let* ((ebg (engine-custom e 'abstract-background))
- (bg (or (and (string? ebg)
- (> (string-length ebg) 0))
- ebg
- "#cccccc"))
- (exp (p (center (color :bg bg :width 90.
- (markup-body n))))))
- (skribe-eval exp e))))
- ;; ACM category, terms, and keywords
- (markup-writer '&acm-category :action #f)
- (markup-writer '&acm-terms :action #f)
- (markup-writer '&acm-keywords :action #f)
- (markup-writer '&acm-copyright :action #f))
-
-;*---------------------------------------------------------------------*/
-;* abstract ... */
-;*---------------------------------------------------------------------*/
-(define-markup (abstract #!rest opt #!key (class "abstract") postscript)
- (if (engine-format? "latex")
- (section :number #f :title "ABSTRACT" (p (the-body opt)))
- (let ((a (new markup
- (markup '&html-acmproc-abstract)
- (body (the-body opt)))))
- (list (if postscript
- (section :number #f :toc #f :title "Postscript download"
- postscript))
- (section :number #f :toc #f :class class :title "Abstract" a)
- (section :number #f :toc #f :title "Table of contents"
- (toc :subsection #t))))))
-
-;*---------------------------------------------------------------------*/
-;* acm-category ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-category #!rest opt #!key index section subsection)
- (new markup
- (markup '&acm-category)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-terms ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-terms #!rest opt)
- (new markup
- (markup '&acm-terms)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-keywords ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-keywords #!rest opt)
- (new markup
- (markup '&acm-keywords)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-copyright ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
- (let* ((le (find-engine 'latex))
- (cop (format "\\conferenceinfo{~a,} {~a}
-\\CopyrightYear{~a}
-\\crdata{~a}\n" conference location year crdata))
- (old (engine-custom le 'predocument)))
- (if (string? old)
- (engine-custom-set! le 'predocument (string-append cop old))
- (engine-custom-set! le 'predocument cop))))
-
-;*---------------------------------------------------------------------*/
-;* references ... */
-;*---------------------------------------------------------------------*/
-(define (references)
- (list "\n\n"
- (if (engine-format? "latex")
- (font :size -1 (flush :side 'left (the-bibliography)))
- (section :title "References"
- (font :size -1 (the-bibliography))))))
diff --git a/skr/french.skr b/skr/french.skr
deleted file mode 100644
index 373d076..0000000
--- a/skr/french.skr
+++ /dev/null
@@ -1,19 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/letter.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Fri Oct 3 12:22:13 2003 */
-;* Last change : Tue Oct 28 14:33:43 2003 (serrano) */
-;* Copyright : 2003 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* French Skribe style */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* LaTeX configuration */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le 'usepackage
- (string-append (engine-custom le 'usepackage)
- "\\usepackage[french]{babel}
-\\usepackage{a4}")))
diff --git a/skr/jfp.skr b/skr/jfp.skr
deleted file mode 100644
index 60b40f2..0000000
--- a/skr/jfp.skr
+++ /dev/null
@@ -1,317 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/jfp.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Sun Sep 28 14:40:38 2003 */
-;* Last change : Mon Oct 11 15:44:08 2004 (serrano) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe style for JFP articles. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* LaTeX global customizations */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le 'documentclass "\\documentclass{jfp}")
- (engine-custom-set! le 'hyperref #f)
- ;; &latex-author
- (markup-writer '&latex-author le
- :action (lambda (n e)
- (define (&latex-subauthor)
- (let* ((d (ast-document n))
- (sa (and (is-markup? d 'document)
- (markup-option d :head-author))))
- (if sa
- (begin
- (display "[")
- (output sa e)
- (display "]")))))
- (define (&latex-author-1 n)
- (display "\\author")
- (&latex-subauthor)
- (display "{\n")
- (output n e)
- (display "}\n"))
- (define (&latex-author-n n)
- (display "\\author")
- (&latex-subauthor)
- (display "{\n")
- (output (car n) e)
- (for-each (lambda (a)
- (display "\\and ")
- (output a e))
- (cdr n))
- (display "}\n"))
- (let ((body (markup-body n)))
- (cond
- ((is-markup? body 'author)
- (&latex-author-1 body))
- ((and (list? body)
- (every? (lambda (b) (is-markup? b 'author))
- body))
- (&latex-author-n body))
- (else
- (skribe-error 'author
- "Illegal `jfp' author"
- body))))))
- ;; title
- (markup-writer '&latex-title le
- :before (lambda (n e)
- (let* ((d (ast-document n))
- (st (and (is-markup? d 'document)
- (markup-option d :head-title))))
- (if st
- (begin
- (display "\\title[")
- (output st e)
- (display "]{"))
- (display "\\title{"))))
- :after "}\n")
- ;; author
- (let ((old-author (markup-writer-get 'author le)))
- (markup-writer 'author le
- :options (writer-options old-author)
- :action (lambda (n e)
- (let ((name (markup-option n :name))
- (aff (markup-option n :affiliation))
- (addr (markup-option n :address))
- (email (markup-option n :email)))
- (if name
- (begin
- (output name e)
- (display "\\\\\n")))
- (if aff
- (begin
- (output aff e)
- (display "\\\\\n")))
- (if addr
- (begin
- (if (pair? addr)
- (for-each (lambda (a)
- (output a e)
- (display "\\\\\n"))
- addr)
- (begin
- (output addr e)
- (display "\\\\\n")))))
- (if email
- (begin
- (display "\\email{")
- (output email e)
- (display "}\\\\\n")))))))
- ;; bib-ref
- (markup-writer 'bib-ref le
- :options '(:bib :text :key)
- :before "("
- :action (lambda (n e)
- (let ((be (handle-ast (markup-body n))))
- (if (is-markup? be '&bib-entry)
- (let ((a (markup-option be 'author))
- (y (markup-option be 'year)))
- (cond
- ((and (is-markup? a '&bib-entry-author)
- (is-markup? y '&bib-entry-year))
- (let ((ba (markup-body a)))
- (if (not (string? ba))
- (output ba e)
- (let* ((s1 (pregexp-replace* " and "
- ba
- " \\& "))
- (s2 (pregexp-replace* ", [^ ]+"
- s1
- "")))
- (output s2 e)
- (display ", ")
- (output y e)))))
- ((is-markup? y '&bib-entry-year)
- (skribe-error 'bib-ref
- "Missing `name' entry"
- (markup-ident be)))
- (else
- (let ((ba (markup-body a)))
- (if (not (string? ba))
- (output ba e)
- (let* ((s1 (pregexp-replace* " and "
- ba
- " \\& "))
- (s2 (pregexp-replace* ", [^ ]+"
- s1
- "")))
- (output s2 e)))))))
- (skribe-error 'bib-ref
- "Illegal bib-ref"
- (markup-ident be)))))
- :after ")")
- ;; bib-ref/text
- (markup-writer 'bib-ref le
- :options '(:bib :text :key)
- :predicate (lambda (n e)
- (markup-option n :key))
- :action (lambda (n e)
- (output (markup-option n :key) e)))
- ;; &the-bibliography
- (markup-writer '&the-bibliography le
- :before (lambda (n e)
- (display "{%
-\\sloppy
-\\sfcode`\\.=1000\\relax
-\\newdimen\\bibindent
-\\bibindent=0em
-\\begin{list}{}{%
- \\settowidth\\labelwidth{[]}%
- \\leftmargin\\labelwidth
- \\advance\\leftmargin\\labelsep
- \\advance\\leftmargin\\bibindent
- \\itemindent -\\bibindent
- \\listparindent \\itemindent
- }%\n"))
- :after (lambda (n e)
- (display "\n\\end{list}}\n")))
- ;; bib-entry
- (markup-writer '&bib-entry le
- :options '(:title)
- :action (lambda (n e)
- (output n e (markup-writer-get '&bib-entry-body e)))
- :after "\n")
- ;; %bib-entry-title
- (markup-writer '&bib-entry-title le
- :action (lambda (n e)
- (output (markup-body n) e)))
- ;; %bib-entry-body
- (markup-writer '&bib-entry-body le
- :action (lambda (n e)
- (define (output-fields descr)
- (display "\\item[")
- (let loop ((descr descr)
- (pending #f)
- (armed #f)
- (first #t))
- (cond
- ((null? descr)
- 'done)
- ((pair? (car descr))
- (if (eq? (caar descr) 'or)
- (let ((o1 (cadr (car descr))))
- (if (markup-option n o1)
- (loop (cons o1 (cdr descr))
- pending
- #t
- #f)
- (let ((o2 (caddr (car descr))))
- (loop (cons o2 (cdr descr))
- pending
- armed
- #f))))
- (let ((o (markup-option n (cadr (car descr)))))
- (if o
- (begin
- (if (and pending armed)
- (output pending e))
- (output (caar descr) e)
- (output o e)
- (if (pair? (cddr (car descr)))
- (output (caddr (car descr)) e))
- (loop (cdr descr) #f #t #f))
- (loop (cdr descr) pending armed #f)))))
- ((symbol? (car descr))
- (let ((o (markup-option n (car descr))))
- (if o
- (begin
- (if (and armed pending)
- (output pending e))
- (output o e)
- (if first
- (display "]"))
- (loop (cdr descr) #f #t #f))
- (loop (cdr descr) pending armed #f))))
- ((null? (cdr descr))
- (output (car descr) e))
- ((string? (car descr))
- (loop (cdr descr)
- (if pending pending (car descr))
- armed
- #f))
- (else
- (skribe-error 'output-bib-fields
- "Illegal description"
- (car descr))))))
- (output-fields
- (case (markup-option n 'kind)
- ((techreport)
- `(author (" (" year ")") " " (or title url) ". "
- number ", " institution ", "
- address ", " month ", "
- ("pp. " pages) "."))
- ((article)
- `(author (" (" year ")") " " (or title url) ". "
- journal ", " volume ", " ("(" number ")") ", "
- address ", " month ", "
- ("pp. " pages) "."))
- ((inproceedings)
- `(author (" (" year ")") " " (or title url) ". "
- book(or title url) ", " series ", " ("(" number ")") ", "
- address ", " month ", "
- ("pp. " pages) "."))
- ((book)
- '(author (" (" year ")") " " (or title url) ". "
- publisher ", " address
- ", " month ", " ("pp. " pages) "."))
- ((phdthesis)
- '(author (" (" year ")") " " (or title url) ". " type ", "
- school ", " address
- ", " month "."))
- ((misc)
- '(author (" (" year ")") " " (or title url) ". "
- publisher ", " address
- ", " month "."))
- (else
- '(author (" (" year ")") " " (or title url) ". "
- publisher ", " address
- ", " month ", " ("pp. " pages) "."))))))
- ;; abstract
- (markup-writer 'jfp-abstract le
- :options '(postscript)
- :before "\\begin{abstract}\n"
- :after "\\end{abstract}\n"))
-
-;*---------------------------------------------------------------------*/
-;* HTML global customizations */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (markup-writer '&html-jfp-abstract he
- :action (lambda (n e)
- (let* ((bg (engine-custom e 'abstract-background))
- (exp (p (if bg
- (center (color :bg bg :width 90.
- (it (markup-body n))))
- (it (markup-body n))))))
- (skribe-eval exp e)))))
-
-;*---------------------------------------------------------------------*/
-;* abstract ... */
-;*---------------------------------------------------------------------*/
-(define-markup (abstract #!rest opt #!key postscript)
- (if (engine-format? "latex")
- (new markup
- (markup 'jfp-abstract)
- (body (p (the-body opt))))
- (let ((a (new markup
- (markup '&html-jfp-abstract)
- (body (the-body opt)))))
- (list (if postscript
- (section :number #f :toc #f :title "Postscript download"
- postscript))
- (section :number #f :toc #f :title "Abstract" a)
- (section :number #f :toc #f :title "Table of contents"
- (toc :subsection #t))))))
-
-;*---------------------------------------------------------------------*/
-;* references ... */
-;*---------------------------------------------------------------------*/
-(define (references)
- (list "\n\n"
- (section :title "References" :class "references"
- :number (not (engine-format? "latex"))
- (font :size -1 (the-bibliography)))))
-
diff --git a/skr/letter.skr b/skr/letter.skr
deleted file mode 100644
index 17a0058..0000000
--- a/skr/letter.skr
+++ /dev/null
@@ -1,146 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/letter.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Fri Oct 3 12:22:13 2003 */
-;* Last change : Thu Sep 23 20:00:42 2004 (serrano) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* Skribe style for letters */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* document */
-;*---------------------------------------------------------------------*/
-(define %letter-document document)
-
-(define-markup (document #!rest opt
- #!key (ident #f) (class "letter")
- where date author
- &skribe-eval-location)
- (let* ((ubody (the-body opt))
- (body (list (new markup
- (markup '&letter-where)
- (loc &skribe-eval-location)
- (options `((:where ,where)
- (:date ,date)
- (:author ,author))))
- ubody)))
- (apply %letter-document
- :author #f :title #f
- (append (apply append
- (the-options opt :where :date :author :title))
- body))))
-
-;*---------------------------------------------------------------------*/
-;* LaTeX configuration */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le 'documentclass "\\documentclass[12pt]{letter}\n")
- (engine-custom-set! le 'maketitle #f)
- ;; &letter-where
- (markup-writer '&letter-where le
- :before "\\begin{raggedright}\n"
- :action (lambda (n e)
- (let* ((w (markup-option n :where))
- (d (markup-option n :date))
- (a (markup-option n :author))
- (hd (if (and w d)
- (list w ", " d)
- (or w d)))
- (ne (copy-engine 'author e)))
- ;; author
- (markup-writer 'author ne
- :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
- :action (lambda (n e)
- (let ((name (markup-option n :name))
- (title (markup-option n :title))
- (affiliation (markup-option n :affiliation))
- (email (markup-option n :email))
- (url (markup-option n :url))
- (address (markup-option n :address))
- (phone (markup-option n :phone)))
- (define (row n)
- (output n e)
- (when hd
- (display "\\hfill ")
- (output hd e)
- (set! hd #f))
- (display "\\\\\n"))
- ;; name
- (if name (row name))
- ;; title
- (if title (row title))
- ;; affiliation
- (if affiliation (row affiliation))
- ;; address
- (if (pair? address)
- (for-each row address))
- ;; telephone
- (if phone (row phone))
- ;; email
- (if email (row email))
- ;; url
- (if url (row url)))))
- ;; emit the author
- (if a
- (output a ne)
- (output hd e))))
- :after "\\end{raggedright}\n\\vspace{1cm}\n\n"))
-
-;*---------------------------------------------------------------------*/
-;* HTML configuration */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- ;; &letter-where
- (markup-writer '&letter-where he
- :before "<table width=\"100%\">\n"
- :action (lambda (n e)
- (let* ((w (markup-option n :where))
- (d (markup-option n :date))
- (a (markup-option n :author))
- (hd (if (and w d)
- (list w ", " d)
- (or w d)))
- (ne (copy-engine 'author e)))
- ;; author
- (markup-writer 'author ne
- :options '(:name :title :affiliation :email :url :address :phone :photo :align :header)
- :action (lambda (n e)
- (let ((name (markup-option n :name))
- (title (markup-option n :title))
- (affiliation (markup-option n :affiliation))
- (email (markup-option n :email))
- (url (markup-option n :url))
- (address (markup-option n :address))
- (phone (markup-option n :phone)))
- (define (row n)
- (display "<tr><td align='left'>")
- (output n e)
- (when hd
- (display "</td><td align='right'>")
- (output hd e)
- (set! hd #f))
- (display "</td></tr>\n"))
- ;; name
- (if name (row name))
- ;; title
- (if title (row title))
- ;; affiliation
- (if affiliation (row affiliation))
- ;; address
- (if (pair? address)
- (for-each row address))
- ;; telephone
- (if phone (row phone))
- ;; email
- (if email (row email))
- ;; url
- (if url (row url)))))
- ;; emit the author
- (if a
- (output a ne)
- (output hd e))))
- :after "</table>\n<hr>\n\n"))
-
-
diff --git a/skr/lncs.skr b/skr/lncs.skr
deleted file mode 100644
index 4668404..0000000
--- a/skr/lncs.skr
+++ /dev/null
@@ -1,147 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/lncs.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Sun Sep 28 14:40:38 2003 */
-;* Last change : Fri Jan 16 07:04:51 2004 (serrano) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe style for LNCS articles. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* LaTeX global customizations */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le 'documentclass "\\documentclass{llncs}")
- ;; &latex-author
- (markup-writer '&latex-author le
- :action (lambda (n e)
- (define (&latex-inst-body n)
- (let ((affiliation (markup-option n :affiliation))
- (address (markup-option n :address)))
- (when affiliation (output affiliation e) (display ", "))
- (when address
- (for-each (lambda (a) (output a e) (display " "))
- address)
- (newline))))
- (define (&latex-inst-n i)
- (display "\\institute{\n")
- (&latex-inst-body (car i))
- (for-each (lambda (n)
- (display "\\and\n")
- (&latex-inst-body n))
- (cdr i))
- (display "}\n"))
- (define (&latex-author-1 n)
- (display "\\author{\n")
- (output n e)
- (display "}\n"))
- (define (&latex-author-n n)
- (display "\\author{\n")
- (output (car n) e)
- (for-each (lambda (a)
- (display " and ")
- (output a e))
- (cdr n))
- (display "}\n"))
- (let ((body (markup-body n)))
- (cond
- ((is-markup? body 'author)
- (markup-option-add! n 'inst 1)
- (&latex-author-1 body)
- (&latex-inst-n (list body)))
- ((and (list? body)
- (every? (lambda (b) (is-markup? b 'author))
- body))
- (define (institute=? n1 n2)
- (let ((aff1 (markup-option n1 :affiliation))
- (add1 (markup-option n1 :address))
- (aff2 (markup-option n2 :affiliation))
- (add2 (markup-option n2 :address)))
- (and (equal? aff1 aff2) (equal? add1 add2))))
- (define (search-institute n i j)
- (cond
- ((null? i)
- #f)
- ((institute=? n (car i))
- j)
- (else
- (search-institute n (cdr i) (- j 1)))))
- (if (null? (cdr body))
- (begin
- (markup-option-add! (car body) 'inst 1)
- (&latex-author-1 (car body))
- (&latex-inst-n body))
- ;; collect the institutes
- (let loop ((ns body)
- (is '())
- (j 1))
- (if (null? ns)
- (begin
- (&latex-author-n body)
- (&latex-inst-n (reverse! is)))
- (let* ((n (car ns))
- (si (search-institute n is (- j 1))))
- (if (integer? si)
- (begin
- (markup-option-add! n 'inst si)
- (loop (cdr ns) is j))
- (begin
- (markup-option-add! n 'inst j)
- (loop (cdr ns)
- (cons n is)
- (+ 1 j)))))))))
- (else
- (skribe-error 'author
- "Illegal `lncs' author"
- body))))))
- ;; author
- (let ((old-author (markup-writer-get 'author le)))
- (markup-writer 'author le
- :options (writer-options old-author)
- :action (lambda (n e)
- (let ((name (markup-option n :name))
- (title (markup-option n :title))
- (inst (markup-option n 'inst)))
- (if name (output name e))
- (if title (output title e))
- (if inst (printf "\\inst{~a}\n" inst)))))))
-
-;*---------------------------------------------------------------------*/
-;* HTML global customizations */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (markup-writer '&html-lncs-abstract he
- :action (lambda (n e)
- (let* ((bg (or (engine-custom e 'abstract-background)
- "#cccccc"))
- (exp (p (center (color :bg bg :width 90.
- (markup-body n))))))
- (skribe-eval exp e)))))
-
-;*---------------------------------------------------------------------*/
-;* abstract ... */
-;*---------------------------------------------------------------------*/
-(define-markup (abstract #!rest opt #!key postscript)
- (if (engine-format? "latex")
- (section :number #f :title "ABSTRACT" (p (the-body opt)))
- (let ((a (new markup
- (markup '&html-lncs-abstract)
- (body (the-body opt)))))
- (list (if postscript
- (section :number #f :toc #f :title "Postscript download"
- postscript))
- (section :number #f :toc #f :title "Abstract" a)
- (section :number #f :toc #f :title "Table of contents"
- (toc :subsection #t))))))
-
-;*---------------------------------------------------------------------*/
-;* references ... */
-;*---------------------------------------------------------------------*/
-(define (references)
- (list "\n\n"
- (if (engine-format? "latex")
- (font :size -1 (flush :side 'left (the-bibliography)))
- (section :title "References"
- (font :size -1 (the-bibliography))))))
diff --git a/skr/scribe.skr b/skr/scribe.skr
deleted file mode 100644
index d9e3bb8..0000000
--- a/skr/scribe.skr
+++ /dev/null
@@ -1,229 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/scribe.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Tue Jul 29 10:07:21 2003 */
-;* Last change : Wed Oct 8 09:56:52 2003 (serrano) */
-;* Copyright : 2003 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* Scribe Compatibility kit */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* style ... */
-;*---------------------------------------------------------------------*/
-(define (style . styles)
- (define (load-style style)
- (let ((name (cond
- ((string? style)
- style)
- ((symbol? style)
- (string-append (symbol->string style) ".scr")))))
- (skribe-load name :engine *skribe-engine*)))
- (for-each load-style styles))
-
-;*---------------------------------------------------------------------*/
-;* chapter ... */
-;*---------------------------------------------------------------------*/
-(define skribe-chapter chapter)
-
-(define-markup (chapter #!rest opt #!key title subtitle split number toc file)
- (apply skribe-chapter
- :title (or title subtitle)
- :number number
- :toc toc
- :file file
- (the-body opt)))
-
-;*---------------------------------------------------------------------*/
-;* table-of-contents ... */
-;*---------------------------------------------------------------------*/
-(define-markup (table-of-contents #!rest opts #!key chapter section subsection)
- (apply toc opts))
-
-;*---------------------------------------------------------------------*/
-;* frame ... */
-;*---------------------------------------------------------------------*/
-(define skribe-frame frame)
-
-(define-markup (frame #!rest opt #!key width margin)
- (apply skribe-frame
- :width (if (real? width) (* 100 width) width)
- :margin margin
- (the-body opt)))
-
-;*---------------------------------------------------------------------*/
-;* copyright ... */
-;*---------------------------------------------------------------------*/
-(define (copyright)
- (symbol 'copyright))
-
-;*---------------------------------------------------------------------*/
-;* sect ... */
-;*---------------------------------------------------------------------*/
-(define (sect)
- (symbol 'section))
-
-;*---------------------------------------------------------------------*/
-;* euro ... */
-;*---------------------------------------------------------------------*/
-(define (euro)
- (symbol 'euro))
-
-;*---------------------------------------------------------------------*/
-;* tab ... */
-;*---------------------------------------------------------------------*/
-(define (tab)
- (char #\tab))
-
-;*---------------------------------------------------------------------*/
-;* space ... */
-;*---------------------------------------------------------------------*/
-(define (space)
- (char #\space))
-
-;*---------------------------------------------------------------------*/
-;* print-bibliography ... */
-;*---------------------------------------------------------------------*/
-(define-markup (print-bibliography #!rest opts
- #!key all (sort bib-sort/authors))
- (the-bibliography all sort))
-
-;*---------------------------------------------------------------------*/
-;* linebreak ... */
-;*---------------------------------------------------------------------*/
-(define skribe-linebreak linebreak)
-
-(define-markup (linebreak . lnum)
- (cond
- ((null? lnum)
- (skribe-linebreak))
- ((string? (car lnum))
- (skribe-linebreak (string->number (car lnum))))
- (else
- (skribe-linebreak (car lnum)))))
-
-;*---------------------------------------------------------------------*/
-;* ref ... */
-;*---------------------------------------------------------------------*/
-(define skribe-ref ref)
-
-(define-markup (ref #!rest opts
- #!key scribe url id page figure mark
- chapter section subsection subsubsection subsubsection
- bib bib+ number)
- (let ((bd (the-body opts))
- (args (apply append (the-options opts :id))))
- (if id (set! args (cons* :mark id args)))
- (if (pair? bd) (set! args (cons* :text bd args)))
- (apply skribe-ref args)))
-
-;*---------------------------------------------------------------------*/
-;* indexes ... */
-;*---------------------------------------------------------------------*/
-(define *scribe-indexes*
- (list (cons "theindex" (make-index "theindex"))))
-
-(define skribe-index index)
-(define skribe-make-index make-index)
-
-(define-markup (make-index index)
- (let ((i (skribe-make-index index)))
- (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*))
- i))
-
-(define-markup (index #!rest opts #!key note index shape)
- (let ((i (if (not index)
- "theindex"
- (let ((i (assoc index *scribe-indexes*)))
- (if (pair? i)
- (cdr i)
- (make-index index))))))
- (apply skribe-index :note note :index i :shape shape (the-body opts))))
-
-(define-markup (print-index #!rest opts
- #!key split (char-offset 0) (header-limit 100))
- (apply the-index
- :split split
- :char-offset char-offset
- :header-limit header-limit
- (map (lambda (i)
- (let ((c (assoc i *scribe-indexes*)))
- (if (pair? c)
- (cdr c)
- (skribe-error 'the-index "Unknown index" i))))
- (the-body opts))))
-
-;*---------------------------------------------------------------------*/
-;* format? */
-;*---------------------------------------------------------------------*/
-(define (scribe-format? fmt) #f)
-
-;*---------------------------------------------------------------------*/
-;* scribe-url ... */
-;*---------------------------------------------------------------------*/
-(define (scribe-url) (skribe-url))
-
-;*---------------------------------------------------------------------*/
-;* Various configurations */
-;*---------------------------------------------------------------------*/
-(define *scribe-background* #f)
-(define *scribe-foreground* #f)
-(define *scribe-tbackground* #f)
-(define *scribe-tforeground* #f)
-(define *scribe-title-font* #f)
-(define *scribe-author-font* #f)
-(define *scribe-chapter-numbering* #f)
-(define *scribe-footer* #f)
-(define *scribe-prgm-color* #f)
-
-;*---------------------------------------------------------------------*/
-;* prgm ... */
-;*---------------------------------------------------------------------*/
-(define-markup (prgm #!rest opts
- #!key lnum lnumwidth language bg frame (width 1.)
- colors (monospace #t))
- (let* ((w (cond
- ((real? width) (* width 100.))
- ((number? width) width)
- (else 100.)))
- (body (if language
- (source :language language (the-body opts))
- (the-body opts)))
- (body (if monospace
- (prog :line lnum body)
- body))
- (body (if bg
- (color :width 100. :bg bg body)
- body)))
- (skribe-frame :width w
- :border (if frame 1 #f)
- body)))
-
-;*---------------------------------------------------------------------*/
-;* latex configuration */
-;*---------------------------------------------------------------------*/
-(define *scribe-tex-predocument* #f)
-
-;*---------------------------------------------------------------------*/
-;* latex-prelude ... */
-;*---------------------------------------------------------------------*/
-(define (latex-prelude e)
- (if (engine-format? "latex" e)
- (begin
- (if *scribe-tex-predocument*
- (engine-custom-set! e 'predocument *scribe-tex-predocument*)))))
-
-;*---------------------------------------------------------------------*/
-;* html-prelude ... */
-;*---------------------------------------------------------------------*/
-(define (html-prelude e)
- (if (engine-format? "html" e)
- (begin
- #f)))
-
-;*---------------------------------------------------------------------*/
-;* prelude */
-;*---------------------------------------------------------------------*/
-(let ((p (user-prelude)))
- (user-prelude-set! (lambda (e) (p e) (latex-prelude e))))
diff --git a/skr/sigplan.skr b/skr/sigplan.skr
deleted file mode 100644
index 9bdb939..0000000
--- a/skr/sigplan.skr
+++ /dev/null
@@ -1,155 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/sigplan.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Sun Sep 28 14:40:38 2003 */
-;* Last change : Wed May 18 16:00:38 2005 (serrano) */
-;* Copyright : 2003-05 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe style for ACMPROC articles. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* LaTeX global customizations */
-;*---------------------------------------------------------------------*/
-(let ((le (find-engine 'latex)))
- (engine-custom-set! le
- 'documentclass
- "\\documentclass[twocolumns]{sigplanconf}")
- ;; &latex-author
- (markup-writer '&latex-author le
- :before (lambda (n e)
- (let ((body (markup-body n)))
- (printf "\\authorinfo{\n"
- (if (pair? body) (length body) 1))))
- :action (lambda (n e)
- (let ((body (markup-body n)))
- (for-each (lambda (a)
- (display "}\n\\authorinfo{")
- (output a e))
- (if (pair? body) body (list body)))))
- :after "}\n")
- ;; author
- (let ((old-author (markup-writer-get 'author le)))
- (markup-writer 'author le
- :options (writer-options old-author)
- :action (writer-action old-author)))
- ;; ACM category, terms, and keywords
- (markup-writer '&acm-category le
- :options '(:index :section :subsection)
- :before (lambda (n e)
- (display "\\category{")
- (display (markup-option n :index))
- (display "}")
- (display "{")
- (display (markup-option n :section))
- (display "}")
- (display "{")
- (display (markup-option n :subsection))
- (display "}\n["))
- :after "]\n")
- (markup-writer '&acm-terms le
- :before "\\terms{"
- :after "}")
- (markup-writer '&acm-keywords le
- :before "\\keywords{"
- :after "}")
- (markup-writer '&acm-copyright le
- :action (lambda (n e)
- (display "\\conferenceinfo{")
- (output (markup-option n :conference) e)
- (display ",} {")
- (output (markup-option n :location) e)
- (display "}\n")
- (display "\\copyrightyear{")
- (output (markup-option n :year) e)
- (display "}\n")
- (display "\\copyrightdata{")
- (output (markup-option n :crdata) e)
- (display "}\n"))))
-
-;*---------------------------------------------------------------------*/
-;* HTML global customizations */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (markup-writer '&html-acmproc-abstract he
- :action (lambda (n e)
- (let* ((ebg (engine-custom e 'abstract-background))
- (bg (or (and (string? ebg)
- (> (string-length ebg) 0))
- ebg
- "#cccccc"))
- (exp (p (center (color :bg bg :width 90.
- (markup-body n))))))
- (skribe-eval exp e))))
- ;; ACM category, terms, and keywords
- (markup-writer '&acm-category :action #f)
- (markup-writer '&acm-terms :action #f)
- (markup-writer '&acm-keywords :action #f)
- (markup-writer '&acm-copyright :action #f))
-
-;*---------------------------------------------------------------------*/
-;* abstract ... */
-;*---------------------------------------------------------------------*/
-(define-markup (abstract #!rest opt #!key postscript)
- (if (engine-format? "latex")
- (section :number #f :title "ABSTRACT" (p (the-body opt)))
- (let ((a (new markup
- (markup '&html-acmproc-abstract)
- (body (the-body opt)))))
- (list (if postscript
- (section :number #f :toc #f :title "Postscript download"
- postscript))
- (section :number #f :toc #f :title "Abstract" a)
- (section :number #f :toc #f :title "Table of contents"
- (toc :subsection #t))))))
-
-;*---------------------------------------------------------------------*/
-;* acm-category ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-category #!rest opt #!key index section subsection)
- (new markup
- (markup '&acm-category)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-terms ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-terms #!rest opt)
- (new markup
- (markup '&acm-terms)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-keywords ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-keywords #!rest opt)
- (new markup
- (markup '&acm-keywords)
- (options (the-options opt))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* acm-copyright ... */
-;*---------------------------------------------------------------------*/
-(define-markup (acm-copyright #!rest opt #!key conference location year crdata)
- (let* ((le (find-engine 'latex))
- (cop (format "\\conferenceinfo{~a,} {~a}
-\\CopyrightYear{~a}
-\\crdata{~a}\n" conference location year crdata))
- (old (engine-custom le 'predocument)))
- (if (string? old)
- (engine-custom-set! le 'predocument (string-append cop old))
- (engine-custom-set! le 'predocument cop))))
-
-;*---------------------------------------------------------------------*/
-;* references ... */
-;*---------------------------------------------------------------------*/
-(define (references)
- (list "\n\n"
- (if (engine-format? "latex")
- (font :size -1 (flush :side 'left (the-bibliography)))
- (section :title "References"
- (font :size -1 (the-bibliography))))))
diff --git a/skr/skribe.skr b/skr/skribe.skr
deleted file mode 100644
index 86425ac..0000000
--- a/skr/skribe.skr
+++ /dev/null
@@ -1,76 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/skribe.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Fri Jan 11 11:23:12 2002 */
-;* Last change : Sun Jul 11 12:22:38 2004 (serrano) */
-;* Copyright : 2002-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The standard Skribe style (always loaded). */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* p ... */
-;*---------------------------------------------------------------------*/
-(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location)
- (paragraph :ident ident :class class :loc &skribe-eval-location
- (the-body opt)))
-
-;*---------------------------------------------------------------------*/
-;* fg ... */
-;*---------------------------------------------------------------------*/
-(define (fg c . body)
- (color :fg c body))
-
-;*---------------------------------------------------------------------*/
-;* bg ... */
-;*---------------------------------------------------------------------*/
-(define (bg c . body)
- (color :bg c body))
-
-;*---------------------------------------------------------------------*/
-;* counter ... */
-;* ------------------------------------------------------------- */
-;* This produces a kind of "local enumeration" that is: */
-;* (counting "toto," "tutu," "titi.") */
-;* produces: */
-;* i) toto, ii) tutu, iii) titi. */
-;*---------------------------------------------------------------------*/
-(define-markup (counter #!rest opts #!key (numbering 'roman))
- (define items (if (eq? (car opts) :numbering) (cddr opts) opts))
- (define vroman '#(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x"))
- (define (the-roman-number num)
- (if (< num (vector-length vroman))
- (list (list "(" (it (vector-ref vroman num)) ") "))
- (skribe-error 'counter
- "too many items for roman numbering"
- (length items))))
- (define (the-arabic-number num)
- (list (list "(" (it (integer->string num)) ") ")))
- (define (the-alpha-number num)
- (list (list "(" (it (+ (integer->char #\a) num -1)) ") ")))
- (let ((the-number (case numbering
- ((roman) the-roman-number)
- ((arabic) the-arabic-number)
- ((alpha) the-alpha-number)
- (else (skribe-error 'counter
- "Illegal numbering"
- numbering)))))
- (let loop ((num 1)
- (items items)
- (res '()))
- (if (null? items)
- (reverse! res)
- (loop (+ num 1)
- (cdr items)
- (cons (list (the-number num) (car items)) res))))))
-
-;*---------------------------------------------------------------------*/
-;* q */
-;*---------------------------------------------------------------------*/
-(define-markup (q #!rest opt)
- (new markup
- (markup 'q)
- (options (the-options opt))
- (body (the-body opt))))
-
diff --git a/skr/slide.skr b/skr/slide.skr
deleted file mode 100644
index f8638ad..0000000
--- a/skr/slide.skr
+++ /dev/null
@@ -1,664 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/slide.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Fri Oct 3 12:22:13 2003 */
-;* Last change : Mon Aug 23 09:08:21 2004 (serrano) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* Skribe style for slides */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* slide-options */
-;*---------------------------------------------------------------------*/
-(define &slide-load-options (skribe-load-options))
-
-;*---------------------------------------------------------------------*/
-;* &slide-seminar-predocument ... */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-predocument
- "\\special{landscape}
- \\slideframe{none}
- \\centerslidesfalse
- \\raggedslides[0pt]
- \\renewcommand{\\slideleftmargin}{0.2in}
- \\renewcommand{\\slidetopmargin}{0.3in}
- \\newdimen\\slidewidth \\slidewidth 9in")
-
-;*---------------------------------------------------------------------*/
-;* &slide-seminar-maketitle ... */
-;*---------------------------------------------------------------------*/
-(define &slide-seminar-maketitle
- "\\def\\labelitemi{$\\bullet$}
- \\def\\labelitemii{$\\circ$}
- \\def\\labelitemiii{$\\diamond$}
- \\def\\labelitemiv{$\\cdot$}
- \\pagestyle{empty}
- \\slideframe{none}
- \\centerslidestrue
- \\begin{slide}
- \\date{}
- \\maketitle
- \\end{slide}
- \\slideframe{none}
- \\centerslidesfalse")
-
-;*---------------------------------------------------------------------*/
-;* &slide-prosper-predocument ... */
-;*---------------------------------------------------------------------*/
-(define &slide-prosper-predocument
- "\\slideCaption{}\n")
-
-;*---------------------------------------------------------------------*/
-;* %slide-the-slides ... */
-;*---------------------------------------------------------------------*/
-(define %slide-the-slides '())
-(define %slide-the-counter 0)
-(define %slide-initialized #f)
-(define %slide-latex-mode 'seminar)
-
-;*---------------------------------------------------------------------*/
-;* %slide-initialize! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-initialize!)
- (unless %slide-initialized
- (set! %slide-initialized #t)
- (case %slide-latex-mode
- ((seminar)
- (%slide-seminar-setup!))
- ((advi)
- (%slide-advi-setup!))
- ((prosper)
- (%slide-prosper-setup!))
- (else
- (skribe-error 'slide "Illegal latex mode" %slide-latex-mode)))))
-
-;*---------------------------------------------------------------------*/
-;* slide ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide #!rest opt
- #!key
- (ident #f) (class #f)
- (toc #t)
- title (number #t)
- (vspace #f) (vfill #f)
- (transition #f)
- (bg #f) (image #f))
- (%slide-initialize!)
- (let ((s (new container
- (markup 'slide)
- (ident (symbol->string (gensym 'slide)))
- (class class)
- (required-options '(:title :number :toc))
- (options `((:number
- ,(cond
- ((number? number)
- (set! %slide-the-counter number)
- number)
- (number
- (set! %slide-the-counter
- (+ 1 %slide-the-counter))
- %slide-the-counter)
- (else
- #f)))
- (:toc ,toc)
- ,@(the-options opt :ident :class :vspace :toc)))
- (body (if vspace
- (list (slide-vspace vspace) (the-body opt))
- (the-body opt))))))
- (set! %slide-the-slides (cons s %slide-the-slides))
- s))
-
-;*---------------------------------------------------------------------*/
-;* ref ... */
-;*---------------------------------------------------------------------*/
-(define %slide-old-ref ref)
-
-(define-markup (ref #!rest opt #!key (slide #f))
- (if (not slide)
- (apply %slide-old-ref opt)
- (new unresolved
- (proc (lambda (n e env)
- (cond
- ((eq? slide 'next)
- (let ((c (assq n %slide-the-slides)))
- (if (pair? c)
- (handle (cadr c))
- #f)))
- ((eq? slide 'prev)
- (let ((c (assq n (reverse %slide-the-slides))))
- (if (pair? c)
- (handle (cadr c))
- #f)))
- ((number? slide)
- (let loop ((s %slide-the-slides))
- (cond
- ((null? s)
- #f)
- ((= slide (markup-option (car s) :number))
- (handle (car s)))
- (else
- (loop (cdr s))))))
- (else
- #f)))))))
-
-;*---------------------------------------------------------------------*/
-;* slide-pause ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-pause)
- (new markup
- (markup 'slide-pause)))
-
-;*---------------------------------------------------------------------*/
-;* slide-vspace ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-vspace #!rest opt #!key (unit 'cm))
- (new markup
- (markup 'slide-vspace)
- (options `((:unit ,unit) ,@(the-options opt :unit)))
- (body (the-body opt))))
-
-;*---------------------------------------------------------------------*/
-;* slide-embed ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-embed #!rest opt
- #!key
- command
- (geometry-opt "-geometry")
- (geometry #f) (rgeometry #f)
- (transient #f) (transient-opt #f)
- (alt #f)
- &skribe-eval-location)
- (if (not (string? command))
- (skribe-error 'slide-embed
- "No command provided"
- command)
- (new markup
- (markup 'slide-embed)
- (loc &skribe-eval-location)
- (required-options '(:alt))
- (options `((:geometry-opt ,geometry-opt)
- (:alt ,alt)
- ,@(the-options opt :geometry-opt :alt)))
- (body (the-body opt)))))
-
-;*---------------------------------------------------------------------*/
-;* slide-record ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-record #!rest opt #!key ident class tag (play #t))
- (if (not tag)
- (skribe-error 'slide-record "Tag missing" tag)
- (new markup
- (markup 'slide-record)
- (ident ident)
- (class class)
- (options `((:play ,play) ,@(the-options opt)))
- (body (the-body opt)))))
-
-;*---------------------------------------------------------------------*/
-;* slide-play ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-play #!rest opt #!key ident class tag color)
- (if (not tag)
- (skribe-error 'slide-play "Tag missing" tag)
- (new markup
- (markup 'slide-play)
- (ident ident)
- (class class)
- (options `((:color ,(if color (skribe-use-color! color) #f))
- ,@(the-options opt :color)))
- (body (the-body opt)))))
-
-;*---------------------------------------------------------------------*/
-;* slide-play* ... */
-;*---------------------------------------------------------------------*/
-(define-markup (slide-play* #!rest opt
- #!key ident class color (scolor "#000000"))
- (let ((body (the-body opt)))
- (for-each (lambda (lbl)
- (match-case lbl
- ((?id ?col)
- (skribe-use-color! col))))
- body)
- (new markup
- (markup 'slide-play*)
- (ident ident)
- (class class)
- (options `((:color ,(if color (skribe-use-color! color) #f))
- (:scolor ,(if color (skribe-use-color! scolor) #f))
- ,@(the-options opt :color :scolor)))
- (body body))))
-
-;*---------------------------------------------------------------------*/
-;* base */
-;*---------------------------------------------------------------------*/
-(let ((be (find-engine 'base)))
- (skribe-message "Base slides setup...\n")
- ;; slide-pause
- (markup-writer 'slide-pause be
- :action #f)
- ;; slide-vspace
- (markup-writer 'slide-vspace be
- :options '()
- :action #f)
- ;; slide-embed
- (markup-writer 'slide-embed be
- :options '(:alt :geometry-opt)
- :action (lambda (n e)
- (output (markup-option n :alt) e)))
- ;; slide-record
- (markup-writer 'slide-record be
- :options '(:tag :play)
- :action (lambda (n e)
- (output (markup-body n) e)))
- ;; slide-play
- (markup-writer 'slide-play be
- :options '(:tag :color)
- :action (lambda (n e)
- (output (markup-option n :alt) e)))
- ;; slide-play*
- (markup-writer 'slide-play* be
- :options '(:tag :color :scolor)
- :action (lambda (n e)
- (output (markup-option n :alt) e))))
-
-;*---------------------------------------------------------------------*/
-;* slide-body-width ... */
-;*---------------------------------------------------------------------*/
-(define (slide-body-width e)
- (let ((w (engine-custom e 'body-width)))
- (if (or (number? w) (string? w)) w 95.)))
-
-;*---------------------------------------------------------------------*/
-;* html-slide-title ... */
-;*---------------------------------------------------------------------*/
-(define (html-slide-title n e)
- (let* ((title (markup-body n))
- (authors (markup-option n 'author))
- (tbg (engine-custom e 'title-background))
- (tfg (engine-custom e 'title-foreground))
- (tfont (engine-custom e 'title-font)))
- (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
- (html-width (slide-body-width e)))
- (if (string? tbg)
- (printf "<td bgcolor=\"~a\">" tbg)
- (display "<td>"))
- (if (string? tfg)
- (printf "<font color=\"~a\">" tfg))
- (if title
- (begin
- (display "<center>")
- (if (string? tfont)
- (begin
- (printf "<font ~a><strong>" tfont)
- (output title e)
- (display "</strong></font>"))
- (begin
- (printf "<div class=\"skribetitle\"><strong><big><big><big>")
- (output title e)
- (display "</big></big></big></strong</div>")))
- (display "</center>\n")))
- (if (not authors)
- (display "\n")
- (html-title-authors authors e))
- (if (string? tfg)
- (display "</font>"))
- (display "</td></tr></tbody></table></center>\n")))
-
-;*---------------------------------------------------------------------*/
-;* slide-number ... */
-;*---------------------------------------------------------------------*/
-(define (slide-number)
- (length (filter (lambda (n)
- (and (is-markup? n 'slide)
- (markup-option n :number)))
- %slide-the-slides)))
-
-;*---------------------------------------------------------------------*/
-;* html */
-;*---------------------------------------------------------------------*/
-(let ((he (find-engine 'html)))
- (skribe-message "HTML slides setup...\n")
- ;; &html-page-title
- (markup-writer '&html-document-title he
- :predicate (lambda (n e) %slide-initialized)
- :action html-slide-title)
- ;; slide
- (markup-writer 'slide he
- :options '(:title :number :transition :toc :bg)
- :before (lambda (n e)
- (printf "<a name=\"~a\">" (markup-ident n))
- (display "<br>\n"))
- :action (lambda (n e)
- (let ((nb (markup-option n :number))
- (t (markup-option n :title)))
- (skribe-eval
- (center
- (color :width (slide-body-width e)
- :bg (or (markup-option n :bg) "#ffffff")
- (table :width 100.
- (tr (th :align 'left
- (list
- (if nb
- (format "~a / ~a -- " nb
- (slide-number)))
- t)))
- (tr (td (hrule)))
- (tr (td :width 100. :align 'left
- (markup-body n))))
- (linebreak)))
- e)))
- :after "<br>")
- ;; slide-vspace
- (markup-writer 'slide-vspace he
- :action (lambda (n e) (display "<br>"))))
-
-;*---------------------------------------------------------------------*/
-;* latex */
-;*---------------------------------------------------------------------*/
-(define &latex-slide #f)
-(define &latex-pause #f)
-(define &latex-embed #f)
-(define &latex-record #f)
-(define &latex-play #f)
-(define &latex-play* #f)
-
-(let ((le (find-engine 'latex)))
- ;; slide-vspace
- (markup-writer 'slide-vspace le
- :options '(:unit)
- :action (lambda (n e)
- (display "\n\\vspace{")
- (output (markup-body n) e)
- (printf " ~a}\n\n" (markup-option n :unit))))
- ;; slide-slide
- (markup-writer 'slide le
- :options '(:title :number :transition :vfill :toc :vspace :image)
- :action (lambda (n e)
- (if (procedure? &latex-slide)
- (&latex-slide n e))))
- ;; slide-pause
- (markup-writer 'slide-pause le
- :options '()
- :action (lambda (n e)
- (if (procedure? &latex-pause)
- (&latex-pause n e))))
- ;; slide-embed
- (markup-writer 'slide-embed le
- :options '(:alt :command :geometry-opt :geometry
- :rgeometry :transient :transient-opt)
- :action (lambda (n e)
- (if (procedure? &latex-embed)
- (&latex-embed n e))))
- ;; slide-record
- (markup-writer 'slide-record le
- :options '(:tag :play)
- :action (lambda (n e)
- (if (procedure? &latex-record)
- (&latex-record n e))))
- ;; slide-play
- (markup-writer 'slide-play le
- :options '(:tag :color)
- :action (lambda (n e)
- (if (procedure? &latex-play)
- (&latex-play n e))))
- ;; slide-play*
- (markup-writer 'slide-play* le
- :options '(:tag :color :scolor)
- :action (lambda (n e)
- (if (procedure? &latex-play*)
- (&latex-play* n e)))))
-
-;*---------------------------------------------------------------------*/
-;* %slide-seminar-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-seminar-setup!)
- (skribe-message "Seminar slides setup...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- ;; latex configuration
- (define (seminar-slide n e)
- (let ((nb (markup-option n :number))
- (t (markup-option n :title)))
- (display "\\begin{slide}\n")
- (if nb (printf "~a/~a -- " nb (slide-number)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n"))
- (engine-custom-set! le 'documentclass
- "\\documentclass[landscape]{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'hyperref-usepackage
- "\\usepackage[setpagesize=false]{hyperref}\n")
- ;; slide-slide
- (set! &latex-slide seminar-slide)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-advi-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-advi-setup!)
- (skribe-message "Generating `Advi Seminar' slides...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base)))
- (define (advi-geometry geo)
- (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo)))
- (if (pair? r)
- (let* ((w (cadr r))
- (w' (string->integer w))
- (w'' (number->string (/ w' *skribe-slide-advi-scale*)))
- (h (caddr r))
- (h' (string->integer h))
- (h'' (number->string (/ h' *skribe-slide-advi-scale*))))
- (values "" (string-append w "x" h "+!x+!y")))
- (let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo)))
- (if (pair? r)
- (let ((w (number->string (/ (string->integer (cadr r))
- *skribe-slide-advi-scale*)))
- (h (number->string (/ (string->integer (caddr r))
- *skribe-slide-advi-scale*)))
- (x (cadddr r))
- (y (car (cddddr r))))
- (values (string-append "width=" w "cm,height=" h "cm")
- "!g"))
- (values "" geo))))))
- (define (advi-transition trans)
- (cond
- ((string? trans)
- (printf "\\advitransition{~s}" trans))
- ((and (symbol? trans)
- (memq trans '(wipe block slide)))
- (printf "\\advitransition{~s}" trans))
- (else
- #f)))
- ;; latex configuration
- (define (advi-slide n e)
- (let ((i (markup-option n :image))
- (n (markup-option n :number))
- (t (markup-option n :title))
- (lt (markup-option n :transition))
- (gt (engine-custom e 'transition)))
- (if (and i (engine-custom e 'advi))
- (printf "\\advibg[global]{image=~a}\n"
- (if (and (pair? i)
- (null? (cdr i))
- (string? (car i)))
- (car i)
- i)))
- (display "\\begin{slide}\n")
- (advi-transition (or lt gt))
- (if n (printf "~a/~a -- " n (slide-number)))
- (output t e)
- (display "\\hrule\n"))
- (output (markup-body n) e)
- (if (markup-option n :vill) (display "\\vfill\n"))
- (display "\\end{slide}\n\n\n"))
- ;; advi record
- (define (advi-record n e)
- (display "\\advirecord")
- (when (markup-option n :play) (display "[play]"))
- (printf "{~a}{" (markup-option n :tag))
- (output (markup-body n) e)
- (display "}"))
- ;; advi play
- (define (advi-play n e)
- (display "\\adviplay")
- (let ((c (markup-option n :color)))
- (when c
- (display "[")
- (display (skribe-get-latex-color c))
- (display "]")))
- (printf "{~a}" (markup-option n :tag)))
- ;; advi play*
- (define (advi-play* n e)
- (let ((c (skribe-get-latex-color (markup-option n :color)))
- (d (skribe-get-latex-color (markup-option n :scolor))))
- (let loop ((lbls (markup-body n))
- (last #f))
- (when last
- (display "\\adviplay[")
- (display d)
- (printf "]{~a}" last))
- (when (pair? lbls)
- (let ((lbl (car lbls)))
- (match-case lbl
- ((?id ?col)
- (display "\\adviplay[")
- (display (skribe-get-latex-color col))
- (printf "]{" ~a "}" id)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) id))
- (else
- (display "\\adviplay[")
- (display c)
- (printf "]{~a}" lbl)
- (skribe-eval (slide-pause) e)
- (loop (cdr lbls) lbl))))))))
- (engine-custom-set! le 'documentclass
- "\\documentclass{seminar}\n")
- (let ((o (engine-custom le 'predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o)
- (string-append &slide-seminar-predocument o)
- &slide-seminar-predocument)))
- (engine-custom-set! le 'maketitle
- &slide-seminar-maketitle)
- (engine-custom-set! le 'usepackage
- (string-append "\\usepackage{advi}\n"
- (engine-custom le 'usepackage)))
- ;; slide
- (set! &latex-slide advi-slide)
- (set! &latex-pause
- (lambda (n e) (display "\\adviwait\n")))
- (set! &latex-embed
- (lambda (n e)
- (let ((geometry-opt (markup-option n :geometry-opt))
- (geometry (markup-option n :geometry))
- (rgeometry (markup-option n :rgeometry))
- (transient (markup-option n :transient))
- (transient-opt (markup-option n :transient-opt))
- (cmd (markup-option n :command)))
- (let* ((a (string-append "ephemeral="
- (symbol->string (gensym))))
- (c (cond
- (geometry
- (string-append cmd " "
- geometry-opt " "
- geometry))
- (rgeometry
- (multiple-value-bind (aopt dopt)
- (advi-geometry rgeometry)
- (set! a (string-append a "," aopt))
- (string-append cmd " "
- geometry-opt " "
- dopt)))
- (else
- cmd)))
- (c (if (and transient transient-opt)
- (string-append c " " transient-opt " !p")
- c)))
- (printf "\\adviembed[~a]{~a}\n" a c)))))
- (set! &latex-record advi-record)
- (set! &latex-play advi-play)
- (set! &latex-play* advi-play*)))
-
-;*---------------------------------------------------------------------*/
-;* %slide-prosper-setup! ... */
-;*---------------------------------------------------------------------*/
-(define (%slide-prosper-setup!)
- (skribe-message "Generating `Prosper' slides...\n")
- (let ((le (find-engine 'latex))
- (be (find-engine 'base))
- (overlay-count 0))
- ;; transitions
- (define (prosper-transition trans)
- (cond
- ((string? trans)
- (printf "[~s]" trans))
- ((eq? trans 'slide)
- (printf "[Blinds]"))
- ((and (symbol? trans)
- (memq trans '(split blinds box wipe dissolve glitter)))
- (printf "[~s]"
- (string-upcase (symbol->string trans))))
- (else
- #f)))
- ;; latex configuration
- (define (prosper-slide n e)
- (let* ((i (markup-option n :image))
- (t (markup-option n :title))
- (lt (markup-option n :transition))
- (gt (engine-custom e 'transition))
- (pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n))
- (lpa (length pa)))
- (set! overlay-count 1)
- (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa)))
- (display "\\begin{slide}")
- (prosper-transition (or lt gt))
- (display "{")
- (output t e)
- (display "}\n")
- (output (markup-body n) e)
- (display "\\end{slide}\n")
- (if (>= lpa 1) (display "}\n"))
- (newline)
- (newline)))
- (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n")
- (let* ((cap (engine-custom le 'slide-caption))
- (o (engine-custom le 'predocument))
- (n (if (string? cap)
- (format "~a\\slideCaption{~a}\n"
- &slide-prosper-predocument
- cap)
- &slide-prosper-predocument)))
- (engine-custom-set! le 'predocument
- (if (string? o) (string-append n o) n)))
- (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n")
- ;; writers
- (set! &latex-slide prosper-slide)
- (set! &latex-pause
- (lambda (n e)
- (set! overlay-count (+ 1 overlay-count))
- (printf "\\FromSlide{~s}%\n" overlay-count)))))
-
-;*---------------------------------------------------------------------*/
-;* Setup ... */
-;*---------------------------------------------------------------------*/
-(let* ((opt &slide-load-options)
- (p (memq :prosper opt)))
- (if (and (pair? p) (pair? (cdr p)) (cadr p))
- ;; prosper
- (set! %slide-latex-mode 'prosper)
- (let ((a (memq :advi opt)))
- (if (and (pair? a) (pair? (cdr a)) (cadr a))
- ;; advi
- (set! %slide-latex-mode 'advi)))))
-
diff --git a/skr/web-article.skr b/skr/web-article.skr
deleted file mode 100644
index e33328b..0000000
--- a/skr/web-article.skr
+++ /dev/null
@@ -1,230 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/web-article.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Sat Jan 10 09:09:43 2004 */
-;* Last change : Wed Mar 24 16:45:08 2004 (serrano) */
-;* Copyright : 2004 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* A Skribe style for producing web articles */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* &web-article-load-options ... */
-;*---------------------------------------------------------------------*/
-(define &web-article-load-options (skribe-load-options))
-
-;*---------------------------------------------------------------------*/
-;* web-article-body-width ... */
-;*---------------------------------------------------------------------*/
-(define (web-article-body-width e)
- (let ((w (engine-custom e 'body-width)))
- (if (or (number? w) (string? w)) w 98.)))
-
-;*---------------------------------------------------------------------*/
-;* html-document-title-web ... */
-;*---------------------------------------------------------------------*/
-(define (html-document-title-web n e)
- (let* ((title (markup-body n))
- (authors (markup-option n 'author))
- (tbg (engine-custom e 'title-background))
- (tfg (engine-custom e 'title-foreground))
- (tfont (engine-custom e 'title-font)))
- (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>"
- (html-width (web-article-body-width e)))
- (if (string? tbg)
- (printf "<td bgcolor=\"~a\">" tbg)
- (display "<td>"))
- (if (string? tfg)
- (printf "<font color=\"~a\">" tfg))
- (if title
- (begin
- (display "<center>")
- (if (string? tfont)
- (begin
- (printf "<font ~a><b>" tfont)
- (output title e)
- (display "</b></font>"))
- (begin
- (printf "<h1>")
- (output title e)
- (display "</h1>")))
- (display "</center>\n")))
- (if (not authors)
- (display "\n")
- (html-title-authors authors e))
- (if (string? tfg)
- (display "</font>"))
- (display "</td></tr></tbody></table></center>\n")))
-
-;*---------------------------------------------------------------------*/
-;* web-article-css-document-title ... */
-;*---------------------------------------------------------------------*/
-(define (web-article-css-document-title n e)
- (let* ((title (markup-body n))
- (authors (markup-option n 'author))
- (id (markup-ident n)))
- ;; the title
- (printf "<div id=\"~a\" class=\"document-title-title\">\n"
- (string-canonicalize id))
- (output title e)
- (display "</div>\n")
- ;; the authors
- (printf "<div id=\"~a\" class=\"document-title-authors\">\n"
- (string-canonicalize id))
- (for-each (lambda (a) (output a e))
- (cond
- ((is-markup? authors 'author)
- (list authors))
- ((list? authors)
- authors)
- (else
- '())))
- (display "</div>\n")))
-
-;*---------------------------------------------------------------------*/
-;* web-article-css-author ... */
-;*---------------------------------------------------------------------*/
-(define (web-article-css-author n e)
- (let ((name (markup-option n :name))
- (title (markup-option n :title))
- (affiliation (markup-option n :affiliation))
- (email (markup-option n :email))
- (url (markup-option n :url))
- (address (markup-option n :address))
- (phone (markup-option n :phone))
- (nfn (engine-custom e 'author-font))
- (align (markup-option n :align)))
- (when name
- (printf "<span class=\"document-author-name\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output name e)
- (display "</span>\n"))
- (when title
- (printf "<span class=\"document-author-title\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output title e)
- (display "</span>\n"))
- (when affiliation
- (printf "<span class=\"document-author-affiliation\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output affiliation e)
- (display "</span>\n"))
- (when (pair? address)
- (printf "<span class=\"document-author-address\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (for-each (lambda (a)
- (output a e)
- (newline))
- address)
- (display "</span>\n"))
- (when phone
- (printf "<span class=\"document-author-phone\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output phone e)
- (display "</span>\n"))
- (when email
- (printf "<span class=\"document-author-email\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output email e)
- (display "</span>\n"))
- (when url
- (printf "<span class=\"document-author-url\" id=\"~a\">"
- (string-canonicalize (markup-ident n)))
- (output url e)
- (display "</span>\n"))))
-
-;*---------------------------------------------------------------------*/
-;* HTML settings */
-;*---------------------------------------------------------------------*/
-(define (web-article-modern-setup he)
- (let ((sec (markup-writer-get 'section he))
- (ft (markup-writer-get '&html-footnotes he)))
- ;; &html-document-title
- (markup-writer '&html-document-title he
- :action html-document-title-web)
- ;; section
- (markup-writer 'section he
- :options 'all
- :before "<br>"
- :action (lambda (n e)
- (let ((e1 (make-engine 'html-web :delegate e))
- (bg (engine-custom he 'section-background)))
- (markup-writer 'section e1
- :options 'all
- :action (lambda (n e2) (output n e sec)))
- (skribe-eval
- (center (color :width (web-article-body-width e)
- :margin 5 :bg bg n))
- e1))))
- ;; &html-footnotes
- (markup-writer '&html-footnotes he
- :options 'all
- :before "<br>"
- :action (lambda (n e)
- (let ((e1 (make-engine 'html-web :delegate e))
- (bg (engine-custom he 'section-background))
- (fg (engine-custom he 'subsection-title-foreground)))
- (markup-writer '&html-footnotes e1
- :options 'all
- :action (lambda (n e2)
- (invoke (writer-action ft) n e)))
- (skribe-eval
- (center (color :width (web-article-body-width e)
- :margin 5 :bg bg :fg fg n))
- e1))))))
-
-;*---------------------------------------------------------------------*/
-;* web-article-css-setup ... */
-;*---------------------------------------------------------------------*/
-(define (web-article-css-setup he)
- (let ((sec (markup-writer-get 'section he))
- (ft (markup-writer-get '&html-footnotes he)))
- ;; &html-document-title
- (markup-writer '&html-document-title he
- :before (lambda (n e)
- (printf "<div id=\"~a\" class=\"document-title\">\n"
- (string-canonicalize (markup-ident n))))
- :action web-article-css-document-title
- :after "</div>\n")
- ;; author
- (markup-writer 'author he
- :options '(:name :title :affiliation :email :url :address :phone :photo :align)
- :before (lambda (n e)
- (printf "<span id=\"~a\" class=\"document-author\">\n"
- (string-canonicalize (markup-ident n))))
- :action web-article-css-author
- :after "</span\n")
- ;; section
- (markup-writer 'section he
- :options 'all
- :before (lambda (n e)
- (printf "<div class=\"section\" id=\"~a\">"
- (string-canonicalize (markup-ident n))))
- :action (lambda (n e) (output n e sec))
- :after "</div>\n")
- ;; &html-footnotes
- (markup-writer '&html-footnotes he
- :options 'all
- :before (lambda (n e)
- (printf "<div class=\"footnotes\" id=\"~a\">"
- (string-canonicalize (markup-ident n))))
- :action (lambda (n e)
- (output n e ft))
- :after "</div>\n")))
-
-;*---------------------------------------------------------------------*/
-;* Setup ... */
-;*---------------------------------------------------------------------*/
-(let* ((opt &web-article-load-options)
- (p (memq :style opt))
- (css (memq :css opt))
- (he (find-engine 'html)))
- (cond
- ((and (pair? p) (pair? (cdr p)) (eq? (cadr p) 'css))
- (web-article-css-setup he))
- ((and (pair? css) (pair? (cdr css)) (string? (cadr css)))
- (engine-custom-set! he 'css (cadr css))
- (web-article-css-setup he))
- (else
- (web-article-modern-setup he))))
diff --git a/skr/web-book.skr b/skr/web-book.skr
deleted file mode 100644
index f907c8b..0000000
--- a/skr/web-book.skr
+++ /dev/null
@@ -1,107 +0,0 @@
-;*=====================================================================*/
-;* serrano/prgm/project/skribe/skr/web-book.skr */
-;* ------------------------------------------------------------- */
-;* Author : Manuel Serrano */
-;* Creation : Mon Sep 1 10:54:32 2003 */
-;* Last change : Mon Nov 8 10:43:46 2004 (eg) */
-;* Copyright : 2003-04 Manuel Serrano */
-;* ------------------------------------------------------------- */
-;* The Skribe web book style. */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;* html customization */
-;*---------------------------------------------------------------------*/
-(define he (find-engine 'html))
-(engine-custom-set! he 'main-browsing-extra #f)
-(engine-custom-set! he 'chapter-file #t)
-
-;*---------------------------------------------------------------------*/
-;* main-browsing ... */
-;*---------------------------------------------------------------------*/
-(define main-browsing
- (lambda (n e)
- ;; search the document
- (let ((p (ast-document n)))
- (cond
- ((document? p)
- ;; got it
- (let* ((mt (markup-option p :margin-title))
- (r (ref :handle (handle p)
- :text (or mt (markup-option p :title))))
- (fx (engine-custom e 'web-book-main-browsing-extra)))
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold "main page"))))
- (tr :bg (engine-custom e 'background)
- (td (apply table :width 100. :border 0
- (tr (td :align 'left
- :valign 'top
- (bold "top:"))
- (td :align 'right
- :valign 'top r))
- (if (procedure? fx)
- (list (tr (td :width 100.
- :colspan 2
- (fx n e))))
- '()))))))))
- ((not p)
- ;; no document!!!
- #f)))))
-
-;*---------------------------------------------------------------------*/
-;* chapter-browsing ... */
-;*---------------------------------------------------------------------*/
-(define chapter-browsing
- (lambda (n e)
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold (markup-option n :title)))))
- (tr :bg (engine-custom e 'background)
- (td (toc (handle n) :chapter #t :section #t :subsection #t)))))))
-
-;*---------------------------------------------------------------------*/
-;* document-browsing ... */
-;*---------------------------------------------------------------------*/
-(define document-browsing
- (lambda (n e)
- (let ((chap (find1-down (lambda (n)
- (is-markup? n 'chapter))
- n)))
- (center
- (table :width 97. :border 1 :frame 'box
- :cellpadding 0 :cellspacing 0
- (tr :bg (engine-custom e 'title-background)
- (th (color :fg (engine-custom e 'background)
- (bold (if chap "Chapters" "Sections")))))
- (tr :bg (engine-custom e 'background)
- (td (if chap
- (toc (handle n) :chapter #t :section #f)
- (toc (handle n) :section #t :subsection #t)))))))))
-
-;*---------------------------------------------------------------------*/
-;* left margin ... */
-;*---------------------------------------------------------------------*/
-(engine-custom-set! he 'left-margin-size 20.)
-
-(engine-custom-set! he 'left-margin
- (lambda (n e)
- (let ((d (ast-document n))
- (c (ast-chapter n)))
- (list (linebreak 1)
- (main-browsing n e)
- (if (is-markup? c 'chapter)
- (list (linebreak 2)
- (chapter-browsing c e))
- #f)
- (if (document? d)
- (list (linebreak 2)
- (document-browsing d e))
- #f)))))
-