diff options
Diffstat (limited to 'skr')
| -rw-r--r-- | skr/Makefile | 43 | ||||
| -rw-r--r-- | skr/acmproc.skr | 155 | ||||
| -rw-r--r-- | skr/french.skr | 19 | ||||
| -rw-r--r-- | skr/jfp.skr | 317 | ||||
| -rw-r--r-- | skr/letter.skr | 146 | ||||
| -rw-r--r-- | skr/lncs.skr | 147 | ||||
| -rw-r--r-- | skr/scribe.skr | 229 | ||||
| -rw-r--r-- | skr/sigplan.skr | 155 | ||||
| -rw-r--r-- | skr/skribe.skr | 76 | ||||
| -rw-r--r-- | skr/slide.skr | 664 | ||||
| -rw-r--r-- | skr/web-article.skr | 230 | ||||
| -rw-r--r-- | skr/web-book.skr | 107 |
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))))) - |