From fc42fe56a57eace2dbdb31574c2e161f0eacf839 Mon Sep 17 00:00:00 2001
From: Ludovic Court`es
Date: Wed, 15 Jun 2005 13:00:39 +0000
Subject: Initial import of Skribe 1.2d.
Initial import of Skribe 1.2d.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--base-0
---
skribe/INSTALL | 110 +
skribe/LICENSE | 25 +
skribe/Makefile | 131 ++
skribe/README | 69 +
skribe/README.java | 36 +
skribe/configure | 124 ++
skribe/doc/Makefile | 233 +++
skribe/doc/Makefile.dir | 22 +
skribe/doc/dir/dir.skb | 113 ++
skribe/doc/img/bsd.gif | Bin 0 -> 4226 bytes
skribe/doc/img/lambda.gif | Bin 0 -> 169 bytes
skribe/doc/img/linux.gif | Bin 0 -> 1972 bytes
skribe/doc/skr/api.skr | 575 ++++++
skribe/doc/skr/env.skr | 32 +
skribe/doc/skr/extension.skr | 95 +
skribe/doc/skr/manual.skr | 281 +++
skribe/doc/user/bib.skb | 252 +++
skribe/doc/user/char.skb | 86 +
skribe/doc/user/colframe.skb | 57 +
skribe/doc/user/document.skb | 80 +
skribe/doc/user/emacs.skb | 58 +
skribe/doc/user/engine.skb | 135 ++
skribe/doc/user/enumeration.skb | 33 +
skribe/doc/user/examples.skb | 34 +
skribe/doc/user/figure.skb | 58 +
skribe/doc/user/font.skb | 30 +
skribe/doc/user/footnote.skb | 28 +
skribe/doc/user/htmle.skb | 111 +
skribe/doc/user/image.skb | 79 +
skribe/doc/user/index.skb | 118 ++
skribe/doc/user/justify.skb | 30 +
skribe/doc/user/latexe.skb | 60 +
skribe/doc/user/lib.skb | 156 ++
skribe/doc/user/line.skb | 39 +
skribe/doc/user/links.skb | 152 ++
skribe/doc/user/markup.skb | 83 +
skribe/doc/user/ornament.skb | 25 +
skribe/doc/user/package.skb | 139 ++
skribe/doc/user/prgm.skb | 121 ++
skribe/doc/user/sectioning.skb | 117 ++
skribe/doc/user/skribe-config.skb | 44 +
skribe/doc/user/skribec.skb | 56 +
skribe/doc/user/skribeinfo.skb | 50 +
skribe/doc/user/slide.skb | 114 ++
skribe/doc/user/src/api1.skb | 5 +
skribe/doc/user/src/api10.skb | 12 +
skribe/doc/user/src/api11.skb | 22 +
skribe/doc/user/src/api12.skb | 1 +
skribe/doc/user/src/api13.skb | 10 +
skribe/doc/user/src/api14.skb | 9 +
skribe/doc/user/src/api15.skb | 25 +
skribe/doc/user/src/api16.skb | 5 +
skribe/doc/user/src/api17.skb | 9 +
skribe/doc/user/src/api18.skb | 2 +
skribe/doc/user/src/api19.skb | 3 +
skribe/doc/user/src/api2.skb | 5 +
skribe/doc/user/src/api20.skb | 2 +
skribe/doc/user/src/api3.skb | 8 +
skribe/doc/user/src/api4.skb | 2 +
skribe/doc/user/src/api5.skb | 2 +
skribe/doc/user/src/api6.skb | 1 +
skribe/doc/user/src/api7.skb | 3 +
skribe/doc/user/src/api8.skb | 15 +
skribe/doc/user/src/api9.skb | 5 +
skribe/doc/user/src/bib1.sbib | 39 +
skribe/doc/user/src/bib2.skb | 7 +
skribe/doc/user/src/bib3.skb | 3 +
skribe/doc/user/src/bib4.skb | 5 +
skribe/doc/user/src/bib5.skb | 24 +
skribe/doc/user/src/bib6.skb | 1 +
skribe/doc/user/src/index1.skb | 1 +
skribe/doc/user/src/index2.skb | 11 +
skribe/doc/user/src/index3.skb | 1 +
skribe/doc/user/src/links1.skb | 23 +
skribe/doc/user/src/links2.skb | 4 +
skribe/doc/user/src/prgm1.skb | 15 +
skribe/doc/user/src/prgm2.skb | 18 +
skribe/doc/user/src/prgm3.skb | 55 +
skribe/doc/user/src/slides.skb | 27 +
skribe/doc/user/src/start1.skb | 2 +
skribe/doc/user/src/start2.skb | 2 +
skribe/doc/user/src/start3.skb | 10 +
skribe/doc/user/src/start4.skb | 13 +
skribe/doc/user/src/start5.skb | 9 +
skribe/doc/user/start.skb | 197 ++
skribe/doc/user/syntax.skb | 105 +
skribe/doc/user/table.skb | 81 +
skribe/doc/user/toc.skb | 37 +
skribe/doc/user/user.skb | 163 ++
skribe/doc/user/xmle.skb | 25 +
skribe/emacs/Makefile | 55 +
skribe/emacs/skribe.el.in | 841 ++++++++
skribe/etc/ChangeLog | 698 +++++++
skribe/etc/Makefile | 50 +
skribe/etc/bigloo/Makefile | 114 ++
skribe/etc/bigloo/Makefile.tpl | 200 ++
skribe/etc/bigloo/autoconf/Makefile | 53 +
skribe/etc/bigloo/autoconf/bfildir | 36 +
skribe/etc/bigloo/autoconf/blibdir | 36 +
skribe/etc/bigloo/autoconf/bversion | 42 +
skribe/etc/bigloo/autoconf/getbversion | 36 +
skribe/etc/bigloo/autoconf/gmaketest | 38 +
skribe/etc/bigloo/configure | 552 +++++
skribe/etc/skribe-config.in | 64 +
skribe/etc/stklos/Makefile.config.in | 5 +
skribe/etc/stklos/Makefile.in | 44 +
skribe/etc/stklos/Makefile.skb.in | 5 +
skribe/etc/stklos/configure | 830 ++++++++
skribe/etc/stklos/configure.in | 57 +
skribe/examples/Makefile | 48 +
skribe/examples/slide/Makefile | 153 ++
skribe/examples/slide/PPRskribe.sty | 67 +
skribe/examples/slide/README | 11 +
skribe/examples/slide/advi.sty | 416 ++++
skribe/examples/slide/ex/skribe.skb | 11 +
skribe/examples/slide/ex/syntax.scr | 1 +
skribe/examples/slide/skb/slides.skb | 286 +++
skribe/examples/slide/skr/local.skr | 73 +
skribe/skr/Makefile | 43 +
skribe/skr/acmproc.skr | 155 ++
skribe/skr/base.skr | 464 +++++
skribe/skr/context.skr | 1380 +++++++++++++
skribe/skr/french.skr | 19 +
skribe/skr/html.skr | 2251 +++++++++++++++++++++
skribe/skr/html4.skr | 165 ++
skribe/skr/jfp.skr | 317 +++
skribe/skr/latex-simple.skr | 101 +
skribe/skr/latex.skr | 1780 ++++++++++++++++
skribe/skr/letter.skr | 146 ++
skribe/skr/lncs.skr | 147 ++
skribe/skr/scribe.skr | 229 +++
skribe/skr/sigplan.skr | 155 ++
skribe/skr/skribe.skr | 76 +
skribe/skr/slide.skr | 664 ++++++
skribe/skr/web-article.skr | 230 +++
skribe/skr/web-book.skr | 107 +
skribe/skr/xml.skr | 111 +
skribe/skribe.prj | 332 +++
skribe/src/Makefile | 41 +
skribe/src/bigloo/Makefile | 271 +++
skribe/src/bigloo/api.bgl | 117 ++
skribe/src/bigloo/api.sch | 91 +
skribe/src/bigloo/asm.scm | 99 +
skribe/src/bigloo/bib.bgl | 161 ++
skribe/src/bigloo/c.scm | 134 ++
skribe/src/bigloo/color.scm | 702 +++++++
skribe/src/bigloo/configure.bgl | 90 +
skribe/src/bigloo/debug.sch | 54 +
skribe/src/bigloo/debug.scm | 188 ++
skribe/src/bigloo/engine.scm | 262 +++
skribe/src/bigloo/eval.scm | 335 +++
skribe/src/bigloo/evapi.scm | 39 +
skribe/src/bigloo/index.bgl | 32 +
skribe/src/bigloo/lib.bgl | 340 ++++
skribe/src/bigloo/lisp.scm | 530 +++++
skribe/src/bigloo/main.scm | 96 +
skribe/src/bigloo/new.sch | 17 +
skribe/src/bigloo/output.scm | 167 ++
skribe/src/bigloo/param.bgl | 134 ++
skribe/src/bigloo/parseargs.scm | 186 ++
skribe/src/bigloo/prog.scm | 196 ++
skribe/src/bigloo/read.scm | 482 +++++
skribe/src/bigloo/resolve.scm | 281 +++
skribe/src/bigloo/source.scm | 238 +++
skribe/src/bigloo/sui.bgl | 34 +
skribe/src/bigloo/types.scm | 685 +++++++
skribe/src/bigloo/verify.scm | 143 ++
skribe/src/bigloo/writer.scm | 232 +++
skribe/src/bigloo/xml.scm | 92 +
skribe/src/common/api.scm | 1243 ++++++++++++
skribe/src/common/bib.scm | 192 ++
skribe/src/common/configure.scm.in | 6 +
skribe/src/common/index.scm | 126 ++
skribe/src/common/lib.scm | 238 +++
skribe/src/common/param.scm | 69 +
skribe/src/common/sui.scm | 166 ++
skribe/src/stklos/Makefile.in | 110 +
skribe/src/stklos/biblio.stk | 161 ++
skribe/src/stklos/c-lex.l | 67 +
skribe/src/stklos/c.stk | 95 +
skribe/src/stklos/color.stk | 622 ++++++
skribe/src/stklos/configure.stk | 90 +
skribe/src/stklos/debug.stk | 161 ++
skribe/src/stklos/engine.stk | 242 +++
skribe/src/stklos/eval.stk | 149 ++
skribe/src/stklos/lib.stk | 317 +++
skribe/src/stklos/lisp-lex.l | 91 +
skribe/src/stklos/lisp.stk | 294 +++
skribe/src/stklos/main.stk | 264 +++
skribe/src/stklos/output.stk | 158 ++
skribe/src/stklos/prog.stk | 219 ++
skribe/src/stklos/reader.stk | 136 ++
skribe/src/stklos/resolve.stk | 255 +++
skribe/src/stklos/runtime.stk | 456 +++++
skribe/src/stklos/source.stk | 191 ++
skribe/src/stklos/types.stk | 294 +++
skribe/src/stklos/vars.stk | 82 +
skribe/src/stklos/verify.stk | 157 ++
skribe/src/stklos/writer.stk | 211 ++
skribe/src/stklos/xml-lex.l | 64 +
skribe/src/stklos/xml.stk | 52 +
skribe/tools/Makefile | 60 +
skribe/tools/skribebibtex/bigloo/Makefile | 70 +
skribe/tools/skribebibtex/bigloo/main.scm | 44 +
skribe/tools/skribebibtex/bigloo/skribebibtex.scm | 385 ++++
skribe/tools/skribebibtex/stklos/Makefile | 62 +
skribe/tools/skribebibtex/stklos/bibtex-lex.l | 75 +
skribe/tools/skribebibtex/stklos/bibtex-parser.y | 117 ++
skribe/tools/skribebibtex/stklos/main.stk | 118 ++
209 files changed, 33287 insertions(+)
create mode 100644 skribe/INSTALL
create mode 100644 skribe/LICENSE
create mode 100644 skribe/Makefile
create mode 100644 skribe/README
create mode 100644 skribe/README.java
create mode 100755 skribe/configure
create mode 100644 skribe/doc/Makefile
create mode 100644 skribe/doc/Makefile.dir
create mode 100644 skribe/doc/dir/dir.skb
create mode 100644 skribe/doc/img/bsd.gif
create mode 100644 skribe/doc/img/lambda.gif
create mode 100644 skribe/doc/img/linux.gif
create mode 100644 skribe/doc/skr/api.skr
create mode 100644 skribe/doc/skr/env.skr
create mode 100644 skribe/doc/skr/extension.skr
create mode 100644 skribe/doc/skr/manual.skr
create mode 100644 skribe/doc/user/bib.skb
create mode 100644 skribe/doc/user/char.skb
create mode 100644 skribe/doc/user/colframe.skb
create mode 100644 skribe/doc/user/document.skb
create mode 100644 skribe/doc/user/emacs.skb
create mode 100644 skribe/doc/user/engine.skb
create mode 100644 skribe/doc/user/enumeration.skb
create mode 100644 skribe/doc/user/examples.skb
create mode 100644 skribe/doc/user/figure.skb
create mode 100644 skribe/doc/user/font.skb
create mode 100644 skribe/doc/user/footnote.skb
create mode 100644 skribe/doc/user/htmle.skb
create mode 100644 skribe/doc/user/image.skb
create mode 100644 skribe/doc/user/index.skb
create mode 100644 skribe/doc/user/justify.skb
create mode 100644 skribe/doc/user/latexe.skb
create mode 100644 skribe/doc/user/lib.skb
create mode 100644 skribe/doc/user/line.skb
create mode 100644 skribe/doc/user/links.skb
create mode 100644 skribe/doc/user/markup.skb
create mode 100644 skribe/doc/user/ornament.skb
create mode 100644 skribe/doc/user/package.skb
create mode 100644 skribe/doc/user/prgm.skb
create mode 100644 skribe/doc/user/sectioning.skb
create mode 100644 skribe/doc/user/skribe-config.skb
create mode 100644 skribe/doc/user/skribec.skb
create mode 100644 skribe/doc/user/skribeinfo.skb
create mode 100644 skribe/doc/user/slide.skb
create mode 100644 skribe/doc/user/src/api1.skb
create mode 100644 skribe/doc/user/src/api10.skb
create mode 100644 skribe/doc/user/src/api11.skb
create mode 100644 skribe/doc/user/src/api12.skb
create mode 100644 skribe/doc/user/src/api13.skb
create mode 100644 skribe/doc/user/src/api14.skb
create mode 100644 skribe/doc/user/src/api15.skb
create mode 100644 skribe/doc/user/src/api16.skb
create mode 100644 skribe/doc/user/src/api17.skb
create mode 100644 skribe/doc/user/src/api18.skb
create mode 100644 skribe/doc/user/src/api19.skb
create mode 100644 skribe/doc/user/src/api2.skb
create mode 100644 skribe/doc/user/src/api20.skb
create mode 100644 skribe/doc/user/src/api3.skb
create mode 100644 skribe/doc/user/src/api4.skb
create mode 100644 skribe/doc/user/src/api5.skb
create mode 100644 skribe/doc/user/src/api6.skb
create mode 100644 skribe/doc/user/src/api7.skb
create mode 100644 skribe/doc/user/src/api8.skb
create mode 100644 skribe/doc/user/src/api9.skb
create mode 100644 skribe/doc/user/src/bib1.sbib
create mode 100644 skribe/doc/user/src/bib2.skb
create mode 100644 skribe/doc/user/src/bib3.skb
create mode 100644 skribe/doc/user/src/bib4.skb
create mode 100644 skribe/doc/user/src/bib5.skb
create mode 100644 skribe/doc/user/src/bib6.skb
create mode 100644 skribe/doc/user/src/index1.skb
create mode 100644 skribe/doc/user/src/index2.skb
create mode 100644 skribe/doc/user/src/index3.skb
create mode 100644 skribe/doc/user/src/links1.skb
create mode 100644 skribe/doc/user/src/links2.skb
create mode 100644 skribe/doc/user/src/prgm1.skb
create mode 100644 skribe/doc/user/src/prgm2.skb
create mode 100644 skribe/doc/user/src/prgm3.skb
create mode 100644 skribe/doc/user/src/slides.skb
create mode 100644 skribe/doc/user/src/start1.skb
create mode 100644 skribe/doc/user/src/start2.skb
create mode 100644 skribe/doc/user/src/start3.skb
create mode 100644 skribe/doc/user/src/start4.skb
create mode 100644 skribe/doc/user/src/start5.skb
create mode 100644 skribe/doc/user/start.skb
create mode 100644 skribe/doc/user/syntax.skb
create mode 100644 skribe/doc/user/table.skb
create mode 100644 skribe/doc/user/toc.skb
create mode 100644 skribe/doc/user/user.skb
create mode 100644 skribe/doc/user/xmle.skb
create mode 100644 skribe/emacs/Makefile
create mode 100644 skribe/emacs/skribe.el.in
create mode 100644 skribe/etc/ChangeLog
create mode 100644 skribe/etc/Makefile
create mode 100644 skribe/etc/bigloo/Makefile
create mode 100644 skribe/etc/bigloo/Makefile.tpl
create mode 100644 skribe/etc/bigloo/autoconf/Makefile
create mode 100755 skribe/etc/bigloo/autoconf/bfildir
create mode 100755 skribe/etc/bigloo/autoconf/blibdir
create mode 100755 skribe/etc/bigloo/autoconf/bversion
create mode 100755 skribe/etc/bigloo/autoconf/getbversion
create mode 100755 skribe/etc/bigloo/autoconf/gmaketest
create mode 100755 skribe/etc/bigloo/configure
create mode 100644 skribe/etc/skribe-config.in
create mode 100644 skribe/etc/stklos/Makefile.config.in
create mode 100644 skribe/etc/stklos/Makefile.in
create mode 100644 skribe/etc/stklos/Makefile.skb.in
create mode 100755 skribe/etc/stklos/configure
create mode 100644 skribe/etc/stklos/configure.in
create mode 100644 skribe/examples/Makefile
create mode 100644 skribe/examples/slide/Makefile
create mode 100644 skribe/examples/slide/PPRskribe.sty
create mode 100644 skribe/examples/slide/README
create mode 100644 skribe/examples/slide/advi.sty
create mode 100644 skribe/examples/slide/ex/skribe.skb
create mode 100644 skribe/examples/slide/ex/syntax.scr
create mode 100644 skribe/examples/slide/skb/slides.skb
create mode 100644 skribe/examples/slide/skr/local.skr
create mode 100644 skribe/skr/Makefile
create mode 100644 skribe/skr/acmproc.skr
create mode 100644 skribe/skr/base.skr
create mode 100644 skribe/skr/context.skr
create mode 100644 skribe/skr/french.skr
create mode 100644 skribe/skr/html.skr
create mode 100644 skribe/skr/html4.skr
create mode 100644 skribe/skr/jfp.skr
create mode 100644 skribe/skr/latex-simple.skr
create mode 100644 skribe/skr/latex.skr
create mode 100644 skribe/skr/letter.skr
create mode 100644 skribe/skr/lncs.skr
create mode 100644 skribe/skr/scribe.skr
create mode 100644 skribe/skr/sigplan.skr
create mode 100644 skribe/skr/skribe.skr
create mode 100644 skribe/skr/slide.skr
create mode 100644 skribe/skr/web-article.skr
create mode 100644 skribe/skr/web-book.skr
create mode 100644 skribe/skr/xml.skr
create mode 100644 skribe/skribe.prj
create mode 100644 skribe/src/Makefile
create mode 100644 skribe/src/bigloo/Makefile
create mode 100644 skribe/src/bigloo/api.bgl
create mode 100644 skribe/src/bigloo/api.sch
create mode 100644 skribe/src/bigloo/asm.scm
create mode 100644 skribe/src/bigloo/bib.bgl
create mode 100644 skribe/src/bigloo/c.scm
create mode 100644 skribe/src/bigloo/color.scm
create mode 100644 skribe/src/bigloo/configure.bgl
create mode 100644 skribe/src/bigloo/debug.sch
create mode 100644 skribe/src/bigloo/debug.scm
create mode 100644 skribe/src/bigloo/engine.scm
create mode 100644 skribe/src/bigloo/eval.scm
create mode 100644 skribe/src/bigloo/evapi.scm
create mode 100644 skribe/src/bigloo/index.bgl
create mode 100644 skribe/src/bigloo/lib.bgl
create mode 100644 skribe/src/bigloo/lisp.scm
create mode 100644 skribe/src/bigloo/main.scm
create mode 100644 skribe/src/bigloo/new.sch
create mode 100644 skribe/src/bigloo/output.scm
create mode 100644 skribe/src/bigloo/param.bgl
create mode 100644 skribe/src/bigloo/parseargs.scm
create mode 100644 skribe/src/bigloo/prog.scm
create mode 100644 skribe/src/bigloo/read.scm
create mode 100644 skribe/src/bigloo/resolve.scm
create mode 100644 skribe/src/bigloo/source.scm
create mode 100644 skribe/src/bigloo/sui.bgl
create mode 100644 skribe/src/bigloo/types.scm
create mode 100644 skribe/src/bigloo/verify.scm
create mode 100644 skribe/src/bigloo/writer.scm
create mode 100644 skribe/src/bigloo/xml.scm
create mode 100644 skribe/src/common/api.scm
create mode 100644 skribe/src/common/bib.scm
create mode 100644 skribe/src/common/configure.scm.in
create mode 100644 skribe/src/common/index.scm
create mode 100644 skribe/src/common/lib.scm
create mode 100644 skribe/src/common/param.scm
create mode 100644 skribe/src/common/sui.scm
create mode 100644 skribe/src/stklos/Makefile.in
create mode 100644 skribe/src/stklos/biblio.stk
create mode 100644 skribe/src/stklos/c-lex.l
create mode 100644 skribe/src/stklos/c.stk
create mode 100644 skribe/src/stklos/color.stk
create mode 100644 skribe/src/stklos/configure.stk
create mode 100644 skribe/src/stklos/debug.stk
create mode 100644 skribe/src/stklos/engine.stk
create mode 100644 skribe/src/stklos/eval.stk
create mode 100644 skribe/src/stklos/lib.stk
create mode 100644 skribe/src/stklos/lisp-lex.l
create mode 100644 skribe/src/stklos/lisp.stk
create mode 100644 skribe/src/stklos/main.stk
create mode 100644 skribe/src/stklos/output.stk
create mode 100644 skribe/src/stklos/prog.stk
create mode 100644 skribe/src/stklos/reader.stk
create mode 100644 skribe/src/stklos/resolve.stk
create mode 100644 skribe/src/stklos/runtime.stk
create mode 100644 skribe/src/stklos/source.stk
create mode 100644 skribe/src/stklos/types.stk
create mode 100644 skribe/src/stklos/vars.stk
create mode 100644 skribe/src/stklos/verify.stk
create mode 100644 skribe/src/stklos/writer.stk
create mode 100644 skribe/src/stklos/xml-lex.l
create mode 100644 skribe/src/stklos/xml.stk
create mode 100644 skribe/tools/Makefile
create mode 100644 skribe/tools/skribebibtex/bigloo/Makefile
create mode 100644 skribe/tools/skribebibtex/bigloo/main.scm
create mode 100644 skribe/tools/skribebibtex/bigloo/skribebibtex.scm
create mode 100644 skribe/tools/skribebibtex/stklos/Makefile
create mode 100644 skribe/tools/skribebibtex/stklos/bibtex-lex.l
create mode 100644 skribe/tools/skribebibtex/stklos/bibtex-parser.y
create mode 100644 skribe/tools/skribebibtex/stklos/main.stk
(limited to 'skribe')
diff --git a/skribe/INSTALL b/skribe/INSTALL
new file mode 100644
index 0000000..30507e7
--- /dev/null
+++ b/skribe/INSTALL
@@ -0,0 +1,110 @@
+Here is the procedure for compiling and installing SKRIBE on a Unix system.
+
+
+Requirements
+************
+
+ - GNU-MAKE is required.
+ - BIGLOO 2.6b (or later) *or* SKTLOS 0.56 is required.
+
+Summary of a SKRIBE compilation, test and installation
+******************************************************
+
+ $ ./configure --with-bigloo|--with-stklos
+ $ make
+ $ make install
+
+ This procedure will self test SKRIBE because it will compile the various
+ Skribe documents that implement the Skribe documentation.
+
+
+Configuring SKRIBE
+******************
+
+ Configuring SKRIBE/BIGLOO
+ *************************
+
+ 1.a Edit the `./etc/bigloo/configure' file and set the variables defined in the Use
+ section (e.g. `bindir', `libdir', `mandir' and `docdir'). Note that
+ if you leave these variable definitions blank the installation procedure
+ will install Skribe at the same location as Bigloo.
+
+ 1.b Configure Skribe for your machine by invoking:
+ `./configure --with-bigloo'
+ or
+ `./configure --with-bigloo --prefix <your-prefix>'
+ or
+ `./configure --with-bigloo --bigloo=<your-bigloo-compiler>'
+ When the system is ready to be compiled, `configure' prints
+ the message `configuration done.'.
+
+ The following command:
+ `./configure --with-bigloo --help'
+ displays the available options.
+
+ The default configuration uses the C back-end. To produce a JVM version of
+ SKRIBE, uses:
+
+ `./configure --with-bigloo --jvm'
+
+ Configuring SKRIBE/STKLOS
+ *************************
+
+ 1. Configure Skribe for your machine by invoking:
+ `./configure --with-stklos'
+ or
+ `./configure --with-stklos --prefix <your-prefix>'
+
+Compiling SKRIBE
+****************
+
+ 2. Type:
+ `make'
+
+ This will compile:
+ - the Skribe compiler: skribe
+ - the Texinfo to Skribe translator: skribeinfo (*)
+ - the BibTex to Skribe translator: skribebibtex (*)
+ - the Skribe documentation (in manuals/man, manuals/user and
+ manuals/expert).
+
+ (*) this tools is compiled only when SKRIBE is compiled with BIGLOO.
+
+
+Installing SKRIBE
+*****************
+
+ 3. Type:
+ `make install'
+
+ This install, the Skribe compiler, the Skribeinfo compiler, the
+ various Skribe back-ends, the variable Skribe style files and
+ the Skribe documentation.
+
+ This does not install the skribe.el emacs package.
+
+
+Cleaning SKRIBE
+***************
+
+ 4. Once, installed, you can type:
+ `make clean'
+ to remove all the useless files.
+
+
+Uninstalling SKRIBE
+*******************
+
+ 5. To uninstall Skribe:
+ `make uninstall'
+
+
+Unconfiguring SKRIBE
+********************
+
+ 6. If you plan to re-install Skribe on a new platform. Before performing
+ the all installation process (step 1 to 5) you must first remove the
+ current configuration. For this type:
+ `make distclean'
+
+
diff --git a/skribe/LICENSE b/skribe/LICENSE
new file mode 100644
index 0000000..dbf912f
--- /dev/null
+++ b/skribe/LICENSE
@@ -0,0 +1,25 @@
+---------------------------------------------------------------------
+ Skribe
+
+ Copyright (c) 2003, 2004 -- Erick Gallesio, Manuel Serrano
+
+ Bug descriptions, use reports, comments or suggestions are
+ welcome. Send them to
+ skribe@sophia.inria.fr
+ http://www.inria.fr/mimosa/fp/Skribe
+
+ This program is free software; you can redistribute it
+ and/or modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation; either
+ version 2 of the License, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program; if not, write to the Free
+ Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ MA 02111-1307, USA.
+---------------------------------------------------------------------
diff --git a/skribe/Makefile b/skribe/Makefile
new file mode 100644
index 0000000..918e91a
--- /dev/null
+++ b/skribe/Makefile
@@ -0,0 +1,131 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Wed Jul 30 16:23:07 2003 */
+#* Last change : Fri May 21 16:37:53 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The general Skribe makefile */
+#*=====================================================================*/
+include etc/Makefile.config
+
+#*---------------------------------------------------------------------*/
+#* DIRECTORIES */
+#*---------------------------------------------------------------------*/
+DIRECTORIES = skr \
+ doc \
+ examples \
+ src \
+ emacs \
+ etc \
+ tools
+
+POPULATIONDIRS = $(DIRECTORIES) \
+ contribs
+
+#*---------------------------------------------------------------------*/
+#* all */
+#*---------------------------------------------------------------------*/
+.PHONY: all
+
+all:
+ (cd src/$(SYSTEM) && $(MAKE))
+ (cd tools && $(MAKE))
+ (cd doc && $(MAKE))
+
+#*---------------------------------------------------------------------*/
+#* install */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install:
+ for d in $(DIRECTORIES); do \
+ (cd $$d && $(MAKE) install) || exit -1; \
+ done
+
+uninstall:
+ for d in $(DIRECTORIES); do \
+ (cd $$d && $(MAKE) uninstall) || exit -1; \
+ done
+
+#*---------------------------------------------------------------------*/
+#* revision */
+#*---------------------------------------------------------------------*/
+.PHONY: revision populate skribe.prj
+
+revision: populate checkin
+
+populate: skribe.prj
+ prcs populate skribe `$(MAKE) pop`
+
+checkin:
+ prcs checkin -r$(SKRIBERELEASE).@ skribe
+
+checkout:
+ @ prcs checkout -r$(SKRIBERELEASE).@ skribe
+
+skribe.prj:
+ @ cat skribe.prj | sed -e s,"(Populate-Ignore ())","(Populate-Ignore (\"\\\\\\\\\\.o\\$$\" \"\\\\\\\\\\~$$\" \"\\\\\\\\\\.log\\$$\" \"\\\\\\\\\\.ps\\$$\" \"\\\\\\\\\\.aux\\$$\" \"\\\\\\\\\\.date_of_backup\\$$\" \"\\\\\\\\\\.so\\$$\" \"\\\\\\\\\\.a\\$$\" \"if_not_there\\$$\" \"if_mach\\$$\" \"threadlibs\\$$\"))", > skribe.dprj; $(RM) -f skribe.prj; mv skribe.dprj skribe.prj
+
+#*---------------------------------------------------------------------*/
+#* population */
+#* ------------------------------------------------------------- */
+#* The list of all files that have to be placed inside the */
+#* repository for revision. */
+#*---------------------------------------------------------------------*/
+.PHONY: subpop popfilelist
+
+subpop:
+ @ for d in $(POPULATIONDIRS); do \
+ (cd $$d && $(MAKE) -s pop); \
+ done
+
+pop:
+ @ echo Makefile INSTALL LICENSE README README.java
+ @ echo configure
+ @ (for p in `$(MAKE) -s subpop`; do \
+ echo $$p; \
+ done) | sort
+
+#*---------------------------------------------------------------------*/
+#* distrib */
+#*---------------------------------------------------------------------*/
+.PHONY: distrib distrib-jvm distrib-src
+
+distrib:
+ $(MAKE) distrib -f etc/$(SYSTEM)/Makefile -I etc/$(SYSTEM)
+ (cd www && $(MAKE))
+
+distrib-jvm:
+ $(MAKE) distrib-jvm -f etc/$(SYSTEM)/Makefile -I etc/$(SYSTEM)
+
+distrib-src:
+ $(MAKE) distrib-src -f etc/$(SYSTEM)/Makefile -I etc/$(SYSTEM)
+
+#*---------------------------------------------------------------------*/
+#* clean/distclean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean distclean
+ $(RM) -f etc/Makefile.config
+
+clean:
+ (cd src && $(MAKE) clean)
+ (cd doc && $(MAKE) clean)
+ (cd tools && $(MAKE) clean)
+ (cd etc && $(MAKE) clean)
+
+distclean: clean
+ (cd emacs && $(MAKE) distclean)
+ (cd etc && $(MAKE) distclean)
+
+#*---------------------------------------------------------------------*/
+#* devclean/devdistclean */
+#*---------------------------------------------------------------------*/
+.PHONY: devclean devdistclean
+
+devclean: clean
+ (cd www && $(MAKE) clean)
+
+devdistclean: devclean distclean
+
diff --git a/skribe/README b/skribe/README
new file mode 100644
index 0000000..db68b22
--- /dev/null
+++ b/skribe/README
@@ -0,0 +1,69 @@
+What is Skribe
+**************
+
+Skribe is programming language design for the production of electronic
+documents. With Skribe one can:
+
+ - Produce HTML web pages.
+ - Produce PS files.
+ - ...
+
+One may also:
+
+ - Translate Texinfo files into HTML.
+
+ - re-use BibTex bibliography databases.
+
+
+Obtaining Skribe
+****************
+
+New versions of Skribe may downloaded from:
+
+ ftp://ftp-sop.inria.fr/mimosa/fp/Skribe
+
+
+Skribe distrubtion
+******************
+
+The Skribe distribution consists of several directories:
+
+ INSTALL installation instructions.
+
+ Makefile the Makefile to compile Skribe.
+
+ README this document.
+
+ README.java specific information regarding the JVM port of Skribe.
+
+ etc private directory.
+
+ bin the directory where binary files are compiled to.
+
+ lib the directory where Skribe libraries are compiled to.
+
+ configure configuration driver script.
+
+ emacs Skribe emacs mode.
+
+ examples Various example of Skribe texts.
+
+ doc the Skribe sources for Skribe manuals.
+
+ src the Scheme source code for Skribe.
+
+ skr the Skribe source code for the Skribe engines and styles.
+
+ tools the Bigloo source code for the Texi->Skribe and BibTex->Skribe
+ compilers.
+
+
+Acknowledgements
+****************
+
+We thank all the people who helped me while writing Skribe. My first
+though goes to Frederic Boussinot who's the first pre-alpha-tester of
+Skribe always volunteering for new testing new features ;-) I then
+thanks all the people that send me fixes, suggestions and
+improvements, that is, all the people that appear in the ChangeLog
+file. Many thanks to all of you.
diff --git a/skribe/README.java b/skribe/README.java
new file mode 100644
index 0000000..dcb0457
--- /dev/null
+++ b/skribe/README.java
@@ -0,0 +1,36 @@
+This README explains how to use the pre-compiled JVM
+version of Skribe. This requires JDK 1.3 or higher.
+
+Installing SKRIBE
+*****************
+
+The pre-compiled version of SKRIBE does not need installation procedure.
+It is pre-installed. The documentation is pre-compiled. It is located
+in the directory doc/html.
+
+
+Running SKRIBE
+**************
+
+Lets assume that SKRIBEDIR is the shell variable containing
+the name of the directory where Skribe has been unzipped:
+
+1. To compile a Skribe program "prog.skr" uses:
+
+ java -classpath $SKRIBEDIR/bin/skribe.zip:$SKRIBEDIR/lib/bigloo_s.zip -Dbigloo.SKRIBEPATH=$SKRIBEDIR/skr bigloo.skribe.main prog.skr
+
+2. To convert a Texi file "prog.texi" into Skribe:
+
+ java -classpath $SKRIBEDIR/bin/skribeinfo.zip:$SKRIBEDIR/lib/bigloo_s.zip bigloo.skribe.skribeinfo.main prog.texi
+
+3. To convert a BibTex database "db.bib" into Skribe:
+
+ java -classpath $SKRIBEDIR/bin/skribebibtex.zip:$SKRIBEDIR/lib/bigloo_s.zip bigloo.skribe.skribebibtex.main db.bib
+
+
+Compiling the examples
+**********************
+
+On a Unix platform:
+
+ cd examples; make
diff --git a/skribe/configure b/skribe/configure
new file mode 100755
index 0000000..798d9d2
--- /dev/null
+++ b/skribe/configure
@@ -0,0 +1,124 @@
+#!/bin/sh
+#
+# This file is a simple trampoline to the real configure script which
+# depends of the Scheme system used
+#
+# Known systems so far:
+# - Bigloo (use --with-bigloo)
+# - STklos (use --with-stklos)
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 29-Jul-2003 13:59 (eg)
+# Last file update: 23-Sep-2004 17:14 (eg)
+
+
+use_bigloo=0
+use_stklos=0
+
+new_args=""
+export new_args
+prefix=/usr/local
+export prefix
+
+for i in "$@"; do
+ case $i in
+ --with-bigloo) scheme=bigloo; use_bigloo=1;;
+ --with-stklos) scheme=stklos; use_stklos=1;;
+ --prefix=*) prefix=`echo $i | sed 's/^[^=]*=//'`;
+ new_args="$new_args $i";;
+ *) new_args="$new_args \"$i\"";;
+ esac
+done
+
+#* for i in $* ;do */
+#* case $i in */
+#* --with-bigloo) scheme=bigloo; use_bigloo=1;; */
+#* --with-stklos) scheme=stklos; use_stklos=1;; */
+#* --prefix=*) prefix=`echo $i | sed 's/^[^=]*=//'`; */
+#* new_args="$new_args $i";; */
+#* *) new_args="$new_args $i";; */
+#* esac */
+#* done */
+
+
+case `expr $use_bigloo + $use_stklos` in
+ 0) echo "You must at least specify a Scheme system: ";
+ echo " --with-bigloo to use Bigloo"
+ echo " --with-stklos to use STklos"
+ exit 1;;
+ 1) ;;
+ *) echo "You must specify ONLY ONE Scheme system"; exit 1;;
+esac
+
+if test $use_bigloo = 1 ;then
+ scheme=bigloo
+fi
+
+if test $use_stklos = 1 ;then
+ scheme=stklos
+fi
+
+
+
+# Common configuration
+release="1.2d"
+skribeurl="http://www.inria.fr/mimosa/fp/Skribe"
+skribeextdir="$prefix/share/skribe/extensions"
+skribedocdir=$prefix/doc/skribe-$release
+skribeskrdir="'(\".\" \"$skribeextdir\" \"$prefix/share/skribe/$release/skr\" )"
+
+# etc/config
+rm -f etc/config 2> /dev/null
+echo "# Automatically generated file (don't edit)" > etc/config
+echo "release=$release" >> etc/config
+echo "skribeurl=$skribeurl" >> etc/config
+echo "prefix=$prefix" >> etc/config
+
+# etc/skribe-config
+cat etc/skribe-config.in \
+ | sed "s|@SKRIBE_RELEASE@|$release|" \
+ | sed "s|@PREFIX@|$prefix|" \
+ | sed "s|@SKRIBE_SKR_DIR@|$prefix/share/skribe/$release/skr|" \
+ | sed "s|@SKRIBE_EXT_DIR@|$skribeextdir|" \
+ | sed "s|@SKRIBE_DOC_DIR@|$skribedocdir|" \
+ | sed "s|@SYSTEM@|$scheme|" \
+ > etc/skribe-config
+chmod a+x etc/skribe-config
+
+# emacs/skribe.el
+cat emacs/skribe.el.in \
+ | sed "s|@SKRIBE_RELEASE@|$release|" \
+ | sed "s|@PREFIX@|$prefix|" \
+ | sed "s|@SKRIBE_EXT_DIR@|$skribeextdir|" \
+ | sed "s|@SYSTEM@|$scheme|" \
+ | sed "s|@SKRIBE_DOCDIR@|$skribedocdir|" \
+ > emacs/skribe.el
+
+# src/common/configure.scm
+rm -f src/common/configure.scm 2> /dev/null
+echo ";; Automatically generated file (don't edit)" > src/common/configure.scm
+cat src/common/configure.scm.in \
+ | sed "s|@SKRIBE_RELEASE@|$release|" \
+ | sed "s|@SKRIBE_URL@|$skribeurl|" \
+ | sed "s|@SKRIBE_DOC_DIR@|$skribedocdir|" \
+ | sed "s|@SKRIBE_EXT_DIR@|$skribeextdir|" \
+ | sed "s|@SKRIBE_SKR_PATH@|$skribeskrdir|" \
+ | sed "s|@SKRIBE_SCHEME@|$scheme|" \
+ >> src/common/configure.scm
+echo "" >> src/common/configure.scm
+
+if test $use_bigloo = 1 ;then
+ # pass all the arguments to the Bigloo autoconf without the --with-bigloo
+ echo "Using Bigloo system"
+ eval "cd etc/bigloo; SKRIBERELEASE=$release ./configure --docdir=$skribedocdir $new_args"
+ exit 0
+fi
+
+# If we are here, it means that we use the STklos system
+if test $use_stklos = 1 ;then
+ # pass all the arguments to the STklos autoconf without the --with-stklos
+ echo "Using STklos system"
+ eval "cd etc/stklos; ./configure $new_args"
+ exit 0
+fi
+
diff --git a/skribe/doc/Makefile b/skribe/doc/Makefile
new file mode 100644
index 0000000..934389e
--- /dev/null
+++ b/skribe/doc/Makefile
@@ -0,0 +1,233 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/doc/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Mon Sep 1 10:29:28 2003 */
+#* Last change : Wed Mar 10 11:16:48 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to build the Skribe documentation. */
+#*=====================================================================*/
+include ../etc/Makefile.config
+include ../etc/$(SYSTEM)/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* Compiler and tools */
+#*---------------------------------------------------------------------*/
+BINDIR = ../bin
+LIBDIR = ../lib
+LATEX = latex
+DVIPS = dvips
+
+SKRIBEVERBOSE = -v1
+SKRIBEWARNING = -w1
+SFLAGS = $(SKRIBEVERBOSE) $(SKRIBEWARNING) \
+ -I ../skr \
+ -I skr \
+ -P img \
+ -S .. \
+ --custom emit-sui=yes \
+ --eval '(define *skribe-bin* "$(SKRIBE)")' \
+ --eval '(define *skribebibtex-bin* "$(SKRIBEBIBTEX)")'
+
+#*---------------------------------------------------------------------*/
+#* Doc skr */
+#*---------------------------------------------------------------------*/
+_SKR = manual.skr env.skr api.skr extension.skr
+SKR = $(_SKR:%=skr/%)
+
+#*---------------------------------------------------------------------*/
+#* Images */
+#*---------------------------------------------------------------------*/
+_IMG = bsd.gif lambda.gif linux.gif
+IMG = $(_IMG:%=img/%)
+
+#*---------------------------------------------------------------------*/
+#* User document */
+#*---------------------------------------------------------------------*/
+_USERMAIN = user.skb
+_USEROTHERS = start.skb syntax.skb \
+ markup.skb document.skb \
+ sectioning.skb toc.skb ornament.skb line.skb font.skb \
+ justify.skb enumeration.skb \
+ examples.skb colframe.skb figure.skb image.skb table.skb \
+ footnote.skb char.skb \
+ links.skb index.skb bib.skb prgm.skb \
+ engine.skb htmle.skb latexe.skb xmle.skb \
+ emacs.skb skribec.skb skribe-config.skb \
+ lib.skb slide.skb package.skb
+_USERSRC = start1.skb start2.skb start3.skb start4.skb start5.skb \
+ api1.skb api2.skb api3.skb api4.skb api5.skb \
+ api6.skb api7.skb api8.skb api9.skb api10.skb \
+ api11.skb api12.skb api13.skb api14.skb api15.skb \
+ api16.skb api17.skb api18.skb api19.skb api20.skb \
+ links1.skb links2.skb \
+ index1.skb index2.skb index3.skb \
+ bib1.sbib bib2.skb bib3.skb bib4.skb bib5.skb bib6.skb \
+ prgm1.skb prgm2.skb prgm3.skb slides.skb
+
+USERMAIN = $(_USERMAIN:%=user/%)
+USEROTHERS = $(_USEROTHERS:%=user/%)
+USERSRC = $(_USERSRC:%=user/src/%)
+USERSKB = $(USERMAIN) $(USEROTHERS) $(USERSRC)
+
+#*---------------------------------------------------------------------*/
+#* User document */
+#*---------------------------------------------------------------------*/
+_DIRMAIN = dir.skb
+_DIROTHERS =
+_DIRSRC =
+
+DIRMAIN = $(_DIRMAIN:%=dir/%)
+DIROTHERS = $(_DIROTHERS:%=dir/%)
+DIRSRC = $(_DIRSRC:%=dir/src/%)
+DIRSKB = $(DIRMAIN) $(DIROTHERS) $(DIRSRC)
+
+#*---------------------------------------------------------------------*/
+#* Suffixes */
+#*---------------------------------------------------------------------*/
+.SUFFIXES:
+.SUFFIXES: .skb .man .html .sui
+
+#*---------------------------------------------------------------------*/
+#* All */
+#*---------------------------------------------------------------------*/
+.PHONY: user dir
+
+all: user dir
+re: re.html re.dir
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo doc/Makefile doc/Makefile.dir
+ @ echo $(USERSKB:%=doc/%)
+ @ echo $(DIRSKB:%=doc/%)
+ @ echo $(SKR:%=doc/%)
+ @ echo $(IMG:%=doc/%)
+
+#*---------------------------------------------------------------------*/
+#* user */
+#*---------------------------------------------------------------------*/
+.PHONY: user re.html user.html
+
+user: user.html user.sui
+user.html: html/user.html html/img/lambda.gif html/img/bsd.gif html/img/linux.gif
+user.sui: html/user.sui
+
+user.ps: tex/user.dvi
+ (cd tex; $(DVIPS) user.dvi -o user.ps)
+
+user.dvi: tex/user.dvi
+tex/user.dvi: tex/user.tex
+ (cd tex; $(LATEX) user.tex)
+
+html/user.html html/user.sui: html $(USERSKB) $(SKR)
+ $(MAKE) re.html
+
+tex/user.tex: tex $(USERSKB) $(SKR) tex/img/lambda.eps tex/img/bsd.eps tex/img/linux.eps
+ $(MAKE) re.tex
+
+# gif
+html/img/lambda.gif: html/img img/lambda.gif
+ cp img/lambda.gif html/img/lambda.gif
+
+html/img/linux.gif: html/img img/linux.gif
+ cp img/linux.gif html/img/linux.gif
+
+html/img/bsd.gif: html/img img/bsd.gif
+ cp img/bsd.gif html/img/bsd.gif
+
+# eps image
+tex/img/lambda.eps: tex/img img/lambda.gif
+ convert img/lambda.gif tex/img/lambda.eps
+
+tex/img/linux.eps: tex/img img/linux.gif
+ convert img/linux.gif tex/img/linux.eps
+
+tex/img/bsd.eps: tex/img img/bsd.gif
+ convert img/bsd.gif tex/img/bsd.eps
+
+re.html:
+ $(SKRIBE) $(SFLAGS) $(USERMAIN) \
+ --base html -I user -S user \
+ -o html/user.html
+
+re.tex:
+ $(SKRIBE) $(SFLAGS) $(USERMAIN) \
+ --base tex -I user -S user \
+ -o tex/user.tex
+
+#*---------------------------------------------------------------------*/
+#* dir */
+#*---------------------------------------------------------------------*/
+.PHONY: dir re.dir dir.html
+
+dir: dir.html
+dir.html: html/dir.html
+
+html/dir.html: html $(DIRSKB) $(SKR)
+ $(MAKE) re.dir
+
+re.dir:
+ $(MAKE) -f Makefile.dir SKRIBE="$(SKRIBE)" BASE=html
+
+#*---------------------------------------------------------------------*/
+#* Misc */
+#*---------------------------------------------------------------------*/
+html:
+ mkdir -p html
+
+html/img:
+ mkdir -p html/img
+
+tex:
+ mkdir -p tex
+
+tex/img:
+ mkdir -p tex/img
+
+gethtml:
+ @ echo "html/user.html"
+
+#*---------------------------------------------------------------------*/
+#* install/uinstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install: $(DESTDIR)$(INSTALL_DOCDIR) $(DESTDIR)$(INSTALL_SKRDIR)/doc/skr
+ cp -r html/* $(DESTDIR)$(INSTALL_DOCDIR) \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_DOCDIR)/* \
+ && chmod a+rx $(DESTDIR)$(INSTALL_DOCDIR)/img
+ cp -r skr/* $(DESTDIR)$(INSTALL_SKRDIR)/doc/skr \
+ && chmod a+rx $(DESTDIR)$(INSTALL_SKRDIR)/doc \
+ && chmod a+rx $(DESTDIR)$(INSTALL_SKRDIR)/doc/skr \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_SKRDIR)/doc/skr/*
+ cp Makefile.dir $(DESTDIR)$(INSTALL_DOCDIR) \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_DOCDIR)/Makefile.dir
+ cp dir/dir.skb $(DESTDIR)$(INSTALL_DOCDIR) \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_DOCDIR)/dir.skb
+
+uninstall:
+ $(RM) -rf $(DESTDIR)$(INSTALL_DOCDIR)
+
+$(DESTDIR)$(INSTALL_DOCDIR):
+ mkdir -p $(DESTDIR)$(INSTALL_DOCDIR) && chmod a+rx $(DESTDIR)$(INSTALL_DOCDIR)
+
+
+$(DESTDIR)$(INSTALL_SKRDIR)/doc/skr:
+ mkdir -p $(DESTDIR)$(INSTALL_SKRDIR)/doc/skr \
+ && chmod -R a+rx $(DESTDIR)$(INSTALL_SKRDIR)/doc
+
+#*---------------------------------------------------------------------*/
+#* Clean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean
+
+clean:
+ $(RM) -rf html
+ $(RM) -rf tex
+ $(RM) -f img/bsd.eps img/linux.eps
diff --git a/skribe/doc/Makefile.dir b/skribe/doc/Makefile.dir
new file mode 100644
index 0000000..e35cf0b
--- /dev/null
+++ b/skribe/doc/Makefile.dir
@@ -0,0 +1,22 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/doc/Makefile.dir */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Jan 1 15:30:39 2004 */
+#* Last change : Wed Feb 4 09:19:03 2004 (serrano) */
+#* Copyright : 2004 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to build the Skribe directory. */
+#*=====================================================================*/
+
+SKRIBE = skribe
+SFLAGS = -I ../skr -I skr -P img -S .. -w0
+BASE = .
+SPATH =
+
+.PHONY: re.dir
+
+re.dir:
+ $(SKRIBE) $(SFLAGS) $(SPATH) dir.skb \
+ --base $(BASE) -I dir -S dir \
+ -o $(BASE)/dir.html
diff --git a/skribe/doc/dir/dir.skb b/skribe/doc/dir/dir.skb
new file mode 100644
index 0000000..8c6d377
--- /dev/null
+++ b/skribe/doc/dir/dir.skb
@@ -0,0 +1,113 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/dir/dir.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Nov 28 10:37:39 2001 */
+;* Last change : Thu Jan 1 17:12:43 2004 (serrano) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe directory */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The Skribe documentation style */
+;*---------------------------------------------------------------------*/
+(skribe-load "web-book.skr")
+(skribe-load "skr/env.skr")
+(skribe-load "skr/manual.skr")
+(skribe-load "skr/api.skr")
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+ (engine-custom-set! he 'web-book-main-browsing-extra
+ (lambda (n e)
+ (table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "Skribe: "))
+ (td :align 'right :valign 'top
+ (ref :url *skribe-user-doc-url*
+ :text "User Manual")))))))
+
+;*---------------------------------------------------------------------*/
+;* The global index */
+;*---------------------------------------------------------------------*/
+(define *sui-index* (make-index "sui"))
+
+;*---------------------------------------------------------------------*/
+;* index-sui ... */
+;*---------------------------------------------------------------------*/
+(define (index-sui sui dir)
+ (sui-filter sui
+ (lambda (s)
+ (and (pair? s) (eq? (car s) 'marks)))
+ (lambda (e)
+ (let ((f (memq :file e))
+ (k (memq :mark e))
+ (c (memq :class e)))
+ (when (and (pair? f)
+ (pair? k)
+ (pair? c)
+ (string=? (cadr c) "public-definition"))
+ (index :index *sui-index*
+ :url (format "~a/~a#~a" dir (cadr f) (cadr k))
+ (cadr k)))
+ #f))))
+
+;*---------------------------------------------------------------------*/
+;* Intern all the sui files */
+;*---------------------------------------------------------------------*/
+(define extensions '())
+
+(let loop ((files (directory->list "html")))
+ (when (pair? files)
+ (if (string=? (suffix (car files)) "sui")
+ (let* ((f (string-append "html/" (car files)))
+ (sui (load-sui f)))
+ (if (not (string=? (car files) "user.sui"))
+ (set! extensions (cons sui extensions)))
+ (index-sui sui (dirname (car files)))))
+ (loop (cdr files))))
+(let loop ((files (directory->list ".")))
+ (when (pair? files)
+ (if (string=? (suffix (car files)) "sui")
+ (let* ((f (car files))
+ (sui (load-sui f)))
+ (if (not (string=? (car files) "user.sui"))
+ (set! extensions (cons sui extensions)))
+ (index-sui sui (dirname f))))
+ (loop (cdr files))))
+
+;*---------------------------------------------------------------------*/
+;* The document */
+;*---------------------------------------------------------------------*/
+(document :title "Skribe directory"
+ :author (list (author :name "Erick Gallesio"
+ :affiliation "Universit� de Nice - Sophia Antipolis"
+ :address '("930 route des Colles, BP 145"
+ "F-06903 Sophia Antipolis, Cedex"
+ "France")
+ :email (mailto "eg@essi.fr"))
+ (author :name "Manuel Serrano"
+ :affiliation "Inria Sophia-Antipolis"
+ :address `("2004 route des Lucioles - BP 93"
+ "F-06902 Sophia Antipolis, Cedex"
+ "France")
+ :url (ref :url *serrano-url*)
+ :email (mailto *serrano-mail*)))
+
+ (linebreak 1)
+
+;;; extensions
+(if (pair? extensions)
+ (section :title "Installed extensions" :number #f
+ (itemize (map (lambda (e)
+ (item :key (ref :url (sui-file e) :text (sui-title e))
+ (let ((d (sui-key e :description)))
+ (if d (list ": " d) #f))))
+ extensions))))
+
+;;; global Index
+(section :title "Global Markup Index" :number #f
+ (mark "global index")
+ (the-index :column 3 *sui-index*)))
diff --git a/skribe/doc/img/bsd.gif b/skribe/doc/img/bsd.gif
new file mode 100644
index 0000000..e406ba6
Binary files /dev/null and b/skribe/doc/img/bsd.gif differ
diff --git a/skribe/doc/img/lambda.gif b/skribe/doc/img/lambda.gif
new file mode 100644
index 0000000..9c46b7d
Binary files /dev/null and b/skribe/doc/img/lambda.gif differ
diff --git a/skribe/doc/img/linux.gif b/skribe/doc/img/linux.gif
new file mode 100644
index 0000000..fa764bd
Binary files /dev/null and b/skribe/doc/img/linux.gif differ
diff --git a/skribe/doc/skr/api.skr b/skribe/doc/skr/api.skr
new file mode 100644
index 0000000..a27c3a4
--- /dev/null
+++ b/skribe/doc/skr/api.skr
@@ -0,0 +1,575 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/skr/api.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 07:45:33 2003 */
+;* Last change : Tue Apr 6 06:51:34 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe style for documenting Lisp APIs. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (tro (markup-writer-get 'tr he)))
+ (markup-writer 'tr he
+ :class 'api-table-header
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'section-title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro))))
+ (markup-writer 'tr he
+ :class 'api-table-prototype
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro))))
+ (markup-writer 'tr he
+ :class 'api-symbol-prototype
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro)))))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX configuration */
+;*---------------------------------------------------------------------*/
+(let* ((le (find-engine 'latex))
+ (tro (markup-writer-get 'tr le)))
+ (markup-writer 'tr le
+ :class 'api-table-prototype
+ :options '(:width :bg)
+ :action #f)
+ (markup-writer 'tr le
+ :class 'api-table-header
+ :options '(:width :bg)
+ :action (lambda (n e)
+ (let ((c (engine-custom e 'section-title-background)))
+ (markup-option-add! n :bg c)
+ (output n e tro)))))
+
+;*---------------------------------------------------------------------*/
+;* api-search-definition ... */
+;* ------------------------------------------------------------- */
+;* Find a definition inside a source file. */
+;*---------------------------------------------------------------------*/
+(define (api-search-definition id file pred)
+ (let ((f (find-file/path file *skribe-source-path*)))
+ (if (not (string? f))
+ (skribe-error 'api-search-definition
+ (format "Can't find source file `~a' in path" file)
+ *skribe-source-path*)
+ (with-input-from-file f
+ (lambda ()
+ (let loop ((exp (read)))
+ (if (eof-object? exp)
+ (skribe-error 'api-search-definition
+ (format "Can't find `~a' definition" id)
+ file)
+ (or (pred id exp) (loop (read))))))))))
+
+;*---------------------------------------------------------------------*/
+;* api-compare-set ... */
+;* ------------------------------------------------------------- */
+;* This function compares two sets. It returns either #t */
+;* is they are equal, or two subsets which contain elements */
+;* not present in the arguments. For instance: */
+;* (api-compare-set '(foo bar) '(bar foo)) ==> #t */
+;* (api-compare-set '(foo gee) '(gee bar)) ==> '((foo) (bar)) */
+;*---------------------------------------------------------------------*/
+(define (api-compare-set s1 s2)
+ (let ((d1 (filter (lambda (x) (not (memq x s2))) s1))
+ (d2 (filter (lambda (x) (not (memq x s1))) s2)))
+ (or (and (null? d1) (null? d2))
+ (list d1 d2))))
+
+;*---------------------------------------------------------------------*/
+;* keyword->symbol ... */
+;*---------------------------------------------------------------------*/
+(define (keyword->symbol kwd)
+ (let ((s (keyword->string kwd)))
+ (if (char=? #\: (string-ref s 0))
+ ;; Bigloo
+ (string->symbol (substring s 1 (string-length s)))
+ ;; STklos
+ (string->symbol s))))
+
+;*---------------------------------------------------------------------*/
+;* define-markup? ... */
+;*---------------------------------------------------------------------*/
+(define (define-markup? id o)
+ (match-case o
+ (((or define-markup define define-inline)
+ ((? (lambda (x) (eq? x id))) . (? (lambda (x) (or (pair? x) (null? x))))) . ?-)
+ o)
+ ((define-simple-markup (? (lambda (x) (eq? x id))))
+ o)
+ ((define-simple-container (? (lambda (x) (eq? x id))))
+ o)
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* make-engine? ... */
+;*---------------------------------------------------------------------*/
+(define (make-engine? id o)
+ (match-case o
+ (((or make-engine copy-engine) (quote (? (lambda (x) (eq? x id)))) . ?-)
+ o)
+ ((quasiquote . ?-)
+ #f)
+ ((quote . ?-)
+ #f)
+ ((?a . ?d)
+ (or (make-engine? id a) (make-engine? id d)))
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* make-engine-custom ... */
+;*---------------------------------------------------------------------*/
+(define (make-engine-custom def)
+ (match-case (memq :custom def)
+ ((:custom (quote ?custom) . ?-)
+ custom)
+ ((:custom ?custom . ?-)
+ (eval custom))
+ (else
+ '())))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-formals ... */
+;* ------------------------------------------------------------- */
+;* Returns the formal parameters of a define-markup (not the */
+;* options). */
+;*---------------------------------------------------------------------*/
+(define (define-markup-formals def)
+ (match-case def
+ ((?- (?- . ?args) . ?-)
+ (if (symbol? args)
+ (list args)
+ (let loop ((args args)
+ (res '()))
+ (cond
+ ((null? args)
+ (reverse! res))
+ ((symbol? args)
+ (reverse! (cons args res)))
+ ((not (symbol? (car args)))
+ (reverse! res))
+ (else
+ (loop (cdr args) (cons (car args) res)))))))
+ ((define-simple-markup ?-)
+ '())
+ ((define-simple-container ?-)
+ '())
+ (else
+ (skribe-error 'define-markup-formals
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-options ... */
+;* ------------------------------------------------------------- */
+;* Returns the options parameters of a define-markup. */
+;*---------------------------------------------------------------------*/
+(define (define-markup-options def)
+ (match-case def
+ ((?- (?- . ?args) . ?-)
+ (if (not (list? args))
+ '()
+ (let ((keys (memq #!key args)))
+ (if (pair? keys)
+ (cdr keys)
+ '()))))
+ ((define-simple-markup ?-)
+ '((ident #f) (class #f)))
+ ((define-simple-container ?-)
+ '((ident #f) (class #f)))
+ (else
+ (skribe-error 'define-markup-formals
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* define-markup-rest ... */
+;* ------------------------------------------------------------- */
+;* Returns the rest parameter of a define-markup. */
+;*---------------------------------------------------------------------*/
+(define (define-markup-rest def)
+ (match-case def
+ ((?- (?- . ?args) . ?-)
+ (if (not (pair? args))
+ args
+ (let ((l (last-pair args)))
+ (if (symbol? (cdr l))
+ (cdr l)
+ (let ((rest (memq #!rest args)))
+ (if (pair? rest)
+ (if (or (not (pair? (cdr rest)))
+ (not (symbol? (cadr rest))))
+ (skribe-error 'define-markup-rest
+ "Illegal `define-markup' form"
+ def)
+ (cadr rest))
+ #f))))))
+ ((define-simple-markup ?-)
+ 'node)
+ ((define-simple-container ?-)
+ 'node)
+ (else
+ (skribe-error 'define-markup-formals
+ "Illegal `define-markup' form"
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* doc-check-arguments ... */
+;*---------------------------------------------------------------------*/
+(define (doc-check-arguments id args dargs)
+ (if (not args)
+ (skribe-error 'doc-check-arguments id args))
+ (if (not dargs)
+ (skribe-error 'doc-check-arguments id dargs))
+ (let* ((s1 (map (lambda (x) (if (pair? x) (car x) x)) args))
+ (s2 (map (lambda (x)
+ (let ((i (car x)))
+ (if (keyword? i)
+ (keyword->symbol i)
+ i)))
+ dargs))
+ (d (api-compare-set s1 s2)))
+ (if (pair? d)
+ (let ((d1 (car d))
+ (d2 (cadr d)))
+ (if (pair? d1)
+ (skribe-error 'doc-markup
+ (format "~a: missing descriptions" id)
+ d1)
+ (skribe-error 'doc-markup
+ (format "~a: extra descriptions" id)
+ d2))))))
+
+;*---------------------------------------------------------------------*/
+;* exp->skribe ... */
+;*---------------------------------------------------------------------*/
+(define (exp->skribe exp)
+ (cond
+ ((number? exp) exp)
+ ((string? exp) (string-append "\"" exp "\""))
+ ((eq? exp #f) "#f")
+ ((eq? exp #t) "#t")
+ ((symbol? exp) (symbol->string exp))
+ ((equal? exp '(quote ())) "'()")
+ ((ast? exp)
+ (table :cellpadding 0 :cellspacing 0
+ (tr (td :align 'left exp))))
+ (else
+ (match-case exp
+ ((quote (and ?sym (? symbol?)))
+ (string-append "'" (symbol->string sym)))
+ (else
+ (with-output-to-string (lambda () (write exp))))))))
+
+;*---------------------------------------------------------------------*/
+;* doc-markup-proto ... */
+;*---------------------------------------------------------------------*/
+(define (doc-markup-proto id options formals rest)
+ (define (option opt)
+ (if (pair? opt)
+ (if (eq? (cadr opt) #f)
+ (list " [" (keyword (car opt)) "]")
+ (list " [" (keyword (car opt)) " "
+ (code (exp->skribe (cadr opt))) "]"))
+ (list " " (keyword opt))))
+ (define (formal f)
+ (list " " (param f)))
+ (code (list (bold "(") (bold :class 'api-proto-ident (format "~a" id)))
+ (map option (sort options
+ (lambda (s1 s2)
+ (cond
+ ((and (pair? s1) (not (pair? s2)))
+ #f)
+ ((and (pair? s2) (not (pair? s1)))
+ #t)
+ (else
+ #t)))))
+ (if (pair? formals)
+ (map formal formals))
+ (if rest (list " " (param rest)))
+ (bold ")")))
+
+;*---------------------------------------------------------------------*/
+;* doc-markup ... */
+;*---------------------------------------------------------------------*/
+(define-markup (doc-markup id args
+ #!rest
+ opts
+ #!key
+ (writer-id #f)
+ (common-args '((:ident "The node identifier.")
+ (:class "The node class.")))
+ (ignore-args '(&skribe-eval-location))
+ (force-args '())
+ (idx *markup-index*)
+ (idx-note "definition")
+ (idx-suffix #f)
+ (source "src/common/api.scm")
+ (def #f)
+ (see-also '())
+ (others '())
+ (force-engines '())
+ (engines *api-engines*)
+ (sui #f)
+ &skribe-eval-location)
+ (define (opt-engine-support opt)
+ ;; find the engines providing a writer for id
+ (map (lambda (e)
+ (let* ((id (engine-ident e))
+ (s (symbol->string id)))
+ (if (engine-format? "latex")
+ (list s " ")
+ (list (if sui
+ (ref :skribe sui
+ :mark (string-append s "-engine")
+ :text s)
+ (ref :mark (string-append s "-engine")
+ :text s))
+ " "))))
+ (if (pair? force-engines)
+ force-engines
+ (filter (lambda (e)
+ (or (memq opt '(:ident :class))
+ (memq opt force-args)
+ (let ((w (markup-writer-get (or writer-id id)
+ e)))
+ (cond
+ ((not (writer? w))
+ #f)
+ (else
+ (let ((o (writer-options w)))
+ (cond
+ ((eq? o 'all)
+ #t)
+ ((not (pair? o))
+ #f)
+ (else
+ (memq opt o)))))))))
+ engines))))
+ (cond
+ ((and def source)
+ (skribe-error 'doc-markup "source and def both specified" id))
+ ((and (not def) (not source))
+ (skribe-error 'doc-markup "source or def must be specified" id))
+ (else
+ (let* ((d (or def (api-search-definition id source define-markup?)))
+ (od (map (lambda (o)
+ (api-search-definition o source define-markup?))
+ others))
+ (args (append common-args args))
+ (formals (define-markup-formals d))
+ (fformals (filter (lambda (s)
+ (let ((c (assq s args)))
+ (not
+ (and (pair? c)
+ (eq? (cadr c) 'ignore)))))
+ formals))
+ (options (filter (lambda (s)
+ (not (memq s ignore-args)))
+ (define-markup-options d)))
+ (dformals (filter (lambda (x)
+ (symbol? (car x)))
+ args))
+ (doptions (filter (lambda (x)
+ (and (keyword? (car x))
+ ;; useful for STklos only
+ (not (eq? (car x) #!rest))))
+ args))
+ (drest (filter (lambda (x)
+ (eq? #!rest (car x)))
+ args))
+ (dargs (and (pair? drest) (cadr (car drest))))
+ (p+ (cons (doc-markup-proto id options fformals dargs)
+ (map (lambda (id def)
+ (doc-markup-proto
+ id
+ (define-markup-options def)
+ (define-markup-formals def)
+ dargs))
+ others od))))
+ ;; doc table
+ (define (doc-markup.html)
+ (let ((df (map (lambda (f)
+ (tr :bg *prgm-skribe-color*
+ (td :colspan 2 :width 20. :align 'left
+ (param (car f)) )
+ (td :align 'left :width 80. (cadr f))))
+ dformals))
+ (dr (and (pair? drest)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left
+ :valign 'top
+ :colspan 2
+ :width 20.
+ (param (cadr (car drest))))
+ (td :align 'left :width 80.
+ (caddr (car drest))))))
+ (do (map (lambda (f)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left
+ :valign 'top
+ :width 10.
+ (param (car f)))
+ (td :align 'left
+ :valign 'top
+ :width 20.
+ (opt-engine-support (car f)))
+ (td :align 'left :width 70. (cadr f))))
+ doptions))
+ (so (map (lambda (x)
+ (let ((s (symbol->string x)))
+ (list
+ (ref :mark s :text (code s))
+ " ")))
+ see-also)))
+ (table :border (if (engine-format? "latex") 1 0)
+ :width (if (engine-format? "latex") #f *prgm-width*)
+ `(,(tr :class 'api-table-prototype
+ (th :colspan 3 :align 'left :width *prgm-width*
+ "prototype"))
+ ,@(map (lambda (p)
+ (tr :bg *prgm-skribe-color*
+ (td :colspan 3 :width *prgm-width*
+ :align 'left p)))
+ p+)
+ ,@(if (pair? do)
+ `(,(tr :class 'api-table-header
+ (th :align 'left "option"
+ :width 10.)
+ (th :align 'center "engines"
+ :width 20.)
+ (th "description"))
+ ,@do)
+ '())
+ ,@(if (or (pair? df) dr)
+ `(,(tr :class 'api-table-header
+ (th :colspan 2
+ :align 'left
+ :width 30.
+ "argument")
+ (th "description"))
+ ,@(if (pair? df) df '())
+ ,@(if dr (list dr) '()))
+ '())
+ ,@(if (pair? so)
+ `(,(tr :class 'api-table-header
+ (th :colspan 3 :align 'left
+ (it "See also")))
+ ,(tr :bg *prgm-skribe-color*
+ (td :colspan 3 :align 'left so)))
+ '())))))
+ ;; doc enumerate
+ (define (doc-markup.latex)
+ (let ((df (map (lambda (f)
+ (item :key (param (car f)) (cadr f)))
+ dformals))
+ (dr (if (pair? drest)
+ (list (item :key (param (cadr (car drest)))
+ (caddr (car drest))))
+ '()))
+ (do (map (lambda (f)
+ (item :key (param (car f))
+ (list (opt-engine-support (car f))
+ (cadr f))))
+ doptions))
+ (so (map (lambda (x)
+ (let ((s (symbol->string x)))
+ (list
+ (ref :mark s :page #t
+ :text [,(code s), p.])
+ " ")))
+ see-also)))
+ (list (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :class 'api-table-prototype
+ :margin 5 :width 100. :bg "#ccccff"
+ p+)))
+ (when (pair? do)
+ (subsubsection :title "Options" :number #f :toc #f
+ (description do)))
+ (when (or (pair? df) (pair? dr))
+ (subsubsection :title "Parameters" :number #f :toc #f
+ (description (append df dr))))
+ (when (pair? so)
+ (subsubsection :title "See also" :number #f :toc #f
+ (p so)
+ (! "\\noindent"))))))
+ ;; check all the descriptions
+ (doc-check-arguments id formals dformals)
+ (doc-check-arguments id options doptions)
+ (if (and (pair? drest) (not (define-markup-rest d)))
+ (skribe-error 'doc-markup "No rest argument for" id)
+ options)
+ (list (mark :class "public-definition" (symbol->string id))
+ (map (lambda (i) (mark (symbol->string i))) others)
+ (map (lambda (i)
+ (let ((is (symbol->string i)))
+ (index (if (string? idx-suffix)
+ (string-append is idx-suffix)
+ is)
+ :index idx
+ :note idx-note)))
+ (cons id others))
+ (cond
+ ((engine-format? "latex")
+ (doc-markup.latex))
+ (else
+ (center (doc-markup.html)))))))))
+
+;*---------------------------------------------------------------------*/
+;* doc-engine ... */
+;*---------------------------------------------------------------------*/
+(define-markup (doc-engine id args
+ #!rest
+ opts
+ #!key
+ (idx *custom-index*)
+ source
+ (def #f))
+ (cond
+ ((and def source)
+ (skribe-error 'doc-engine "source and def both specified" id))
+ ((and (not def) (not source))
+ (skribe-error 'doc-engine "source or def must be specified" id))
+ (else
+ (let* ((d (or def (api-search-definition id source make-engine?)))
+ (c (make-engine-custom d)))
+ (doc-check-arguments id c args)
+ (cond
+ ((engine-format? "latex")
+ #f)
+ (else
+ (center
+ (apply table
+ :width *prgm-width*
+ (tr :class 'api-table-header
+ (th :align 'left :width 20. "custom")
+ (th :width 10. "default")
+ (th "description"))
+ (map (lambda (r)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left :valign 'top
+ (list (index (symbol->string (car r))
+ :index idx
+ :note (format "~a custom" id))
+ (symbol->string (car r))))
+ (let ((def (assq (car r) c)))
+ (td :valign 'top
+ (code (exp->skribe (cadr def)))))
+ (td :align 'left :valign 'top (cadr r))))
+ (filter cadr args))))))))))
+
diff --git a/skribe/doc/skr/env.skr b/skribe/doc/skr/env.skr
new file mode 100644
index 0000000..09d5146
--- /dev/null
+++ b/skribe/doc/skr/env.skr
@@ -0,0 +1,32 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/skr/env.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 10:22:42 2003 */
+;* Last change : Thu Jan 29 06:48:54 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The environment variables for the documentation. */
+;*=====================================================================*/
+
+(define *serrano-url* "http://www.inria.fr/mimosa/Manuel.Serrano")
+(define *serrano-mail* "Manuel.Serrano@sophia.inria.fr")
+(define *html-url* "http://www.w3.org/TR/html4")
+(define *html-form* "interact/forms.html")
+(define *emacs-url* "http://www.gnu.org/software/emacs")
+(define *xemacs-url* "http://www.xemacs.org")
+(define *texinfo-url* "http://www.texinfo.org")
+(define *r5rs-url* "http://www.inria.fr/mimosa/fp/Bigloo/doc/r5rs.html")
+(define *bigloo-url* "http://www.inria.fr/mimosa/fp/Bigloo")
+(define *skribe-user-doc-url* (string-append (skribe-doc-dir) "/user.html"))
+(define *skribe-dir-doc-url* (string-append (skribe-doc-dir) "/dir.html"))
+
+(define *prgm-width* 97.)
+(define *prgm-skribe-color* "#ffffcc")
+(define *prgm-default-color* "#ffffcc")
+(define *prgm-xml-color* "#ffcccc")
+(define *prgm-example-color* "#ccccff")
+(define *disp-color* "#ccffcc")
+(define *header-color* "#cccccc")
+
+(define *api-engines* (map find-engine '(html latex xml)))
diff --git a/skribe/doc/skr/extension.skr b/skribe/doc/skr/extension.skr
new file mode 100644
index 0000000..ce10ce7
--- /dev/null
+++ b/skribe/doc/skr/extension.skr
@@ -0,0 +1,95 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/skr/extension.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Dec 23 07:18:36 2003 */
+;* Last change : Fri Jan 2 21:25:49 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe package for documenting extensions */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* extension */
+;*---------------------------------------------------------------------*/
+(define-markup (extension #!rest opt
+ #!key (ident (symbol->string (gensym 'extension)))
+ (class "extension")
+ title html-title ending author description
+ (env '()))
+ (new document
+ (markup 'extension)
+ (ident ident)
+ (class class)
+ (options (the-options opt))
+ (body (the-body opt))
+ (env (append env
+ (list (list 'example-counter 0) (list 'example-env '())
+ (list 'chapter-counter 0) (list 'chapter-env '())
+ (list 'section-counter 0) (list 'section-env '())
+ (list 'footnote-counter 0) (list 'footnote-env '())
+ (list 'figure-counter 0) (list 'figure-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;* html engine */
+;*---------------------------------------------------------------------*/
+(let ((he (find-engine 'html)))
+ (engine-custom-set! he 'web-book-main-browsing-extra
+ (lambda (n e)
+ (let ((i (let ((m (find-markup-ident "Index")))
+ (and (pair? m) (car m)))))
+ (if (not i)
+ (table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "Skribe: "))
+ (td :align 'right :valign 'top
+ (ref :url *skribe-dir-doc-url*
+ :text "Directory")))
+ (tr (td)
+ (td :align 'right :valign 'top
+ (ref :url *skribe-user-doc-url*
+ :text "User Manual"))))
+ (table :width 100. :border 0 :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "index:"))
+ (td :align 'right (ref :handle (handle i))))
+ (tr (td :align 'left :valign 'top (bold "Skribe: "))
+ (td :align 'right :valign 'top
+ (ref :url *skribe-dir-doc-url*
+ :text "Directory")))
+ (tr (td)
+ (td :align 'right :valign 'top
+ (ref :url *skribe-user-doc-url*
+ :text "User Manual"))))))))
+ (default-engine-set! he))
+
+;*---------------------------------------------------------------------*/
+;* extension-sui ... */
+;*---------------------------------------------------------------------*/
+(define (extension-sui n e)
+ (define (sui)
+ (display "(sui \"")
+ (skribe-eval (markup-option n :title) html-title-engine)
+ (display "\"\n")
+ (printf " :file ~s\n" (sui-referenced-file n e))
+ (printf " :description ~s\n" (markup-option n :description))
+ (sui-marks n e)
+ (display " )\n"))
+ (if (string? *skribe-dest*)
+ (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+ (with-output-to-file f sui))
+ (sui)))
+
+;*---------------------------------------------------------------------*/
+;* project ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'extension
+ :options '(:title :html-title :ending :author :description)
+ :action (lambda (n e)
+ (output n e (markup-writer-get 'document he)))
+ :after (lambda (n e)
+ (if (engine-custom e 'emit-sui)
+ (extension-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;* Restore the base engine */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/skribe/doc/skr/manual.skr b/skribe/doc/skr/manual.skr
new file mode 100644
index 0000000..1982237
--- /dev/null
+++ b/skribe/doc/skr/manual.skr
@@ -0,0 +1,281 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/skr/manual.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 11:24:19 2003 */
+;* Last change : Mon Sep 13 19:18:48 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe manuals and documentation pages style */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Base configuration */
+;*---------------------------------------------------------------------*/
+(let ((be (find-engine 'base)))
+ (markup-writer 'example be
+ :options '(:legend :number)
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (skribe-eval (mark ident) e)
+ (skribe-eval (center
+ (markup-body n)
+ (if number (bold (format "Ex. ~a: " number)))
+ legend)
+ e)))))
+
+;*---------------------------------------------------------------------*/
+;* html-browsing-extra ... */
+;*---------------------------------------------------------------------*/
+(define (html-browsing-extra n e)
+ (let ((i1 (let ((m (find-markup-ident "Index")))
+ (and (pair? m) (car m))))
+ (i2 (let ((m (find-markup-ident "markups-index")))
+ (and (pair? m) (car m)))))
+ (cond
+ ((not i1)
+ (skribe-error 'left-margin "Can't find section" "Index"))
+ ((not i2)
+ (skribe-error 'left-margin "Can't find chapter" "Standard Markups"))
+ (else
+ (table :width 100.
+ :border 0
+ :cellspacing 0 :cellpadding 0
+ (tr (td :align 'left :valign 'top (bold "index:"))
+ (td :align 'right (ref :handle (handle i1) :text "Global")))
+ (tr (td :align 'left :valign 'top (bold "markups:"))
+ (td :align 'right (ref :handle (handle i2) :text "Index")))
+ (tr (td :align 'left :valign 'top (bold "extensions:"))
+ (td :align 'right (ref :url *skribe-dir-doc-url*
+ :text "Directory"))))))))
+
+;*---------------------------------------------------------------------*/
+;* Html configuration */
+;*---------------------------------------------------------------------*/
+(let* ((he (find-engine 'html))
+ (bd (markup-writer-get 'bold he)))
+ (markup-writer 'bold he
+ :class 'api-proto-ident
+ :before "<font color=\"red\">"
+ :action (lambda (n e) (output n e bd))
+ :after "</font>")
+ (engine-custom-set! he 'web-book-main-browsing-extra html-browsing-extra)
+ (engine-custom-set! he 'favicon "lambda.gif"))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX */
+;*---------------------------------------------------------------------*/
+(let* ((le (find-engine 'latex))
+ (opckg (engine-custom le 'usepackage))
+ (lpckg "\\usepackage{fullpage}\n\\usepackage{eurosym}\n")
+ (npckg (if (string? opckg)
+ (string-append lpckg opckg)
+ lpckg)))
+ (engine-custom-set! le 'documentclass "\\documentclass{book}")
+ (engine-custom-set! le 'usepackage npckg))
+
+;*---------------------------------------------------------------------*/
+;* prgm ... */
+;*---------------------------------------------------------------------*/
+(define-markup (prgm #!rest opts #!key (language skribe) (line #f) (file #f) (definition #f))
+ (let* ((c (cond
+ ((eq? language skribe) *prgm-skribe-color*)
+ ((eq? language xml) *prgm-xml-color*)
+ (else *prgm-default-color*)))
+ (sc (cond
+ ((and file definition)
+ (source :language language :file file :definition definition))
+ (file
+ (source :language language :file file))
+ (else
+ (source :language language (the-body opts)))))
+ (pr (cond
+ (line
+ (prog :line line sc))
+ (else
+ (pre sc)))))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg c pr)))))
+
+;*---------------------------------------------------------------------*/
+;* disp ... */
+;*---------------------------------------------------------------------*/
+(define-markup (disp #!rest opts #!key (verb #f) (line #f) (bg *disp-color*))
+ (if (engine-format? "latex")
+ (if verb
+ (pre (the-body opts))
+ (the-body opts))
+ (center
+ (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :width 100. :bg bg
+ (if verb
+ (pre (the-body opts))
+ (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;* keyword ... */
+;*---------------------------------------------------------------------*/
+(define-markup (keyword arg)
+ (new markup
+ (markup '&source-key)
+ (body (cond
+ ((keyword? arg)
+ (keyword->string arg))
+ ((symbol? arg)
+ (string-append ":" (symbol->string arg)))
+ (else
+ arg)))))
+
+;*---------------------------------------------------------------------*/
+;* param ... */
+;*---------------------------------------------------------------------*/
+(define-markup (param arg)
+ (cond
+ ((keyword? arg)
+ (keyword arg))
+ ((symbol? arg)
+ (code (symbol->string arg)))
+ (else
+ arg)))
+
+;*---------------------------------------------------------------------*/
+;* example ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example #!rest opts #!key legend class)
+ (new container
+ (markup 'example)
+ (ident (symbol->string (gensym 'example)))
+ (class class)
+ (required-options '(:legend :number))
+ (options `((:number
+ ,(new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env 'example #t)))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* example-produce ... */
+;*---------------------------------------------------------------------*/
+(define-markup (example-produce example . produce)
+ (list (it "Example:")
+ example
+ (if (pair? produce)
+ (list (paragraph "Produces:") (car produce)))))
+
+;*---------------------------------------------------------------------*/
+;* markup-ref ... */
+;*---------------------------------------------------------------------*/
+(define-markup (markup-ref mk)
+ (ref :mark mk :text (code mk)))
+
+;*---------------------------------------------------------------------*/
+;* &the-index ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+ :class 'markup-index
+ :options '(:column)
+ :before (lambda (n e)
+ (output (markup-option n 'header) e))
+ :action (lambda (n e)
+ (define (make-mark-entry n fst)
+ (let ((l (tr :class 'index-mark-entry
+ (td :colspan 2 :align 'left
+ (bold (it (sf n)))))))
+ (if fst
+ (list l)
+ (list (tr (td :colspan 2)) l))))
+ (define (make-primary-entry n p)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n)))
+ (when p
+ (markup-option-add! b :text
+ (list (markup-option b :text)
+ ", p."))
+ (markup-option-add! b :page #t))
+ (tr :class 'index-primary-entry
+ (td :colspan 2 :valign 'top :align 'left b))))
+ (define (make-column ie p)
+ (let loop ((ie ie)
+ (f #t))
+ (cond
+ ((null? ie)
+ '())
+ ((not (pair? (car ie)))
+ (append (make-mark-entry (car ie) f)
+ (loop (cdr ie) #f)))
+ (else
+ (cons (make-primary-entry (caar ie) p)
+ (loop (cdr ie) #f))))))
+ (define (make-sub-tables ie nc p)
+ (define (split-list l num)
+ (let loop ((l l)
+ (i 0)
+ (acc '())
+ (res '()))
+ (cond
+ ((null? l)
+ (reverse! (cons (reverse! acc) res)))
+ ((= i num)
+ (loop l
+ 0
+ '()
+ (cons (reverse! acc) res)))
+ (else
+ (loop (cdr l)
+ (+ i 1)
+ (cons (car l) acc)
+ res)))))
+ (let* ((l (length ie))
+ (w (/ 100. nc))
+ (iepc (let ((d (/ l nc)))
+ (if (integer? d)
+ (inexact->exact d)
+ (+ 1 (inexact->exact (truncate d))))))
+ (split (split-list ie iepc)))
+ (tr (map (lambda (ies)
+ (td :valign 'top :width w
+ (if (pair? ies)
+ (table :width 100. (make-column ies p))
+ "")))
+ split))))
+ (let* ((ie (markup-body n))
+ (nc (markup-option n :column))
+ (pref (eq? (engine-custom e 'index-page-ref) #t))
+ (loc (ast-loc n))
+ (t (cond
+ ((null? ie)
+ "")
+ ((or (not (integer? nc)) (= nc 1))
+ (table :width 100. :&skribe-eval-location loc
+ (make-column ie pref)))
+ (else
+ (table :width 100. :&skribe-eval-location loc
+ (make-sub-tables ie nc pref))))))
+ (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;* compiler-command ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-command bin . opts)
+ (disp :verb #t
+ (color :fg "red" (bold bin))
+ (map (lambda (o)
+ (list " [" (it o) "]"))
+ opts)
+ "..."))
+
+;*---------------------------------------------------------------------*/
+;* compiler-options ... */
+;*---------------------------------------------------------------------*/
+(define-markup (compiler-options bin)
+ (skribe-message " [executing: ~a --options]\n" bin)
+ (let ((port (open-input-file (format "| ~a --options" bin))))
+ (let ((opts (read port)))
+ (close-input-port port)
+ (apply description (map (lambda (opt) (item :key (bold (car opt))
+ (cadr opt) "."))
+ opts)))))
diff --git a/skribe/doc/user/bib.skb b/skribe/doc/user/bib.skb
new file mode 100644
index 0000000..a006a9b
--- /dev/null
+++ b/skribe/doc/user/bib.skb
@@ -0,0 +1,252 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/bib.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Dec 2 10:02:56 2001 */
+;* Last change : Tue Oct 26 21:41:19 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe index */
+;*=====================================================================*/
+
+(bibliography "user/src/bib1.sbib")
+
+;*---------------------------------------------------------------------*/
+;* Index */
+;*---------------------------------------------------------------------*/
+(chapter :title "Bibliographies"
+
+ (p [
+Skribe supports bibliographies. In order to use bibliography
+,(markup-ref "ref") it is needed to:])
+ (itemize
+ (item [
+Use the default pre-existing ,(emph "bibliography table") or create a
+custom one.])
+ (item [
+Provide a ,(emph "bibliography database").])
+ (item [
+Load the database by the mean of the ,(markup-ref "bibliography")
+Skribe function call.])
+ (item [
+Reference to a bibliography entry, with a ,(markup-ref "ref") Skribe
+function call.]))
+
+;*---------------------------------------------------------------------*/
+;* Bibliography tables */
+;*---------------------------------------------------------------------*/
+(section :title "Bibliography tables"
+
+ (p [
+This section describes the function of using and creating bibliography
+tables.])
+
+ (p [The predicate ,(code "bib-table?") returns ,(code "#t") if and only
+if its argument is a bibliography table as returned by
+,(markup-ref "make-bib-table") or ,(markup-ref "default-bib-table"). Otherwise
+,(code "bib-table?") returns ,(code "#f").])
+
+ (doc-markup 'bib-table?
+ '((obj [The value to be tested]))
+ :see-also '(make-bib-table default-bib-table bibliography the-bibliography)
+ :force-engines *api-engines*
+ :common-args '()
+ :source "../src/bigloo/bib.bgl")
+
+ (p [The function ,(code "default-bib-table") returns a global, pre-existing
+bibliography-table:])
+ (doc-markup 'default-bib-table
+ '()
+ :see-also '(bib-table? make-bib-table bibliography the-bibliography)
+ :force-engines *api-engines*
+ :common-args '()
+ :source "../src/bigloo/bib.bgl")
+
+ (p [The function ,(code "make-bib-table") constructs a new
+bibliography-table:])
+ (doc-markup 'make-bib-table
+ '((ident [The name of the bibliography table.]))
+ :see-also '(bib-table? default-bib-table bibliography the-bibliography)
+ :force-engines *api-engines*
+ :common-args '()
+ :source "../src/bigloo/bib.bgl"))
+
+;*---------------------------------------------------------------------*/
+;* bibliography ... @label bibliography@ */
+;*---------------------------------------------------------------------*/
+(section :title "Bibliography"
+
+(p [The function ,(code "bibliography") loads bibliography ,(param 'entries)
+into the Skribe memory. An ,(emph "entry") is either a list
+representing one entry (such as an article or book reference) or a
+string which denotes a file name that contains several
+entries. All the entries loaded in memory are available for the function
+,(ref :ident "ref" :node "references"). A bibliography database must be loaded
+,(emph "before") any reference is introduced. It is advised to place
+the ,(code "bibliography") Skribe function call before the call to the
+,(markup-ref "document") function call.])
+
+(doc-markup 'bibliography
+ `((:command ,[An external command to be applied when loading
+ the bibliography entries. The sequence ,(code "~a") is replaced
+ with the name of the file when the command is invoked.])
+ (:bib-table ,[The ,(ref :mark "make-bib-table" :text "table")
+ where entry is searched.])
+ (#!rest entry... ,[If ,(param 'entry) is a string, it denotes
+ a file containing the entry (see ,(ref :mark "skribe-bib-path"
+ :text "bibliograph path")). Otherwise, it is a list described
+ by the ,(ref :subsection "Bibliography syntax" :text "syntax")
+ below.]))
+ :see-also '(bib-table? make-bib-table default-bib-table the-bibliography)
+ :force-engines *api-engines*
+ :common-args '())
+
+(p [The ,(param :command) option can be used to import foreign bibliography.
+The following example, shows how to directly use a Bibtex bibliography
+using the ,(ref :section "Skribebibtex") translator.])
+
+(example-produce
+ (example :legend "Printing a bibliography" (prgm :file "src/bib6.skb")))
+
+
+;; bibliography syntax
+(subsection :title "Bibliography syntax"
+
+(p [The Skribe bibliography database uses a format very close to
+the Bibtex one. It is a parenthetic version of Bibtex. Here is the
+syntax of an entry:])
+
+(disp :verb #t :bg *prgm-skribe-color* [
+<entry> --> ,(bold "(")<kind> <key> <field>+,(bold ")")
+<kind> --> techreport | article | inproceedings | book
+<key> --> <symbol> | <string>
+<field> --> ,(bold "(")<symbol> <string>,(bold ")")])
+
+(p [Bibtex files cannot be directly loaded in Skribe but the tool
+,(ref :section "Skribebibtex" :text (tt "skribebibtex")) can be use to
+automatically convert Bibtex format to Skribe bibliography format.
+Here is an example of a simple Skribe database.])
+
+(prgm :file "src/bib1.sbib")))
+
+;*---------------------------------------------------------------------*/
+;* the-bibliography ... @label the-bibliography@ */
+;*---------------------------------------------------------------------*/
+(section :title "Printing a bibliography"
+
+(p [The function ,(code "the-bibliography") displays the bibliography. ])
+
+(doc-markup 'the-bibliography
+ `((:bib-table [The bibliography
+ ,(ref :mark "make-bib-table" :text "table") to be displayed.])
+ (:pred [A predicate filtering the bibliography entries. It takes
+ two parameters: the bibliography entry and the
+ ,(code "the-bibliography") node.])
+ (:sort [A function sorting a list of entries.])
+ (:count ,[The symbol ,(code "partial") or ,(code "full")
+ specifies the numbering to be applied. The value
+ ,(code "partial") tells Skribe to count only the entries
+ filtered in by ,(param :pred). The value ,(code "full")
+ tells Skribe to count all entries, event those filtered out
+ by ,(param :pred).]))
+ :see-also '(bib-table? make-bib-table default-bib-table bibliography)
+ :force-engines *api-engines*
+ :common-args '())
+
+(example-produce
+ (example :legend "Printing a bibliography" (prgm :file "src/bib2.skb"))
+ (disp (include "src/bib2.skb")))
+
+;; filtering bibliography
+(subsection :title "Filtering bibliography entries"
+(index "the-bibliography" :note "filtering")
+
+(p [The ,(param :pred) option is bound to a function of one argument
+that filters bibliography entries. It is used to control which entries
+must appears on a bibliography. The default behavior is to display
+only the entries referenced to in the text. For instance, in order to
+display ,(emph "all") the entries of a bibliography, is it needed to
+print the bibliography with a predicate returning always ,(code "#t").])
+
+(example-produce
+ (example :legend "Unfiltering bibliography entries" (prgm :file "src/bib3.skb"))
+ (disp (include "src/bib3.skb")))
+
+(p [The second example, filters out the entries that are not ,(emph "book")
+or that are not referenced to from the document.])
+
+(example-produce
+ (example :legend "Unfiltering bibliography entries" (prgm :file "src/bib4.skb"))
+ (disp (include "src/bib4.skb")))
+
+(p [The last example, illustrates how to change the rendering of a
+bibliography. It uses the ,(markup-ref "processor") construction
+and it defines two ,(ref :ident "writer" :text "writers") for
+displaying ,(code "&bib-entry-ident") and ,(code "&bib-entry-title")
+markups. These two markups are introduced by Skribe when it loads a
+bibliography. All fields of bibliography entries are represented by
+markups whose prefix are ,(code "&bib-entry-"). The parent of all these
+markups is the bibliography entry itself. The ,(code "&bib-entry-") markups
+are options of there parent.])
+
+(example-produce
+ (example :legend "Unfiltering bibliography entries" (prgm :file "src/bib5.skb"))
+ (disp (include "src/bib5.skb"))))
+
+;; sorting bibliography
+(subsection :title "Sorting bibliography entries"
+(index "the-bibliography" :note "sorting")
+
+(p [The ,(param :sort) option of the ,(markup-ref "the-bibliography")
+markup is used for sorting the bibliography entries. There are three
+pre-existing functions for sorting entries:])
+
+(doc-markup 'bib-sort/authors
+ '((l [The list of entries.]))
+ :force-engines *api-engines*
+ :source "../src/common/bib.scm"
+ :others '(bib-sort/idents bib-sort/dates)
+ :common-args '())
+
+(p [The first function sorts the entries according to an alphabetic ordering
+on authors. The second sorts according to an alphabetic ordering on
+entries identifier. The last one sorts according to entries date.])
+
+(example-produce
+ (example :legend "Sorting bibliography entries"
+ (prgm :file "src/common/bib.scm" :definition 'bib-sort/idents)))))
+
+;*---------------------------------------------------------------------*/
+;* skribebibtex */
+;*---------------------------------------------------------------------*/
+(section :title "Skribebibtex"
+(index "skribebibtex" :note "manual page")
+(index "bibtex")
+(p [
+In this section we present the Skribebibtex translator that compiles Bibtex
+source files into a Skribe bibliography.])
+
+;; Synopsis
+(subsection :title "SYNOPSIS" :number #f
+ (compiler-command *skribebibtex-bin* "options" "input"))
+
+;; Description
+(subsection :title "DESCRIPTION" :number #f [
+This manual page is not meant to be exhaustive. It
+documents the ,(tt "skribebibtex"), a tool that translates
+,(bold "Bibtex") files into ,(it "Skribe"), bibliography format. These
+files can be used by the ,(bold "skribe") compiler to produce
+bibliography entries.])
+
+;; Suffixes
+(subsection :title "SUFFIXES" :number #f [
+The ,(ref :chapter "Skribe compiler" :text "skribe") compiler uses file
+suffixes in order to select amongst its possible targets which to choose.
+These suffixes are:
+
+,(description (item :key (it ".bib") [a ,(bold "Bibtex") source file.]))])
+
+;; Options
+(subsection :title "OPTIONS" :number #f
+(compiler-options *skribebibtex-bin*))))
+
diff --git a/skribe/doc/user/char.skb b/skribe/doc/user/char.skb
new file mode 100644
index 0000000..85409f0
--- /dev/null
+++ b/skribe/doc/user/char.skb
@@ -0,0 +1,86 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/char.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Sep 6 16:07:08 2003 */
+;* Last change : Mon Feb 2 11:16:57 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Characters, strings and symbols */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Footnote ... */
+;*---------------------------------------------------------------------*/
+(section :title "Characters, Strings and Symbols" :file #t
+
+;*--- characters ------------------------------------------------------*/
+(subsection :title "Characters"
+
+(p [The function ,(code "char") introduces a ,(emph "character") in
+the produced document. The purpose of this function is to introduce
+escape characters or to introduce characters that cannot be typesetted
+in the document (for instance because the editors does not support
+them). The escapes characters are ,(code (char 91)), ,(code (char 93))
+and ,(code (char 59)).])
+
+(doc-markup 'char
+ '((char [The character to be introduced. Specified value can be
+a character, a string or an integer]))
+ :common-args '())
+
+(example-produce
+ (example :legend "Some characters" (prgm :file "src/api19.skb"))
+ (disp (include "src/api19.skb"))))
+
+
+;*--- Strings ---------------------------------------------------------*/
+(subsection :title "Strings"
+
+(p [the function ,(code "!") introduces raw strings in the target.
+That is, the strings introduced by ,(code "!") are written ,(emph "as is"),
+without any transformation from the engine.])
+
+(doc-markup '!
+ '((format [The format of the command.])
+ (#!rest node... "The arguments."))
+ :common-args '())
+
+(p [The sequences ,(code "$1"), ,(code "$2"), ... in the ,(param 'format)
+are replaced with the actual values of the arguments ,(param 'node).])
+
+(example-produce
+ (example :legend "Some characters" (prgm :file "src/api20.skb"))
+ (disp (include "src/api20.skb"))))
+
+;*--- Symbols ---------------------------------------------------------*/
+(subsection :title "Symbols"
+
+(p [The function ,(code "symbol") introduces special symbols in the
+produced file. Note that the rendering of symbols is unportable. It depends
+of the capacity of the targeted format.])
+
+(doc-markup 'symbol
+ '((symbol [The symbol to introduce.]))
+ :common-args '())
+
+(p [Here is the list of recognized symbols:])
+
+(center
+ (apply table
+ :width *prgm-width*
+ (tr :class 'api-symbol-prototype (th "Symbol name") (th "Rendering"))
+ (map (lambda (s)
+ (tr :bg *prgm-skribe-color*
+ (td :align 'left s)
+ (td :align 'left (symbol s))))
+ (sort (let ((t (make-hashtable)))
+ (for-each (lambda (e)
+ (for-each (lambda (s)
+ (hashtable-put! t (car s) (car s)))
+ (engine-symbol-table e)))
+ *api-engines*)
+ (hashtable->list t))
+ string<?))))))
+
+
diff --git a/skribe/doc/user/colframe.skb b/skribe/doc/user/colframe.skb
new file mode 100644
index 0000000..79b32f9
--- /dev/null
+++ b/skribe/doc/user/colframe.skb
@@ -0,0 +1,57 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/colframe.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Mon Apr 5 11:51:08 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe color and frame */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Frame and color */
+;*---------------------------------------------------------------------*/
+(section :title "Frame and color" :file #t
+
+(p [The function ,(code "frame") embeds a text inside a frame.
+The function ,(code "color") may also use the same purpose when it is
+specified a ,(code "bg") option. This is why both functions are included
+in the same Skribe manual section.])
+
+;*--- Frame -----------------------------------------------------------*/
+(subsection :title "Frame"
+
+(doc-markup 'frame
+ `((:width ,[The ,(ref :mark "width") of the frame.])
+ (:margin [The margin pixel size of the frame.])
+ (:border [The border pixel of the frame.])
+ (#!rest node... "The items of the enumeration."))
+ :see-also '(color table))
+
+(example-produce
+ (example :legend "The frame markup" (prgm :file "src/api12.skb"))
+ (disp (include "src/api12.skb"))))
+
+;*--- color -----------------------------------------------------------*/
+(subsection :title "Color"
+
+(p [The ,(code "color") markup enables changing ,(emph "locally") the
+text of the document. If the ,(code "bg") color is used, then, ,(code "color")
+acts as a container. Otherwise, it acts as an ,(ref :section "Ornaments").])
+
+(doc-markup 'color
+ `((:width ,[The ,(ref :mark "width") of the frame.])
+ (:margin [The margin pixel size of the frame.])
+ (:bg [The background color])
+ (:fg [The foreground color])
+ (#!rest node... "The items of the enumeration."))
+ :see-also '(frame table))
+(example-produce
+ (example :legend "The color markup" (prgm :file "src/api13.skb"))
+ (disp (include "src/api13.skb")))))
+
+
+
+
+
diff --git a/skribe/doc/user/document.skb b/skribe/doc/user/document.skb
new file mode 100644
index 0000000..09f8cb3
--- /dev/null
+++ b/skribe/doc/user/document.skb
@@ -0,0 +1,80 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/document.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 2 11:39:07 2003 */
+;* Last change : Wed Feb 4 14:51:12 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Document and author */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* dummy-document-output ... */
+;*---------------------------------------------------------------------*/
+(define dummy-document-output
+ (lambda (n e)
+ (let* ((a (markup-option n :author))
+ (t (markup-option n :title))
+ (b (markup-body n))
+ (ta (table (tr (map (lambda (n)
+ (td :valign 'top :align 'center n))
+ a)))))
+ (skribe-eval (center (bold t)) e)
+ (skribe-eval (center ta) e)
+ (output b e))))
+
+;*---------------------------------------------------------------------*/
+;* Document */
+;*---------------------------------------------------------------------*/
+(section :title "Building documents" :file #t
+
+;*--- document --------------------------------------------------------*/
+(subsection :title "Document"
+
+(p [The ,(tt "document") function defines a Skribe document.])
+
+(doc-markup 'document
+ '((:title "The title of the document.")
+ (:html-title "The title of window of the HTML browser.")
+ (:author "The authors of the document.")
+ (:ending "An ending text.")
+ (:env "A counter environment.")
+ (#!rest node... "The document nodes."))
+ :see-also '(author chapter toc))
+
+(example-produce
+ (example :legend "The document markup" (prgm :file "src/api2.skb"))
+ (disp
+ (processor :combinator
+ (lambda (e1 e2)
+ (let ((e (copy-engine 'document-engine e2)))
+ (markup-writer 'document e
+ :options '(:title :author :ending)
+ :action dummy-document-output)
+ e))
+ (include "src/api2.skb")))))
+
+;*---------------------------------------------------------------------*/
+;* Author ... */
+;*---------------------------------------------------------------------*/
+(subsection :title "Author"
+
+(p [The ,(tt "author") function is used to specify the authors of a Skribe
+document.])
+
+(doc-markup 'author
+ '((:name "The name of the author.")
+ (:title "His title.")
+ (:affiliation "His affiliation.")
+ (:email "His email.")
+ (:url "His web page.")
+ (:address "His address.")
+ (:phone "His phone number.")
+ (:photo "His photograph.")
+ (:align "The author item alignment."))
+ :see-also '(mailto ref))
+
+(example-produce
+ (example :legend "The author markup" (prgm :file "src/api3.skb"))
+ (disp (include "src/api3.skb")))))
diff --git a/skribe/doc/user/emacs.skb b/skribe/doc/user/emacs.skb
new file mode 100644
index 0000000..742fa87
--- /dev/null
+++ b/skribe/doc/user/emacs.skb
@@ -0,0 +1,58 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/emacs.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Nov 30 13:36:44 2001 */
+;* Last change : Sun Feb 29 16:12:32 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Editing Skribe programs */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Editing Skribe programs */
+;*---------------------------------------------------------------------*/
+(chapter :title "Editing Skribe Programs" (p [
+Skribe sources can be automatically generated from
+,(ref :url *texinfo-url* :text "Texinfo") by the ,(tt "skribeinfo") compiler.
+They can also be typed in. For this task, it is highly recommended to
+use ,(ref :url *emacs-url* :text "GNU Emacs") or
+,(ref :url *xemacs-url* :text "Xemacs").
+These editors provide parentheses matching and Skribe expressions
+handling.])
+
+;*---------------------------------------------------------------------*/
+;* Skribe emacs mode */
+;*---------------------------------------------------------------------*/
+(section :title "Skribe Emacs mode" [
+,(index "emacs" :note "skribe mode")
+
+The Skribe distribution contains a minor mode dedicated to
+Skribe edition. This mode provides ,(emph "fontification") and
+indentation of Skribe programs. In this manual, we present
+the two most important key bindings specific to this mode.
+
+,(itemize (item [,(color :fg "#007700" (kbd "tab")) Indents the current line.])
+ (item [,(color :fg "#007700" (kbd "M-C-q")) Indents a whole Skribe
+expression.]))
+
+,(p [In order to install the Skribe emacs mode, you need to specify that
+when the emacs Lisp ,(tt "skribe-mode") function is needed
+it has to be loaded from the ,(tt "skribe.el") file:])
+
+
+,(disp :verb #t (source :language lisp [
+(autoload 'skribe-mode "skribe.el" "Skribe mode." t)]))
+
+,(p [The ,(tt "skribe.el") file must in the path described by the Emacs Lisp
+,(tt "load-path") variable.])
+
+,(p [
+The ,(code "skribe") mode is a minor mode. It is intended to be used with
+a Lisp or Scheme mode. Hence, to use the ,(code "skribe") mode you will
+have to use the following Emacs commands:])
+
+,(disp :vert #t (source :language lisp [
+ESC-x: scheme-mode
+ESC-x: skribe-mode
+]))]))
diff --git a/skribe/doc/user/engine.skb b/skribe/doc/user/engine.skb
new file mode 100644
index 0000000..06be3c4
--- /dev/null
+++ b/skribe/doc/user/engine.skb
@@ -0,0 +1,135 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/engine.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 11:19:21 2003 */
+;* Last change : Mon Nov 8 15:07:35 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The description of the Skribe engines */
+;*=====================================================================*/
+;; @indent: (put 'doc-markup 'skribe-indent 'skribe-indent-function)@
+
+(cond-expand
+ (bigloo
+ (define *engine-src* "../src/bigloo/engine.scm")
+ (define *types-src* "../src/bigloo/types.scm"))
+ (stklos
+ (define *engine-src* "../src/stklos/engine.stk")
+ (define *types-src* "../src/stklos/types.stk")))
+
+;*---------------------------------------------------------------------*/
+;* Engine */
+;*---------------------------------------------------------------------*/
+(chapter :title "Engines"
+
+ (p [When Skribe produces a document in a given format, it uses a
+specialize engine. For instance, when a Web page is made from a Skribe
+document, the HTML engine is used. The engines provided by Skribe are
+given below:])
+
+ (resolve (lambda (n e env)
+ (let* ((current-chapter (ast-chapter n))
+ (body (map (lambda (x) (if (pair? x) (car x) x))
+ (markup-body current-chapter)))
+ (sects (filter (lambda (x) (is-markup? x 'section))
+ body)))
+ (itemize
+ (map (lambda (x)
+ (let ((title (markup-option x :title)))
+ (item (ref :text title :section title))))
+ sects)))))
+
+ (section :title "Functions dealing with engines"
+
+ (subsection :title "Creating engines"
+ (p [The function ,(code "make-engine") creates a brand new engine.])
+
+ (doc-markup 'make-engine
+ '((ident [The name (a symbol) of the new engine.])
+ (:version [The version number.])
+ (:format [The output format (a string) of this engine.])
+ (:filter [A string filter (a function).])
+ (:delegate [A delegate engine.])
+ (:symbol-table [The engine symbol table.])
+ (:custom [The engine custom list.])
+ (:info [Miscellaneous.]))
+ :common-args '()
+ :source *engine-src*
+ :idx *function-index*)
+
+ (p [The function ,(code "copy-engine") duplicates an existing engine.])
+ (doc-markup 'copy-engine
+ '((ident [The name (a symbol) of the new engine.])
+ (e [The old engine to be duplicated.])
+ (:version [The version number.])
+ (:filter [A string filter (a function).])
+ (:delegate [A delegate engine.])
+ (:symbol-table [The engine symbol table.])
+ (:custom [The engine custom list.]))
+ :common-args '()
+ :source *engine-src*
+ :idx *function-index*))
+
+ (subsection :title "Retrieving engines"
+
+ (p [The ,(code "find-engine") function searches in the list of defined
+engines. It returns an ,(code "engine") object on success and ,(code "#f")
+on failure.])
+ (doc-markup 'find-engine
+ '((id [The name (a symbol) of the engine to be searched.])
+ (:version [An optional version number for the searched engine.]))
+ :common-args '()
+ :source *engine-src*
+ :idx *function-index*))
+
+ (subsection :title "Engine accessors"
+ (p [The predicate ,(code "engine?") returns ,(code "#t") if its
+argument is an engine. Otherwise, it returns ,(code "#f"). In other words,
+,(code "engine?") returns ,(code "#t") for objects created by
+,(code "make-engine"), ,(code "copy-engine"), and ,(code "find-engine").])
+ (doc-markup 'engine?
+ '((obj [The checked object.]))
+ :common-args '()
+ :source *types-src*
+ :idx *function-index*)
+
+ (p [The following functions return information about engines.])
+
+ (doc-markup 'engine-ident
+ '((obj [The engine.]))
+ :common-args '()
+ :others '(engine-format engine-customs engine-filter engine-symbol-table)
+ :source *types-src*
+ :idx *function-index*))
+
+ (subsection :title "Engine customs"
+
+ (p [Engine customs are locations where dynamic informations relative
+to engines can be stored. Engine custom can be seen a global variables that
+are specific to engines. The function ,(code "engine-custom") returns the
+value of a custom or ,(code "#f") if that custom is not defined. The
+function ,(code "engine-custom-set!") defines or sets a new value for
+a custom.])
+
+ (doc-markup 'engine-custom
+ `((e ,[The engine (as returned by
+,(ref :mark "find-engine" :text (code "find-engine"))).])
+ (id [The name of the custom.]))
+ :common-args '()
+ :source *engine-src*
+ :idx *function-index*)
+
+ (doc-markup 'engine-custom-set!
+ `((e ,[The engine (as returned by
+,(ref :mark "find-engine" :text (code "find-engine"))).])
+ (id [The name of the custom.])
+ (val [The new value of the custom.]))
+ :common-args '()
+ :source *engine-src*
+ :idx *function-index*)))
+
+ ;; existing engines
+ (include "htmle.skb")
+ (include "latexe.skb")
+ (include "xmle.skb"))
diff --git a/skribe/doc/user/enumeration.skb b/skribe/doc/user/enumeration.skb
new file mode 100644
index 0000000..01155e2
--- /dev/null
+++ b/skribe/doc/user/enumeration.skb
@@ -0,0 +1,33 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/enumeration.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Fri Sep 12 15:31:37 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe enumerations */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Justification */
+;*---------------------------------------------------------------------*/
+(section :title "Enumeration" :file #t
+
+(p [These functions implements three various style of enumerations.])
+
+(doc-markup 'itemize
+ '((:symbol [The symbol that prefixes the items.])
+ (#!rest item... "The items of the enumeration."))
+ :others '(enumerate description))
+
+(p [Items are introduce by the means of the ,(code "item") markup:])
+
+(doc-markup 'item
+ '((:key [The item key.])))
+
+;; FIXME: Rien n'est fait en html sur le type de bullet. Mais peut on faire?
+(example-produce
+ (example :legend "The enumeration markups" (prgm :file "src/api11.skb"))
+ (disp (include "src/api11.skb"))))
+
diff --git a/skribe/doc/user/examples.skb b/skribe/doc/user/examples.skb
new file mode 100644
index 0000000..a37ece4
--- /dev/null
+++ b/skribe/doc/user/examples.skb
@@ -0,0 +1,34 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/examples.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 13:35:34 2003 */
+;* Last change : Tue Feb 3 14:52:33 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The list of examples */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Examples */
+;*---------------------------------------------------------------------*/
+(chapter :title "List of examples"
+
+(resolve (lambda (n e env)
+ (let* ((d (ast-document n))
+ (ex (container-env-get d 'example-env)))
+ (table (map (lambda (e)
+ (tr (td :align 'left
+ (markup-option e :number)
+ ". "
+ (ref :handle (handle e)
+ :text (markup-option e :legend))
+ " (chapter "
+ (let ((c (ast-chapter e)))
+ (ref :handle (handle c)
+ :text (markup-option c :title)))
+ ")")))
+ (sort ex
+ (lambda (e1 e2)
+ (< (markup-option e1 :number)
+ (markup-option e2 :number))))))))))
diff --git a/skribe/doc/user/figure.skb b/skribe/doc/user/figure.skb
new file mode 100644
index 0000000..08fbdd5
--- /dev/null
+++ b/skribe/doc/user/figure.skb
@@ -0,0 +1,58 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/figure.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Fri Sep 12 15:31:48 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe figures */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Figure ... @label figure@ */
+;*---------------------------------------------------------------------*/
+(section :title "Figure" :file #t
+
+(doc-markup 'figure
+ `((:legend ,[The legend of the figure. If no ,(param :ident) is
+ provided to the figure, it uses the legend value as an
+ identifier. In consequence, it is possible to use the
+ ,(param :legend) value in
+ ,(ref :mark "ref" :text "references").])
+ (:number ,[If the optional argument ,(param :number) is a number,
+ that number is used as the new Scribe compiler figure
+ counter. If it is ,(tt "#t") the compiler automatically
+ sets a number for that figure. If it is ,(tt "#f") the
+ figure is numberless.])
+ (:multicolumns ,[A boolean that indicates, for back-ends
+ supporting multi-columns rendering (e.g., "TeX"), if the figure
+ spans over all the columns.])
+ (#!rest body [The body of the figure.]))
+
+ :see-also '(ref document))
+
+(example-produce
+ (example :legend "The figure markup" (prgm :file "src/api14.skb"))
+ (disp (include "src/api14.skb")))
+
+;*--- List of figures -------------------------------------------------*/
+(subsection :title "List of figures"
+(index "figure" :note "list of figures")
+
+(p [Skribe has no builtin facility for displaying the list of figures.
+Instead, it provides a general machinery for displaying any kind of lists
+contained in the document. This is described in the section ,(ref
+:section "Resolve") and ,(ref :section "Introspection") but for the
+sake of the coherence, this section also contains an example that
+shows how to display the list of figures of a document.])
+
+(example-produce
+ (example :legend "The figure markup" (prgm :file "src/api15.skb"))
+ (disp (include "src/api15.skb")))))
+
+
+
+
+
+
diff --git a/skribe/doc/user/font.skb b/skribe/doc/user/font.skb
new file mode 100644
index 0000000..df0bfed
--- /dev/null
+++ b/skribe/doc/user/font.skb
@@ -0,0 +1,30 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/font.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Fri Sep 12 15:31:25 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe font */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Font */
+;*---------------------------------------------------------------------*/
+(section :title "Font" :file #t
+
+(p [The function ,(code "font") enables font selection.])
+
+(doc-markup 'font
+ '((:size [The size of the font. The size may be ,(emph "relative")
+(with respect to the current font size) or absolute. A relative
+font is either specified with a floating point value or a negative
+integer value. A positive integer value specifies an absolute font size.])
+ (:face [The name of the font to be used.])
+ (#!rest node... "The nodes of the font.")))
+
+(example-produce
+ (example :legend "The font markup" (prgm :file "src/api9.skb"))
+ (disp (include "src/api9.skb"))))
+
diff --git a/skribe/doc/user/footnote.skb b/skribe/doc/user/footnote.skb
new file mode 100644
index 0000000..96101f3
--- /dev/null
+++ b/skribe/doc/user/footnote.skb
@@ -0,0 +1,28 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/footnote.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Sep 6 15:43:24 2003 */
+;* Last change : Fri Sep 12 15:32:13 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe footnotes. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Footnote ... */
+;*---------------------------------------------------------------------*/
+(section :title "Footnote" :file #t
+
+(p [By default, footnotes appear at the bottom of the page that contains
+the reference to the footnote.])
+
+(doc-markup 'footnote
+ `((:number [The number of the footnote.])
+ (#!rest text... [The text of the footnote.]))
+ :see-also '(document chapter section))
+
+(example-produce
+ (example :legend "A footnote" (prgm :file "src/api18.skb"))
+ (disp (include "src/api18.skb"))))
+
diff --git a/skribe/doc/user/htmle.skb b/skribe/doc/user/htmle.skb
new file mode 100644
index 0000000..b5d0b0e
--- /dev/null
+++ b/skribe/doc/user/htmle.skb
@@ -0,0 +1,111 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/htmle.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 11:20:49 2003 */
+;* Last change : Wed Oct 27 12:05:53 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The documentation of the html engine */
+;*=====================================================================*/
+;; @indent: (put 'doc-engine 'skribe-indent 'skribe-indent-function)@
+
+;*---------------------------------------------------------------------*/
+;* Document */
+;*---------------------------------------------------------------------*/
+(section :title "Html engine" :file #t
+ (mark "html-engine")
+ (index "Html" :note "Engine")
+ (p [The html engine...])
+
+ (subsection :title "The HTML customization"
+
+ (doc-engine 'html
+ `((favicon ,[The name of an image file of the URL image. The
+,(code "favicon") custom can be either bound to a string
+which is the name of the image, or to a procedure of
+two arguments, a node and an engine that returns the file name
+of the icon. This can be used to use different icons per
+chapter or section.])
+ (charset [The character set used for the document.])
+ (javascript [Enable/disable Javascript support.])
+ (head [A string included in the HTML header.])
+ (css ,[The URL or a list of URLs of
+,(ref :url "http://www.w3.org/TR/REC-CSS2/" :text "CSS")
+used by the document.])
+ (inline-css ,[The file or a list of files inlined
+inside the header's style section. The custom ,(code "inline-css") should be
+used in replacement of the ,(code "css") custom in order to produce
+stand alone HTML documents.])
+ (js ,[A URL or a list of URLs of JavaScript programs used by
+the document.])
+ (emit-sui [Emit a SUI file for this document.])
+ (background "The background color of the document.")
+ (foreground "The foreground color of the document.")
+ ;; the margins
+ (margin-padding "Margins padding.")
+ (left-margin "A procedure of two arguments producing the left margin of the document.")
+ (chapter-left-margin "A procedure of two arguments producing the left margin of the document.")
+ (section-left-margin "A procedure of two arguments producing the left margin of the document.")
+ (left-margin-font "The font of the left margin.")
+ (left-margin-size ,[The ,(ref :mark "width" :text "width") of the left margin.])
+ (left-margin-background "The background color of the left margin.")
+ (left-margin-foreground "The foreground color of the left margin.")
+ (right-margin "A procedure of two arguments producing the right margin of the document.")
+ (chapter-right-margin "A procedure of two arguments producing the right margin of the document.")
+ (section-right-margin "A procedure of two arguments producing the right margin of the document.")
+ (right-margin-font "The font of the right margin.")
+ (right-margin-size ,[The ,(ref :mark "width" :text "width") of the right margin.])
+ (right-margin-background "The background color of the right margin.")
+ (right-margin-foreground "The foreground color of the right margin.")
+ ;; author configuration
+ (author-font "The author font.")
+ ;; title configuration
+ (title-font "The title font.")
+ (title-background "The title background color.")
+ (title-foreground "The title foreground color.")
+ (file-title-separator "A text to be inserted in between the document title and the chapter or section title when the chapter or section is rendered in a separate file.")
+ ;; index configuration
+ (index-header-font-size "The index header font size.")
+ ;; chapter configuration
+ (chapter-number->string "A procedure of one argument for rendering chapter numbers.")
+ (chapter-file ,[A boolean specifying if chapters are rendered in speparate html file (see ,(markup-ref "chapter") markup).])
+ ;; section configuration
+ (section-title-start "The HTML sequence for starting section title.")
+ (section-title-stop "The HTML sequence for stopping section title.")
+ (section-title-background "The background color of section title.")
+ (section-title-foreground "The foreground color of section title.")
+ (section-title-number-separator "The section title number separator.")
+ (section-number->string "A procedure of one argument for rendering section numbers.")
+ (section-file ,[A boolean specifying if sections are rendered in speparate html file (see ,(markup-ref "section") markup).])
+ ;; subsection configuration
+ (subsection-title-start "The HTML sequence for starting subsection title.")
+ (subsection-title-stop "The HTML sequence for stopping subsection title.")
+ (subsection-title-background "The background color of subsection title.")
+ (subsection-title-foreground "The foreground color of subsection title.")
+ (subsection-title-number-separator "The subsection title number separator.")
+ (subsection-number->string "A procedure of one argument for rendering subsection numbers.")
+ (subsection-file ,[A boolean specifying if subsections are rendered in speparate html file (see ,(markup-ref "subsection") markup).])
+ ;; subsubsection configuration
+ (subsubsection-title-start "The HTML sequence for starting subsubsection title.")
+ (subsubsection-title-stop "The HTML sequence for stopping subsubsection title.")
+ (subsubsection-title-background "The background color of subsubsection title.")
+ (subsubsection-title-foreground "The foreground color of subsubsection title.")
+ (subsubsection-title-number-separator "The subsubsection title number separator.")
+ (subsubsection-number->string "A procedure of one argument for rendering subsubsection numbers.")
+ (subsubsection-file ,[A boolean specifying if subsubsections are rendered in speparate html file (see ,(markup-ref "subsubsection") markup).])
+ ;; source fontification
+ (source-color ,[A boolean enabling/disabling color of source code (see ,(markup-ref "source") markup).])
+ (source-comment-color "The source comment color.")
+ (source-error-color "The source error color.")
+ (source-define-color "The source define color.")
+ (source-module-color "The source module color.")
+ (source-markup-color "The source markup color.")
+ (source-thread-color "The source thread color.")
+ (source-string-color "The source string color.")
+ (source-bracket-color "The source bracket color.")
+ (source-type-color "The source type color.")
+ (image-format "The image formats for this engine."))
+ :source "skr/html.skr")))
+
+
diff --git a/skribe/doc/user/image.skb b/skribe/doc/user/image.skb
new file mode 100644
index 0000000..d08ad18
--- /dev/null
+++ b/skribe/doc/user/image.skb
@@ -0,0 +1,79 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/image.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Sat Jan 17 18:08:15 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe images */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Image ... @label image@ */
+;*---------------------------------------------------------------------*/
+(section :title "Image" :file #t
+
+(p [Images are defined by the means of the ,(code "image") function])
+
+(doc-markup 'image
+ `((:file ,[The file where the image is stored on the disk
+ (see ,(ref :mark "skribe-image-path"
+ :text "image path")).
+ The image is converted
+ (see ,(markup-ref "convert-image")) into a format
+ supported by the engine. This option is exclusive
+ with the ,(param :url) option.])
+ (:url [The URL of the file. This option is exclusive with the
+ ,(param :file) option.])
+ (:width [The width of the image. It may be an integer for a pixel
+ size or a floating point number for a percentage.])
+ (:height [The height of the image. It may be an integer for a
+ pixel size or a floating point number for a
+ percentage.])
+ (:zoom [A zoom factor.])
+ (#!rest comment [A text describing the image.]))
+ :see-also '(skribe-image-path convert-image))
+
+(example-produce
+ (example :legend "The image markup" (prgm :file "src/api16.skb"))
+ (disp (include "src/api16.skb")))
+
+;*--- Image format ----------------------------------------------------*/
+(subsection :title "Image formats"
+ (index "image" :note "conversion")
+
+ (p [
+Images are unfortunately ,(emph "unportable"). The various Skribe output
+formats support different image formats. For instance, HTML supports
+,(code "gif") and ,(code "jpeg") while the LaTeX back-end only supports
+,(code "ps"). Skribe tries, only when needed, to automatically
+,(emph "convert") images to a format supported by the target
+to be produced. For this, it uses external tools. The default Skribe
+translation scheme is:])
+(itemize (item [Do not translate an image that needs no conversion.])
+ (item [Uses the ,(code "fig2dev") external tool to translate
+ ,(code "Xfig") images.])
+ (item [Uses the ,(code "convert") external tools to translate all
+ other formats.]))
+
+ (p [,(ref :chapter "Engines" :text "Engines") support different image
+formats. Each engine may specify a converter to be applied to an image.
+The engine custom ,(code "image-format") specifies the list of supported
+image formats. This list is composed of a suffix such as ,(code "jpeg") or
+,(code "gif").])
+
+ (p [The function ,(code "convert-image") tries to convert an
+image according to a list of formats. All the specified formats are
+successively tried. On the first success, the function ,(code "convert-image")
+returns the name of the new converted image. On failure, it returns
+,(code "#f").])
+ (doc-markup 'convert-image
+ `((file [The image file to be converted. The file is
+searched in the ,(ref :mark "skribe-image-path" :text "image path").])
+ (formats [A list of formats into which images are converted to.]))
+ :common-args '()
+ :source "../src/bigloo/lib.bgl"
+ :see-also '(skribe-image-path)
+ :idx *function-index*)))
+
diff --git a/skribe/doc/user/index.skb b/skribe/doc/user/index.skb
new file mode 100644
index 0000000..dd5e8fa
--- /dev/null
+++ b/skribe/doc/user/index.skb
@@ -0,0 +1,118 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/index.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Dec 2 10:02:56 2001 */
+;* Last change : Mon Feb 23 18:59:00 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe indexes */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Index */
+;*---------------------------------------------------------------------*/
+(chapter :title "Indexes" (p [
+Skribe support indexes. One may accumulate all entries inside one
+unique index or dispatch them amongst user declared indexes. Indexes
+may be ,(emph "monolithic") or ,(emph "split"). They only differ in
+the way they are rendered by the back-ends. For a split index a sectioning
+based on the specific (e.g., "the first one") character of
+index entries is deployed.])
+
+;*---------------------------------------------------------------------*/
+;* make-index ... @label make-index@ */
+;*---------------------------------------------------------------------*/
+(section :title "Making indexes"
+
+(p [The function ,(code "make-index") declares a new index.])
+
+(doc-markup 'make-index
+ '((ident "A string, the name the index (currently unused)."))
+ :common-args '()
+ :see-also '(default-index index the-index ref mark))
+
+(p [For instance, the following Skribe expression declares an index named
+,(tt "*index1*"):])
+
+(example-produce
+ (example :legend "Creation of a new index" (prgm :file "src/index1.skb")))
+
+(include "src/index1.skb")
+
+(p [This example produces no output but enables entries to be added to that
+index. In general it is convenient to declare indexes ,(emph "before")
+the call to the ,(markup-ref "document") function.])
+
+(p [The function ,(code "default-index") returns the default index
+that pre-exists to all execution.])
+
+(doc-markup 'default-index
+ '()
+ :common-args '()
+ :source "src/common/index.scm"))
+
+;*---------------------------------------------------------------------*/
+;* Index ... @label index@ */
+;*---------------------------------------------------------------------*/
+(section :title "Adding entries to an index"
+
+(p [The function ,(code "index") adds a new entry into one existing
+index and sets a mark in the text where the index will point to. It is
+an error to add an entry into an index that is not already declared.])
+
+(doc-markup 'index
+ '((:index [The name of the index whose index entry belongs to.
+ A value of ,(tt "#f") means that the
+ ,(markup-ref :mark "default-index") owns this entry.])
+ (:note [An optional note added to the index entry. This note
+ will be displayed in the index printing.])
+ (:shape [An optional shape to be used for rendering the entry.])
+ (:url [An optional URL that is referenced in the index table
+ instead of the location of the ,(code "index").])
+ (#!rest name [The name of the entry. This must be a string.]))
+ :see-also '(make-index default-index the-index))
+
+(p [The following expressions add entries to the index ,(code "*index1*"):])
+
+(example-produce
+ (example :legend "Adding entries to an index" (prgm :file "src/index2.skb")))
+
+(include "src/index2.skb")
+
+(p [There is no output associated with these expressions.]))
+
+;*---------------------------------------------------------------------*/
+;* Print-index ... @label the-index@ */
+;*---------------------------------------------------------------------*/
+(section :title "Printing indexes"
+
+ (p [The function ,(code "the-index") displays indexes in the produced
+document.])
+
+ (doc-markup 'the-index
+ '((:split [If ,(tt "#t"), character based sectioning is deployed.
+ Otherwise all the index entries are displayed one next to
+ the other.])
+ (:char-offset [The character number to use when split is
+ required. This option may be useful when printing index whose
+ items share a common prefix. The ,(param :char-offset)
+ argument can be used to skip this prefix.])
+ (:header-limit [The number of entries from which an index header
+ is introduced.])
+ (:column [The number of columns of the index.])
+ (#!rest index... [The indexes to be displayed. If index
+ is provided, the global index ,(markup-ref "default-index")
+ is printed.])))
+
+ (p [If the engine custom
+,(ref :chapter "Engines" :text (code "index-page-ref")) is true when a
+index is rendered then, page reference framework is used instead of
+a direct reference framework.])
+
+(example-produce
+ (example :legend "Printing indexes" (prgm :file "src/index3.skb"))
+ (disp (include "src/index3.skb")))
+
+(p [See the Skribe ,(ref :mark "global index" :text "global index") for
+a real life index example.])))
diff --git a/skribe/doc/user/justify.skb b/skribe/doc/user/justify.skb
new file mode 100644
index 0000000..94db7d5
--- /dev/null
+++ b/skribe/doc/user/justify.skb
@@ -0,0 +1,30 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/justify.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 11:53:32 2003 */
+;* Last change : Fri Sep 12 15:31:31 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe justification */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Justification */
+;*---------------------------------------------------------------------*/
+(section :title "Justification" :file #t
+
+(p [These functions control the text layout. The default layout is text
+justification.])
+
+(doc-markup 'flush
+ '((:side [The possible values for the side justification
+ are ,(tt "left"), ,(tt "center") or ,(tt "right").])
+ (#!rest node... "The nodes of the font."))
+ :others '(center pre)
+ :see-also '(linebreak table prog))
+
+(example-produce
+ (example :legend "The justification markups" (prgm :file "src/api10.skb"))
+ (disp (include "src/api10.skb"))))
+
diff --git a/skribe/doc/user/latexe.skb b/skribe/doc/user/latexe.skb
new file mode 100644
index 0000000..f53737b
--- /dev/null
+++ b/skribe/doc/user/latexe.skb
@@ -0,0 +1,60 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/latexe.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 11:20:49 2003 */
+;* Last change : Tue Apr 6 06:28:59 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The documentation of the html engine */
+;*=====================================================================*/
+;; @indent: (put 'doc-engine 'skribe-indent 'skribe-indent-function)@
+
+;*---------------------------------------------------------------------*/
+;* Document */
+;*---------------------------------------------------------------------*/
+(section :title "LaTeX engine" :file #t
+ (mark "latex-engine")
+ (index "LaTeX" :note "Engine")
+ (p [The LaTeX engine...])
+
+
+ (subsection :title "The LaTeX customization"
+
+ (doc-engine 'latex
+ `((documentclass ,[A string declaring The LaTeX document class.])
+ (usepackage ,[The boolean ,(code "#f") if no package is used or a string declaring The LaTeX packages.])
+ (predocument ,[The boolean ,(code "#f") or a string to be written before the \\begin{document} statement.])
+ (postdocument ,[The boolean ,(code "#f") or a string to be written after the \\begin{document} statement.])
+ (maketitle ,[The boolean ,(code "#f") or a string to be written after the \\begin{document} statement for emitting the document title.])
+ (color [Enable/disable colors.])
+ (%font-size #f)
+ ;; source fontification
+ (source-color ,[A boolean enabling/disabling color of source code (see ,(markup-ref "source") markup).])
+ (source-comment-color "The source comment color.")
+ (source-error-color "The source error color.")
+ (source-define-color "The source define color.")
+ (source-module-color "The source module color.")
+ (source-markup-color "The source markup color.")
+ (source-thread-color "The source thread color.")
+ (source-string-color "The source string color.")
+ (source-bracket-color "The source bracket color.")
+ (source-type-color "The source type color.")
+ (color-usepackage "The LaTeX package for coloring.")
+ (hyperref "Enables/disables hypererrf.")
+ (hyperref-usepackage "The LaTeX package for hyperref.")
+ (image-format "The image formats for this engine.")
+ (index-page-ref "Indexes use page references."))
+ :source "skr/latex.skr"))
+
+ (subsection :title "LaTeX documentclass"
+
+ (p [The default setting of the Skribe LaTeX engine is to produce
+a document using the ,(code "article") document class. In order to
+generate a document using ,(code "chapter") this must be changed because
+this LaTeX style does not define any ,(code "\\chapter") function. For
+instance, one may use the LaTeX ,(code "book") document class. Changing
+this setting can be done with expressions such as:
+,(prgm :language skribe [
+(let ((le (find-engine 'latex)))
+ (engine-custom-set! le 'documentclass "\\\\documentclass{book}"))])])))
diff --git a/skribe/doc/user/lib.skb b/skribe/doc/user/lib.skb
new file mode 100644
index 0000000..499ca61
--- /dev/null
+++ b/skribe/doc/user/lib.skb
@@ -0,0 +1,156 @@
+;;;;
+;;;; Standard Library
+;;;;
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 21-Nov-2003 07:20 (eg)
+;;;; Last file update: 21-Nov-2003 10:17 (eg)
+
+
+(chapter :title "Standard Library"
+
+ (p [This section describes the Skribe standard library])
+
+;;;
+(section :title "File functions"
+
+ (p [The function ,(code "include") is particularily useful to spread a
+long document amongst several files.])
+
+ (doc-markup 'include
+ '((file [The file containing the nodes to be included.
+These nodes are included in the document in place of the ,(code "include")
+call.]))
+ :common-args '()
+ :see-also '(skribe-load skribe-path skribe-path-set!)
+ :idx *function-index*)
+
+ (p [The given file is searched in the current
+,(ref :mark "skribe-path" :text "Skribe path")])
+
+ (p [The function ,(code "skribe-load") is generally used to load in the
+Skribe memory, a package or an extension. In general the prelude of a
+Skribe document (the expressions placed before the ,(markup-ref "document")
+call) contains several ,(code "skribe-load"). The file is search
+in the ,(ref :mark "skribe-path" :text "Skribe path").])
+
+ (doc-markup 'skribe-load
+ `((file [The file containing the expressions to be loaded.])
+ (:engine [The engine used to evaluate the expressions.])
+ (:path ,[The optional path where to find the file. The default
+ path is ,(markup-ref "skribe-path").])
+ (#!rest opt... [Additional user options.]))
+ :source "../src/bigloo/eval.scm"
+ :common-args '()
+ :see-also '(skribe-load-options skribe-path skribe-path-set!)
+ :idx *function-index*)
+
+ (p [Returns the user of options of the last call to
+,(markup-ref "skribe-load")])
+ (doc-markup 'skribe-load-options
+ '()
+ :source "../src/bigloo/eval.scm"
+ :common-args '()
+ :see-also '(skribe-load)
+ :idx *function-index*)
+
+ (p [Skribe provides functions for dealing with paths. These functions
+are related to the path that can be specified on the command line,
+when the Skribe compiler is invoked (see Chapter
+,(ref :chapter "Skribe compiler").)])
+
+ (doc-markup 'skribe-path
+ '()
+ :source "../src/bigloo/eval.scm"
+ :common-args '()
+ :others '(skribe-image-path skribe-bib-path skribe-source-path)
+ :see-also '(include skribe-load image source bibliography skribe-path-set! skribe-image-path-set! skribe-bib-path-set! skribe-source-path-set!)
+ :idx *function-index*)
+
+ (p [The function ,(code "skribe-path-set!") sets a new path.])
+ (doc-markup 'skribe-path-set!
+ '((path [A list of strings which is the new Skribe search path.]))
+ :source "../src/bigloo/eval.scm"
+ :common-args '()
+ :others '(skribe-image-path-set! skribe-bib-path-set! skribe-source-path-set!)
+ :see-also '(skribe-path skribe-image-path skribe-bib-path skribe-source-path)
+ :idx *function-index*))
+
+;;; Misc
+(section :title "Misc. Functions"
+
+ (p [The function ,(code "skribe-release") returns the Skribe version
+as a string])
+ (doc-markup 'skribe-release
+ '()
+ :common-args '()
+ :source #f
+ :def '(define (skribe-release) ...)
+ :idx *function-index*)
+
+ (p [For instance, the following piece of code:])
+ (prgm :language skribe
+ "[This manual documents the ,(bold (skribe-release)) Skribe release]")
+ (p [produces the following output])
+ (disp [This manual documents the ,(bold (skribe-release)) Skribe release]))
+
+ (p [The function ,(code "skribe-configure") accesses the whole
+Skribe configuration. It can be used to ,(emph "get") or ,(emph "check")
+the configuration.])
+
+ (doc-markup 'skribe-configure
+ '((opt... [Optional arguments.]))
+ :common-args '()
+ :source #f
+ :def '(define (skribe-configure . opt...) ...)
+ :idx *function-index*)
+
+ (p [The function ,(code "skribe-configure") can be used in three distinct
+ways depending on the number of provided arguments:])
+
+ (enumerate
+ (item [If no argument is provided, ,(code "skribe-configure") returns
+a fresh list of Skribe configuration.])
+ (item [If one keyword argument is provided, ,(code "skribe-configure")
+returns the value associated with this keyword in the configuration list.
+If this value does not exist, it returns the symbol ,(code "void").])
+ (item [(code "skribe-configure") is invoked with a list composed
+of ,(emph "keyword") ,(emph "value"). The actual configuration is checked
+against the provided values. Values are compared with ,(code "equal") except
+if the value to check has to be compared with a procedure. In that particular
+case the value of the check is the value produces by ,(emph "applying") the
+function to the actual value. The result of ,(code "skribe-configure") is a
+boolean.]))
+
+ (p [Here are some examples.])
+ (prgm :language skribe [
+;; fetch the whole configuration list
+(skribe-configure)
+
+;; fetch the release number
+(skribe-configure :release)
+
+;; test if the release number is 1.0b
+(skribe-configure :release "1.0b")
+
+;; test if the release number is greater or equal than "1.0b"
+(skribe-configure :release (lambda (v) (string>=? v "1.0b")))
+
+;; test if the release number is greater or equal than "1.0b"
+;; and the implementation is bigloo
+(skribe-configure :release (lambda (v) (string>=? v "1.0b")) :scheme "bigloo")])
+
+ (p [The function ,(code "skribe-enforce-configure") checks for the Skribe
+configuration. In case of mismatch, it raises an error. The syntax of the
+arguments if the same as that of ,(code "skribe-configure") when invoked
+with several arguments.])
+
+ (doc-markup 'skribe-enforce-configure
+ '((opt... [Optional arguments.]))
+ :common-args '()
+ :source #f
+ :def '(define (skribe-enforce-configure . opt...) ...)
+ :idx *function-index*))
+
+
+
diff --git a/skribe/doc/user/line.skb b/skribe/doc/user/line.skb
new file mode 100644
index 0000000..85f84dd
--- /dev/null
+++ b/skribe/doc/user/line.skb
@@ -0,0 +1,39 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/line.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 4 10:08:08 2003 */
+;* Last change : Thu Sep 4 13:29:49 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Line breaks */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Line breaks */
+;*---------------------------------------------------------------------*/
+(section :title "Line breaks" :file #t
+
+(p [Line breaks and horizontal rules enable text cutting.])
+
+;*--- linebreak -------------------------------------------------------*/
+(subsection :title "Linebreak"
+
+(p [The Skribe function ,(code "linebreak") is unportable. Even if
+most engines handle it for their code production, using ,(code "linebreak")
+generally produces expected result. For instance, using ,(code "linebreak")
+with an engine producing LaTeX code is bound to fail. In consequence,
+as much as possible, one should prefer other ways for splitting a text])
+
+(doc-markup 'linebreak
+ '((#!rest num "The number of line breaks."))
+ :see-also '(paragraph table)))
+
+;*--- Horizontal rule -------------------------------------------------*/
+(subsection :title "Horizontal rule"
+
+(doc-markup 'hrule
+ `((:width ,[The ,(ref :mark "width") of the horizontal rule.])
+ (:height [The thickness of the rule. A positive integer
+ value stands for a number of pixels.])))))
+
diff --git a/skribe/doc/user/links.skb b/skribe/doc/user/links.skb
new file mode 100644
index 0000000..b454f28
--- /dev/null
+++ b/skribe/doc/user/links.skb
@@ -0,0 +1,152 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/links.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu Sep 11 06:10:44 2003 */
+;* Last change : Thu Feb 26 20:56:48 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe links */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Links and references */
+;*---------------------------------------------------------------------*/
+(chapter :title "References and Hyperlinks" [
+Skribe supports traditional ,(emph "references") (that is, references to some
+part of documents) and ,(emph "hyperlinks") (that is visual marks enriching
+texts that enable interactive browsing). Hyperlinks may point to
+
+,(itemize (item [Inner parts of a document, such as a section or a figure.])
+ (item [Other documents, such as Web documents.])
+ (item [Other Skribe documents.])
+ (item [Specific part of other Skribe documents, such as a chapter
+ of another Skribe document.]))
+
+,(paragraph [In order to use hyperlinks, Skribe documents must:])
+
+,(itemize (item [,(emph "Refer to") marks. This is the role of the ,(tt "ref")
+ Skribe function.])
+ (item [,(emph "Set") marks. This is the role of the ,(tt "mark")
+ function. However, most Skribe functions that introduce text
+ structures (e.g., chapters, sections, figures, ...)
+ automatically introduce marks as well. So, it is
+ useless to ,(emph "explicitly") introduce a mark at the
+ beginning of these constructions in order to refer to them
+ with an hyperlink.]))]
+
+;*---------------------------------------------------------------------*/
+;* mark ... @label mark@ */
+;*---------------------------------------------------------------------*/
+(section :title "Mark"
+
+(p [The ,(code "mark") function sets a mark in the produced document
+that can be referenced to with the ,(markup-ref "ref")
+function. Unless a ,(param :text) option is specified, no visible text
+in associated with the mark in the generated document.])
+
+(doc-markup 'mark
+ '((:text "A text associated with the markup.")
+ (#!rest mark [A string that will be used in a
+ ,(markup-ref "ref") function call to point to that mark.])))
+
+(p [The Skribe functions
+ ,(map (lambda (x y)
+ (list (markup-ref x) y))
+ '("chapter" "section" "subsection" "subsubsection")
+ '(", " ", " ", " " "))
+Skribe automatically set a mark whose value is the title of the section.
+The Skribe function ,(markup-ref "figure")
+automatically sets a mark whose value is the legend of the figure.]))
+
+;*---------------------------------------------------------------------*/
+;* ref ... @label ref@ */
+;*---------------------------------------------------------------------*/
+(section :title "Reference"
+
+(p [Skribe proposes only one single function for all the references.
+This same ,(code "ref") function is used for introducing references to
+section, to bibliographic entries, to source code line number, etc.])
+
+(doc-markup 'ref
+ `((:text [The text that is the visual part the links for
+ engines that support hyperlinks.])
+ (:url [An URL, that is, a location of another file,
+ such as an HTML file.])
+ (:mark [A string that is the name of a mark. That mark has
+ been introduced by a ,(markup-ref "mark") markup.])
+ (:handle [A Skribe node ,(markup-ref "handle").])
+ (:ident [A reference to a node who has been specified
+ an ,(param :ident) value.])
+ (:figure [The name of a ,(markup-ref "figure").])
+ (:chapter [The name of a ,(markup-ref "chapter").])
+ (:section [The name of a ,(markup-ref "section").])
+ (:subsection [The name of a ,(markup-ref "subsection").])
+ (:subsubsection [The name of a ,(markup-ref "subsubsection").])
+ (:page [A boolean enabling/disabling page reference.])
+ (:bib ,[A name or a list of names of
+ ,(ref :chapter "Bibliographies" :text "bibliographic") entry.])
+ (:bib-table ,[The
+ ,(ref :chapter "Bibliographies" :text "bibliography") where
+ searching the entry.])
+ (:line [A reference to a ,(ref :mark "prog" :text "program")
+ line number.])
+ (:skribe [The name of a
+ ,(ref :section "Skribe Url Index" :text "Skribe Url Index")
+ ,(var "file") that contains the reference. The
+ reference can be a ,(tt "chapter"), ,(tt "section"),
+ ,(tt "subsection"), ,(tt "subsubsection") or even
+ a ,(tt "mark") located in the Skribe document
+ described by the ,(var "file") ,(sc "sui").]))
+ :force-args '(:url :bib :line :skribe)
+ :see-also '(index))
+
+
+(example-produce
+ (example :legend "Some references" (prgm :file "src/links1.skb"))
+ (disp (include "src/links1.skb"))))
+
+;*---------------------------------------------------------------------*/
+;* mailto ... @label mailto@ */
+;*---------------------------------------------------------------------*/
+(section :title "Electronic mails"
+
+(p [The ,(code "mailto") function is mainly useful for electronic
+output formats that are able to run a mailing agent. The function ,(tt "mailto")
+introduces mail annotation in a Skribe document.])
+
+(doc-markup 'mailto
+ '((:text [The text that is the visual part the links.])
+ (#!rest email [The electronic address.])))
+
+(example-produce
+ (example :legend "Mail address reference" (prgm :file "src/links2.skb"))
+ (disp (include "src/links2.skb"))))
+
+;*---------------------------------------------------------------------*/
+;* Skribe Url Index ... */
+;*---------------------------------------------------------------------*/
+(section :title "Skribe Url Index" [
+,(p [A ,(emph "Skribe Url Index") (henceforth ,(sc "Sui")) describes the
+marks that are available in a Skribe document. It is to be used to
+make Skribe marks available to other Skribe documents. The syntax
+of a ,(sc "Sui") file is:])
+
+,(disp :verb #t :bg *prgm-skribe-color* [
+<sui> --> (skribe-url-index <title>
+ :file <file-name>
+ (marks <sui-ref>*)
+ (chapters <sui-ref>*)
+ (section <sui-ref>*)
+ (subsection <sui-ref>*)
+ (subsubsection <sui-ref>*))
+<sui-ref> --> (<string> :file <file-name> :mark <string>)])
+
+,(p [,(sc "Sui") files can be automatically produced by the Skribe compiler.
+For instance, in order to produce the ,(sc "Sui") file of this user
+manual, one should write:])
+
+,(disp :verb #t [
+$ skribe user.skb -o user.sui])]))
+
+;; LocalWords: Hyperlinks HTML URL url
diff --git a/skribe/doc/user/markup.skb b/skribe/doc/user/markup.skb
new file mode 100644
index 0000000..272bfbe
--- /dev/null
+++ b/skribe/doc/user/markup.skb
@@ -0,0 +1,83 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/markup.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 2 06:09:18 2003 */
+;* Last change : Wed Feb 4 06:11:45 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe standard markups */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* API */
+;*---------------------------------------------------------------------*/
+(chapter :title "Standard Markups" [
+
+This chapter describes the forms composing Skribe texts. In XML/HTML
+these forms are called ,(emph "markups"). In LaTeX they are called
+,(emph "macros"). In Skribe these forms are called ,(emph
+"functions"). In this manual, we will say that we ,(emph "call a
+function") when a function is used in a form. The values used in a
+function call are named the ,(emph "actual parameters") of the
+function or ,(emph "parameters") in short. When calling a function
+with parameters we say that we are ,(emph "passing") arguments to the
+function.
+
+,(p [ In this documentation function names are typesetted in bold
+face. We call a ,(emph "keyword argument"), an argument whose
+identifier starts with the ,(tt ":") character. Arguments whose
+identifier does not start with this character are called ,(emph "plain
+arguments") or ,(emph "arguments") in short. An ,(emph "optional
+argument") is represented by a list, starting with the character ,(q
+(char 91)) and ending with the character ,(q (char 93)), whose first
+element is a keyword argument and the optional second (,(code "#f")
+when not specified) element is the default value used if the optional
+argument value is not provided on a function call. Arguments that are
+not optional are said ,(emph "mandatory"). If a plain argument is
+preceeded with a ,(tt ".") character, this argument may be used to
+accumulate several values. There are two ways to pass actual arguments
+to a function.])
+
+,(itemize (item [for keyword arguments: the value of the parameter
+must be preceeded by the name of the argument.])
+ (item [for plain arguments: a value is provided.]))
+
+Example: Let us consider the function ,(tt "section") defined as follows:
+,(prgm "(section :title [:number #t] [:toc #t] . body)")
+
+,(p [
+The argument ,(param :title) is a mandatory keyword argument.
+The keyword arguments ,(param :number) and ,(param :toc) are
+optional. The plain argument ,(param 'body) is preceeded with a
+,(tt ".") character so it may receive several values. All the following
+calls are legal ,(tt "section") calls:])
+
+,(prgm (source :file "src/api1.skb"))]
+
+;*---------------------------------------------------------------------*/
+;* Markup index ... */
+;*---------------------------------------------------------------------*/
+(section :title "Markup index" :ident "markups-index" :file #f :number #f :toc #t
+ (the-index :class 'markup-index
+ :column (if (engine-format? "latex") 2 4)
+ :split #f
+ *markup-index*))
+
+;*---------------------------------------------------------------------*/
+;* Markups */
+;*---------------------------------------------------------------------*/
+(include "document.skb")
+(include "sectioning.skb")
+(include "toc.skb")
+(include "ornament.skb")
+(include "line.skb")
+(include "font.skb")
+(include "justify.skb")
+(include "enumeration.skb")
+(include "colframe.skb")
+(include "figure.skb")
+(include "image.skb")
+(include "table.skb")
+(include "footnote.skb")
+(include "char.skb"))
diff --git a/skribe/doc/user/ornament.skb b/skribe/doc/user/ornament.skb
new file mode 100644
index 0000000..e65b9d1
--- /dev/null
+++ b/skribe/doc/user/ornament.skb
@@ -0,0 +1,25 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/ornament.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 14:00:52 2003 */
+;* Last change : Fri Sep 12 15:31:19 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The skribe ornaments */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Ornaments */
+;*---------------------------------------------------------------------*/
+(section :title "Ornaments" :file #t
+
+(p [Skribe supports the standard text ornaments.])
+
+(doc-markup 'bold
+ '((#!rest node... "The nodes of the ornament."))
+ :others '(code emph it kbd roman sc sf sub sup tt underline var))
+
+(example-produce
+ (example :legend "The ornament markups" (prgm :file "src/api8.skb"))
+ (disp (include "src/api8.skb"))))
diff --git a/skribe/doc/user/package.skb b/skribe/doc/user/package.skb
new file mode 100644
index 0000000..ad989d0
--- /dev/null
+++ b/skribe/doc/user/package.skb
@@ -0,0 +1,139 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/package.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Feb 21 08:26:44 2004 */
+;* Last change : Fri Jun 3 16:51:30 2005 (serrano) */
+;* Copyright : 2004-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Packages */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Standard packages */
+;*---------------------------------------------------------------------*/
+(chapter :title "Standard Packages"
+
+ (p [
+This chapter describes the standard Skribe packages. Additional
+packages can be found from the
+,(ref :url (skribe-url) :text "Skribe web page").
+This chapter only describes the packages that are contained in the standard
+Skribe distribution.])
+
+ (p [
+In order to use the facilities described in the following sections, the
+Skribe source file must contains expressions such as:])
+
+(prgm [(skribe-load ,(it "package.skr") ...)])
+
+[where ,(it (tt "package.skr")) is the described package.]
+
+;*---------------------------------------------------------------------*/
+;* jfp */
+;*---------------------------------------------------------------------*/
+(section :title "Articles"
+
+ (subsection :title (tt "acmproc.skr") :ident "acmproc"
+ (index :index *package-index* "acmproc.skr" :note "package")
+ (p [
+This package enables producing LaTeX documents conforming to the
+,(emph "ACM proceeding") (ACMPROC) style. It introduces the
+markup ,(code "abstract"):])
+ (doc-markup 'abstract
+ `((:class "The node class.")
+ (:postscript [The URL of the PostScript version of the paper.]))
+ :common-args '()
+ :idx-note "acmproc"
+ :idx-suffix " (acmproc)"
+ :force-engines *api-engines*
+ :source "../skr/acmproc.skr"))
+
+ (subsection :title (tt "jfp.skr") :ident "jfp"
+ (index :index *package-index* "jfp.skr" :note "package")
+ (p [
+This package enables producing LaTeX documents conforming to the
+,(emph "Journal of Functional Programming") (JFP) style. It introduces the
+markup ,(code "abstract"):])
+ (doc-markup 'abstract
+ `((:postscript [The URL of the PostScript version of the paper.]))
+ :common-args '()
+ :idx-note "jfp"
+ :idx-suffix " (jfp)"
+ :force-engines *api-engines*
+ :source "../skr/jfp.skr"))
+
+ (subsection :title (tt "lncs.skr") :ident "lncs"
+ (index :index *package-index* "lncs.skr" :note "package")
+ (p [
+This package enables producing LaTeX documents conforming to the
+,(emph "Lecture Notes on Computer Science") (LNCS) style. It introduces the
+markup ,(code "abstract"):])
+ (doc-markup 'abstract
+ `((:postscript [The URL of the PostScript version of the paper.]))
+ :common-args '()
+ :idx-note "lncs"
+ :idx-suffix " (lncs)"
+ :force-engines *api-engines*
+ :source "../skr/lncs.skr")))
+
+;*---------------------------------------------------------------------*/
+;* french */
+;*---------------------------------------------------------------------*/
+(section :title "Languages"
+ (subsection :title (tt "french.skr")
+ (index :index *package-index* "french.skr" :note "package")
+ (p [
+Enables French typesetting and typographical rules.])))
+
+;*---------------------------------------------------------------------*/
+;* letter */
+;*---------------------------------------------------------------------*/
+(section :title (tt "letter.skr")
+ (index :index *package-index* "letter.skr" :note "package")
+ (p [
+This package is to be used to authoring simple letters. It redefines the
+,(markup-ref "document") markup.])
+
+ (doc-markup 'document
+ `((:where [The location where the letter is posted.])
+ (:date [The date of the letter.])
+ (:author [The author of the letter.]))
+ :idx-note "letter"
+ :idx-suffix " (letter)"
+ :force-engines *api-engines*
+ :source "../skr/letter.skr"))
+
+;*---------------------------------------------------------------------*/
+;* Web */
+;*---------------------------------------------------------------------*/
+(section :title "Web"
+
+ (subsection :title (tt "web-article.skr")
+ (index :index *package-index* "web-article.skr" :note "package")
+ (p [
+A convenient mode for rendering articles (i.e., documents made of
+sections) in HTML. The Slide package supports two ,(markup-ref "skribe-load")
+user options:
+,(param :style) and ,(param :css). The ,(param :style) option can either
+be ,(code "'traditional") which forces traditional HTML code
+emission or ,(code "'css") which forces HTML code emission using CSS
+annotations. The CSS style used is specified in the (code "css")
+HTML engine ,(ref :subsection "The HTML customization" :text "custom").
+The ,(param :css) is a shorthand for ,(param :style). For instance:])
+(prgm [(skribe-load "web-article.skr" :css "style.css")])
+[is equivalent to:]
+(prgm [(skribe-load "web-article.skr" :style 'css)
+(engine-custom-set! (find-engine 'html) :css "style.css")]))
+
+ (subsection :title (tt "web-book.skr")
+ (index :index *package-index* "web-book.skr" :note "package")
+ (p [
+A convenient mode for rendering books (i.e., documents made of
+chapters and sections) in HTML.]))))
+
+;*---------------------------------------------------------------------*/
+;* Emacs indentation */
+;*---------------------------------------------------------------------*/
+;; @indent: (put 'doc-markup 'skribe-indent 'skribe-indent-function)@*
+
diff --git a/skribe/doc/user/prgm.skb b/skribe/doc/user/prgm.skb
new file mode 100644
index 0000000..c894614
--- /dev/null
+++ b/skribe/doc/user/prgm.skb
@@ -0,0 +1,121 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/prgm.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Nov 30 09:21:11 2001 */
+;* Last change : Wed Sep 22 02:11:49 2004 (serrano) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Computer programs */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* fib ... */
+;*---------------------------------------------------------------------*/
+(define (fib x) ;!fib
+ (if (< x 2)
+ 1
+ (+ (fib (- x 1)) (fib (- x 2)))))
+
+;*---------------------------------------------------------------------*/
+;* Computer programs */
+;*---------------------------------------------------------------------*/
+(chapter :title "Computer programs"
+
+(p [It is common that some parts of a Skribe text represent other
+texts. For instance, for a document describing a computer programming
+language, it is frequent to include excerpt of programs. These
+embedded texts are frequently displayed in a specific font and with no
+justification but with a precise ,(emph "indentation"). This indentation is
+important because it helps in understanding the text,(begin ";")
+it is thus desirable to preserve it in the Skribe text. The
+,(markup-ref "pre") text layout already enables such a
+text formating. This chapter presents two new Skribe functions:
+,(markup-ref "prog") and ,(markup-ref "source") that is specially
+designed to represent computer programs in Skribe text.])
+
+;*---------------------------------------------------------------------*/
+;* Programs ... @label prog@ */
+;*---------------------------------------------------------------------*/
+(section :title "Program"
+
+(p [A ,(code "prog") function call preserves the indentation of the
+program. It may automatically introduce line numbers.])
+
+(doc-markup 'prog
+ `((:line ,[Enables/disables automatic line numbering. An integer
+ value enables the line number and specifies the number of
+ the first line of the program. A value of ,(code "#f") disables
+ the line numbering.])
+ (:linedigit ,[The number of digit for representing line
+ numbers.])
+ (:mark ,[A string or the boolean ,(code "#f"). If this option
+ is a string, that string is the prefix
+ of line marks. These marks can be used in the
+ ,(markup-ref "ref") reference. A mark
+ identifier is defined by the regular expression:
+ ,(code [,(char "[")_a-zA-Z,(char "]"),(char "[")_a-zA-Z0-9,(char "]")*]). The prefix and the mark are removed from the output program.]))
+ :force-engines *api-engines*
+ :see-also '(source pre ref))
+
+(example-produce
+ (example :legend "A program" (prgm :file "src/prgm1.skb"))
+ (disp (include "src/prgm1.skb"))))
+
+;*---------------------------------------------------------------------*/
+;* Source code ... @label source@ */
+;*---------------------------------------------------------------------*/
+(section :title "Source code"
+
+(p [The ,(code "source") function extracts part of the source code and
+enables ,(emph "fontification"). That is, some words of the program
+can be rendered using different colors or faces.])
+
+;!source-start
+(doc-markup 'source
+ `((:language ,[The ,(markup-ref "language") of the source code.])
+ (:file ,[The file containing the actual source code. The file
+ is searched in the ,(markup-ref "skribe-source-path") path.])
+ (:start [A start line number or a start marker.])
+ (:stop [A stop line number or a stop marker.])
+ (:definition [The identifier of the definition to extract.])
+ (:tab [The tabulation width.]))
+ :common-args '()
+ :force-engines *api-engines*
+ :see-also '(prog language ref skribe-source-path))
+;!source-stop
+
+(example-produce
+ (example :legend "The source markup" (prgm :file "src/prgm2.skb"))
+ (disp (include "src/prgm2.skb"))))
+
+;*---------------------------------------------------------------------*/
+;* Language ... @label language@ */
+;*---------------------------------------------------------------------*/
+(section :title "Language"
+(index "source" :note "fontification")
+(index "fontification")
+
+(p [The ,(code "language") function builds a language that can be used
+in ,(markup-ref "source") function call.])
+
+(doc-markup 'language
+ `((:name [A string which denotes the name of the language.])
+ (:fontifier [A function of one argument (a string), that
+ colorizes a line source code.])
+ (:extractor [A function of three arguments: an input port,
+ an identifier, a tabulation size. This function ,(emph "scans")
+ in the input port the definition is looks for.]))
+ :common-args '()
+ :force-engines *api-engines*
+ :see-also '(prog source ref))
+
+; **** FIXME:
+(cond-expand
+ (bigloo
+ (example-produce
+ (example :legend "An ad-hoc fontification"
+ (prgm :file "src/prgm3.skb"))
+ (disp (include "src/prgm3.skb"))))
+ (else
+ '()))))
diff --git a/skribe/doc/user/sectioning.skb b/skribe/doc/user/sectioning.skb
new file mode 100644
index 0000000..48bbc45
--- /dev/null
+++ b/skribe/doc/user/sectioning.skb
@@ -0,0 +1,117 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/sectioning.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 12:27:03 2003 */
+;* Last change : Tue Apr 6 06:45:28 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Sectioning markups */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* dummy-section-output ... */
+;*---------------------------------------------------------------------*/
+(define dummy-section-output
+ (lambda (n e)
+ (let* ((t (markup-option n :title))
+ (b (markup-body n)))
+ (skribe-eval (center (bold t)) e)
+ (output b e))))
+
+;*---------------------------------------------------------------------*/
+;* Sectioning */
+;*---------------------------------------------------------------------*/
+(section :title "Sectioning" :file #t
+
+;*--- chapter ---------------------------------------------------------*/
+(subsection :title "Chapter"
+
+(p [The function ,(code "chapter") creates new chapters.])
+
+(doc-markup 'chapter
+ `((:title [The title of the chapter.])
+ (:html-title "The title of window of the HTML browser.")
+ (:number [This argument controls the chapter number.
+A value of ,(tt "#t") means that the Skribe compiler computes the chapter
+number. A value of ,(tt "#f") means that the chapter has no number.])
+ (:toc ,[This argument controls if the chapter must
+be referenced in the ,(ref :mark "toc" :text "table of contents").])
+ (:file [The argument must be a boolean. A value of
+,(tt "#t") tells the Skribe compiler to compile that chapter in a separate
+file. A value of ,(tt "#f") tells the Skribe compiler to embed the chapter
+in the main target file.])
+ (#!rest node... [The nodes of the chapter.]))
+ :see-also '(document section toc))
+
+(example-produce
+ (example :legend "The chapter markup" (prgm :file "src/api4.skb"))
+ (disp
+ (processor :combinator
+ (lambda (e1 e2)
+ (let ((e (copy-engine 'document-engine e2)))
+ (markup-writer 'chapter e
+ :options '(:title :file :number :toc)
+ :action dummy-section-output)
+ e))
+ (include "src/api4.skb")))))
+
+;*--- section ---------------------------------------------------------*/
+(subsection :title "Sections"
+
+(p [These functions create new sections.])
+
+(doc-markup 'section
+ `((:title [The title of the chapter.])
+ (:number [This argument controls the chapter number.
+A value of ,(tt "#t") means that the Skribe compiler computes the chapter
+number. A value of ,(tt "#f") means that the chapter has no number.])
+ (:toc ,[This argument controls if the chapter must
+be referenced in the ,(ref :mark "toc" :text "table of contents").])
+ (:file [The argument must be a boolean. A value of
+,(tt "#t") tells the Skribe compiler to compile that section in a separate
+file. A value of ,(tt "#f") tells the Skribe compiler to embed the chapter
+in the main target file.])
+ (#!rest node... [The nodes of the section.]))
+ :others '(subsection subsubsection)
+ :see-also '(document chapter paragraph toc))
+
+(example-produce
+ (example :legend "The chapter markup" (prgm :file "src/api5.skb"))
+ (disp
+ (processor :combinator
+ (lambda (e1 e2)
+ (let ((e (copy-engine 'document-engine e2)))
+ (markup-writer 'chapter e
+ :options '(:title :file :number :toc)
+ :action dummy-section-output)
+ e))
+ (include "src/api5.skb")))))
+
+;*--- paragraph -------------------------------------------------------*/
+(subsection :title "Paragraph"
+
+(p [The function ,(code "paragraph") (also aliased ,(code "p")) creates
+paragraphs.])
+
+(doc-markup 'paragraph
+ '((#!rest node... "The nodes of the paragraph."))
+ :see-also '(document chapter section p))
+
+(p [The function ,(code "p") is an alias for ,(code "paragraph").])
+(doc-markup 'p
+ '((#!rest node... "The nodes of the paragraph."))
+ :source "../skr/skribe.skr"
+ :see-also '(document chapter section paragraph)))
+
+;*--- blockquote -----------------------------------------------------*/
+(subsection :title "Blockquote"
+
+(p [The function ,(code "blockquote") can be used for text
+quotations. A text quotation is generally renderd as an indented block
+of text.])
+(doc-markup 'blockquote
+ '((#!rest node... "The nodes of the quoted text.")))))
+
+
+
diff --git a/skribe/doc/user/skribe-config.skb b/skribe/doc/user/skribe-config.skb
new file mode 100644
index 0000000..956af63
--- /dev/null
+++ b/skribe/doc/user/skribe-config.skb
@@ -0,0 +1,44 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/skribe-config.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Jan 2 21:12:24 2004 */
+;* Last change : Thu Sep 23 17:11:53 2004 (eg) */
+;* Copyright : 2004 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The skribe-config tool */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The skribe-config tool */
+;*---------------------------------------------------------------------*/
+(chapter :title "Getting Skribe configuration information"
+(index "skribe-config")
+
+(p [
+In this chapter we present ,(code "skribe-config") that gives
+information about the current Skribe configuration.])
+
+;; Synopsis
+(section :title "SYNOPSIS" :number #f
+(compiler-command "skribe-config" "options"))
+
+;; Description
+(section :title "DESCRIPTION" :number #f [
+The ,(code "skribe-config") gives information about the Skribe configuration.
+This information can be the directories used to install Skribe, the Scheme
+implementation used for compiling Skribe, etc.])
+
+;; Options
+(section :title "OPTIONS" :number #f [
+,(pre (let* ((proc (run-process "../etc/skribe-config" "--help" error: pipe:))
+ (port (process-error-port proc)))
+ (let loop ((line (read-line port))
+ (lines '()))
+ (if (eof-object? line)
+ (reverse! lines)
+ (begin
+ (loop (read-line port) (cons* line "\n" lines)))))))]))
+
+
+
diff --git a/skribe/doc/user/skribec.skb b/skribe/doc/user/skribec.skb
new file mode 100644
index 0000000..0f00632
--- /dev/null
+++ b/skribe/doc/user/skribec.skb
@@ -0,0 +1,56 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/skribec.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Nov 30 13:43:50 2001 */
+;* Last change : Thu Feb 26 20:58:26 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe compiler */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The Skribe compiler */
+;*---------------------------------------------------------------------*/
+(chapter :title "Skribe compiler"
+(index "skribe" :note "manual page")
+(p [
+In this chapter we present the Skribe compiler that compiles Skribe
+source text into various output formats.])
+
+;; Synopsis
+(section :title "SYNOPSIS" :number #f
+(linebreak 1)
+(compiler-command "skribe" "options" "input"))
+
+;; Description
+(section :title "DESCRIPTION" :number #f
+(p [
+This manual page is not meant to be exhaustive. The complete documentation
+for the programming language ,(bold "Skribe") can be found at the following
+,(ref :url (skribe-url) :text "URL"). This manual page only documents
+the ,(tt "skribe")
+compiler that compiles ,(bold "Skribe") programs into ,(it "HTML"),
+,(it "TeX"), ,(it "Info") or ,(it "Nroff") formats.]))
+
+;; Suffixes
+(section :title "SUFFIXES" :number #f [
+The ,(tt "skribe") compiler uses file suffixes in order to select amongst
+its possible targets which one to choose. These suffixes are:
+
+,(description (item :key (it ".skb") [a ,(bold "Skribe") source file.])
+ (item :key (it ".html") [an ,(it "HTML") target file.])
+ (item :key (it ".tex") [a ,(it "TeX") target file.])
+ (item :key (it ".sui") [a ,(it "Skribe url index") file.]))])
+
+;; Options
+(section :title "OPTIONS" :number #f [
+,(mark "skribe compiler option")
+,(compiler-options *skribe-bin*)])
+
+;; Environment variables
+(section :title "ENVIRONMENT VARIABLES" :number #f [
+Some shell variables control the Skribe search path:
+,(description (item :key (it "SKRIBEPATH")
+ "Search path for source and style files."))]))
+
diff --git a/skribe/doc/user/skribeinfo.skb b/skribe/doc/user/skribeinfo.skb
new file mode 100644
index 0000000..502cc73
--- /dev/null
+++ b/skribe/doc/user/skribeinfo.skb
@@ -0,0 +1,50 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/skribeinfo.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Nov 30 13:43:50 2001 */
+;* Last change : Mon Dec 15 13:22:08 2003 (serrano) */
+;* Copyright : 2001-03 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribeinfo compiler */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The Skribeinfo compiler */
+;*---------------------------------------------------------------------*/
+(chapter :title "Compiling Texi documents"
+(index "skribeinfo" :note "compiler")
+(index "texinfo")
+
+(p [
+In this chapter we present the Skribeinfo compiler that compiles Texinfo
+(texi) source files into Skribe source file.])
+
+;; Synopsis
+(section :title "SYNOPSIS" :number #f
+(compiler-command "skribeinfo" "options" "input"))
+
+;; Description
+(section :title "DESCRIPTION" :number #f [
+This manual page is not meant to be exhaustive. The complete documentation
+for the programming language ,(bold "Skribe") can be found at the
+following ,(ref :url (skribe-url) :text "url"). This manual page only
+document the ,(tt "skribeinfo")
+compiler that compiles ,(bold "Texinfo") source files into ,(it "Skribe"),
+source files. These Skribe files can be compiled by the ,(bold "skribe")
+compiler in order to produce ,(it "HTML"), ,(it "TeX"), ,(it "Info")
+or ,(it "Nroff") target files.])
+
+;; Suffixes
+(section :title "SUFFIXES" :number #f [
+The ,(tt "skribe") compiler uses file suffixes in order to select amongst
+its possible targets which to choose. These suffixes are:
+
+,(description (item :key (it ".texi") [a ,(bold "Texinfo") source file.])
+ (item :key (it ".skb") [a ,(bold "Skribe") source file.])
+ (item :key (it ".sui") [a ,(it "Skribe url index") file.]))])
+
+;; Options
+(section :title "OPTIONS" :number #f [
+,(compiler-options *skribeinfo-bin*)]))
+
diff --git a/skribe/doc/user/slide.skb b/skribe/doc/user/slide.skb
new file mode 100644
index 0000000..c1111ee
--- /dev/null
+++ b/skribe/doc/user/slide.skb
@@ -0,0 +1,114 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/slide.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Jan 9 06:37:47 2004 */
+;* Last change : Thu Feb 26 21:00:04 2004 (eg) */
+;* Copyright : 2004 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Slides */
+;*=====================================================================*/
+(skribe-load "slide.skr")
+
+;*---------------------------------------------------------------------*/
+;* Computer programs */
+;*---------------------------------------------------------------------*/
+(chapter :title "Slide Package"
+
+ (p [
+This chapter describes the facilities Skribe offers authoring slides.
+In order to access the functionalities described in this chapter, it
+is require to introduce a ,(code [(skribe-load "slides.skr")]) expression
+at the beginning of the document. The Slide package supports two
+,(markup-ref "skribe-load") user options: ,(param :advi) and ,(param :prosper).
+The first one tells Skribe to generate slides for the Advi presenter. The
+second one tells Skribe to generate slides for the LaTeX prosper package.])
+
+;*---------------------------------------------------------------------*/
+;* slide ... @label slide@ */
+;*---------------------------------------------------------------------*/
+(section :title "Slide"
+
+ (p [A ,(code "slide") function call creates a slide.])
+
+ (doc-markup 'slide
+ `((:title [The title of the slide.])
+ (:number [The number of the slide (a boolean or an integer).])
+ (:toc [This argument controls if the slide must
+be referenced in the ,(mark :mark "toc" "table of contents").])
+ (:vspace [The boolean ,(code "#f") or an integer representing
+the vertical space size between the title and the body of the slide.])
+ (:vfill [A boolean that is used to control whether a LaTeX
+,(code "\\vfill") is issued at the end of the slide.])
+ (:transition [The boolean ,(code "#f") or a symbol in the
+list ,(code "(split blinds box wipe dissolve glitter)").])
+ (:bg [The background color of the slide.])
+ (:image [The background image of the slide.]))
+ :source "../skr/slide.skr"))
+
+;*---------------------------------------------------------------------*/
+;* slide-pause */
+;*---------------------------------------------------------------------*/
+(section :title "Pause"
+
+ (p [A ,(code "slide-pause") function call introduces a pause in the slide
+projection.])
+
+ (doc-markup 'slide-pause
+ '()
+ :common-args '()
+ :source "../skr/slide.skr"))
+
+;*---------------------------------------------------------------------*/
+;* slide-vspace ... */
+;*---------------------------------------------------------------------*/
+(section :title "Slide Vertical Space"
+
+ (p [The ,(code "slide-vspace") introduces a vertical space in the slide.])
+
+ (doc-markup 'slide-vspace
+ '((:unit [The unit of the space.])
+ (#!rest val [The size of the vertical space.]))
+ :common-args '()
+ :source "../skr/slide.skr"))
+
+;*---------------------------------------------------------------------*/
+;* slide-embed ... */
+;*---------------------------------------------------------------------*/
+(section :title "Slide Embed Applications"
+
+ (p [Embed an application inside a slide.])
+
+ (doc-markup 'slide-embed
+ `((:command [The binary file for running the embedded
+application.])
+ (:geometry-opt [The name of the geometry option to be sent
+to the embedded application.])
+ (:geometry [The geometry value to be sent.])
+ (:rgeometry [A relative geometry to be sent.])
+ (:transient-opt [The name of the transient option to be sent
+to the embedded application.])
+ (:transient [The transient value to be sent.])
+ (:alt [An alternative Skribe expression to be used if the
+output format does not support embedded application.]))
+ :common-args '()
+ :source "../skr/slide.skr"))
+
+;*---------------------------------------------------------------------*/
+;* Example */
+;*---------------------------------------------------------------------*/
+(section :title "Example"
+ (p [Here is a complete example of Skribe slides:])
+
+ (if (and (engine-format? "html")
+ (not (equal? (engine-custom html-engine 'html-variant) "html4")))
+ ;; Show the example and its result
+ (example-produce
+ (example :legend "Example of Skribe slides"
+ (prgm :file "src/slides.skb"))
+ (disp (include "src/slides.skb")))
+ ;; Show only the example (i.e. don't produce a document in a document)
+ (example :legend "Example of Skribe slides"
+ (prgm :file "src/slides.skb")))))
+
+
diff --git a/skribe/doc/user/src/api1.skb b/skribe/doc/user/src/api1.skb
new file mode 100644
index 0000000..80c4389
--- /dev/null
+++ b/skribe/doc/user/src/api1.skb
@@ -0,0 +1,5 @@
+(section :title "A title" "This is the body of the section")
+(section :title "A title" "This" " is" " the body of the section")
+(section :title "A title" :number 3 "This" " is" " the body of the section")
+(section :title "A title" :toc #f :number 3 "This" " is" " the body of the section")
+(section :title "A title" :number 3 :toc #f "This" " is" " the body of the section")
diff --git a/skribe/doc/user/src/api10.skb b/skribe/doc/user/src/api10.skb
new file mode 100644
index 0000000..207d8a7
--- /dev/null
+++ b/skribe/doc/user/src/api10.skb
@@ -0,0 +1,12 @@
+(center [A ,(linebreak) multilines ,(linebreak) text])
+(hrule)
+(flush :side 'left [A ,(linebreak) multilines ,(linebreak) text])
+(hrule)
+(flush :side 'right [A ,(linebreak) multilines ,(linebreak) text])
+(hrule)
+(pre [A text layout that
+
+ preserves
+ linebreaks and spaces ,(it "(into which it is still legal")
+,(it "to use Skribe markups)").
+])
diff --git a/skribe/doc/user/src/api11.skb b/skribe/doc/user/src/api11.skb
new file mode 100644
index 0000000..5014e30
--- /dev/null
+++ b/skribe/doc/user/src/api11.skb
@@ -0,0 +1,22 @@
+(itemize (item [A first item.])
+ (item [A ,(bold "second") one:
+ ,(itemize (item "One.")
+ (item "Two.")
+ (item "Three."))])
+ (item [Lists can be nested. For instance that item contains a
+ ,(tt "description"):
+ ,(description (item :key (bold "foo")
+ [is a usual Lisp dummy identifier.])
+ (item :key (bold "bar")
+ [is another one.])
+ (item :key (list (bold "foo") (bold "bar"))
+ [A description entry may contain more than
+ one keyword.]))])
+ (item [The last ,(tt "itemize") entry contains an ,(tt "enumerate"):
+ ,(enumerate (item "One.") (item "Two.") (item "Three."))]))
+
+(itemize :symbol "-"
+ (item "One.")
+ (item "Two.")
+ (item "Three.")
+ (item "Four."))
diff --git a/skribe/doc/user/src/api12.skb b/skribe/doc/user/src/api12.skb
new file mode 100644
index 0000000..b0c68da
--- /dev/null
+++ b/skribe/doc/user/src/api12.skb
@@ -0,0 +1 @@
+(center (frame :width 10. :margin 10 (p [This is a frame.])))
diff --git a/skribe/doc/user/src/api13.skb b/skribe/doc/user/src/api13.skb
new file mode 100644
index 0000000..a9acb04
--- /dev/null
+++ b/skribe/doc/user/src/api13.skb
@@ -0,0 +1,10 @@
+(center
+ (color :bg "#aaaaaa"
+ :margin 10
+ :width 30.
+ (center
+ (color :bg "#eeeeee" :fg "blue" :width 100. :margin 10 [This is an
+example of color box that uses a color for the
+background ,(emph "and") the ,(color :fg "red" "foreground"). It also specifies
+a width, that is, an horizontal space, the text should
+span to.]))))
diff --git a/skribe/doc/user/src/api14.skb b/skribe/doc/user/src/api14.skb
new file mode 100644
index 0000000..a3ede40
--- /dev/null
+++ b/skribe/doc/user/src/api14.skb
@@ -0,0 +1,9 @@
+(center
+ (figure :legend "This is a unnumbered figure"
+ :ident "fig1"
+ :number #f
+ (frame [Skribe is a functional programming language.])))
+
+(center
+ (figure :legend "The great Penguin"
+ (image :file "linux.gif")))
diff --git a/skribe/doc/user/src/api15.skb b/skribe/doc/user/src/api15.skb
new file mode 100644
index 0000000..f8f4958
--- /dev/null
+++ b/skribe/doc/user/src/api15.skb
@@ -0,0 +1,25 @@
+(resolve (lambda (n e env)
+ (let* ((d (ast-document n))
+ (ex (container-env-get d 'figure-env)))
+ (table (map (lambda (e)
+ (tr (td :align 'left
+ (markup-option e ':number)
+ " "
+ (ref :handle (handle e)
+ :text (markup-option e :legend))
+ " (section "
+ (let ((c (ast-section e)))
+ (ref :handle (handle c)
+ :text (markup-option c :title)))
+ ")")))
+ (sort ex
+ (lambda (e1 e2)
+ (let ((n1 (markup-option e1 :number))
+ (n2 (markup-option e2 :number)))
+ (cond
+ ((not (number? n1))
+ #t)
+ ((not (number? n2))
+ #f)
+ (else
+ (< n1 n2)))))))))))
diff --git a/skribe/doc/user/src/api16.skb b/skribe/doc/user/src/api16.skb
new file mode 100644
index 0000000..a9d5705
--- /dev/null
+++ b/skribe/doc/user/src/api16.skb
@@ -0,0 +1,5 @@
+(image :file "linux.gif" "A first image")
+(image :height 50 :file "linux.gif" "A smaller one")
+(image :file "bsd.gif" "A second image")
+(image :width 50 :file "bsd.gif")
+(image :width 200 :height 40 :file "bsd.gif")
diff --git a/skribe/doc/user/src/api17.skb b/skribe/doc/user/src/api17.skb
new file mode 100644
index 0000000..42fa54f
--- /dev/null
+++ b/skribe/doc/user/src/api17.skb
@@ -0,0 +1,9 @@
+(center
+ (table :border 1 :width 50. :frame 'hsides :cellstyle 'collapse
+ (tr :bg "#cccccc" (th :align 'center :colspan 3 "A table"))
+ (tr (th "Col 1") (th "Col 2") (th "Col 3"))
+ (tr (td :align 'center "10") (td "-20") (td "30"))
+ (tr (td :align 'right :rowspan 2 :valign 'center "12") (td "21"))
+ (tr (td :align 'center :colspan 2 "1234"))
+ (tr (td :align 'center :colspan 2 "1234") (td :align 'right "5"))
+ (tr (td :align 'center :colspan 1 "1") (td :colspan 2 "2345"))))
diff --git a/skribe/doc/user/src/api18.skb b/skribe/doc/user/src/api18.skb
new file mode 100644
index 0000000..2112dc4
--- /dev/null
+++ b/skribe/doc/user/src/api18.skb
@@ -0,0 +1,2 @@
+[Scheme,(footnote [To be pronounced ,(char "[")Skim,(char "]")])
+is a programming language,(footnote [And a great one!]).]
diff --git a/skribe/doc/user/src/api19.skb b/skribe/doc/user/src/api19.skb
new file mode 100644
index 0000000..cfc11f6
--- /dev/null
+++ b/skribe/doc/user/src/api19.skb
@@ -0,0 +1,3 @@
+(itemize (item [The character ,(code "#\\a"): ,(char #\a).])
+ (item [The character ,(code "\"a\""): ,(char "a").])
+ (item [The character ,(code "97"): ,(char 97).]))
diff --git a/skribe/doc/user/src/api2.skb b/skribe/doc/user/src/api2.skb
new file mode 100644
index 0000000..2c20965
--- /dev/null
+++ b/skribe/doc/user/src/api2.skb
@@ -0,0 +1,5 @@
+(document :title "This is a Scribe document"
+ :author (list (author :name "Foo" :email (mailto "foo@nowhere.org"))
+ (author :name "Bar" :email (mailto "bar@anywhere.org"))
+ (author :name "Gee" :email (mailto "gee@nowhere.org")))
+ "A body...")
diff --git a/skribe/doc/user/src/api20.skb b/skribe/doc/user/src/api20.skb
new file mode 100644
index 0000000..686efcb
--- /dev/null
+++ b/skribe/doc/user/src/api20.skb
@@ -0,0 +1,2 @@
+[A simple ,(! "string"). A more annoying one ,(! "<strong>string</strong>").
+A last one with arguments ,(! "<u>$1 $2</u>" (bold 1) (it 2)).]
diff --git a/skribe/doc/user/src/api3.skb b/skribe/doc/user/src/api3.skb
new file mode 100644
index 0000000..ed46eea
--- /dev/null
+++ b/skribe/doc/user/src/api3.skb
@@ -0,0 +1,8 @@
+(author :name "Manuel Serrano"
+ :affiliation "Inria Sophia-Antipolis"
+ :url (ref :url "http://www.inria.fr/mimosa/Manuel.Serrano")
+ :email (mailto "Manuel.Serrano@inria.fr")
+ :address `("2004 route des Lucioles - BP 93"
+ "F-06902 Sophia Antipolis, Cedex"
+ "France")
+ :phone "phone: (+33) 4 92 38 76 41")
diff --git a/skribe/doc/user/src/api4.skb b/skribe/doc/user/src/api4.skb
new file mode 100644
index 0000000..cfe13f7
--- /dev/null
+++ b/skribe/doc/user/src/api4.skb
@@ -0,0 +1,2 @@
+(chapter :title "This is a simple chapter" :number #f :toc #f [
+Its body is just one sentence.])
diff --git a/skribe/doc/user/src/api5.skb b/skribe/doc/user/src/api5.skb
new file mode 100644
index 0000000..01188c1
--- /dev/null
+++ b/skribe/doc/user/src/api5.skb
@@ -0,0 +1,2 @@
+(section :title "This is a simple section" :number #f :toc #f [
+Its body is just one sentence.])
diff --git a/skribe/doc/user/src/api6.skb b/skribe/doc/user/src/api6.skb
new file mode 100644
index 0000000..22a1c77
--- /dev/null
+++ b/skribe/doc/user/src/api6.skb
@@ -0,0 +1 @@
+(toc :chapter #t :section #f :subsection #f)
diff --git a/skribe/doc/user/src/api7.skb b/skribe/doc/user/src/api7.skb
new file mode 100644
index 0000000..c6aec8b
--- /dev/null
+++ b/skribe/doc/user/src/api7.skb
@@ -0,0 +1,3 @@
+(resolve (lambda (n e env)
+ (toc :chapter #t :section #t :subsection #t
+ (handle (ast-chapter n)))))
diff --git a/skribe/doc/user/src/api8.skb b/skribe/doc/user/src/api8.skb
new file mode 100644
index 0000000..a4403ff
--- /dev/null
+++ b/skribe/doc/user/src/api8.skb
@@ -0,0 +1,15 @@
+(itemize (item (roman "a roman text."))
+ (item (bold "a bold text."))
+ (item (it "an italic text."))
+ (item (emph "an emphasized text."))
+ (item (underline "an underline text."))
+ (item (kbd "a keyboard description."))
+ (item (tt "a typewritter text."))
+ (item (code "a text representing computer code."))
+ (item (var "a computer program variable description."))
+ (item (samp "a sample."))
+ (item (sc "a smallcaps text."))
+ (item (sf "a sans-serif text."))
+ (item (sup "a superscripts text."))
+ (item (sub "a subscripts text."))
+ (item (underline (bold (it "an underline, bold, italic text.")))))
diff --git a/skribe/doc/user/src/api9.skb b/skribe/doc/user/src/api9.skb
new file mode 100644
index 0000000..1f6890e
--- /dev/null
+++ b/skribe/doc/user/src/api9.skb
@@ -0,0 +1,5 @@
+(itemize
+ (item (font :size -2 [A smaller font.]))
+ (item (font :size 6 [An absolute font size.]))
+ (item (font :size 4. [A larger font.]))
+ (item (font :face "Helvetica" [An helvetica example.])))
diff --git a/skribe/doc/user/src/bib1.sbib b/skribe/doc/user/src/bib1.sbib
new file mode 100644
index 0000000..3f1c04f
--- /dev/null
+++ b/skribe/doc/user/src/bib1.sbib
@@ -0,0 +1,39 @@
+(book queinnec:lisp
+ (author "Queinnec, C.")
+ (title "Lisp In Small Pieces")
+ (publisher "Cambridge University Press")
+ (year "1996"))
+
+(book scheme:ieee
+ (title "IEEE Standard for the Scheme Programming Language")
+ (author "IEEE Std 1178-1990")
+ (publisher "Institute of Electrical and Electronic Engineers, Inc.")
+ (address "New York, NY")
+ (year "1991"))
+
+(misc bigloo
+ (url "http://www.inria.fr/mimosa/fp/Bigloo"))
+
+(misc scheme:r4rs
+ (title "The Revised4 Report on the Algorithmic Language Scheme")
+ (author "Clinger, W. and Rees, J.")
+ (month "Nov")
+ (year "1991")
+ (url "http://www.cs.indiana.edu/scheme-repository/R4RS/r4rs_toc.html"))
+
+(article scheme:r5rs
+ (title "The Revised5 Report on the Algorithmic Language Scheme")
+ (author "Kelsey, R. and Clinger, W. and Rees, J.")
+ (journal "Higher-Order and Symbolic Computation")
+ (volume "11")
+ (number "1")
+ (month "Sep")
+ (year "1998")
+ (url "http://kaolin.unice.fr/Bigloo/doc/r5rs.html"))
+
+(book as:sicp
+ (author "Abelson, H. and Sussman, G.")
+ (title "Structure and Interpretation of Computer Programs")
+ (year "1985")
+ (publisher "MIT Press")
+ (address "Cambridge, Mass., USA"))
diff --git a/skribe/doc/user/src/bib2.skb b/skribe/doc/user/src/bib2.skb
new file mode 100644
index 0000000..25417b5
--- /dev/null
+++ b/skribe/doc/user/src/bib2.skb
@@ -0,0 +1,7 @@
+[Scheme ,(ref :bib 'scheme:r5rs) is functional programming language. It exists
+several books about this language ,(ref :bib '(as:sicp queinnec:lisp)).
+
+,(linebreak 2)
+,(center (bold [-- Bibliography --]))
+
+,(center (frame :border 1 :margin 2 :width 90. (the-bibliography)))]
diff --git a/skribe/doc/user/src/bib3.skb b/skribe/doc/user/src/bib3.skb
new file mode 100644
index 0000000..9cb838e
--- /dev/null
+++ b/skribe/doc/user/src/bib3.skb
@@ -0,0 +1,3 @@
+(center
+ (frame :border 1 :margin 2 :width 90.
+ (the-bibliography :pred (lambda (m n) #t))))
diff --git a/skribe/doc/user/src/bib4.skb b/skribe/doc/user/src/bib4.skb
new file mode 100644
index 0000000..81ba5df
--- /dev/null
+++ b/skribe/doc/user/src/bib4.skb
@@ -0,0 +1,5 @@
+(center
+ (frame :border 1 :margin 2 :width 90.
+ (the-bibliography :pred (lambda (m n)
+ (and (eq? (markup-option m 'kind) 'book)
+ (pair? (markup-option m 'used)))))))
diff --git a/skribe/doc/user/src/bib5.skb b/skribe/doc/user/src/bib5.skb
new file mode 100644
index 0000000..a0ee361
--- /dev/null
+++ b/skribe/doc/user/src/bib5.skb
@@ -0,0 +1,24 @@
+(center
+ (frame :border 1 :margin 2 :width 90.
+ (processor :engine
+ (make-engine '_ :filter string-upcase)
+ :combinator
+ (lambda (e1 e2)
+ (let ((e (copy-engine '_ e2)))
+ (markup-writer '&bib-entry-ident e
+ :action
+ (lambda (n e)
+ (let* ((be (ast-parent n))
+ (o (markup-option be 'author))
+ (y (markup-option be 'year)))
+ (output (markup-body o) e1)
+ (display ":")
+ (output (markup-body y) e))))
+ (markup-writer '&bib-entry-title e
+ :action
+ (lambda (n e)
+ (skribe-eval (it (markup-body n)) e)))
+ e))
+ (the-bibliography :pred
+ (lambda (m n)
+ (eq? (markup-option m 'kind) 'book))))))
diff --git a/skribe/doc/user/src/bib6.skb b/skribe/doc/user/src/bib6.skb
new file mode 100644
index 0000000..013ca97
--- /dev/null
+++ b/skribe/doc/user/src/bib6.skb
@@ -0,0 +1 @@
+(bibliography :command "gzip -d --to-stdout ~a | skribebibtex" "scheme.bib.gz")
diff --git a/skribe/doc/user/src/index1.skb b/skribe/doc/user/src/index1.skb
new file mode 100644
index 0000000..199428c
--- /dev/null
+++ b/skribe/doc/user/src/index1.skb
@@ -0,0 +1 @@
+(define *index1* (make-index "a new index"))
diff --git a/skribe/doc/user/src/index2.skb b/skribe/doc/user/src/index2.skb
new file mode 100644
index 0000000..f49cf33
--- /dev/null
+++ b/skribe/doc/user/src/index2.skb
@@ -0,0 +1,11 @@
+[The identifier ,(code "Foo"),(index :index *index1* "Foo") is a usually
+used as an example. When two identifiers have to used, frequently the
+second choice is ,(code "Bar"),(index :index *index1* "Bar" :shape (it "Bar")).
+When three are needed, some use ,(code "Baz")
+,(index :index *index1* "Baz" :shape (it "Baz")).
+
+This illustrates how to use identifier
+,(index :index *index1* "Foo" :note "How to use Foo")
+,(index :index *index1* "Foo" :note "How not to use Foo")
+,(index :index *index1* "Fooz")
+...]
diff --git a/skribe/doc/user/src/index3.skb b/skribe/doc/user/src/index3.skb
new file mode 100644
index 0000000..3d76a90
--- /dev/null
+++ b/skribe/doc/user/src/index3.skb
@@ -0,0 +1 @@
+(the-index *index1*)
diff --git a/skribe/doc/user/src/links1.skb b/skribe/doc/user/src/links1.skb
new file mode 100644
index 0000000..e0ce61c
--- /dev/null
+++ b/skribe/doc/user/src/links1.skb
@@ -0,0 +1,23 @@
+[This hyperlink points to the ,(ref :figure "The great Penguin" :text "figure")
+of the chapter ,(ref :chapter "Standard Markups") (or also, the
+,(ref :ident "Standard Markups" :text "chapter") about markups).
+In the second example of reference, no ,(code ":text") option is specified:
+,(ref :figure "The great Penguin"). One may use the ,(param ":ident")
+field when specified such as: ,(ref :ident "fig1") or ,(ref :figure "fig1").
+
+,(linebreak)
+That other one points to a well known
+,(ref :url "http://slashdot.org/" :text "url"). The same without
+,(code ":text"): ,(ref :url "http://slashdot.org/").
+
+,(linebreak)
+With more complex tricks that are explained in Section
+,(ref :section "Resolve"), it is also possible use, for the text of the
+reference, a container number such as chapter:
+,(resolve (lambda (n e env)
+ (let ((s (find1-down (lambda (x)
+ (and (is-markup? x 'chapter)
+ (string=? (markup-option x :title)
+ "Standard Markups")))
+ (ast-document n))))
+ (ref :handle (handle s) :text (markup-option s :number))))).]
diff --git a/skribe/doc/user/src/links2.skb b/skribe/doc/user/src/links2.skb
new file mode 100644
index 0000000..7cdee07
--- /dev/null
+++ b/skribe/doc/user/src/links2.skb
@@ -0,0 +1,4 @@
+[It is possible to send a mail by
+,(mailto "foo@nowhere.com" :text "clicking") that link. That same
+reference without ,(code ":text") options: ,(mailto "foo@nowhere.com").
+]
diff --git a/skribe/doc/user/src/prgm1.skb b/skribe/doc/user/src/prgm1.skb
new file mode 100644
index 0000000..dcdeb88
--- /dev/null
+++ b/skribe/doc/user/src/prgm1.skb
@@ -0,0 +1,15 @@
+(frame :width 100.
+ (prog :line 10 :mark "##" [
+SKRIBE=skribe
+
+all: demo.html demo.man ##main-goal
+
+demo.html: demo.skb
+ $(SKRIBE) demo.skb -o demo.html
+
+demo.man: demo.skb
+ $(SKRIBE) demo.skb -o demo.man
+]))
+
+(p [The main goal is specified line ,(ref :line "main-goal").])
+
diff --git a/skribe/doc/user/src/prgm2.skb b/skribe/doc/user/src/prgm2.skb
new file mode 100644
index 0000000..5b5644b
--- /dev/null
+++ b/skribe/doc/user/src/prgm2.skb
@@ -0,0 +1,18 @@
+(frame :width 100.
+ (prog (source :language bigloo :file "prgm.skb" :definition 'fib)))
+
+(p [The Fibonacci function is defined line ,(ref :line "fib").])
+
+;!start
+(frame :width 100.
+ (prog :line 11 :mark #f
+ (source :language skribe :file "prgm.skb" :start 11 :stop 24)))
+;!stop
+
+(p [Here is the source of the frame above:])
+
+(frame :width 100.
+ (prog :line 30 :mark #f
+ (source :language skribe :file "src/prgm2.skb"
+ :start ";!start"
+ :stop ";!stop")))
diff --git a/skribe/doc/user/src/prgm3.skb b/skribe/doc/user/src/prgm3.skb
new file mode 100644
index 0000000..51cb564
--- /dev/null
+++ b/skribe/doc/user/src/prgm3.skb
@@ -0,0 +1,55 @@
+(define (makefile-fontifier string)
+ (with-input-from-string string
+ (lambda ()
+ (read/rp (regular-grammar ()
+ ((: #\# (+ all))
+ ;; makefile comment
+ (let ((cmt (the-string)))
+ (cons (it cmt) (ignore))))
+ ((bol (: (+ (out " \t\n:")) #\:))
+ ;; target
+ (let ((prompt (the-string)))
+ (cons (bold prompt) (ignore))))
+ ((bol (: (+ alpha) #\=))
+ ;; variable definitions
+ (let* ((len (- (the-length) 1))
+ (var (the-substring 0 len)))
+ (cons (list (color :fg "#bb0000" (bold var)) "=")
+ (ignore))))
+ ((+ (out " \t\n:=$"))
+ ;; plain strings
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ ((: #\$ #\( (+ (out " )\n")) #\))
+ ;; variable references
+ (let ((str (the-string))
+ (var (the-substring 2 (- (the-length) 1))))
+ (cons (underline str) (ignore))))
+ ((+ (in " \t\n:"))
+ ;; separators
+ (let ((nl (the-string)))
+ (cons nl (ignore))))
+ (else
+ ;; default
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ '()
+ (skribe-error 'makefile "Unexpected char" c)))))
+ (current-input-port)))))
+
+(define makefile
+ (language :name "Makefile"
+ :fontifier makefile-fontifier))
+
+(frame :width 100.
+ (prog (source :language makefile [
+SKRIBE=skribe
+
+all: demo.html demo.man
+
+demo.html: demo.skb
+ $(SKRIBE) demo.skb -o demo.html
+
+demo.man: demo.skb
+ $(SKRIBE) demo.skb -o demo.man
+])))
diff --git a/skribe/doc/user/src/slides.skb b/skribe/doc/user/src/slides.skb
new file mode 100644
index 0000000..ac584d1
--- /dev/null
+++ b/skribe/doc/user/src/slides.skb
@@ -0,0 +1,27 @@
+(skribe-load "slide.skr" :advi #t)
+
+(document :title (color :fg "red" (sf (font :size +2. "Skribe Slides")))
+ :author (author :name (it "Manuel Serrano")
+ :affiliation [Inria Sophia Antipolis]
+ :address (ref :url "http://www.inria.fr/mimosa/Manuel.Serrano"))
+
+ (if (engine-format? "html")
+ (slide :title "Table of contents" :number #f :toc #f
+ (toc :chapter #f :section #f :subsection #f :subsubsection #f
+ :slide #t)))
+
+ (slide :title "X11 client" :toc #t :vspace 0.3
+
+ (itemize
+ (item "xlock")
+ (item "xeyes")
+ (item "xterm")))
+
+ (slide :title "Xclock" :toc #t :vspace 0.3
+
+ (center (sf (underline "The Unix xclock client")))
+ (slide-vspace 0.3)
+
+ (slide-pause)
+ (slide-embed :command "xlock"
+ :alt (frame "Can't run embedded application"))))
diff --git a/skribe/doc/user/src/start1.skb b/skribe/doc/user/src/start1.skb
new file mode 100644
index 0000000..4e37dda
--- /dev/null
+++ b/skribe/doc/user/src/start1.skb
@@ -0,0 +1,2 @@
+(document :title [Hello World!] [
+This is a very simple text.])
diff --git a/skribe/doc/user/src/start2.skb b/skribe/doc/user/src/start2.skb
new file mode 100644
index 0000000..9fcfdbf
--- /dev/null
+++ b/skribe/doc/user/src/start2.skb
@@ -0,0 +1,2 @@
+(document :title [Hello World!] [
+This is a ,(bold [very]) ,(it [simple]) ,(color :fg [red] [text]).])
diff --git a/skribe/doc/user/src/start3.skb b/skribe/doc/user/src/start3.skb
new file mode 100644
index 0000000..0705966
--- /dev/null
+++ b/skribe/doc/user/src/start3.skb
@@ -0,0 +1,10 @@
+(document :title [Hello World!]
+
+(section :title [A first Section] [
+ This is a ,(bold [very]) ,(it [simple]) ,(color :fg [red] [text]).])
+
+(section :title [A second Section] [
+ That section contains an ,(bold itemize) construction:
+ ,(itemize (item [first item])
+ (item [second item])
+ (item [third item]))]))
diff --git a/skribe/doc/user/src/start4.skb b/skribe/doc/user/src/start4.skb
new file mode 100644
index 0000000..3311925
--- /dev/null
+++ b/skribe/doc/user/src/start4.skb
@@ -0,0 +1,13 @@
+(document :title [Various links] [
+
+(section :title "A Section" [
+The first link points to an external web page. Here we point to a
+,(ref :url [http://slashdot.org/] [Slashdot])
+web page. The second one points to the second
+,(ref :section [A second Section] [Section])
+of that document.])
+
+(section :title [A second Section] [
+The last links points to the first
+,(ref :scribe [user.scr] :figure [A simple web page] [Figure])
+of the Scribe User Manual.])])
diff --git a/skribe/doc/user/src/start5.skb b/skribe/doc/user/src/start5.skb
new file mode 100644
index 0000000..9e6b877
--- /dev/null
+++ b/skribe/doc/user/src/start5.skb
@@ -0,0 +1,9 @@
+(resolve (lambda (n e env)
+ (let* ((current-chapter (ast-chapter n))
+ (body (markup-body current-chapter))
+ (sects (filter (lambda (x) (is-markup? x 'section))
+ body)))
+ (itemize
+ (map (lambda (x)
+ (item (it (markup-option x :title))))
+ sects)))))
\ No newline at end of file
diff --git a/skribe/doc/user/start.skb b/skribe/doc/user/start.skb
new file mode 100644
index 0000000..f3c1e28
--- /dev/null
+++ b/skribe/doc/user/start.skb
@@ -0,0 +1,197 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/start.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 11:22:25 2003 */
+;* Last change : Sun Feb 29 16:14:21 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Getting started with Skribe */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Getting started */
+;*---------------------------------------------------------------------*/
+(chapter :title "Getting Started"
+
+(p [
+In this chapter, the syntax of a Skribe text is presented ,(emph "informally").
+In particular, the Skribe syntax is compared to the HTML syntax. Then,
+it is presented how one can use Skribe to make dynamic text
+(i.e texts which are generated by the system rather than entered-in by hand.
+Finally, It is also
+presented how Skribe source files can be processed.])
+
+;*--- Hello world -----------------------------------------------------*/
+(section :title "Hello World!" [
+In this section we show how to produce very simple electronic documents
+with Skribe. Suppose that we want to produce the following Web document:
+
+,(disp [,(font :size 2. (bold "Hello World!"))
+,(linebreak 2)
+This is a very simple text.])
+
+The HTML source file for such a page should look like:
+
+,(prgm :language xml [
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>Hello world Example</TITLE>
+</HEAD>
+<BODY>
+<H1>Hello World!</H1>
+
+This is a very simple text.
+</BODY>
+</HTML>])
+
+In Skribe, the very same document must be written:
+
+,(prgm :language skribe :file "src/start1.skb")])
+
+;*--- Adding colors and fonts -----------------------------------------*/
+(section :title "Adding colors and fonts" [
+Let us suppose that we want now to colorize and change the face of some
+words such as:
+
+,(disp [,(font :size 2. (bold "Hello World!"))
+,(linebreak 2)
+This is a ,(bold "very") ,(it "simple") ,(color :fg "red" "text").])
+
+The HTML source file for such a document should look like:
+
+,(prgm :language xml [
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>Hello world Example</TITLE>
+</HEAD>
+<BODY>
+<H1>Hello World!</H1>
+
+This is a <B>very</B> <I>simple</I> <FONT color="red">text</FONT>.
+</BODY>
+</HTML>])
+
+In Skribe, the very same document must be written:
+
+,(prgm :language skribe (source :file "src/start2.skb"))
+
+As one may notice the Skribe version is much more compact than the HTML one.])
+
+;*--- Structured documents --------------------------------------------*/
+(section :title "Structured documents" [
+,(p [For large documents there is an obvious need of structure. Skribe
+documents may contain ,(bold "chapters"), ,(bold "sections"),
+,(bold "subsections"), ,(bold "itemize"), ... For instance, if we want to
+extend our previous example to:])
+
+,(disp :verb #t [,(bold (font :size 2. "Hello World!"))
+
+,(font :size 1. (bold "1. A first Section"))
+This is a ,(bold "very") ,(it "simple") ,(color :fg "red" "text").
+
+,(font :size 1. (bold "2. A second Section"))
+That contains an ,(bold "itemize") construction:
+ . first item
+ . second item
+ . third item])
+
+The Skribe source for that text is:
+
+,(prgm :language skribe (source :file "src/start3.skb"))])
+
+;*--- Hyperlinks ------------------------------------------------------*/
+(section :title "Hyperlinks" [
+A Skribe document may contain links to chapters, to sections, to other
+Skribe documents or Web pages. The following Skribe source
+code illustrates these various kinds of links:
+
+,(prgm :language skribe (source :file "src/start4.skb"))])
+
+;*--- Dynamic documents -----------------------------------------------*/
+(section :title "Dynamic documents" [
+Since Skribe is a programming language, rather than just a markup language,
+it is easy to use it to generate some parts of a document. This section
+presents here the kind of documents that can be created with Skribe.
+
+,(subsection :title "Simple computations" [
+In this section we present how to introduce a simple computation into a
+document. For instance, the following sentence
+,(disp [
+Document creation date: ,(date)])
+is generated with the following piece of code
+
+,(prgm :language skribe [
+\[Document creation date: \,(date)\]
+])
+
+Here, we use the Skribe function ,(code "date") to compute the date to
+be inserted in the document. In general, any valid Scheme expression
+is authorized inside a ,(code ",(...)") construct.,(footnote
+[Skribe can be built either with Bigloo or STklos Scheme systems. The Scheme
+expressions which are valid inside a ,(code ",(...)") depends of the Scheme system
+used at Skribe construction.]).
+Another example of
+such a computation is given below.
+,(prgm :language skribe [
+\[The value of \,(symbol "pi") is \,(* 4 (atan 1))\]
+])
+When evaluated, this form produces the following output:
+,(disp [
+The value of ,(symbol "pi") is ,(* 4 (atan 1)).])
+])
+
+,(subsection :title "Text generation" [ When building a document, one
+often need to generate some repetitive text. Skribe programming skills
+can be used to ease the construction of such documents as illustrated below.
+,(disp
+(itemize
+ (map (lambda (x) (item [The square of ,(bold x) is ,(bold (* x x))]))
+ '(1 2 3 4 5 6 7 8 9))))
+This text has been generated with the following piece of code
+,(prgm :language skribe [
+(itemize
+ (map (lambda (x) (item \[The square of \,(bold x) is \,(bold (* x x))\]))
+ '(1 2 3 4 5 6 7 8 9)))
+])])
+
+,(subsection :title "Introspection" [
+In Skribe, a document is represented by a tree which is available to
+the user. So, it is easy to perform introspective tasks on the current
+document. For instance the following code displays as an
+enumeration the sections titles of the current chapter:
+
+,(prgm :language skribe :file "src/start5.skb")
+
+Without entering too much into the details here, the resolve function
+is called at the end of the document processing. This function
+searches the node representing the chapter to which belongs the
+current node and from it finds all its sections. The titles
+of these sections are put in italics in an itemize.
+
+,(p [The execution of this code yield the following text])
+
+,(disp (include "src/start5.skb"))])
+])
+
+
+;*--- Compiling skribe documents --------------------------------------*/
+(section :title "Compiling Skribe documents" [
+
+There are several ways to render a Skribe document. It can be statically
+compiled by the ,(tt "skribe") compiler to various formats such as HTML,
+LaTeX, man and so on. It can be compiled on-demand by the ,(tt "mod_skribe")
+,(ref :url "http://www.apache.org/" :text "Apache") Skribe module. In this
+section we only present static compilation.
+
+,(p [Let us suppose a Skribe text located in a file ,(tt "file.skb").
+In order to compile to various formats one must type in:])
+
+,(disp :verb #t [
+$ skribe file.skb -o file.html ,(char 35) ,(it "This produces an HTML file.")
+$ skribe file.skb -o file.tex ,(char 35) ,(it "This produces a TeX file.")
+$ skribe file.skb -o file.man ,(char 35) ,(it "This produces a man page.")
+$ skribe file.skb -o file.info ,(char 35) ,(it "This produces an info page.")
+$ skribe file.skb -o file.mgp ,(char 35) ,(it "This produces a MagicPoint document")])]))
diff --git a/skribe/doc/user/syntax.skb b/skribe/doc/user/syntax.skb
new file mode 100644
index 0000000..de60bd9
--- /dev/null
+++ b/skribe/doc/user/syntax.skb
@@ -0,0 +1,105 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/syntax.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Nov 30 11:55:24 2001 */
+;* Last change : Sun Feb 29 16:14:53 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The syntax of Skribe */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The Skribe syntax */
+;*---------------------------------------------------------------------*/
+(chapter :title "Syntax & Values" [
+A Skribe document is composed of Skribe expressions. A Skribe expression
+can be:
+
+,(itemize (item [An atomic expression, such as a string of characters, a number.])
+ (item [A list.])
+ (item [A text.]))
+
+Here are several examples of correct Skribe expressions:
+
+,(center (frame :margin 5 :border 0 :width *prgm-width*
+ (color :margin 5 :bg *disp-color* :width 100.
+(itemize (item [,(color :fg "#009900" (tt "\"foo\"")), a string of characters composed of the
+characters `,(color :fg "#009900" "f")', `,(color :fg "#009900" "o")'
+and `,(color :fg "#009900" "o")'.])
+ (item [,(color :fg "#009900" (tt "123") " " (tt "3.14")), two numbers.])
+ (item [,(color :fg "#009900" (tt "#t") " " (tt "#f")), the ,(emph "true") and ,(emph "false")
+Skribe value.])
+ (item [,(color :fg "#009900" (tt "(bold \"foo bar\")")), a list.])
+ (item [,(color :fg "#009900" (tt (char 91)"A text sample"(char 93))), a simple text containing
+three words and no escape sequence.])
+ (item [,(color :fg "#009900" (tt (char 91)"Another text sample (that is still) simple"(char 93))),
+another simple text.])
+ (item [,(color :fg "#009900" (tt (char 91)"Another ,(bold \"text\") sample"(char 93))),
+a more complex text that contains two words (,(color :fg "#009900" (tt "Another")) and ,(color :fg "#009900" (tt "sample")))
+and an expression ,(color :fg "#009900" (tt "(bold \"text\")")). The escape sequence is introduced
+with the `,(color :fg "#009900" (tt ",("))' characters.])))))
+
+,(p [
+Expressions are evaluated, thus ,(color :fg "#009900" (tt "(bold \"foo\")"))
+has the effect of typesetting the word ,(color :fg "#009900" (tt "foo")) in
+bold face to produce ,(color :fg "#009999" (bold "foo")). Escape sequences
+enable evaluation of expressions inside the text. Thus the text
+,(color :fg "#009900" (tt (char 91)"Another ,(bold \"text\") sample"(char 93)))
+produces `,(color :fg "#009999" (tt [Another ,(bold "text") sample]))'.
+On the other hand
+,(color :fg "#009900" (tt (char 91)"Another (bold \"text\") sample"(char 93)))
+produces
+`,(color :fg "#009999" (tt [Another (bold "text") sample]))' because it does not contain
+the escape sequence `,(color :fg "#009900" (char #\,)(char #\())'.])
+]
+
+;*---------------------------------------------------------------------*/
+;* Formal syntax */
+;*---------------------------------------------------------------------*/
+(section :title "Skribe syntax"
+
+(disp :verb #t :bg *prgm-skribe-color* [
+<expr> --> <atom>
+ | <text>
+ | <list>
+<list> --> (<expr>+)
+<text> --> ,(bold (color :fg "red" (char 91))),(it "any sequence but `,(' or a `,")<list>,(it "'"),(bold (color :fg "red" (char 93)))
+<atom> --> <boolean>
+ | <integer>
+ | <float>
+ | <string>
+ | <color>
+<integer> --> ,(tt (char 91))0-9,(tt (char 93))+
+<float> --> ,(tt (char 91))0-9,(tt (char 93))+.,(tt (char 91))0-9,(tt (char 93))*
+ | ,(tt (char 91))0-9,(tt (char 93))*.,(tt (char 91))0-9,(tt (char 93))+
+<string> --> ,(tt #\")...,(tt #\")
+<color> --> <string>
+ | ,(tt #\")#,(tt (char 91))0-9a-f,(tt (char 93)),(tt (char 91))0-9a-f,(tt (char 93)),(tt (char 91))0-9a-f,(tt (char 93)),(tt (char 91))0-9a-f,(tt (char 93)),(tt (char 91))0-9a-f,(tt (char 93)),(tt (char 91))0-9a-f,(tt (char 93)),(tt #\")]))
+
+;*---------------------------------------------------------------------*/
+;* Values */
+;*---------------------------------------------------------------------*/
+(section :title "Values" :file #f :toc #t
+
+;*--- width -----------------------------------------------------------*/
+(subsection :title "Width" (p [
+,(mark "width")
+A Skribe ,(emph "width") refers to the horizontal size a construction
+occupies on an output document. There are three different ways for
+specifying a width:])
+
+(description (item :key "An absolute pixel size"
+ [This is represented by an ,(emph "exact") integer value
+ (such as ,(code "350")).])
+ (item :key "A relative size"
+ [This is represented by an ,(emph "inexact") integer value
+ (such as ,(code "50.0")) which ranges in the interval
+ ,(char 91)-100.0 .. 100.0,(char 93)])
+ (item :key "An engine dependent representation"
+ [This is represented by a string that is directly emitted
+ in the output document (such as HTML column ,(code "\"0*\"")
+ specification). Note that this way of specifying width
+ is strictly unportable.])))))
+
+
diff --git a/skribe/doc/user/table.skb b/skribe/doc/user/table.skb
new file mode 100644
index 0000000..c726d44
--- /dev/null
+++ b/skribe/doc/user/table.skb
@@ -0,0 +1,81 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/table.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Sep 5 13:45:18 2003 */
+;* Last change : Wed Oct 27 12:09:01 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe tables */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Table ... */
+;*---------------------------------------------------------------------*/
+(section :title "Table" :file #t
+
+ (p [Tables are defined by the means of the ,(code "table") function.])
+
+ (doc-markup 'table
+ `((:border [The table border thickness.])
+ (:width ,[The ,(ref :mark "width") of the table.])
+ (:frame ,[Which parts of frame to render. Must be one of
+ ,(code "none"), ,(code "above"), ,(code "below"),
+ ,(code "hsides"), ,(code "vsides"), ,(code "lhs"),
+ ,(code "rhs"), ,(code "box"), ,(code "border").])
+ (:rules ,[Rulings between rows and cols, Must be one of
+ ,(code [none]), ,(code "rows"), ,(code "cols"), ,(code "header"),
+ ,(code "all").])
+ (:cellstyle ,[The style of cells border. Must be either
+ ,(code "collapse"), ,(code "separate"), or a length representing
+ the horizontal and vertical space separating the cells.])
+ (:cellpadding [A number of pixels around each cell.])
+ (:cellspacing [An optional number of pixels used to separate each
+ cell of the table. A negative uses the target default.])
+ (#!rest row... [The rows of the table. Each row must be
+ constructed by the ,(ref :mark "tr" :text (code "tr")) function.])))
+
+ (p [,(bold (emph (color :fg "red" "Note:"))) Tables rendering may be only
+partially supported by graphical agents. For instance, the ,(code "cellstyle")
+attribute is only supported by HTML engines supporting
+,(ref :url "http://www.w3.org/TR/REC-CSS2/" :text "CSS2").])
+
+
+;*--- table rows ------------------------------------------------------*/
+(subsection :title "Table row"
+
+(p [Table rows are defined by the ,(code "tr") function.])
+
+(doc-markup 'tr
+ '((:bg [The background color of the row.])
+ (#!rest cell... [The row cells.]))))
+
+;*--- Table cell ------------------------------------------------------*/
+(subsection :title "Table cell"
+
+(p [Two functions define table cells: ,(code "th") for header cells and
+,(code "td") for plain cells.])
+
+(doc-markup 'th
+ '((:bg [The background color of the cell.])
+ (:width ,[The ,(ref :mark "width") of the table.])
+ (:align [The horizontal alignment of the table cell
+ (,(tt "left"), ,(tt "right"), or ,(tt "center"). Some
+ engines, such as the HTML engine, also supports a
+ character for the alignment.)])
+ (:valign [The vertical alignment of the cell. The value can
+ be ,(code "top"), ,(code "center"), ,(code "bottom").])
+ (:colspan [The number of columns that the cell expands to.])
+ (#!rest node [The value of the cell.]))
+ :writer-id 'tc
+ :ignore-args '(m)
+ :others '(td)))
+
+;*--- Example ---------------------------------------------------------*/
+(subsection :title "Example"
+
+(example-produce
+ (example :legend "A table" (prgm :file "src/api17.skb"))
+ (disp (include "src/api17.skb")))))
+
+;; @indent: (put 'doc-markup 'skribe-indent 'skribe-indent-function)@*
diff --git a/skribe/doc/user/toc.skb b/skribe/doc/user/toc.skb
new file mode 100644
index 0000000..aa6c0dc
--- /dev/null
+++ b/skribe/doc/user/toc.skb
@@ -0,0 +1,37 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/toc.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 13:01:03 2003 */
+;* Last change : Fri Sep 12 15:31:14 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Table of contents */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Sectioning */
+;*---------------------------------------------------------------------*/
+(section :title "Table of contents" :file #t
+
+(p [The production of table of contains.])
+
+(doc-markup 'toc
+ '((:chapter [A boolean. The value ,(code "#t") forces the
+ inclusion of chapters in the table of contents.])
+ (:section [A boolean controlling sections.])
+ (:subsection [A boolean controlling subsections.])
+ (#!rest handle [An optional handle pointing to the node from
+ which the table of contents if computed.]))
+ :see-also '(document chapter section resolve handle))
+
+(example-produce
+ (example :legend "The toc markup" (prgm :file "src/api6.skb"))
+ (disp (include "src/api6.skb")))
+
+(p [The second example only displays the table of contents of the current
+chapter.])
+
+(example-produce
+ (example :legend "A restricted table of contents" (prgm :file "src/api7.skb"))
+ (disp (include "src/api7.skb"))))
diff --git a/skribe/doc/user/user.skb b/skribe/doc/user/user.skb
new file mode 100644
index 0000000..07a6e03
--- /dev/null
+++ b/skribe/doc/user/user.skb
@@ -0,0 +1,163 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/user.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Nov 28 10:37:39 2001 */
+;* Last change : Thu Feb 26 21:02:00 2004 (eg) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe user manual */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The Skribe documentation style */
+;*---------------------------------------------------------------------*/
+(skribe-load "web-book.skr")
+(skribe-load "skr/env.skr")
+(skribe-load "skr/manual.skr")
+(skribe-load "skr/api.skr")
+
+;*---------------------------------------------------------------------*/
+;* HTML custom */
+;*---------------------------------------------------------------------*/
+;; since we load slides (for documenting it), we have to use a
+;; correct title width
+(let ((he (find-engine 'html)))
+ (engine-custom-set! he 'body-width 100.))
+
+;*---------------------------------------------------------------------*/
+;* The various indexes */
+;*---------------------------------------------------------------------*/
+(define *markup-index* (make-index "markup"))
+(define *custom-index* (make-index "custom"))
+(define *function-index* (make-index "function"))
+(define *package-index* (make-index "package"))
+
+;*---------------------------------------------------------------------*/
+;* The document */
+;*---------------------------------------------------------------------*/
+(document :title "Skribe User Manual"
+ :env '((example-counter 0) (example-env ()))
+ :author (list (author :name "Erick Gallesio"
+ :affiliation "Universit� de Nice - Sophia Antipolis"
+ :address '("930 route des Colles, BP 145"
+ "F-06903 Sophia Antipolis, Cedex"
+ "France")
+ :email (mailto "eg@essi.fr"))
+ (author :name "Manuel Serrano"
+ :affiliation "Inria Sophia-Antipolis"
+ :address `("2004 route des Lucioles - BP 93"
+ "F-06902 Sophia Antipolis, Cedex"
+ "France")
+ :url (ref :url *serrano-url*)
+ :email (mailto *serrano-mail*)))
+
+ (linebreak 1)
+ (center (frame (bold (font :size 1. [
+This is the documentation for Skribe version
+,(color :fg "red" (skribe-release)).]))))
+ (linebreak 1)
+
+;;; Introduction
+(section :title "Introduction" :number #f :toc #f [
+Skribe is a programming language designed for implementing electronic
+documents. It is mainly designed for the writing of technical documents
+such as the documentation of computer programs. With Skribe these
+documents can be rendered using various tools and technologies. For
+instance, a Skribe document can be ,(emph "compiled") to an HTML file
+that suits Web browser, it can be compiled to a TeX file in order to
+produce a high-quality printed document, and so on.]
+
+ (subsection :title "Who may use Skribe?" :number #f [
+Everyone needing to design web pages, info documents, man pages or
+Postscript files can use Skribe. In particular, there is ,(bold "no need")
+for programming skills in order to use Skribe. Skribe can be used as
+any text description languages such as TeX, LaTeX or HTML.])
+
+ (subsection :title "Why using Skribe?" :number #f [
+There are three main reasons for using Skribe:]
+
+ (itemize
+ (item [
+It is easier to type in Skribe texts than other text description formats.
+The need for ,(emph "meta keyword"), that is, words used to describe
+the structure of the text and not the text itself, is very limited.])
+ (item [
+Skribe is highly skilled for computing texts. It is very common that
+one needs to automatically produce parts of the text. This can
+be very simple such as, for instance, the need to include inside a text,
+the date of the last update or the number of the last revision.
+Sometimes it may be more complex. For instance, one may be willing to
+embed inside a text the result of a complex arithmetic computation. Or
+even, you may want to include some statistics about that
+text, such as, the number of words, paragraphs, sections, and so on.
+Skribe makes these sort of text manipulation easy whereas other
+systems rely on the use of text preprocessors.])
+ (item [
+The same source file can be compiled to various output formats such
+as HTML, Info pages, man pages, Postscript, etc.]))))
+
+;;; toc
+(if (engine-format? "latex")
+ (toc :chapter #t :section #t :subsection #t))
+
+;;; Getting started
+(include "start.skb")
+
+;;; Syntax
+(include "syntax.skb")
+
+;;; Skribe Markup Library
+(include "markup.skb")
+
+;;; Hyperlinks and references
+(include "links.skb")
+
+;;; Indexes
+(include "index.skb")
+
+;;; Bibliography
+(include "bib.skb")
+
+;;; Computer programs
+(include "prgm.skb")
+
+;;; Standard Library
+(include "lib.skb")
+
+;;; Engines
+(include "engine.skb")
+
+;;; Emacs
+(include "emacs.skb")
+
+;;; Skribe
+(include "skribec.skb")
+
+;;; Slides
+(include "slide.skb")
+
+;;; Packages
+(include "package.skb")
+
+;;; skribe-config
+(include "skribe-config.skb")
+
+;;; List of examples
+(include "examples.skb")
+
+;;; table of contents
+(if (not (engine-format? "latex"))
+ (begin
+ (chapter :title "Table of contents"
+ (toc :chapter #t :section #t :subsection #t))
+ (section :title "Index" :number #f
+ (mark "global index")
+ (the-index :column (if (engine-format? "latex") 2 3)
+ *markup-index* *custom-index* *function-index* *package-index*
+ (default-index))))
+ (chapter :title "Index"
+ (mark "global index")
+ (the-index :column (if (engine-format? "latex") 2 3)
+ *markup-index* *custom-index* *function-index* *package-index*
+ (default-index)))))
diff --git a/skribe/doc/user/xmle.skb b/skribe/doc/user/xmle.skb
new file mode 100644
index 0000000..4a1ee78
--- /dev/null
+++ b/skribe/doc/user/xmle.skb
@@ -0,0 +1,25 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/doc/user/xmle.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 3 11:20:49 2003 */
+;* Last change : Tue Apr 6 06:27:51 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The documentation of the XML engine */
+;*=====================================================================*/
+;; @indent: (put 'doc-engine 'skribe-indent 'skribe-indent-function)@
+
+;*---------------------------------------------------------------------*/
+;* Document */
+;*---------------------------------------------------------------------*/
+(section :title "Xml engine" :file #t
+ (mark "xml-engine")
+ (index "Xml" :note "Engine")
+ (p [The Xml engine...])
+
+ (subsection :title "The Xml customization"
+
+ (doc-engine 'xml
+ `()
+ :source "skr/xml.skr")))
diff --git a/skribe/emacs/Makefile b/skribe/emacs/Makefile
new file mode 100644
index 0000000..52074cb
--- /dev/null
+++ b/skribe/emacs/Makefile
@@ -0,0 +1,55 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/emacs/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Sat Oct 25 08:20:06 2003 */
+#* Last change : Thu Jan 1 16:46:32 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* Skribe emacs Makefile */
+#*=====================================================================*/
+include ../etc/Makefile.config
+include ../etc/$(SYSTEM)/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo emacs/skribe.el.in emacs/Makefile
+
+#*---------------------------------------------------------------------*/
+#* install/uninstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install:
+ $(MAKE) install-$(SYSTEM)
+uninstall:
+ $(MAKE) uninstall-$(SYSTEM)
+
+install-bigloo:
+ if [ "$(EMACSDIR) " != " " ]; then \
+ if [ -d $(EMACSDIR) ]; then \
+ cp skribe.el $(EMACSDIR) && chmod $(BMASK) $(EMACSDIR)/skribe.el; \
+ fi \
+ fi
+uninstall-bigloo:
+ if [ "$(EMACSDIR) " != " " ]; then \
+ if [ -d $(EMACSDIR) ]; then \
+ $(RM) -f $(EMACSDIR)/skribe.el; \
+ fi \
+ fi
+
+install-stklos:
+uninstall-stklos:
+
+#*---------------------------------------------------------------------*/
+#* clean/distclean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean distclean
+
+clean:
+distclean: clean
+ $(RM) -f skribe.el
diff --git a/skribe/emacs/skribe.el.in b/skribe/emacs/skribe.el.in
new file mode 100644
index 0000000..1b1ae4f
--- /dev/null
+++ b/skribe/emacs/skribe.el.in
@@ -0,0 +1,841 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/emacs/skribe.el.in */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Nov 23 13:16:30 2003 */
+;* Last change : Sun Jul 11 10:38:17 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe minor mode (major mode is supposed to be a */
+;* Scheme-like mode). */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* module */
+;*---------------------------------------------------------------------*/
+(provide 'skribe)
+(require 'ude-custom)
+(require 'ude-config)
+(require 'ude-icon)
+(require 'ude-autoload)
+(require 'bmacs-config)
+(require (if (featurep 'xemacs) 'bmacs-xemacs 'bmacs-gnu-emacs))
+
+;*---------------------------------------------------------------------*/
+;* custom */
+;*---------------------------------------------------------------------*/
+;; skribe version
+(defconst skribe-version "@SKRIBE_RELEASE@"
+ "*The Skribe version.")
+
+;; skribe group
+(defgroup skribe nil
+ "Skribe Emacs Environment."
+ :tag "Skribe"
+ :prefix "skribe-"
+ :group 'processes)
+
+;; emacs directory
+(defcustom skribe-emacs-dir '"@SKRIBE_EMACSDIR@"
+ "*Directory for Skribe Emacs installation."
+ :group 'skribe
+ :type '(string))
+
+;; additional directories for online documentation
+(defcustom skribe-docdirs '("@SKRIBE_DOCDIR@")
+ "*Directories for online documentation."
+ :group 'skribe
+ :type '(repeat (string)))
+
+;; Host scheme documentation
+(defcustom skribe-host-scheme-docdirs '("@SKRIBE_HOSTSCHEMEDOCDIR@")
+ "*URL for hosting Scheme system."
+ :group 'skribe
+ :type '(string))
+
+;; html browser
+(defcustom skribe-html-browser "mozilla"
+ "*The binary file to run for browing HTML files or nil for Emacs mode."
+ :group 'skribe
+ :type '(choice string (const nil)))
+
+;; electric parenthesis
+(defcustom skribe-electric-parenthesis t
+ "*Set his to nil if you don't want electric closing parenthesis."
+ :type 'boolean)
+
+;;;###autoload
+(defcustom skribe-mode-line-string " Skr"
+ "*String displayed on the modeline when skribe is active.
+Set this to nil if you don't want a modeline indicator."
+ :group 'skribe
+ :type '(choice string (const :tag "None" nil)))
+
+;; fixed indentation
+(defcustom skribe-forced-indent-regexp ";;;\\|;[*]"
+ "*The regexp that marks a forced indentation"
+ :group 'skribe
+ :type 'string)
+
+;; normal indentation
+(defcustom skribe-body-indent 3
+ "*The Skribe indentation width"
+ :group 'skribe
+ :type 'integer)
+
+;; font lock
+(defcustom skribe-font-lock-keywords
+ (list
+ (list (concat "\(\\(let\\|let[*]\\|letrec\\|define"
+ "\\|define-markup\\|set[!]"
+ "\\|lambda\\|labels"
+ "\\|let-syntax\\|letrec-syntax"
+ "\\|regular-grammar\\|lalr-grammar"
+ "\\|if\\|when\\|unless\\|begin\\|case\\|cond\\|else"
+ "\\|multiple-value-bind\\|values\\)[ :\n\t]")
+ 1
+ 'font-lock-keyword-face)
+
+ (list "(\\(document\\|chapter\\|section\\|subsection\\|subsubsection\\|paragraph\\|p\\|skribe-load\\|include\\|slide\\)[) \n]"
+ 1
+ 'font-lock-function-name-face)
+ (list "(\\(toc\\|itemize\\|enumerate\\|description\\|item\\|the-bibliography\\|the-index\\|default-index\\|frame\\|center\\|table\\|tr\\|th\\|td\\|linebreak\\|footnote\\|color\\|author\\|prog\\|source\\|figure\\|image\\)[) \n]"
+ 1
+ 'ude-font-lock-face-2)
+ (list "(\\(bold\\|code\\|emph\\|it\\|kbd\\|tt\\|roman\\|underline\\|var\\|samp\\|sc\\|sf\\|sup\\|sub\\)[ )]"
+ 1
+ 'ude-font-lock-face-8)
+ (list "(\\(ref\\|mailto\\|mark\\|new\\)[) \n]"
+ 1
+ 'ude-font-lock-face-3)
+ (cons "\\(:[^] \n)]+\\|#![a-zA-Z]+\\)"
+ 'ude-font-lock-face-7)
+ (cons "[[]\\|]"
+ 'ude-font-lock-face-3)
+ (list "(\\(markup-writer\\|make-engine\\|copy-engine\\|default-engine-set!\\|engine-custom\\|engine-custom-set!\\|engine-custom-add!\\|markup-option\\|markup-option-add!\\|markup-body\\)[ \n]"
+ 1
+ 'font-lock-function-name-face)
+ (list ",(\\([^ \n()]+\\)"
+ 1
+ 'ude-font-lock-face-6))
+ "*The Skribe font-lock specification."
+ :group 'skribe)
+
+;; tool-bar
+(defcustom skribe-toolbar
+ `(;; the spell button
+ ("spell.xpm" flyspell-buffer "Buffer spell check")
+ --
+ ;; the compile button
+ (,ude-compile-icon ude-mode-compile-from-menu "Compile")
+ ;; the root button
+ (,ude-root-icon ude-user-set-root-directory "Set new root directory")
+ --
+ ;; the repl button
+ (,ude-repl-icon ude-repl-other-frame "Start a read-eval-print loop")
+ --
+ -->
+ --
+ ;; online documentation
+ (,ude-help-icon skribe-doc-ident "Describe markup at point")
+ (,ude-info-icon skribe-manuals "Skribe online documentations"))
+ "*The Skribe toolbar"
+ :group 'skribe)
+
+;; paragraphs
+(defcustom skribe-paragraph-start
+ "^\\(?:[ \t\n\f]\\|;;\\|[(]\\(?:section\\|sub\\|p\\|slide\\|document\\)\\)"
+ "*The regexp that marks a paragraph start"
+ :group 'skribe
+ :type 'string)
+
+(defcustom skribe-paragraph-separate
+ "^[ \t\f%]*$"
+ "*The regexp that marks a paragraph separation"
+ :group 'skribe
+ :type 'string)
+
+;*---------------------------------------------------------------------*/
+;* Which emacs are we currently running */
+;*---------------------------------------------------------------------*/
+(defvar skribe-emacs
+ (cond
+ ((string-match "XEmacs" emacs-version)
+ 'xemacs)
+ (t
+ 'emacs))
+ "The type of Emacs we are currently running.")
+
+;*---------------------------------------------------------------------*/
+;* Autoloading */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defvar skribe-mode-map (make-sparse-keymap))
+
+;;;###autoload
+(if (fboundp 'add-minor-mode)
+ (add-minor-mode 'skribe-mode
+ 'skribe-mode-line-string
+ nil
+ nil
+ 'skribe-mode)
+
+ (or (assoc 'skribe-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(skribe-mode skribe-mode-line-string)
+ minor-mode-alist)))
+
+ (or (assoc 'skribe-mode minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'skribe-mode skribe-mode-map)
+ minor-mode-map-alist))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-manuals-menu-entry ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-manuals-menu-entry (s)
+ (let ((sym (gensym)))
+ (fset sym `(lambda ()
+ (interactive)
+ (ude-system skribe-html-browser
+ (format "file:%s" (expand-file-name ,s)))))
+ (vector (file-name-nondirectory s) sym t)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-directory-html-files */
+;*---------------------------------------------------------------------*/
+(defun skribe-directory-html-files (dirs)
+ (let ((dirs dirs)
+ (res '()))
+ (while (consp dirs)
+ (let ((dir (car dirs)))
+ (when (file-directory-p dir)
+ (setq res (append (directory-files dir t "^.+[^0-9][.]html$") res))
+ (setq dirs (cdr dirs)))))
+ res))
+
+;*---------------------------------------------------------------------*/
+;* skribe-manuals ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-manuals ()
+ (interactive)
+ (when (stringp skribe-html-browser)
+ (let ((res (skribe-directory-html-files skribe-docdirs))
+ (host (sort (skribe-directory-html-files skribe-host-scheme-docdirs)
+ 'string<)))
+ (if (= (length res) 1)
+ (ude-system skribe-html-browser
+ (format "file:%s" (expand-file-name (car res))))
+ (let (user dir)
+ (let ((old res)
+ (new '()))
+ (while (consp old)
+ (let* ((f (car old))
+ (b (file-name-nondirectory f)))
+ (setq old (cdr old))
+ (cond
+ ((string-equal b "user.html")
+ (setq user f))
+ ((string-equal b "dir.html")
+ (setq dir f))
+ (t (setq new (cons f new))))))
+ (let* ((rest (mapcar 'skribe-manuals-menu-entry
+ (sort new
+ '(lambda (s u)
+ (string<
+ (file-name-nondirectory s)
+ (file-name-nondirectory u))))))
+ (smenu (cond
+ ((and user dir)
+ (append (list (skribe-manuals-menu-entry user)
+ (skribe-manuals-menu-entry dir)
+ "--:shadowEtchedInDash")
+ rest))
+ ((dir)
+ (cons (skribe-manuals-menu-entry dir) rest))
+ ((user)
+ (cons (skribe-manuals-menu-entry user) rest))
+ (t
+ rest)))
+ (menu (if (consp host)
+ (append smenu
+ (cons "--:shadowEtchedInDash"
+ (mapcar 'skribe-manuals-menu-entry
+ host)))
+ smenu)))
+ (popup-menu
+ (cons "Doc" menu)))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-scheme-indent-line ... */
+;*---------------------------------------------------------------------*/
+(defvar skribe-scheme-indent-line nil)
+(make-variable-buffer-local 'skribe-scheme-indent-line)
+
+;*---------------------------------------------------------------------*/
+;* skribe-insert-parenthesis ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-insert-parenthesis (char)
+ ;; find the open parenthesis
+ (if skribe-electric-parenthesis
+ (let ((clo nil)
+ (tag nil))
+ (save-excursion
+ (save-restriction
+ ;; Scan across one sexp within that range.
+ ;; Errors or nil mean there is a mismatch.
+ (insert ?\))
+ (condition-case ()
+ (let ((pos (scan-sexps (point) -1)))
+ (if pos
+ (progn
+ (save-excursion
+ (goto-char pos)
+ (forward-word 1)
+ (setq tag (buffer-substring (1+ pos) (point))))
+ (setq clo (matching-paren (char-after pos)))) ))
+ (error nil))))
+ (if clo
+ (progn
+ (delete-char 1)
+ (insert clo))
+ (forward-char 1)))
+ (insert char)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-parenthesis ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-parenthesis (&optional dummy)
+ "Automatic parenthesis closing of )."
+ (interactive)
+ ;; find the open parenthesis
+ (skribe-insert-parenthesis ?\)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-bracket ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-bracket (&optional dummy)
+ "Automatic parenthesis closing of ]."
+ (interactive)
+ (skribe-insert-parenthesis ?\]))
+
+;*---------------------------------------------------------------------*/
+;* skribe-doc-ident ... */
+;* ------------------------------------------------------------- */
+;* On-line document for identifier IDENT. This spawns an */
+;* HTML browser for serving the documentation. */
+;*---------------------------------------------------------------------*/
+(defun skribe-doc-ident (ident)
+ (interactive (ude-interactive-ident (point) "Identifier: "))
+ (and (stringp skribe-html-browser)
+ (let ((dirs skribe-docdirs))
+ (while (consp dirs)
+ (let* ((dir (car dirs))
+ (html-ref (ude-sui-find-ref ident dir)))
+ (if (stringp html-ref)
+ (progn
+ (ude-system skribe-html-browser
+ (format "file:%s/%s"
+ (expand-file-name dir)
+ html-ref))
+ (setq dirs '()))
+ (setq dirs (cdr dirs))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-mode ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defvar skribe-mode nil)
+(make-variable-buffer-local 'skribe-mode)
+
+;*---------------------------------------------------------------------*/
+;* skribe-major-mode ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun skribe-major-mode ()
+ "Major mode for editing Skribe code."
+ (interactive)
+ (bee-mode)
+ (skribe-mode t))
+
+;*---------------------------------------------------------------------*/
+;* skribe-mode ... */
+;*---------------------------------------------------------------------*/
+;;;###autoload
+(defun skribe-mode (&optional arg)
+ "Minor mode for editing Skribe sources.
+
+Bindings:
+\\[skribe-doc-ident]: on-line document.
+
+Hooks:
+This runs `skribe-mode-hook' after skribe is enterend."
+ (interactive "P")
+ (let ((old-skribe-mode skribe-mode))
+ ;; Mark the mode as on or off.
+ (setq skribe-mode (not (or (and (null arg) skribe-mode)
+ (<= (prefix-numeric-value arg) 0))))
+ ;; Do the real work.
+ (unless (eq skribe-mode old-skribe-mode)
+ (if skribe-mode (skribe-activate-mode) nil))
+ ;; Force modeline redisplay.
+ (set-buffer-modified-p (buffer-modified-p))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-return ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-return (&optional dummy)
+ "Automatic indentation on RET."
+ (interactive)
+ (newline)
+ (if (>= (point) (point-min))
+ (skribe-indent-line)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-line-toggle ... */
+;*---------------------------------------------------------------------*/
+(defvar skribe-indent-line-toggle nil)
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-line ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-line ()
+ (interactive)
+ (if (eq last-command 'skribe-indent-line)
+ (if skribe-indent-line-toggle
+ (skribe-do-indent-line)
+ (progn
+ (setq skribe-indent-line-toggle t)
+ (if skribe-scheme-indent-line
+ (funcall skribe-scheme-indent-line))))
+ (skribe-do-indent-line)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-do-indent-line ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-do-indent-line ()
+ (setq skribe-indent-line-toggle nil)
+ (let ((start (point)) beg)
+ (beginning-of-line)
+ (setq beg (point))
+ (skip-chars-forward " \t")
+ (let* ((pos (- (point-max) start))
+ (indent (skribe-calculate-indent start)))
+ (when indent
+ (if (listp indent) (setq indent (car indent)))
+ (let ((shift-amt (- indent (current-column))))
+ (if (zerop shift-amt)
+ nil
+ (delete-region beg (point))
+ (indent-to indent))))
+ ;; If initial point was within line's indentation,
+ ;; position after the indentation.
+ ;; Else stay at same point in text.
+ (if (> (- (point-max) pos) (point))
+ (goto-char (- (point-max) pos))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-calculate-indent ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-calculate-indent (start &optional parse-start)
+ "Return appropriate indentation for current line as Skribe code.
+In usual case returns an integer: the column to indent to.
+Can instead return a list, whose car is the column to indent to.
+This means that following lines at the same level of indentation
+should not necessarily be indented the same way.
+The second element of the list is the buffer position
+of the start of the containing expression."
+ (or (skribe-calculate-forced-indent)
+ (skribe-calculate-free-indent start parse-start)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-calculate-forced-indent ... */
+;* ------------------------------------------------------------- */
+;* Returns a column number iff the line indentation is forced */
+;* (i.e. the previous line starts with a "[ \t]*;;;"). Otherwise */
+;* returns f. */
+;*---------------------------------------------------------------------*/
+(defun skribe-calculate-forced-indent ()
+ (save-excursion
+ (previous-line 1)
+ (beginning-of-line)
+ (skip-chars-forward " \t")
+ (let ((s (current-column)))
+ (and (looking-at skribe-forced-indent-regexp) s))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-calculate-free-indent ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-calculate-free-indent (start &optional parse-start)
+ (save-excursion
+ (beginning-of-line)
+ (let ((indent-point (point)) state paren-depth desired-indent (retry t)
+ last-sexp containing-sexp first-sexp-list-p skribe-indent)
+ (if parse-start
+ (goto-char parse-start)
+ ;; TOBE IMPROVED
+ (goto-char (point-min)))
+;* (beginning-of-defun)) */
+ ;; Find outermost containing sexp
+ (while (< (point) indent-point)
+ (setq state (parse-partial-sexp (point) indent-point 0)))
+ ;; Find innermost containing sexp
+ (while (and retry (setq paren-depth (car state)) (> paren-depth 0))
+ (setq retry nil)
+ (setq last-sexp (nth 2 state))
+ (setq containing-sexp (car (cdr state)))
+ ;; Position following last unclosed open.
+ (goto-char (1+ containing-sexp))
+ ;; Is there a complete sexp since then?
+ (if (and last-sexp (> last-sexp (point)))
+ ;; Yes, but is there a containing sexp after that?
+ (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
+ (if (setq retry (car (cdr peek))) (setq state peek))))
+ (if (not retry)
+ ;; Innermost containing sexp found
+ (progn
+ (goto-char (1+ containing-sexp))
+ (if (not last-sexp)
+ ;; indent-point immediately follows open paren.
+ ;; Don't call hook.
+ (setq desired-indent (current-column))
+ ;; Move to first sexp after containing open paren
+ (parse-partial-sexp (point) last-sexp 0 t)
+ (setq first-sexp-list-p (looking-at "\\s("))
+ (cond
+ ((> (save-excursion (forward-line 1) (point))
+ last-sexp)
+ ;; Last sexp is on same line as containing sexp.
+ ;; It's almost certainly a function call.
+ (parse-partial-sexp (point) last-sexp 0 t)
+ (if (/= (point) last-sexp)
+ ;; Indent beneath first argument or, if only one sexp
+ ;; on line, indent beneath that.
+ (progn (forward-sexp 1)
+ (parse-partial-sexp (point) last-sexp 0 t)))
+ (backward-prefix-chars))
+ (t
+ ;; Indent beneath first sexp on same line as last-sexp.
+ ;; Again, it's almost certainly a function call.
+ (goto-char last-sexp)
+ (beginning-of-line)
+ (parse-partial-sexp (point) last-sexp 0 t)
+ (backward-prefix-chars)))))))
+ ;; If looking at a list, don't call hook.
+ (if first-sexp-list-p
+ (setq desired-indent (current-column)))
+ ;; Point is at the point to indent under unless we are inside a string.
+ ;; Call indentation hook except when overriden by skribe-indent-offset
+ ;; or if the desired indentation has already skriben computed.
+ '(message-box (format "start=%s\nfirst-sexp-lisp-p: %s\nstate: %s\ndesired-indent: %s\nintegerp=%s\nchar-after=%s\ncur-char=%s\npoint=%s\nskribe-indent-function-p=%s\n" start first-sexp-list-p state desired-indent
+ (integerp (car (nthcdr 1 state)))
+ (char-after (car (nthcdr 1 state)))
+ (char-after (point))
+ (point)
+ (skribe-indent-method state)))
+ (cond ((car (nthcdr 3 state))
+ ;; Inside a string, don't change indentation.
+ (goto-char indent-point)
+ (skip-chars-forward " \t")
+ (setq desired-indent (current-column)))
+ ((skribe-indent-bracket-p state)
+ ;; indenting a bracket
+ (save-excursion
+ (goto-char start)
+ (skip-chars-forward " \t")
+ (let ((c (car (nthcdr 9 state))))
+ (if (and (consp c) (looking-at ",(") nil)
+ (let ((l (length c)))
+ (if (< l 2)
+ (setq desired-indent 0)
+ (progn
+ (goto-char (car (nthcdr (- l 2) c)))
+ (setq desired-indent (current-column)))))
+ (setq desired-indent 0)))))
+ ((setq skribe-indent (skribe-indent-method state))
+ ;; skribe special form
+ (setq desired-indent skribe-indent))
+ (skribe-scheme-indent-line
+ ;; scheme form
+ (goto-char start)
+ (funcall skribe-scheme-indent-line)
+ (setq desired-indent nil))
+ (t
+ ;; use default indentation if not computed yet
+ (setq desired-indent (current-column))))
+ desired-indent)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-bracket-p ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-bracket-p (state)
+ (or (and (integerp (car (nthcdr 1 state)))
+ (eq (char-after (car (nthcdr 1 state))) ?[))
+ (let ((op (car (nthcdr 9 state))))
+ (and (consp op)
+ (let ((po (reverse op))
+ (context 'unknown))
+ (save-excursion
+ (while (and (consp po) (eq context 'unknown))
+ (cond
+ ((eq (char-after (car po)) ?[)
+ (setq context 'skribe))
+ ((and (eq (char-after (car po)) ?\()
+ (> (car po) (point-min))
+ (eq (char-after (1- (car po))) ?,))
+ (setq context 'scheme))
+ (t
+ (setq po (cdr po))))))
+ (eq context 'skribe))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-method ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-method (state)
+ (let ((is (car (nthcdr 1 state))))
+ (and (integerp is)
+ (save-excursion
+ (goto-char is)
+ (let* ((function (intern-soft
+ (buffer-substring
+ (progn (forward-char 1) (point))
+ (progn (forward-sexp 1) (point)))))
+ (method (get function 'skribe-indent)))
+ (if (functionp method)
+ (funcall method state)
+ nil))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-function ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-function (state)
+ (save-excursion
+ (goto-char (car (nthcdr 1 state)))
+ (+ (current-column) skribe-body-indent)))
+
+;*---------------------------------------------------------------------*/
+;* normal-indent ... */
+;*---------------------------------------------------------------------*/
+(defvar normal-indent 0)
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-sexp ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-sexp ()
+ "Indent each line of the list starting just after point."
+ (interactive)
+ (let ((indent-stack (list nil)) (next-depth 0) last-depth bol
+ outer-loop-done inner-loop-done state this-indent)
+ (save-excursion (forward-sexp 1))
+ (save-excursion
+ (setq outer-loop-done nil)
+ (while (not outer-loop-done)
+ (setq last-depth next-depth
+ inner-loop-done nil)
+ (while (and (not inner-loop-done)
+ (not (setq outer-loop-done (eobp))))
+ (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
+ nil nil state))
+ (setq next-depth (car state))
+ (if (car (nthcdr 4 state))
+ (progn (skribe-comment-indent)
+ (end-of-line)
+ (setcar (nthcdr 4 state) nil)))
+ (if (car (nthcdr 3 state))
+ (progn
+ (forward-line 1)
+ (setcar (nthcdr 5 state) nil))
+ (setq inner-loop-done t)))
+ (if (setq outer-loop-done (<= next-depth 0))
+ nil
+ (while (> last-depth next-depth)
+ (setq indent-stack (cdr indent-stack)
+ last-depth (1- last-depth)))
+ (while (< last-depth next-depth)
+ (setq indent-stack (cons nil indent-stack)
+ last-depth (1+ last-depth)))
+ (forward-line 1)
+ (setq bol (point))
+ (skip-chars-forward " \t")
+ (if (or (eobp) (looking-at ";\\(;;\\|[*]\\)"))
+ nil
+ (let ((val (skribe-calculate-indent
+ (point)
+ (if (car indent-stack) (- (car indent-stack))))))
+ (cond
+ ((integerp val)
+ (setcar indent-stack (setq this-indent val)))
+ ((consp val)
+ (setcar indent-stack (- (car (cdr val))))
+ (setq this-indent (car val)))
+ (t
+ (setq this-indent nil))))
+ (if (and (integerp this-indent) (/= (current-column) this-indent))
+ (progn (delete-region bol (point))
+ (indent-to this-indent)))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-comment-indent ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-comment-indent (&optional pos)
+ (save-excursion
+ (if pos (goto-char pos))
+ (cond
+ ((looking-at ";;;")
+ (current-column))
+ ((looking-at ";*")
+ 0)
+ ((looking-at "[ \t]*;;")
+ (let ((tem (skribe-calculate-indent (point))))
+ (if (listp tem) (car tem) tem)))
+ (t
+ (skip-chars-backward " \t")
+ (max (if (bolp) 0 (1+ (current-column)))
+ comment-column)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-custom-indent ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-custom-indent ()
+ (save-excursion
+ (goto-char (point-min))
+ ;; The concat is used to split the regexp so that it is nolonger
+ ;; to find itself! Without the split, the skribe mode cannot be
+ ;; used to edit this source file!
+ (let ((regexp (concat "@ind" "ent:\\([^@]+\\)@")))
+ (while (re-search-forward regexp (point-max) t)
+ (condition-case ()
+ (eval-region (match-beginning 1) (match-end 1) nil)
+ (error nil))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-indent-load ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-indent-load (file)
+ (let ((lp (cons skribe-emacs-dir load-path)))
+ (while (consp lp)
+ (let ((f (concat (car lp) "/" file)))
+ (if (file-exists-p f)
+ (progn
+ (load f)
+ (set! lp '()))
+ (set! lp (cdr lp)))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-activate-mode ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-activate-mode ()
+ ;; buffer local global variables
+ (make-variable-buffer-local 'ude-extra-identifier-chars)
+ (setq ude-extra-identifier-chars "-")
+ ;; the keymap
+ (skribe-activate-keymap skribe-mode-map)
+ ;; font lock
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults '(skribe-font-lock-keywords))
+ (font-lock-mode nil)
+ (font-lock-mode t)
+ ;; paragraph
+ (make-variable-buffer-local 'paragraph-start)
+ (setq paragraph-start skribe-paragraph-start)
+ (make-variable-buffer-local 'paragraph-separate)
+ (setq paragraph-separate skribe-paragraph-separate)
+ ;; try to retreive the globa'paragraph-startl indentation binding
+ (if (not skribe-scheme-indent-line)
+ (setq skribe-scheme-indent-line (global-key-binding "\t")))
+ ;; the toolbar
+ (use-local-map skribe-mode-map)
+ (ude-toolbar-set skribe-toolbar)
+ ;; the custom indentation
+ (skribe-custom-indent)
+ ;; we end with the skribe hooks
+ (run-hooks 'skribe-mode-hook)
+ t)
+
+;*---------------------------------------------------------------------*/
+;* skribe-activate-keymap ... */
+;*---------------------------------------------------------------------*/
+(defun skribe-activate-keymap (map)
+ (define-key map "\C-m" 'skribe-return)
+ (define-key map "\e\C-m" 'newline)
+ (define-key map "\t" 'skribe-indent-line)
+ (define-key map ")" 'skribe-parenthesis)
+ (define-key map "]" 'skribe-bracket)
+ (define-key map "\e\C-q" 'skribe-indent-sexp)
+ (cond
+ ((eq skribe-emacs 'xemacs)
+ (define-key map [(control \))] (lambda () (interactive) (insert ")")))
+ (define-key map [(control \])] (lambda () (interactive) (insert "]"))))
+ (t
+ (define-key map [?\C-\)] (lambda () (interactive) (insert ")")))
+ (define-key map [?\C-\]] (lambda () (interactive) (insert "]"))))))
+
+;*---------------------------------------------------------------------*/
+;* Standard Skribe indent forms */
+;*---------------------------------------------------------------------*/
+(put 'make-engine 'skribe-indent 'skribe-indent-function)
+(put 'copy-engine 'skribe-indent 'skribe-indent-function)
+(put 'markup-writer 'skribe-indent 'skribe-indent-function)
+(put 'engine-custom 'skribe-indent 'skribe-indent-function)
+(put 'engine-custom-set! 'skribe-indent 'skribe-indent-function)
+(put 'document 'skribe-indent 'skribe-indent-function)
+(put 'author 'skribe-indent 'skribe-indent-function)
+(put 'chapter 'skribe-indent 'skribe-indent-function)
+(put 'section 'skribe-indent 'skribe-indent-function)
+(put 'subsection 'skribe-indent 'skribe-indent-function)
+(put 'subsubsection 'skribe-indent 'skribe-indent-function)
+(put 'paragraph 'skribe-indent 'skribe-indent-function)
+(put 'footnote 'skribe-indent 'skribe-indent-function)
+(put 'linebreak 'skribe-indent 'skribe-indent-function)
+(put 'hrule 'skribe-indent 'skribe-indent-function)
+(put 'color 'skribe-indent 'skribe-indent-function)
+(put 'frame 'skribe-indent 'skribe-indent-function)
+(put 'font 'skribe-indent 'skribe-indent-function)
+(put 'flush 'skribe-indent 'skribe-indent-function)
+(put 'center 'skribe-indent 'skribe-indent-function)
+(put 'pre 'skribe-indent 'skribe-indent-function)
+(put 'prog 'skribe-indent 'skribe-indent-function)
+(put 'source 'skribe-indent 'skribe-indent-function)
+(put 'language 'skribe-indent 'skribe-indent-function)
+(put 'itemize 'skribe-indent 'skribe-indent-function)
+(put 'enumerate 'skribe-indent 'skribe-indent-function)
+(put 'description 'skribe-indent 'skribe-indent-function)
+(put 'item 'skribe-indent 'skribe-indent-function)
+(put 'figure 'skribe-indent 'skribe-indent-function)
+(put 'table 'skribe-indent 'skribe-indent-function)
+(put 'tr 'skribe-indent 'skribe-indent-function)
+(put 'td 'skribe-indent 'skribe-indent-function)
+(put 'th 'skribe-indent 'skribe-indent-function)
+(put 'image 'skribe-indent 'skribe-indent-function)
+(put 'blockquote 'skribe-indent 'skribe-indent-function)
+(put 'roman 'skribe-indent 'skribe-indent-function)
+(put 'bold 'skribe-indent 'skribe-indent-function)
+(put 'underline 'skribe-indent 'skribe-indent-function)
+(put 'strike 'skribe-indent 'skribe-indent-function)
+(put 'emph 'skribe-indent 'skribe-indent-function)
+(put 'kbdb 'skribe-indent 'skribe-indent-function)
+(put 'it 'skribe-indent 'skribe-indent-function)
+(put 'tt 'skribe-indent 'skribe-indent-function)
+(put 'code 'skribe-indent 'skribe-indent-function)
+(put 'var 'skribe-indent 'skribe-indent-function)
+(put 'smap 'skribe-indent 'skribe-indent-function)
+(put 'sf 'skribe-indent 'skribe-indent-function)
+(put 'sc 'skribe-indent 'skribe-indent-function)
+(put 'sub 'skribe-indent 'skribe-indent-function)
+(put 'sup 'skribe-indent 'skribe-indent-function)
+(put 'mailto 'skribe-indent 'skribe-indent-function)
+(put 'mark 'skribe-indent 'skribe-indent-function)
+(put 'handle 'skribe-indent 'skribe-indent-function)
+(put 'ref 'skribe-indent 'skribe-indent-function)
+(put 'resolve 'skribe-indent 'skribe-indent-function)
+(put 'bibliography 'skribe-indent 'skribe-indent-function)
+(put 'the-bibliography 'skribe-indent 'skribe-indent-function)
+(put 'make-index 'skribe-indent 'skribe-indent-function)
+(put 'index 'skribe-indent 'skribe-indent-function)
+(put 'the-index 'skribe-indent 'skribe-indent-function)
+(put 'char 'skribe-indent 'skribe-indent-function)
+(put 'symbol 'skribe-indent 'skribe-indent-function)
+(put '! 'skribe-indent 'skribe-indent-function)
+(put 'processor 'skribe-indent 'skribe-indent-function)
+(put 'slide 'skribe-indent 'skribe-indent-function)
+(put 'counter 'skribe-indent 'skribe-indent-function)
diff --git a/skribe/etc/ChangeLog b/skribe/etc/ChangeLog
new file mode 100644
index 0000000..6987245
--- /dev/null
+++ b/skribe/etc/ChangeLog
@@ -0,0 +1,698 @@
+Thu Jun 2 10:58:23 CEST 2005 (Manuel Serrano):
+
+ *** Minor changes in acmproc.skr and html.skr in order to improve
+ HTML div generation of abstracts.
+
+
+Thu May 26 12:59:53 CEST 2005 (Manuel Serrano):
+
+ *** Fix LaTeX author address printing.
+
+
+Sun Apr 10 09:10:31 CEST 2005 (Manuel Serrano):
+
+ * Handles correctly LaTeX \charNUMNUMNUM commands in Skribebibtex.
+ This enables handling ~ as \char126.
+
+
+Fri Mar 4 08:44:36 CET 2005 (Manuel Serrano):
+
+ *** Fix HTML inner links. If the reference pointed to by a link
+ is located inside the document, the link doest contain the file name
+ any longer. This enables the renaming of the HTML file while preserving
+ the correctness of the HTML links.
+
+
+Wed Nov 17 11:10:53 CET 2004 (Erick Gallesio, Manuel Serrano):
+
+ ********* release 1.2b.
+
+
+Wed Nov 10 11:03:47 CET 2004 (Manuel Serrano):
+
+ * The image conversion process is now coherent. That is, when an
+ image does not need conversion, it is still copied into the
+ output directory.
+
+
+Mon Nov 8 11:00:07 CET 2004 (Erick Gallesio)
+
+ * skr/web-book.skr: Added the option :margin-title to web-book
+
+
+Thu Oct 28 21:53:34 CEST 2004 (Erick Gallesio)
+
+ * New back-end using the ConTeXt TeX macro package
+
+
+Tue Oct 26 10:52:05 CEST 2004 (Erick Gallesio):
+
+ * Added the STklos skribebibtex. Makefile and hierearchy changed
+ accordingly.
+
+
+Thu Oct 21 14:55:04 CEST 2004 (Ludovic Court�s):
+
+ *** Bibliography parsers use SKRIBE-READ instead of READ.
+
+
+Mon Oct 11 15:47:08 CEST 2004 (Manuel Serrano):
+
+ *** Fix TABLE construction in src/common/api.scm.
+
+
+Fri Oct 8 22:14:06 CEST 2004 (Manuel Serrano):
+
+ *** Fix a bug in src/common/api.scm. The subsection environment
+ was erroneously represented as a shared constant instead of a
+ freshly allocated list.
+
+
+Thu Sep 23 19:30:13 CEST 2004 (Manuel Serrano):
+
+ *** Fix the definition of the ITEM markup that was erroneously
+ doubling its :key attribute.
+
+
+Thu Sep 23 17:15:21 CEST 2004 (Erick Gallesio)
+
+ * In the documentation the installed skribe-config script was used,
+ instead of the one of the distribution. Fixed.
+
+
+Wed Sep 22 14:51:45 CEST 2004 (Damien Ciabrini):
+
+ * New latex-simple.skr Skribe style that let's LaTex handling
+ references, links, and the enables non-breakable ~ character.
+
+
+Wed Sep 22 14:11:36 CEST 2004 (Manuel Serrano):
+
+ *** Improve error detections.
+
+
+Wed Sep 22 02:13:59 CEST 2004 (Manuel Serrano):
+
+ * Change the start and stop SOURCE markup. These can now be
+ integer standing for line numbers or then can be marks matched
+ against the beginning of the lines.
+
+
+Sun Jul 11 10:38:23 CEST 2004 (Manuel Serrano):
+
+ *** Fix SKRIBE.el paragraph delimiters.
+
+
+Wed Jul 7 06:23:49 CEST 2004 (Manuel Serrano):
+
+ *** Switch the execution order of verify and resolve. Resolve now
+ takes place *before* verify (because verify simply requires the
+ ast to be already resolved).
+
+
+Wed Jun 23 16:56:57 CEST 2004 (Manuel Serrano):
+
+ *** etc/bigloo/configure, README.java: add JVM visibility over the
+ environment variable SKRIBEPATH.
+
+
+Tue Jun 22 09:47:37 CEST 2004 (Manuel Serrano):
+
+ * skr/html.skr: Add the inline-css HTML engine custom.
+
+
+Mon May 31 18:51:09 CEST 2004 (Erick Gallesio)
+
+ *** skr/html.skr: Added the charset custom to html
+
+
+Mon May 31 14:35:17 CEST 2004 (Manuel Serrano):
+
+ *** skr/html.skr: fix a small HTML compliance bug in the TD/TH
+ background color emission.
+
+
+Fri May 21 16:44:53 CEST 2004 (Yann Dirson):
+
+ *** Add DESTDIR to generated Bigloo Makefiles (in order to ease
+ the Debian package).
+
+
+Fri May 21 16:12:48 CEST 2004 (St�phane Epardaud):
+
+ *** src/bigloo/engine.scm: Fix a bug in ENGINE-FORMAT?
+
+
+Fri May 21 15:54:46 CEST 2004 (Manuel Serrano):
+
+ *** skr/web-book.skr: Add subsection to navigation tocs.
+
+
+Mon May 17 10:14:25 CEST 2004 (Manuel Serrano):
+
+ *** src/bigloo/xml.scm: Improve XML fontification.
+
+
+Mon May 10 21:00:10 CEST 2004 (Manuel Serrano):
+
+ *** skr/html.skr: Fix an error in negative relative font size handling.
+
+
+Thu Apr 29 05:52:53 CEST 2004 (Manuel Serrano):
+
+ *** skr/html.skr: Add JS custom.
+
+ * src/common/lib.scm: Add ENGINE-CUSTOM-ADD!.
+
+
+Tue Apr 20 13:40:00 CEST 2004 (Manuel Serrano):
+
+ *** skr/html.skr: Add &html-figure-legend to the figure
+ writer.
+
+
+Tue Apr 20 12:07:36 CEST 2004 (Manuel Serrano):
+
+ *** skr/base.skr: fix a bug in &bib-entry emission. The writer
+ used to display the label of the entry (&bib-entry-label) was
+ the writer of the default engine instead of the engine of the
+ dynamically active engine.
+
+
+Tue Apr 13 10:11:33 CEST 2004 (Manuel Serrano):
+
+ *** skr/html.skr: Fix SUI mark reference generation.
+
+
+Tue Apr 6 06:58:28 CEST 2004 (Manuel Serrano):
+
+ *** doc/user/{engine,latexe}.skb: add document about engines.
+
+
+Thu Apr 1 14:43:47 CEST 2004 (Manuel Serrano):
+
+ *** src/bigloo/evapi.scm: export the SKRIBE-READ function into
+ the standard api.
+
+
+Fri Mar 26 05:50:10 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr, skr/slide.skr: fix PRE and PROG LaTeX tabcolsep.
+
+
+Wed Mar 24 16:37:06 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr: add the postdocument custom.
+
+ *** skr/web-article.skr: fix illegal html identifiers (add
+ calls to STRING-CANONICALIZE).
+
+
+Mon Mar 22 15:53:37 CET 2004 (Erick Gallesio):
+
+ * Fix a bash problem in the configure driver script.
+
+
+Tue Mar 16 09:44:49 CET 2004 (Erick Gallesio, Manuel Serrano):
+
+ ********* release 1.1a.
+
+
+Mon Mar 15 00:00:37 CET 2004 (Erick Gallesio):
+
+ *** skr/html.skr: Changed the generated JavaScript for email
+ obfuscation to be conform to HTML 4. This is an ugly hack.
+
+
+Thu Mar 11 11:28:17 CET 2004 (Manfred Lotz):
+
+ *** emacs/emacs.el.in: Fix error in font lock declarations.
+
+ *** skr/latex.skr: fix inconsistency in bold face generation.
+
+
+Wed Mar 10 06:06:48 CET 2004 (Manuel Serrano):
+
+ *** src/lib/bigloo.bgl, skr/latex.skr: fix a path bug in
+ BUILTIN-CONVERT-IMAGE. The generated image was generated in the
+ source directory but it should be generated in the target directory.
+
+
+Mon Mar 8 11:40:46 CET 2004 (Manuel Serrano):
+
+ * src/common/lib.scm: add an optional filler to LIST-SPLIT.
+
+
+Sat Mar 6 21:17:45 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: change the generation of font markup. It now uses
+ <big> and <small> as much as possible.
+
+ *** skr/html.skr: fix mailto markup.
+
+
+Fri Mar 5 18:45:34 CET 2004 (Manuel Serrano):
+
+ *** src/{bigloo,stklos}/{engine,types,writer}.{scm,stk} rename
+ inherit in delegate.
+
+
+Sun Feb 29 06:40:53 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/lib.bgl: change image conversion in order to avoid
+ new conversion when the target image already exists.
+
+ *** src/bigloo/writer.scm: change MARKUP-WRITER-GET. The optional
+ argument PRED may now be #unspecified which means that writers
+ predicate are not checked during the search.
+
+
+Sat Feb 28 10:18:16 CET 2004 (Erick Gallesio):
+
+ *** src/stklos/reader.stk (%read-bracket): Bug correction: ",("
+ sequences in strings were interpreted.
+
+
+Thu Feb 26 20:44:50 CET 2004 (Erick Gallesio):
+
+ *** main.stk: Added the --use-variant option
+
+Thu Feb 26 16:33:49 CET 2004 (Erick Gallesio):
+
+ *** Documentation can now be conform to HTML 4.01, if compiled
+ using html4.skr
+
+
+Thu Feb 26 10:18:21 CET 2004 (Manuel Serrano):
+
+ * src/common/api.scm, skr/html.skr: ref markups have no default class.
+ The HTML engine generates a class which is the name of the protocol
+ of the reference (i.e., ftp, http, file, ...) for url references.
+
+
+Wed Feb 25 06:41:51 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/engine.scm: add PUSH-DEFAULT-ENGINE and
+ POP-DEFAULT-ENGINE.
+
+
+Wed Feb 25 01:03:22 CET 2004 (Erick Gallesio):
+
+ *** skr/html4.skr: File that must be preloaded to produce HTML
+ 4.01 output
+
+
+Mon Feb 23 10:13:57 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr: change the output of URL-REF when a text is
+ provided.
+
+
+Sat Feb 21 10:39:26 CET 2004 (Manuel Serrano):
+
+ * Document standard packages (letter, french, web-book, acmproc, ...).
+
+
+Fri Feb 20 07:36:09 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: add the lower case Nu greek symbol.
+
+
+Thu Feb 19 18:28:43 CET 2004 (Manuel Serrano):
+
+ * doc/skr/api.skr: Improve MAKE-ENGINE? predicate in order to
+ break deeply recursive searches.
+
+Wed Feb 19 00:48:47 CET 2004 (Erick Gallesio):
+ *** src/stklos/writer.stk: writers can be cloned with COPY-MARKUP-WRITER
+
+Wed Feb 18 22:55:20 CET 2004 (Erick Gallesio):
+
+ *** src/stklos/output.stk: added a way to insert a validation phase
+ before outputting a markup. This should permit, for instance to
+ verify that a document is conform to certain constraints, as a DTD.
+
+Wed Feb 18 13:25:47 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/lib.bgl: change STRING-CANONICALIZE to get rid
+ of #\# characters that pose problem for both HTML and LaTeX.
+
+
+Wed Feb 18 12:03:11 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr: improve error detection of FONT markups.
+
+
+Tue Feb 17 13:26:38 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm, skr/html.skr, skr/latex.skr: fix the big
+ mess about string used by references (string-canonicalize).
+
+ *** src/common/api.scm, skr/html.skr, skr/latex.skr: fix bibliography
+ references. Bibliography database must be loaded prior to bibliography
+ entries are referenced. Otherwise, this causes a problem of fix
+ point iterations between citations and database printing.
+
+
+Tue Feb 17 11:36:19 CET 2004 (Damien Ciabrini):
+
+ *** src/common/sui.scm: fix sui subsection and subsubsection
+ searches.
+
+
+Tue Feb 17 06:42:44 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr, skr/latex.skr: add the TABLE rules 'header
+ option.
+
+
+Mon Feb 16 15:02:19 CET 2004 (Manuel Serrano):
+
+ *** tools/skribebibtex/skribebibtex.scm: add n~ and N~ character
+ parsing.
+
+
+Thu Feb 12 22:26:31 CET 2004 (Manuel Serrano):
+
+ *** Get rid of the user stage.
+
+
+Thu Feb 12 16:31:41 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm: fix table border width handling (option
+ was ignored).
+
+
+Thu Feb 12 16:13:48 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm, skr/html.skr: Improve HTML4.01 compliance.
+
+
+Thu Feb 12 10:42:30 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/lisp.scm, skr/html.skr, skr/latex.skr: add
+ &source-error markup.
+
+
+Wed Feb 11 09:48:08 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/types.scm: The functions LANGUAGE-NAME,
+ LANGUAGE-FONTIFIER, and LANGUAGE-EXTRACTOR are now exported and
+ visible from the standard Skribe runtime system.
+
+ *** src/common/api.scm, skr/html.skr: Change the default table
+ attributes value for BORDER, CELLPADDING, and CELLSPACING in order
+ to get rid of warning messages when producing LaTeX documents.
+
+
+Mon Feb 9 20:38:28 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr: fix tt, code, pre engine that were not using
+ the correct symbol table.
+
+
+Mon Feb 9 09:44:59 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/lib/bgl: fix the STRING-CANONICALIZE function
+ so now it turns #\space into #\_.
+
+
+Mon Feb 9 06:40:33 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/main.scm: the RC file (.skribe/skriberc) is now loaded
+ before the command line is parsed.
+
+
+Sat Feb 7 08:23:38 CET 2004 (Manuel Serrano):
+
+ * configure, src/bigloo/configure.bgl, src/common/configure.scm:
+ Improve the configuration mechanism (enabling dynamic configuration
+ tests).
+
+
+Fri Feb 6 10:10:31 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr, skr/slide.skr, skr/web-article.skr: redesign HTML
+ header generation.
+
+
+Wed Feb 4 14:58:25 CET 2004 (Manuel Serrano):
+
+ *** src/common/index.scm: indexes letter references are now
+ made unique.
+
+
+Wed Feb 4 05:24:51 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm, src/{common,bigloo}/index.scm: improve
+ error localization for indexes.
+
+ *** skr/base.skr: improve indexed generation.
+
+
+Tue Feb 3 11:58:43 CET 2004 (Manuel Serrano):
+
+ * src/bigloo/param.scm, src/bigloo/parse-args.scm, src/bigloo/eval.scm:
+ add the -w?level command line option.
+
+
+Tue Feb 3 05:51:41 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm, skr/{html.skr,latex.skr}, doc/user/table.skb:
+ Redesign of tables.
+
+
+Mon Feb 2 09:43:28 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: Improve HTML4.01 compliance.
+
+ *** skr/latex.skr: Fix LaTeX symbol table.
+
+ *** src/common/api.scm: Fix color declaration in TC and TR.
+
+
+Sun Feb 1 06:18:08 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/c.scm, src/bigloo/xml.scm: fix multi-lines
+ fontification in C and XML mode. Older fontification was producing
+ ill-formed LaTeX outputs.
+
+ *** src/common/api.scm: fix figure identifier.
+
+
+Wed Jan 28 20:57:11 CET 2004 (Manuel Serrano):
+
+ * WEB-ARTICLE.SKR now supports the :css option that enables CSS
+ production and sets the CSS to be used.
+
+
+Mon Jan 26 15:25:12 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: various HTML4.01 conformity fixes.
+
+
+Sun Jan 25 18:31:19 CET 2004 (Manuel Serrano):
+
+ *** skr/slide.skr: fix a error is the slide numbering.
+
+
+Thu Jan 22 07:28:08 CET 2004 (Manuel Serrano):
+
+ *** src/common/api.scm: fix a bug in multiple bib references.
+
+
+Sun Jan 18 11:55:56 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: fix a bug in the HTML class attribute production.
+
+ * src/bigloo/asm.scm: Creation of the assembly fontification (asm).
+
+
+Sat Jan 17 18:26:00 CET 2004 (Manuel Serrano):
+
+ * src/bigloo/api.sch, skr/slide.skr: Change the definition
+ of DEFINE-MARKUP. This macro now defines a function and a macro.
+ The macro adds an extra parameters called &SKRIBE-EVAL-LOCATION
+ that can be used inside the body of the defined function to retrieve
+ the location of the call. This is extremely useful for function
+ that defines new nodes. In general, it is desired that the location
+ associated with these nodes is the user call to the function that
+ has created the node, instead of the location of the call to
+ the constructor.
+
+
+Fri Jan 16 06:56:14 CET 2004 (Manuel Serrano):
+
+ * emacs/skribe.el.in: fontification of markups "PROG" and "SOURCE".
+
+ * skr/html.skr, skr/web-article.skr: explicit introduction of two
+ dummy markups &HTML-DOCUMENT-HEADER and &HTML-DOCUMENT-TITLE for
+ enabling user fine-grain customizations.
+
+
+Thu Jan 15 17:57:01 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/eval.scm, src/bigloo/lib.bgl, src/bigloo/resolve.scm,
+ src/common/api.scm:
+ Improved location detection for unbound references (such as
+ unbound (ref :bib ...).
+
+
+Wed Jan 14 08:03:18 CET 2004 (Manuel Serrano):
+
+ * src/common/api.scm, src/common/bib.scm, src/bigloo/bib.bgl,
+ doc/user/bib.skb, doc/user/links.skb: change the bibliography
+ table mechanism. Bib tables are now first class citizen.
+
+
+Tue Jan 13 16:22:30 CET 2004 (Manuel Serrano):
+
+ * src/bigloo/eval.scm, src/bigloo/parse-args.scm, src/bigloo/lib.bgl,
+ src/common/api.scm, src/bigloo/source.scm, doc/user/lib.skb:
+ Creation of the SKRIBE-{IMAGE,BIB,SOURCE}-PATH and
+ SKRIBE-{IMAGE,BIB,SOURCE}-PATH-SET! functions.
+
+ * src/common/api.scm, skr/html.skr, skr/latex.skr, doc/usr/image.skb:
+ Add :URL image option.
+
+
+Tue Jan 13 09:02:18 CET 2004 (Manuel Serrano):
+
+ *** src/bigloo/eval.scm, src/bigloo/parse-args.scm, doc/user/lib.skb:
+ Remove the SKRIBE-PATH-ADD! function. Only SKRIBE-PATH-SET! lefts.
+
+
+Tue Jan 13 08:59:17 CET 2004 (Todd Dukes):
+
+ *** configure: Fix illegal shell exports.
+
+
+Mon Jan 12 13:50:29 CET 2004 (Manuel Serrano):
+
+ * src/bigloo/eval.scm: Add the functions SKRIBE-PATH, SKRIBE-PATH-SET!,
+ and SKRIBE-PATH-ADD!.
+
+
+Mon Jan 12 12:02:58 CET 2004 (Manuel Serrano):
+
+ *** skr/latex.skr: fix when color were disabled.
+
+
+Mon Jan 12 09:17:46 CET 2004 (Manuel Serrano):
+
+ *** skr/html.skr: change the default value of css which used to
+ be '(quote ()) and which is now ().
+
+
+Sat Jan 10 10:00:08 CET 2004 (Manuel Serrano):
+
+ * src/common/api.scm, src/bigloo/types.scm, src/bigloo/output.scm:
+ Add the PROCEDURE field to PROCESSOR nodes .
+
+ * skr/web-article.skb: Creation of this new package.
+
+
+Fri Jan 9 15:35:03 CET 2004 (Manuel Serrano):
+
+ * The slide.skr package is now documented in the user manual.
+
+ * SKRIBE-LOAD and SKRIBE-LOAD-OPTIONS are now documented.
+
+
+Wed Jan 7 16:37:52 CET 2004 (Manuel Serrano):
+
+ * skr/html.skr, skr/latex.skr: fix &source-type and
+ &source-bracket markups implementation.
+
+
+Wed Jan 7 11:29:16 CET 2004 (Manuel Serrano):
+
+ * src/bigloo/color.scm: colors are lower case, the search
+ color search is lower case.
+
+ *** src/bigloo/color.scm: fix a bug in the string search.
+
+ *** skr/latex.skr: The LaTeX engines now uses the "symbol" itemize
+ option.
+
+ *** skr/latex.skr: The LaTeX engines now uses the "key" item
+ option.
+
+
+Wed Jan 7 06:12:53 CET 2004 (Manuel Serrano):
+
+ * Add skribe-emacs-dir in emacs/skribe.el.in.
+
+ * Add the skribe-indent-load in emacs/skribe.el.in.
+
+ * Add --emacs-dir in etc/skribe-config.
+
+
+Sat Jan 3 06:59:15 CET 2004 (Manuel Serrano):
+
+ * etc/ChangeLog is now included in the distribution and included
+ in the Web page.
+
+ * Extensions are now uploaded on the Skribe ftp server. They are
+ also listed from the Skribe Web page.
+
+
+Fri Jan 2 21:21:52 CET 2004 (Manuel Serrano):
+
+ * Add a chapter for skribe-config in the user documentation.
+
+ * Creation of the directory documentation that gives information
+ about the installed extensions.
+
+
+Thu Jan 1 06:21:39 CET 2004 (Manuel Serrano):
+
+ * Implement the SUI link mechanisms.
+
+ *** Fix RESOLVE-SEARCH-PARENT whose behavior was incorrect for orphans.
+
+ * Add SKRIBE-DOC-DIR in configure.scm.in.
+
+
+Dec 30 22:09:54 CET 2003 (Manuel Serrano):
+
+ *** Fix FIND-MARKUP-IDENT whose return type was incorrect.
+
+ * Add the :URL option to the INDEX markup.
+
+
+Thu Dec 18 09:12:33 CET 2003 (Erick Gallesio, Manuel Serrano):
+
+ ********* release 1.0a.
+
+
+Wed Dec 17 10:22:27 CET 2003 (Manuel Serrano):
+
+ * Change the processor nodes. The COMBINATOR argument is no longer
+ required to be a procedure. It can be #f.
+
+ * Export predicates such as COMMAND?, UNRESOLVED? and PROCESSOR?.
+ Export the accessors associated with these primitive types.
+
+
+Tue Dec 9 16:44:01 CET 2003 (Manuel Serrano):
+
+ * the "q" markup now introduces a new node that is handled by the
+ engines.
+
+
+Thu Dec 4 09:53:24 CET 2003 (Manuel Serrano):
+
+ * Bib (Bigloo) manager now detects duplicate entries.
+
+ *** Fix LaTeX engine (latex.skr). LaTeX titles (for chapters,
+ sections, ...) where incorrects.
+
+ *** Various fixes in skribe.el.
+
+
+Mon Nov 24 10:28:15 CET 2003 (Manuel Serrano):
+
+ * Add -c, --custom command line options.
+
+ * Re-design the SUI file generation.
diff --git a/skribe/etc/Makefile b/skribe/etc/Makefile
new file mode 100644
index 0000000..349fcf8
--- /dev/null
+++ b/skribe/etc/Makefile
@@ -0,0 +1,50 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/etc/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Sat Oct 25 08:29:30 2003 */
+#* Last change : Sat Jan 3 06:40:19 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Skribe Meta etc Makefile */
+#*=====================================================================*/
+include ../etc/Makefile.config
+include ../etc/$(SYSTEM)/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo etc/Makefile etc/skribe-config.in etc/ChangeLog
+ @ (cd bigloo && $(MAKE) pop)
+ @ (cd stklos && $(MAKE) pop)
+
+#*---------------------------------------------------------------------*/
+#* Install/Uninstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install: $(DESTDIR)$(INSTALL_EXTDIR)
+ cp skribe-config $(DESTDIR)$(INSTALL_BINDIR) && \
+ chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)/skribe-config
+
+uninstall:
+ $(RM) -f $(DESTDIR)$(INSTALL_BINDIR)/skribe-config
+
+$(DESTDIR)$(INSTALL_EXTDIR):
+ mkdir -p $(DESTDIR)$(INSTALL_EXTDIR) && chmod a+rx $(DESTDIR)$(INSTALL_EXTDIR)
+
+
+#*---------------------------------------------------------------------*/
+#* clean/distclean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean distclean
+
+clean:
+ (cd $(SYSTEM) && $(MAKE) clean)
+
+distclean: clean
+ (cd $(SYSTEM) && $(MAKE) distclean)
+ $(RM) -f skribe-config config
diff --git a/skribe/etc/bigloo/Makefile b/skribe/etc/bigloo/Makefile
new file mode 100644
index 0000000..82ffceb
--- /dev/null
+++ b/skribe/etc/bigloo/Makefile
@@ -0,0 +1,114 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/etc/bigloo/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Oct 23 08:58:55 2003 */
+#* Last change : Wed Nov 17 10:51:50 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Bigloo etc Makefile */
+#*=====================================================================*/
+include Makefile.skb
+include ../Makefile.config
+
+#*---------------------------------------------------------------------*/
+#* TMPDIR */
+#*---------------------------------------------------------------------*/
+DISTRIBTMPDIR = /tmp
+DISTRIBDIR = $$HOME/prgm/distrib
+
+#*---------------------------------------------------------------------*/
+#* POPULATION */
+#*---------------------------------------------------------------------*/
+POPULATION = configure Makefile Makefile.tpl
+
+#*---------------------------------------------------------------------*/
+#* distrib */
+#* ------------------------------------------------------------- */
+#* This rule must be executed in the main SKribe directory */
+#* (i.e. ../..). They must be run with a command such as: */
+#* "cd skribe; make -f etc/bigloo/Makefile distrib". */
+#*---------------------------------------------------------------------*/
+.PHONY: distrib distrib-src distrib-jvm
+
+distrib: distrib-src # distrib-jvm
+
+#*--- distrib-src -----------------------------------------------------*/
+distrib-src:
+ @ echo "[0m[1;31m>>> distrib-src[0m"; \
+ (skribedir=`pwd` \
+ && /bin/rm -rf $(DISTRIBTMPDIR)/skribe \
+ && mkdir -p $(DISTRIBTMPDIR)/skribe \
+ && cd $(DISTRIBTMPDIR)/skribe \
+ && $(MAKE) -f $$skribedir/Makefile -I $$skribedir checkout \
+ && /bin/rm -rf contribs \
+ && $(MAKE) -f $$skribedir/etc/bigloo/Makefile -I $$skribedir/etc/bigloo do-distrib-src \
+ && $(RM) -rf $(DISTRIBTMPDIR)/skribe$(SKRIBERELEASE))
+
+.PHONY: do-distrib-src
+do-distrib-src:
+ (cd .. && \
+ mv skribe skribe$(SKRIBERELEASE) && \
+ tar cvfz $(DISTRIBDIR)/skribe$(SKRIBERELEASE).tar.gz skribe$(SKRIBERELEASE))
+
+#*--- distrib-jvm -----------------------------------------------------*/
+distrib-jvm:
+ @ echo "[0m[1;32m>>> distrib-jvm[0m"; \
+ (skribedir=`pwd` \
+ && /bin/rm -rf $(DISTRIBTMPDIR)/skribe \
+ && mkdir -p $(DISTRIBTMPDIR)/skribe \
+ && cd $(DISTRIBTMPDIR)/skribe \
+ && $(MAKE) -f $$skribedir/Makefile -I $$skribedir checkout \
+ && /bin/rm -rf contribs \
+ && $(MAKE) -f $$skribedir/etc/bigloo/Makefile -I $$skribedir/etc/bigloo do-distrib-jvm \
+ && $(RM) -rf $(DISTRIBTMPDIR)/skribe)
+
+.PHONY: do-distrib-jvm
+do-distrib-jvm: lib bin lib/bigloo_s.zip
+ $(RM) -f $(DISTRIBDIR)/skribe$(SKRIBERELEASE).zip
+ (./configure --with-bigloo --jvm \
+ && $(MAKE) \
+ && cd .. \
+ && zip -qr $(ZFLAGS) $(DISTRIBDIR)/skribe$(SKRIBERELEASE).zip \
+ skribe \
+ -x "*~" \
+ -x "*/bin/*-bigloo" \
+ -x "*.class" \
+ -x "*.o")
+
+#*--- bigloo_s.zip ----------------------------------------------------*/
+lib/bigloo_s.zip: lib
+ cp $(FILDIR)/bigloo_s.zip $@
+
+#*--- lib -------------------------------------------------------------*/
+lib:
+ mkdir -p lib
+
+#*--- bin -------------------------------------------------------------*/
+bin:
+ mkdir -p bin
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo $(POPULATION:%=etc/bigloo/%)
+ @ (cd autoconf && $(MAKE) -s pop)
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean distclean
+
+clean:
+ /bin/rm -f ../../lib/bigloo_s.zip
+
+#*--- distclean -------------------------------------------------------*/
+distclean:
+ /bin/rm -f Makefile.skb
+ /bin/rm -f ../../src/common/configure.scm
+
+
+
diff --git a/skribe/etc/bigloo/Makefile.tpl b/skribe/etc/bigloo/Makefile.tpl
new file mode 100644
index 0000000..24326c1
--- /dev/null
+++ b/skribe/etc/bigloo/Makefile.tpl
@@ -0,0 +1,200 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/etc/bigloo/Makefile.tpl */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Wed Nov 7 09:20:47 2001 */
+#* Last change : Wed Feb 18 11:23:12 2004 (serrano) */
+#* Copyright : 2001-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* Standard Skribe makefile to build various libraries. */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* Compilers, Tools and Destinations */
+#*---------------------------------------------------------------------*/
+# The heap file
+HEAP_FILE = $(LIB)/$(TARGETNAME).heap
+HEAPJVM_FILE = $(LIB)/$(TARGETNAME).jheap
+# Where to store the library class files
+PBASE = bigloo.skribe.$(TARGETNAME)
+CLASS_DIR = o/class_s/bigloo/skribe/$(TARGETNAME)
+O_DIR = o
+
+BUNSAFEFLAGS = -unsafe
+
+#*---------------------------------------------------------------------*/
+#* Suffixes */
+#*---------------------------------------------------------------------*/
+.SUFFIXES:
+.SUFFIXES: .scm .class .o
+
+#*---------------------------------------------------------------------*/
+#* The implicit rules */
+#*---------------------------------------------------------------------*/
+$(O_DIR)/%.o: %.scm
+ $(BIGLOO) $(BUNSAFEFLAGS) $(BCFLAGS) $(BCOMMONFLAGS) -c $< -o $@
+
+$(CLASS_DIR)/%.class: %.scm
+ $(BIGLOO) $(BUNSAFEFLAGS) $(BJVMFLAGS) $(BCOMMONFLAGS) -c $< -o $@
+
+#*---------------------------------------------------------------------*/
+#* bin */
+#*---------------------------------------------------------------------*/
+.PHONY: bin-c bin-jvm
+
+#*--- bin-c -----------------------------------------------------------*/
+bin-c: $(TAGS) .afile .etags $(O_DIR) $(SKRIBEBINDIR)/$(TARGETNAME).bigloo
+
+$(SKRIBEBINDIR)/$(TARGETNAME).bigloo: $(OBJECTS)
+ $(BIGLOO) $(BUNSAFEFLAGS) $(BLINKFLAGS) $(BCOMMONFLAGS) $(OBJECTS) -o $(SKRIBEBINDIR)/$(TARGETNAME).bigloo
+ @ echo "$(SKRIBEBINDIR)/$(TARGETNAME).bigloo done..."
+ @ echo "-------------------------------"
+
+#*--- bin-jvm ---------------------------------------------------------*/
+bin-jvm: $(TAGS) .afile .etags .jfile $(CLASS_DIR) $(SKRIBEBINDIR)/$(TARGETNAME).zip
+
+$(SKRIBEBINDIR)/$(TARGETNAME).zip: $(CLASSES)
+ @ /bin/rm -f $(SKRIBEBINDIR)/$(TARGETNAME).zip
+ @ (cd $(O_DIR)/class_s; \
+ $(ZIP) -q $(ZFLAGS) $(SKRIBEBINDIR)/$(TARGETNAME).zip -r .)
+ @ echo "$(SKRIBEBINDIR)/$(TARGETNAME).zip done..."
+ @ echo "-------------------------------"
+
+#*---------------------------------------------------------------------*/
+#* Directories */
+#*---------------------------------------------------------------------*/
+$(O_DIR):
+ mkdir -p $(O_DIR)
+
+$(CLASS_DIR):
+ mkdir -p $(CLASS_DIR)
+
+#*---------------------------------------------------------------------*/
+#* The heap construction */
+#*---------------------------------------------------------------------*/
+.PHONY: heap heap-c heap-jvm
+
+heap-c: $(HEAP_FILE)
+heap-jvm: $(HEAPJVM_FILE)
+
+$(HEAP_FILE): .afile make-lib.scm
+ @ \rm -f $(HEAP_FILE)
+ @ $(BIGLOO) $(BHEAPFLAGS) make-lib.scm -addheap $(HEAP_FILE)
+ @ echo "Heap Done..."
+ @ echo "-------------------------------"
+
+$(HEAPJVM_FILE): .jfile .afile make-lib.scm
+ @ \rm -f $(HEAPJVM_FILE)
+ @ $(BIGLOO) -jvm $(BHEAPFLAGS) make-lib.scm -addheap $(HEAPJVM_FILE)
+ @ echo "Heap JVM Done..."
+ @ echo "-------------------------------"
+
+#*---------------------------------------------------------------------*/
+#* lib */
+#*---------------------------------------------------------------------*/
+.PHONY: lib-c lib-jvm
+
+#*--- lib-c -----------------------------------------------------------*/
+lib-c: $(TAGS) .afile lib.$(SHAREDSUFFIX) lib.a
+
+lib.$(SHAREDSUFFIX): $(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX) $(LIB)/lib$(TARGETNAME)_u.$(SHAREDSUFFIX)
+lib.a: $(LIB)/lib$(TARGETNAME)_s.a $(LIB)/lib$(TARGETNAME)_u.a
+
+$(LIB)/lib$(TARGETNAME)_u.$(SHAREDSUFFIX): $(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX)
+ cd $(LIB); \
+ /bin/rm -f lib$(TARGETNAME)_u.$(SHAREDSUFFIX); \
+ ln -s lib$(TARGETNAME)_s.$(SHAREDSUFFIX) lib$(TARGETNAME)_u.$(SHAREDSUFFIX)
+
+$(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX): .afile $(OBJECTS)
+ @ /bin/rm -f $(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX)
+ @ $(LD) -o $(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX) $(OBJECTS) -lm -lc
+ @ echo "lib$(TARGETNAME)_s.$(SHAREDSUFFIX) Done..."
+ @ echo "-------------------------------"
+
+$(LIB)/lib$(TARGETNAME)_u.a: $(LIB)/lib$(TARGETNAME)_s.a
+ cd $(LIB); \
+ /bin/rm -f lib$(TARGETNAME)_u.a; \
+ ln -s lib$(TARGETNAME)_s.a lib$(TARGETNAME)_u.a
+
+$(LIB)/lib$(TARGETNAME)_s.a: .afile $(OBJECTS)
+ @ /bin/rm -f $(LIB)/lib$(TARGETNAME)_s.a
+ @ $(AR) $(ARFLAGS) $(LIB)/lib$(TARGETNAME)_s.a $(OBJECTS)
+ @ $(RANLIB) $(LIB)/lib$(TARGETNAME)_s.a
+ @ echo "lib$(TARGETNAME)_s.a Done..."
+ @ echo "-------------------------------"
+
+#*--- lib-jvm ---------------------------------------------------------*/
+lib-jvm: $(TAGS) $(CLASS_DIR) lib.zip
+
+lib.zip: .afile .jfile $(CLASSES)
+ @ /bin/rm -f $(LIB)/$(TARGETNAME).zip
+ @ (cd $(O_DIR)/class_s; \
+ $(ZIP) -q $(ZFLAGS) \
+ $(LIB)/$(TARGETNAME)_s.zip \
+ $(CLASS_DIR:$(O_DIR)/class_s/%=%)/*.class)
+ @ echo "lib$(TARGETNAME)_s.zip done..."
+ @ echo "-------------------------------"
+
+#*---------------------------------------------------------------------*/
+#* ude */
+#*---------------------------------------------------------------------*/
+.PHONY: ude
+ude:
+ @ $(MAKE) -f Makefile .afile .etags
+
+.afile: $(SOURCES)
+ @ $(AFILE) -o .afile $(_BGL_SOURCES)
+
+.jfile: $(SOURCES)
+ @ $(JFILE) -o .jfile -pbase $(PBASE) $(SOURCES)
+
+.etags: $(SOURCES)
+ @ $(BTAGS) -o .etags $(_BGL_SOURCES)
+
+#*---------------------------------------------------------------------*/
+#* stdclean */
+#*---------------------------------------------------------------------*/
+stdclean:
+ /bin/rm -f $(OBJECTS) $(_BGL_OBJECTS:%=%.c)
+ /bin/rm -f $(SKRIBEBINDIR)/$(TARGETNAME).bigloo
+ /bin/rm -f $(SKRIBEBINDIR)/$(TARGETNAME).zip
+ /bin/rm -f $(LIB)/lib$(TARGETNAME)_s.$(SHAREDSUFFIX)
+ /bin/rm -f $(LIB)/lib$(TARGETNAME)_u.$(SHAREDSUFFIX)
+ /bin/rm -f .afile .etags .jfile
+ /bin/rm -rf $(O_DIR)
+ /bin/rm -f *~
+ /bin/rm -f *.mco
+
+#*---------------------------------------------------------------------*/
+#* install/uninstall */
+#*---------------------------------------------------------------------*/
+install:
+ $(MAKE) install-$(TARGET)
+
+uninstall:
+ $(MAKE) uninstall-$(TARGET)
+
+install-c: $(DESTDIR)$(INSTALL_BINDIR)
+ cp $(SKRIBEBINDIR)/$(TARGETNAME).bigloo $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME).bigloo \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME).bigloo
+ /bin/rm -f $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME)
+ ln -s $(TARGETNAME).bigloo $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME)
+
+uninstall-c:
+ /bin/rm $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME).bigloo
+ /bin/rm $(DESTDIR)$(INSTALL_BINDIR)/$(TARGETNAME)
+
+install-jvm: $(DESTDIR)$(INSTALL_FILDIR)
+ cp $(SKRIBEBINDIR)/$(TARGETNAME).zip $(DESTDIR)$(INSTALL_FILDIR)/$(TARGETNAME).zip
+ cp $(FILDIR)/bigloo_s.zip $(DESTDIR)$(INSTALL_FILDIR)
+
+uninstall-jvm:
+ /bin/rm $(DESTDIR)$(INSTALL_FILDIR)/$(TARGETNAME).zip
+ /bin/rm -f $(DESTDIR)$(INSTALL_FILDIR)/bigloo_s.zip
+
+$(DESTDIR)$(INSTALL_BINDIR):
+ mkdir -p $(DESTDIR)$(INSTALL_BINDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)
+
+$(FILDIR):
+ mkdir -p $(FILDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)
+
diff --git a/skribe/etc/bigloo/autoconf/Makefile b/skribe/etc/bigloo/autoconf/Makefile
new file mode 100644
index 0000000..c077107
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/Makefile
@@ -0,0 +1,53 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/etc/bigloo/autoconf/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Jun 19 20:48:50 1997 */
+#* Last change : Sat Oct 25 08:34:37 2003 (serrano) */
+#* Copyright : 1997-2003 Manuel Serrano, see LICENSE file */
+#* ------------------------------------------------------------- */
+#* The global autoconf Makefile (mainly for backuping). */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* Flags */
+#*---------------------------------------------------------------------*/
+POPULATION = Makefile bversion getbversion blibdir gmaketest \
+ blstlen bfildir
+
+#*---------------------------------------------------------------------*/
+#* pop ... */
+#*---------------------------------------------------------------------*/
+pop:
+ @ echo $(POPULATION:%=etc/bigloo/autoconf/%)
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean cleanall distclean
+
+clean:
+ @ find . \( -name '*[~%]' \
+ -o -name '.??*[~%]' \
+ -o -name '#*#' \
+ -o -name '?*#' \
+ -o -name \*core \) \
+ -type f -exec rm {} \;
+ @ echo "cleanup done..."
+ @ echo "-------------------------------"
+
+cleanall: clean
+distclean: cleanall
+
+#*---------------------------------------------------------------------*/
+#* distrib */
+#*---------------------------------------------------------------------*/
+distrib: $(POPULATION)
+ @ if [ `pwd` = $$HOME/prgm/project/bglk/autoconf ]; then \
+ echo "*** ERROR:Illegal dir to make a distrib `pwd`"; \
+ exit 1; \
+ fi
+ @ $(MAKE) clean
+ @ chmod a+rx $(POPULATION)
+
+
diff --git a/skribe/etc/bigloo/autoconf/bfildir b/skribe/etc/bigloo/autoconf/bfildir
new file mode 100755
index 0000000..128d5c7
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/bfildir
@@ -0,0 +1,36 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/scribe/autoconf/bfildir */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Tue Jan 12 14:53:33 1999 */
+#* Last change : Wed Aug 7 21:41:06 2002 (serrano) */
+#* ------------------------------------------------------------- */
+#* Find out the directory where Bigloo is installed */
+#*=====================================================================*/
+bigloo=bigloo
+
+#*---------------------------------------------------------------------*/
+#* We parse the arguments */
+#*---------------------------------------------------------------------*/
+while : ; do
+ case $1 in
+ "")
+ break;;
+ --bigloo=*|-bigloo=*)
+ bigloo="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ -*)
+ echo "Unknown option \"$1\", ignored" >&2;;
+ esac
+ shift
+done
+
+#*---------------------------------------------------------------------*/
+#* We spawn a bigloo process to check its version number */
+#*---------------------------------------------------------------------*/
+$bigloo -q -eval "(begin (print *default-lib-dir*) (exit 0))"
+
+exit 0
+
+
diff --git a/skribe/etc/bigloo/autoconf/blibdir b/skribe/etc/bigloo/autoconf/blibdir
new file mode 100755
index 0000000..603d484
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/blibdir
@@ -0,0 +1,36 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/scribe/autoconf/blibdir */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Tue Jan 12 14:53:33 1999 */
+#* Last change : Wed Aug 7 21:41:48 2002 (serrano) */
+#* ------------------------------------------------------------- */
+#* Find out the directory where Bigloo library is read. */
+#*=====================================================================*/
+bigloo=bigloo
+
+#*---------------------------------------------------------------------*/
+#* We parse the arguments */
+#*---------------------------------------------------------------------*/
+while : ; do
+ case $1 in
+ "")
+ break;;
+ --bigloo=*|-bigloo=*)
+ bigloo="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ -*)
+ echo "Unknown option \"$1\", ignored" >&2;;
+ esac
+ shift
+done
+
+#*---------------------------------------------------------------------*/
+#* We spawn a bigloo process to check its version number */
+#*---------------------------------------------------------------------*/
+$bigloo -q -eval "(begin (print *ld-library-dir*) (exit 0))"
+
+exit 0
+
+
diff --git a/skribe/etc/bigloo/autoconf/bversion b/skribe/etc/bigloo/autoconf/bversion
new file mode 100755
index 0000000..1f24c86
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/bversion
@@ -0,0 +1,42 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/scribe/autoconf/bversion */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Tue Jan 12 14:33:21 1999 */
+#* Last change : Sun Jan 13 07:30:21 2002 (serrano) */
+#* ------------------------------------------------------------- */
+#* Check the current bigloo version */
+#*=====================================================================*/
+
+bigloo=bigloo
+version=2.4b
+
+#*---------------------------------------------------------------------*/
+#* We parse the arguments */
+#*---------------------------------------------------------------------*/
+while : ; do
+ case $1 in
+ "")
+ break;;
+ --bigloo=*|-bigloo=*)
+ bigloo="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --version=*|-version=*)
+ version="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ -*)
+ echo "Unknown option \"$1\", ignored" >&2;;
+ esac
+ shift
+done
+
+#*---------------------------------------------------------------------*/
+#* We spawn a bigloo process to check its version number */
+#*---------------------------------------------------------------------*/
+bver=`$bigloo -q -eval "(exit (print *bigloo-version*))"`
+echo $bver
+
+$bigloo -q -eval "(exit (if (string>=? *bigloo-version* \"$version\") 0 1))"
+
+exit $?
diff --git a/skribe/etc/bigloo/autoconf/getbversion b/skribe/etc/bigloo/autoconf/getbversion
new file mode 100755
index 0000000..ff83b1c
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/getbversion
@@ -0,0 +1,36 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/bglk/autoconf/getbversion */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Tue Jan 12 14:33:21 1999 */
+#* Last change : Mon May 22 10:47:46 2000 (serrano) */
+#* ------------------------------------------------------------- */
+#* Get the current bigloo version (with the level) */
+#*=====================================================================*/
+
+bigloo=bigloo
+
+#*---------------------------------------------------------------------*/
+#* We parse the arguments */
+#*---------------------------------------------------------------------*/
+while : ; do
+ case $1 in
+ "")
+ break;;
+ --bigloo=*|-bigloo=*)
+ bigloo="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --version=*|-version=*)
+ version="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ -*)
+ echo "Unknown option \"$1\", ignored" >&2;;
+ esac
+ shift
+done
+
+#*---------------------------------------------------------------------*/
+#* We spawn a bigloo process to check its version number */
+#*---------------------------------------------------------------------*/
+$bigloo -q -eval "(begin (print *bigloo-version*) (exit 0))"
diff --git a/skribe/etc/bigloo/autoconf/gmaketest b/skribe/etc/bigloo/autoconf/gmaketest
new file mode 100755
index 0000000..1bedd72
--- /dev/null
+++ b/skribe/etc/bigloo/autoconf/gmaketest
@@ -0,0 +1,38 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/bigloo/autoconf/gmaketest */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Jan 14 10:31:33 1999 */
+#* Last change : Thu May 18 07:19:28 2000 (serrano) */
+#* ------------------------------------------------------------- */
+#* Checsk that Make is GNU make */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* flags */
+#*---------------------------------------------------------------------*/
+make=make
+
+#*---------------------------------------------------------------------*/
+#* We parse the arguments */
+#*---------------------------------------------------------------------*/
+while : ; do
+ case $1 in
+ "")
+ break;;
+
+ --make=*)
+ make="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ -*)
+ echo "Unknown option \"$1\", ignored" >&2;;
+ esac
+ shift
+done
+
+# Check the make version number
+$make -v --version | grep -i "gnu make" > /dev/null
+
+# Return the grep result
+exit $?
diff --git a/skribe/etc/bigloo/configure b/skribe/etc/bigloo/configure
new file mode 100755
index 0000000..9215911
--- /dev/null
+++ b/skribe/etc/bigloo/configure
@@ -0,0 +1,552 @@
+#!/bin/sh
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/etc/bigloo/configure */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Tue Jan 25 16:05:10 1994 */
+#* Last change : Tue Aug 24 10:31:53 2004 (serrano) */
+#* Copyright : 1994-2004 Manuel Serrano, see LICENSE file */
+#* ------------------------------------------------------------- */
+#* The skribe configuration file */
+#*=====================================================================*/
+
+# the name of the current bigloo compiler
+bigloo=bigloo
+target=c
+
+# bigloo compilation flags
+bcommonflags="-no-hello -fno-reflection"
+blinkflags="-no-hello -ld-relative -O3"
+boptflags="$bcommonflags -O3"
+bsafeflags="$bcommonflags -g"
+bflags="$boptflags"
+bheapflags="-unsafe -q -mkaddheap -mkaddlib"
+bcflags="-copt \"$""(CPICFLAGS)\""
+bjvmflags="-jvm -jvm-purify -saw -jvm-env SKRIBEPATH"
+prcs=/usr/bin/prcs
+
+# the afile, jfile and btags binaries
+afile=afile
+jfile=
+btags=btags
+bdepend=bdepend
+
+# C compilation (left blank for automatic configuration (from Bigloo setup))
+cc=
+cflags=
+ldopt=
+
+# path (left blank for automatic configuration (from Bigloo setup))
+bgllibdir=
+bglbindir=
+bgllddir=
+bgldocdir=
+skribebindir=
+skribelibdir=
+skribefildir=
+skribeskrdir=
+skribeextdir=
+skribedocdir=
+skribemandir=
+
+# mask of Skribe intalled files
+smask=755
+
+#*---------------------------------------------------------------------*/
+#* !!! DON'T EDIT AFTER THIS COMMENT !!! */
+#*---------------------------------------------------------------------*/
+if [ "x$DISTRIBDIR" = "x" ]; then
+ distribdir=$HOME/prgm/distrib
+else
+ distribdir=$DISTRIBDIR
+fi
+
+if [ "x$SKRIBERELEASE" = "x" ]; then
+ echo "*** ERROR:configure:release. Aborting"
+ echo "Variable \"SKRIBERELEASE\" is unset."
+ exit 1;
+else
+ release=$SKRIBERELEASE
+fi
+
+if [ "x$SKRIBEBETARELEASE" = "x" ]; then
+ if [ -f $prcs ]; then
+ beta=`$prcs info skribe 2>&1 /dev/null | tail --lines=1 | awk '{ print $2 }' | sed 's/[0-9]*[.][0-9]*[a-z]*/&-beta/'`
+ elif [ -f /usr/local/bin/prcs ]; then
+ beta=`/usr/local/bin/prcs info skribe 2>&1 /dev/null | tail --lines=1 | awk '{ print $2 }' | sed 's/[0-9]*[.][0-9]*[a-z]*/&-beta/'`
+ else
+ beta=no
+ fi
+else
+ beta=$SKRIBEBETARELEASE
+fi
+
+if [ "x$SKRIBEURL" = "x" ]; then
+ skribeurl="http://www.inria.fr/mimosa/fp/Skribe"
+else
+ skribeurl=$SKRIBEURL
+fi
+
+requiredbigloo=2.6c
+
+action=all
+makefile_config=Makefile.skb
+skribe_config=../../src/common/configure.scm
+summary=yes
+
+http="www-sop.inria.fr/mimosa/fp"
+autoconfdir=`dirname $0 2> /dev/null`/autoconf
+bootconfig=false;
+
+if [ $? != "0" ]; then
+ autoconfdir="autoconf"
+fi
+
+# Argument parsing
+while : ; do
+ case $1 in
+ "")
+ break;;
+
+ -c)
+ target=c;;
+
+ -j|--jvm)
+ target=jvm;;
+
+ -|--dotnet)
+ target=dotnet;;
+
+ --skribe_config=*)
+ action="skribe_config";
+ skribe_config="`echo $1 | sed 's/^[-a-z_.]*=//'`";;
+
+ --makefile.skb=*)
+ action="makefile.skb";
+ makefile_config="`echo $1 | sed 's/^[-Da-z.]*=//'`";;
+
+ --bglbindir=*)
+ bglbindir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bgllibdir=*)
+ bgllibdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bgllddir=*)
+ bgllddir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bgldocdir=*)
+ bgldocdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bindir=*)
+ skribebindir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --libdir=*)
+ skribelibdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --fildir=*)
+ skribefildir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --skrdir=*)
+ skribeskrdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --extdir=*)
+ skribeextdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --docdir=*)
+ skribedocdir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --mandir=*)
+ skribemandir="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bigloo=*)
+ bigloo="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --afile=*)
+ afile="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --jfile=*)
+ jfile="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --btags=*)
+ btags="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --mask=*)
+ smask="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --cc=*)
+ cc="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --cflags=*)
+ cflags="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --ldopt=*)
+ ldopt="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --backends=*)
+ backends="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --no-summary)
+ summary=no;;
+
+ --debug)
+ bflags="-g -cg $bsafeflags";;
+
+ --debug2)
+ bflags="-g2 -cg $bsafeflags";;
+
+ --debug3)
+ bflags="-g3 -cg $bsafeflags";;
+
+ --optimize)
+ bflags=$boptflags;;
+
+ --bjvmflags=*)
+ bjvmflags="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --bcflags=*)
+ bcflags="`echo $1 | sed 's/^[-a-z]*=//'`";;
+
+ --prefix=*)
+ prefix="`echo $1 | sed 's/^[^=]*=//'`";
+ skribebindir=$prefix/bin;
+ skribeskrdir=$prefix/share/skribe/$release/skr;
+ skribeextdir=$prefix/share/skribe/extensions;
+ skribelibdir=$prefix/lib
+ skribefildir=$skribelibdir/skribe/$release;
+ skribemandir=$prefix/man/man1;
+ skribedocdir=$prefix/doc/skribe-$release;;
+
+ --bootconfig)
+ bootconfig=true;;
+
+ -*)
+ echo "*** Configure error, unknown option $1" >&2;
+ echo >&2;
+ echo "Usage: configure --with-bigloo [options]" >&2;
+ echo " -c.................... uses the Bigloo C back-end" >&2;
+ echo " -j|--jvm.............. uses the Bigloo JVM back-end" >&2;
+ echo " -d|--dotnet........... uses the Bigloo .NET back-end" >&2;
+ echo " --skribe_config=file.. sets the name of the skribe-config file" >&2;
+ echo " --makefile.skb=file... sets the name of the Makefile.skb file" >&2;
+ echo " --prefix=dir.......... prefix to Skribe install" >&2;
+ echo " --bindir=file......... alternative Skribe bin directory" >&2;
+ echo " --libdir=file......... alternative Skribe lib directory" >&2;
+ echo " --fildir=file......... alternative Skribe file directory" >&2;
+ echo " --skrdir=file......... Skribe skr directory" >&2;
+ echo " --bglbindir=file...... Bigloo bin directory" >&2;
+ echo " --bgllibdir=file...... Bigloo lib directory" >&2;
+ echo " --bglfildir=file...... Bigloo file directory" >&2;
+ echo " --bgldocdir=file...... Bigloo doc directory" >&2;
+ echo " --docdir=file......... Documentation directory" >&2;
+ echo " --mandir=file......... Manual pages directory" >&2;
+ echo " --bigloo=comp......... The Bigloo compiler" >&2;
+ echo " --afile=afile......... The Bigloo afile tool" >&2;
+ echo " --jfile=jfile......... The Bigloo jfile tool" >&2;
+ echo " --btags=btags......... The Bigloo btags tool" >&2;
+ echo " --cc=comp............. The C compiler (for C back-end)" >&2;
+ echo " --cflags=args......... The C compilation options" >&2;
+ echo " --ldopt=args.......... The C link options" >&2;
+ echo " --smask=mask.......... The installation mask" >&2;
+ echo " --no-summary.......... Private option" >&2;
+ echo " --debug............... Enables Bigloo debug mode" >&2;
+ echo " --optimize............ Enables Bigloo optimization mode (default)" >&2;
+ echo " --bootconfig.......... Private option" >&2;
+ exit -1;
+ esac
+ shift
+done
+
+#*---------------------------------------------------------------------*/
+#* First check if bigloo exists and if it is recent enough */
+#*---------------------------------------------------------------------*/
+if [ ! -f $bigloo ]; then
+ which $bigloo > /dev/null 2> /dev/null
+ if [ "$?" != "0" ]; then
+ echo "*** ERROR:configure:bigloo. Aborting"
+ echo "Can't find bigloo."
+ exit 1;
+ fi
+fi
+
+installedbigloo=`$autoconfdir/bversion --bigloo=$bigloo --version=$requiredbigloo`
+
+if [ $? != "0" ]; then
+ echo "*** ERROR:configure:bigloo. Aborting"
+ echo "Your version ($installedbigloo) of Bigloo is too old."
+ echo "Release $requiredbigloo or more recent is required."
+ echo "Bigloo may be downloaded from $http"
+ exit 1;
+fi
+
+#*---------------------------------------------------------------------*/
+#* The binary directory */
+#*---------------------------------------------------------------------*/
+if [ "$bglbindir " = " " ]; then
+ if [ "$bigloo " = " " ]; then
+ bgl=`which bigloo`;
+ else
+ bgl=`which $bigloo`;
+ fi
+ bglbindir=`dirname $bgl`
+fi
+if [ "$skribebindir " = " " ]; then
+ skribebindir=$prefix/bin;
+fi
+
+#*---------------------------------------------------------------------*/
+#* The Bigloo library directory */
+#*---------------------------------------------------------------------*/
+if [ "$bgllibdir " = " " ]; then
+ bgllibdir=`$autoconfdir/blibdir --bigloo="$bigloo"`
+fi
+if [ "$bglfildir " = " " ]; then
+ bglfildir=`$autoconfdir/bfildir --bigloo="$bigloo"`
+fi
+
+#*---------------------------------------------------------------------*/
+#* We check the installed Bigloo Makefile.config file */
+#*---------------------------------------------------------------------*/
+if [ ! -f $bglfildir/Makefile.config ]; then
+ echo "*** ERROR:configure:Can't find Makefile.config file"
+ echo "Should be $bglfildir/Makefile.config."
+ exit 1;
+fi
+
+#*---------------------------------------------------------------------*/
+#* jfile */
+#*---------------------------------------------------------------------*/
+if [ "$jfile " = " " ]; then
+ if [ ! -f $bigloo ]; then
+ which jfile > /dev/null 2> /dev/null
+ if [ "$?" != "0" ]; then
+ jfile=true;
+ else
+ jfile=jfile;
+ fi
+ fi
+fi
+
+#*---------------------------------------------------------------------*/
+#* We are now able to set the correct value for cc since we know */
+#* what Bigloo is. */
+#*---------------------------------------------------------------------*/
+if [ "$cc " = " " ]; then
+ cc=`$bigloo -eval '(begin (print *cc*) (exit 0))'`
+fi
+
+if [ "$cflags " = " " ]; then
+ cflags=`grep '^CFLAGS=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//'`
+fi
+
+ldflags=`grep '^EXTRALIBS=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//'`
+cpicflags=`grep '^CPICFLAGS=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//'`
+
+#*---------------------------------------------------------------------*/
+#* Completing dirs */
+#*---------------------------------------------------------------------*/
+if [ "$skribelibdir " = " " ]; then
+ skribelibdir=$prefix/lib;
+fi
+if [ "$skribefildir " = " " ]; then
+ skribefildir=$skribelibdir/skribe/$release;
+fi
+if [ "$skribeskrdir " = " " ]; then
+ skribeskrdir=$prefix/share/skribe/$release/skr;
+fi
+if [ "$skribeextdir " = " " ]; then
+ skribeextdir=$prefix/share/skribe/extensions;
+fi
+if [ "$bgldocdir " = " " ]; then
+ bgldocdir=`grep '^DOCDIR=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//' | sed 's/[$][(][^)]*[)]//'`
+fi
+if [ "$skribedocdir " = " " ]; then
+ skribedocdir=`dirname $bgldocdir`/skribe-$release
+fi
+if [ "$skribemandir " = " " ]; then
+ skribemandir=`grep '^MANDIR=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//'`
+fi
+if [ "$skribeemacsdir " = " " ]; then
+ skribeemacsdir=`grep '^EMACSDIR=' $bglfildir/Makefile.config | sed 's/^[A-Z]*=//'`
+fi
+
+#*---------------------------------------------------------------------*/
+#* emacs/skribe.el */
+#*---------------------------------------------------------------------*/
+cat ../../emacs/skribe.el \
+ | sed "s|@SKRIBE_EMACSDIR@|$skribeemacsdir|" \
+ | sed "s|@SKRIBE_HOSTSCHEMEDOCDIR@|$bgldocdir|" \
+ > ../../emacs/skribe.el.aux \
+ && mv ../../emacs/skribe.el.aux ../../emacs/skribe.el
+
+#*---------------------------------------------------------------------*/
+#* etc/skribe-config */
+#*---------------------------------------------------------------------*/
+cat ../skribe-config \
+ | sed "s|@SKRIBE_EMACS_DIR@|$skribeemacsdir|" \
+ > ../skribe-config.aux \
+ && mv ../skribe-config.aux ../skribe-config
+
+#*---------------------------------------------------------------------*/
+#* makefile.skb */
+#* ------------------------------------------------------------- */
+#* This part of the configure script produces the file */
+#* makefile.skb. This file contains machine dependant */
+#* informations and location where Bigloo is to be installed. */
+#*---------------------------------------------------------------------*/
+if [ $action = "all" -o $action = "makefile.skb" ]; then
+
+ # We create an unexisting temporary file name
+ name=foo
+ while( test -f "$name.c" -o -f "$name.o" ); do
+ name="$name"x;
+ done
+
+ # We check the C compiler
+ cat > $name.c <<EOF
+ int foobar( int x ) {
+ return x;
+ }
+EOF
+
+ if $cc $cflags -c $name.c >/dev/null 2>&1
+ then
+ true
+ else
+ echo "***ERROR:configure:$cc:Can't compile c file -- $cc $cflags -c $name.c";
+ /bin/rm -f $name.c $name.o $name.a;
+ exit 1
+ fi
+ /bin/rm -f $name.c $name.o $name.a;
+
+ # We first cleanup the general Makefile config
+ rm -f ../Makefile.config 2> /dev/null
+ echo "## Skribe ($release) configure" > ../Makefile.config
+ echo "## Don't edit, file generated by etc/bigloo/configure" >> ../Makefile.config
+ echo "SKRIBERELEASE=$release" >> ../Makefile.config
+ echo "SKRIBEBETARELEASE=$beta" >> ../Makefile.config
+ echo >> ../Makefile.config
+ echo "SYSTEM=bigloo" >> ../Makefile.config
+ case $target in
+ jvm)
+ echo 'SKRIBE=java -classpath $(BINDIR)/skribe.zip:$(ZIPDIR)/bigloo_s.zip:$(LIBDIR)/bigloo_s.zip bigloo.skribe.main' >> ../Makefile.config;
+ echo 'SKRIBEINFO=java -classpath $(BINDIR)/skribeinfo.zip:$(ZIPDIR)/bigloo_s.zip:$(LIBDIR)/bigloo_s.zip bigloo.skribe.skribeinfo.main' >> ../Makefile.config;
+ echo 'SKRIBEBIBTEX=java -classpath $(BINDIR)/skribebibtex.zip:$(ZIPDIR)/bigloo_s.zip:$(LIBDIR)/bigloo_s.zip bigloo.skribe.skribebibtex.main' >> ../Makefile.config;;
+ *)
+ echo 'SKRIBE=$'"(BINDIR)/skribe.bigloo" >> ../Makefile.config;
+ echo 'SKRIBEINFO=$'"(BINDIR)/skribeinfo.bigloo" >> ../Makefile.config;
+ echo 'SKRIBEBIBTEX=$'"(BINDIR)/skribebibtex.bigloo" >> ../Makefile.config;;
+ esac
+
+ # We first cleanup the file
+ rm -f $makefile_config 2> /dev/null
+ touch $makefile_config
+ echo "## Skribe ($release) configure" >> $makefile_config
+ echo "## Don't edit, file generated by etc/bigloo/configure" >> $makefile_config
+ echo >> $makefile_config
+
+ # The Bigloo target (c, jvm, dotnet)
+ echo "TARGET=$target" >> $makefile_config
+ echo >> $makefile_config
+
+ # The boot directories
+ echo "SKRIBEDIR=`pwd`/../.." >> $makefile_config
+ echo 'SKRIBEBINDIR=$'"(SKRIBEDIR)/bin" >> $makefile_config;
+ echo 'SKRIBELIBDIR=$'"(SKRIBEDIR)/lib" >> $makefile_config;
+ echo 'SKRIBEFILDIR=$'"(SKRIBEDIR)/lib" >> $makefile_config;
+ echo >> $makefile_config
+
+ # The distribution directory
+ echo "DISTRIBDIR=$distribdir" >> $makefile_config
+ echo >> $makefile_config
+
+ # The installation directories
+ echo "INSTALL_BINDIR=$skribebindir" >> $makefile_config
+ echo "INSTALL_LIBDIR=$skribelibdir" >> $makefile_config
+ echo "INSTALL_FILDIR=$skribefildir" >> $makefile_config
+ echo "INSTALL_SKRDIR=$skribeskrdir" >> $makefile_config
+ echo "INSTALL_EXTDIR=$skribeextdir" >> $makefile_config
+ if [ ! "$skribedocdir " = " " ]; then
+ echo "INSTALL_DOCDIR=$skribedocdir" >> $makefile_config;
+ fi
+ if [ ! "$skribemandir " = " " ]; then
+ echo "INSTALL_MANDIR=$skribemandir" >> $makefile_config;
+ fi
+ echo "INSTALL_HOSTHTTP=$skribehttphost" >> $makefile_config
+ echo "INSTALL_MASK=$smask" >> $makefile_config
+ echo >> $makefile_config
+
+ # The bigloo configuration
+ cat $bglfildir/Makefile.config >> $makefile_config
+ echo >> $makefile_config
+
+ # The bigloo compiler
+ echo "BIGLOO=$bigloo" >> $makefile_config
+ echo "BIGLOO_FILDIR=$bglfildir" >> $makefile_config
+ echo "BIGLOO_LIBDIR=$bgllibdir" >> $makefile_config
+ echo >> $makefile_config
+
+ # The bigloo compiler options
+ echo "BLINKFLAGS=$blinkflags -ldopt '$ldopt'" >> $makefile_config
+ echo "BSAFEFLAGS=$bsafeflags" >> $makefile_config
+ echo "BHEAPFLAGS=$bheapflags" >> $makefile_config
+ echo "BCOMMONFLAGS=$bflags" >> $makefile_config
+ echo "BCFLAGS=$bcflags" >> $makefile_config
+ echo "BJVMFLAGS=$bjvmflags" >> $makefile_config
+ echo >> $makefile_config
+
+ # Bigloo bde
+ echo "AFILE=$afile" >> $makefile_config
+ echo "JFILE=$jfile" >> $makefile_config
+ echo "BTAGS=$btags" >> $makefile_config
+ echo "BDEPEND=$bdepend" >> $makefile_config
+ echo "SKRIBEINDENT=bpp" >> $makefile_config
+ echo >> $makefile_config
+
+ # Misc
+ echo "RM=/bin/rm" >> $makefile_config
+ echo >> $makefile_config
+fi
+
+#*---------------------------------------------------------------------*/
+#* Ok, we are done now */
+#*---------------------------------------------------------------------*/
+if [ "$summary" = "yes" ]; then
+ echo
+ echo
+ echo "** Configuration summary **"
+ echo
+ echo "Release number:"
+ echo " Skribe release number................. $release"
+ echo " Skribe beta number.................... $beta"
+ echo " Minimum Bigloo version required....... $requiredbigloo"
+ echo " Installed Bigloo version.............. $installedbigloo"
+ echo
+ echo "Compilers:"
+ echo " Bigloo................................ $bigloo"
+ echo " Bigloo link flags..................... $blinkflags"
+ echo " Bigloo compilation flags.............. $bflags"
+ echo " Bigloo heap flags..................... $bheapflags"
+ echo " afile................................. $afile"
+ echo " jfile................................. $jfile"
+ echo " btags................................. $btags"
+ echo " cc.................................... $cc"
+ echo " cc compilation flags.................. $cflags"
+ echo " link options.......................... $ldopt"
+ echo
+ echo "Path:"
+ echo " Binary directory...................... $skribebindir"
+ echo " Skr directory......................... $skribeskrdir"
+ echo " Extensions directory.................. $skribeextdir"
+ echo " File directory........................ $skribefildir"
+ echo " Library directory..................... $skribelibdir"
+ echo " Documentation directory............... $skribedocdir"
+ echo " Man pages directory................... $skribemandir"
+ echo " Home page............................. $skribeurl"
+ echo
+ echo "Misc configuration:"
+ echo " mask for installed files.............. $smask"
+ echo
+ echo "Emacs:"
+ echo " Emacs Lisp files directory............ $skribeemacsdir"
+ echo
+fi
diff --git a/skribe/etc/skribe-config.in b/skribe/etc/skribe-config.in
new file mode 100644
index 0000000..2a03e26
--- /dev/null
+++ b/skribe/etc/skribe-config.in
@@ -0,0 +1,64 @@
+#!/bin/sh
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 19-Nov-2003 21:04 (eg)
+# Last file update: 19-Nov-2003 22:29 (eg)
+
+
+function usage()
+{
+ cat <<EOF
+Usage: skribe-config [OPTIONS]
+Options:
+ [--prefix | -p] Prefix that was given during the build
+ [--version | -v] Version of Skribe that is installed
+ [--skr-dir | -k] Display the skr directory location
+ [--extension-dir | -e] Display the extension directory location
+ [--doc-dir | -d] Display the documentation directory location
+ [--emacs-dir | -m] Display the emacs directory location
+ [--scheme | -s] Display the Scheme systeme used
+ [--help | -h | -?] Show a list of options
+EOF
+ exit $1
+}
+
+
+if test $# -eq 0; then
+ usage 1 1>&2
+fi
+
+while test $# -gt 0; do
+ case $1 in
+ --prefix|-p)
+ echo @PREFIX@
+ ;;
+ --version|-v)
+ echo @SKRIBE_RELEASE@
+ ;;
+ --extension-dir|-e)
+ echo @SKRIBE_EXT_DIR@
+ ;;
+ --skr-dir|-k)
+ echo @SKRIBE_SKR_DIR@
+ ;;
+ --doc-dir|-d)
+ echo @SKRIBE_DOC_DIR@
+ ;;
+ --emacs-dir|-m)
+ echo @SKRIBE_EMACS_DIR@
+ ;;
+ --scheme|-s)
+ echo @SYSTEM@
+ ;;
+ --help|-h|-\?)
+ usage 0 1>&2
+ ;;
+ *)
+ echo "bad option $1" 1>&2
+ usage 1 1>&2
+ ;;
+ esac
+ shift
+done
+exit 0
+
diff --git a/skribe/etc/stklos/Makefile.config.in b/skribe/etc/stklos/Makefile.config.in
new file mode 100644
index 0000000..13a60d8
--- /dev/null
+++ b/skribe/etc/stklos/Makefile.config.in
@@ -0,0 +1,5 @@
+SYSTEM=@SYSTEM@
+SKRIBE=@SKRIBE@
+SKRIBEINFO=@SKRIBEINFO@
+SKRIBEBIBTEX=@SKRIBEBIBTEX@
+
diff --git a/skribe/etc/stklos/Makefile.in b/skribe/etc/stklos/Makefile.in
new file mode 100644
index 0000000..186fd58
--- /dev/null
+++ b/skribe/etc/stklos/Makefile.in
@@ -0,0 +1,44 @@
+#
+# Makefile.in -- Skribe Makefile for Stklos
+#
+# Copyright � 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+#
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 10-Aug-2003 17:31 (eg)
+# Last file update: 10-Nov-2003 19:48 (eg)
+#
+
+PRCS_FILES=Makefile.config.in Makefile.in Makefile.skb.in configure.in \
+configure
+
+all: configure
+
+
+configure: configure.in
+ autoconf
+
+clean:
+ /bin/rm -f config.* *~
+
+pop:
+ @echo $(PRCS_FILES:%=etc/stklos/%)
+
+distclean: clean
+ (cd ../../src/stklos/; $(MAKE) distclean)
+ /bin/rm -f Makefile Makefile.skb ../Makefile.config
diff --git a/skribe/etc/stklos/Makefile.skb.in b/skribe/etc/stklos/Makefile.skb.in
new file mode 100644
index 0000000..7568474
--- /dev/null
+++ b/skribe/etc/stklos/Makefile.skb.in
@@ -0,0 +1,5 @@
+BMASK=0755
+INSTALL_DOCDIR=@PREFIX@/share/doc/skribe-@SKRIBE_RELEASE@
+INSTALL_BINDIR=@PREFIX@/bin
+INSTALL_SKRDIR=@PREFIX@/share/skribe/@SKRIBE_RELEASE@/skr
+INSTALL_EXTDIR=@PREFIX@/share/skribe/extensions
diff --git a/skribe/etc/stklos/configure b/skribe/etc/stklos/configure
new file mode 100755
index 0000000..e1d2526
--- /dev/null
+++ b/skribe/etc/stklos/configure
@@ -0,0 +1,830 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../../src/common/api.scm
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+### AM_INIT_AUTOMAKE(skribe,0.0)
+PACKAGE=skribe
+
+SYSTEM=stklos
+SKRIBE='$(BINDIR)/skribe.stklos'
+SKRIBEBIBTEX='$(BINDIR)/skribebibtex.stklos'
+
+##
+## Initialize prefix
+##
+if test "${prefix}" = "NONE" -o "$prefix" = "" ;then
+ prefix="/usr/local"
+fi
+
+##
+## Get information from ../config
+##
+if test -f ../config ;then
+ . ../config
+else
+ echo "You must configure Skribe from the ../.. directory"
+ exit 1
+fi
+
+
+PREFIX=$prefix
+SKRIBE_RELEASE=${release}
+SKRIBE_URL=${skribeurl}
+
+##
+## Substitutions
+##
+
+
+
+
+
+
+
+
+
+#
+# Outputs
+#
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile ../../src/stklos/Makefile Makefile.config Makefile.skb" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@PACKAGE@%$PACKAGE%g
+s%@PREFIX@%$PREFIX%g
+s%@SKRIBE_RELEASE@%$SKRIBE_RELEASE%g
+s%@SKRIBE_URL@%$SKRIBE_URL%g
+s%@SYSTEM@%$SYSTEM%g
+s%@SKRIBE@%$SKRIBE%g
+s%@SKRIBEINFO@%$SKRIBEINFO%g
+s%@SKRIBEBIBTEX@%$SKRIBEBIBTEX%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../../src/stklos/Makefile Makefile.config Makefile.skb"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
+# Makefile.config must be in the parent directory
+mv Makefile.config ..
+
diff --git a/skribe/etc/stklos/configure.in b/skribe/etc/stklos/configure.in
new file mode 100644
index 0000000..956af77
--- /dev/null
+++ b/skribe/etc/stklos/configure.in
@@ -0,0 +1,57 @@
+dnl
+dnl Configure.in for Skribe
+dnl
+dnl Author: Erick Gallesio [eg@essi.fr]
+dnl Creation date: 23-Jul-2003 12:04 (eg)
+dnl Last file update: 26-Oct-2004 20:24 (eg)
+
+AC_INIT(../../src/common/api.scm)
+### AM_INIT_AUTOMAKE(skribe,0.0)
+PACKAGE=skribe
+
+SYSTEM=stklos
+SKRIBE='$(BINDIR)/skribe.stklos'
+SKRIBEBIBTEX='$(BINDIR)/skribebibtex.stklos'
+
+##
+## Initialize prefix
+##
+if test "${prefix}" = "NONE" -o "$prefix" = "" ;then
+ prefix="/usr/local"
+fi
+
+##
+## Get information from ../config
+##
+if test -f ../config ;then
+ . ../config
+else
+ echo "You must configure Skribe from the ../.. directory"
+ exit 1
+fi
+
+
+PREFIX=$prefix
+SKRIBE_RELEASE=${release}
+SKRIBE_URL=${skribeurl}
+
+##
+## Substitutions
+##
+AC_SUBST(PACKAGE)
+AC_SUBST(PREFIX)
+AC_SUBST(SKRIBE_RELEASE)
+AC_SUBST(SKRIBE_URL)
+AC_SUBST(SYSTEM)
+AC_SUBST(SKRIBE)
+AC_SUBST(SKRIBEINFO)
+AC_SUBST(SKRIBEBIBTEX)
+
+#
+# Outputs
+#
+AC_OUTPUT(Makefile ../../src/stklos/Makefile Makefile.config Makefile.skb)
+
+# Makefile.config must be in the parent directory
+mv Makefile.config ..
+
diff --git a/skribe/examples/Makefile b/skribe/examples/Makefile
new file mode 100644
index 0000000..7f47f6e
--- /dev/null
+++ b/skribe/examples/Makefile
@@ -0,0 +1,48 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/examples/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Fri Oct 24 13:25:43 2003 */
+#* Last change : Wed Feb 18 11:25:20 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The meta Makefile for the examples */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* All the examples */
+#*---------------------------------------------------------------------*/
+EXAMPLES=slide
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ for p in $(EXAMPLES); do \
+ (cd $$p && $(MAKE) pop); \
+ done
+ @ echo examples/Makefile
+
+#*---------------------------------------------------------------------*/
+#* Install/Uinstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install:
+
+uninstall:
+
+#*---------------------------------------------------------------------*/
+#* cleaning */
+#*---------------------------------------------------------------------*/
+.PHONY: clean distclean
+
+clean:
+ for p in $(EXAMPLES); do \
+ (cd $$p && $(MAKE) clean); \
+ done
+
+distclean: clean
+
diff --git a/skribe/examples/slide/Makefile b/skribe/examples/slide/Makefile
new file mode 100644
index 0000000..c9b7a84
--- /dev/null
+++ b/skribe/examples/slide/Makefile
@@ -0,0 +1,153 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/examples/slide/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Fri Jan 11 10:19:46 2002 */
+#* Last change : Thu Dec 18 09:21:41 2003 (serrano) */
+#* Copyright : 2002-03 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to build the Slides example */
+#*=====================================================================*/
+include ../../etc/Makefile.config
+include ../../etc/$(SYSTEM)/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* Compiler and tools */
+#*---------------------------------------------------------------------*/
+BINDIR = ../../bin
+LIBDIR = ../../lib
+
+#*---------------------------------------------------------------------*/
+#* Compilers and Tools */
+#*---------------------------------------------------------------------*/
+SFLAGS = -I txt -I skr -I skb -I ../../skr
+LATEX = latex
+DVIPS = dvips -Ppdf -G0
+TEXHOME = $$HOME/tex
+PS2PDF = ps2pdf -dPDFSETTINGS=/prepress -sPAPERSIZE=a4
+MODE = advi
+
+#*---------------------------------------------------------------------*/
+#* Skribe variables */
+#*---------------------------------------------------------------------*/
+SKRIBEVARS = --eval "(define *mode* '$(MODE))"
+
+#*---------------------------------------------------------------------*/
+#* Sources */
+#*---------------------------------------------------------------------*/
+MASTER = skb/slides.skb
+
+INPUTSNAME =
+EXNAME = skribe.skb syntax.scr
+INPUTS = $(INPUTSNAME:%=skb/%.skb) $(EXNAME:%=ex/%)
+
+SOURCESNAME =
+SOURCES = $(SOURCESNAME:%=scm/%.scm)
+
+STYLES = local
+LSTYLES = $(STYLE:%=skr/%.skr)
+
+FIGS_SOURCES =
+FIGURES = $(FIGS_SOURCES:%=fig/%.eps) $(FIGS_SOURCES:%=fig/%.png)
+
+#*---------------------------------------------------------------------*/
+#* Suffixes */
+#*---------------------------------------------------------------------*/
+.SUFFIXES:
+.SUFFIXES: .skb .skr .eps .fig .tex .ps .pdf .png .html .dvi
+
+#*---------------------------------------------------------------------*/
+#* All */
+#*---------------------------------------------------------------------*/
+all: ps html
+
+ps: slides.ps
+slides.ps: slides.dvi
+ $(DVIPS) -o slides.ps slides.dvi
+
+pdf: slides.pdf
+slides.pdf: slides.ps
+ $(PS2PDF) slides.ps slides.pdf
+
+dvi: slides.dvi
+slides.dvi: slides.tex
+ $(LATEX) slides.tex
+
+slides.tex: $(MASTER) $(INPUTS) $(LSTYLES) $(SOURCES) $(FIGURES)
+ $(SKRIBE) $(SKRIBEVARS) $(SFLAGS) $(MASTER) -o slides.tex
+
+html: slides.html
+slides.html: $(MASTER) $(INPUTS) $(LSTYLES) $(SOURCES) $(FIGURES)
+ $(SKRIBE) $(SKRIBEVARS) $(SFLAGS) $(MASTER) -o slides.html
+
+text: slides.text
+slides.text: $(MASTER) $(INPUTS) $(LSTYLES) $(SOURCES) $(FIGURES)
+ $(SKRIBE) $(SKRIBEVARS) $(SFLAGS) $(MASTER) -t text -o slides.text
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo examples/slide/Makefile \
+ examples/slide/README \
+ examples/slide/advi.sty \
+ examples/slide/PPRskribe.sty \
+ examples/slide/skr/local.skr
+ @ echo $(MASTER:%=examples/slide/%)
+ @ echo $(EXNAME:%=examples/slide/ex/%)
+
+#*---------------------------------------------------------------------*/
+#* binary */
+#*---------------------------------------------------------------------*/
+getbinary:
+ echo "slides"
+
+#*---------------------------------------------------------------------*/
+#* re */
+#*---------------------------------------------------------------------*/
+.PHONY: re re.ps re.html
+
+re: re.ps re.html
+
+re.ps:
+ touch -m -d 0 slides.tex
+ $(MAKE) ps
+
+re.html:
+ touch -m -d 0 slides.html
+ $(MAKE) html
+
+#*---------------------------------------------------------------------*/
+#* .eps.png */
+#*---------------------------------------------------------------------*/
+.eps.png:
+ @ echo $*.png:
+ @ convert $*.eps $*.png
+
+#*---------------------------------------------------------------------*/
+#* .eps.fig */
+#*---------------------------------------------------------------------*/
+.fig.eps:
+ @ echo $*.fig:
+ @ fig2dev -L eps $*.fig > $*.eps
+
+#*---------------------------------------------------------------------*/
+#* Clean */
+#*---------------------------------------------------------------------*/
+clean:
+ -/bin/rm -f slides.tex 2> /dev/null
+ -/bin/rm -f slides.dvi 2> /dev/null
+ -/bin/rm -f *.aux *.log 2> /dev/null
+ -/bin/rm -f *~ 2> /dev/null
+ -/bin/rm -f */*~ 2> /dev/null
+ -/bin/rm -f */*/*~ 2> /dev/null
+ -/bin/rm -f slides.ps 2> /dev/null
+ -/bin/rm -f slides.pdf 2> /dev/null
+ -/bin/rm -f slides*.html 2> /dev/null
+ -/bin/rm -f slides.text 2> /dev/null
+ -/bin/rm -f slides.out 2> /dev/null
+ -/bin/rm -f $(FIGURES)
+
+cleanall: clean
diff --git a/skribe/examples/slide/PPRskribe.sty b/skribe/examples/slide/PPRskribe.sty
new file mode 100644
index 0000000..40b2d08
--- /dev/null
+++ b/skribe/examples/slide/PPRskribe.sty
@@ -0,0 +1,67 @@
+%==============================================================================
+% Prosper -- (PPRskribe.sty) Style file
+% A LaTeX class for creating slides
+% Author: Manuel Serrano
+%
+% Permission is hereby granted, without written agreement and without
+% license or royalty fees, to use, copy, modify, and distribute this
+% software and its documentation for any purpose, provided that the
+% above copyright notice and the following two paragraphs appear in
+% all copies of this software.
+%
+% IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT,
+% SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF
+% THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED
+% OF THE POSSIBILITY OF SUCH DAMAGE.
+%
+% THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES,
+% INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+% AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+% ON AN "AS IS" BASIS, AND THE AUTHOR HAS NO OBLIGATION TO
+% PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+%==============================================================================
+\NeedsTeXFormat{LaTeX2e}[1995/12/01]
+\ProvidesPackage{PPRskribe}[2003/10/21]
+\typeout{`skribe' style for Prosper ---}
+\typeout{ }
+
+\RequirePackage{amssymb}
+% Loading packages necessary to define this slide style.
+% none
+
+\FontTitle{%
+ \usefont{T1}{ptm}{b}{n}\fontsize{13.82pt}{12pt}\selectfont\blue}{%
+ \usefont{T1}{ptm}{b}{n}\fontsize{13.82pt}{12pt}\selectfont\blue}
+\FontText{%
+ \black\usefont{T1}{phv}{m}{n}\fontsize{9.4pt}{9pt}\selectfont}{%
+ \black\usefont{T1}{phv}{m}{n}\fontsize{9.4pt}{9pt}\selectfont}
+
+
+% Positionning of the title of a slide.
+\newcommand{\slidetitle}[1]{%
+ \rput[c](5.25,4.4){\fontTitle{#1}}
+}
+
+% Positionning for a logo
+% \LogoPosition{-1,-1.1}
+
+% Definition of this style for slides.
+
+\newcommand{\BasicFrame}[1]{%
+ {#1}}
+
+%\NewSlideStyle[115mm]{t}{5.3,3.2}{BasicFrame}
+\NewSlideStyle[125mm]{t}{5.3,3.8}{BasicFrame}
+\PDFCroppingBox{10 40 594 800}
+\RequirePackage{semhelv}
+
+\myitem{1}{$\bullet$}
+\myitem{2}{$\circ$}
+\myitem{3}{$\diamond$}
+
+\endinput
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/skribe/examples/slide/README b/skribe/examples/slide/README
new file mode 100644
index 0000000..cb9f303
--- /dev/null
+++ b/skribe/examples/slide/README
@@ -0,0 +1,11 @@
+This example shows how to program slides with Skribe. Three slide
+formats can be produced:
+
+1. Advi
+ type `make MODE=advi'
+
+2. Plain PDF
+ type `make pdf MODE=pdf'
+
+3. LaTeX prosper
+ type `make pdf MODE=prosper'
diff --git a/skribe/examples/slide/advi.sty b/skribe/examples/slide/advi.sty
new file mode 100644
index 0000000..9b5e09f
--- /dev/null
+++ b/skribe/examples/slide/advi.sty
@@ -0,0 +1,416 @@
+%%
+%% This is the original source file advi.sty
+%%
+%% Package `advi' to use with LaTeX 2e
+%% Copyright Roberto Di Cosmo, Jun Furuse, Didier Remy, and Pierre Weis
+%% All rights reserved.
+
+% Which name is ours
+\def \ActiveDVI {Active-DVI}
+
+\NeedsTeXFormat{LaTeX2e}
+\ProvidesPackage{advi}
+ [2001/29/08 v0.40 Advi Package for advi Previewer]
+
+%%
+
+%% Identification
+%% Preliminary declarations
+
+\RequirePackage {keyval}
+
+%% Options
+
+\newif \ifadvi@ignore \advi@ignorefalse
+\DeclareOption {ignore}{\advi@ignoretrue}
+
+\ProcessOptions
+% \@ifundefined {AdviOptions}{}{\ExecuteOptions {\AdviOptions}}
+
+%% More declarations
+
+% Auxilliary macros
+
+
+\def \advi@empty{}
+\def \advi@ifempty #1{\def \@test {#1}\ifx \@test \advi@empty
+ \expandafter \@firstoftwo \else \expandafter \@secondoftwo \fi}
+\def \advi@error #1{\PackageError {Advi}{#1}{Type <RETURN> to proceed.}}
+\def \advi@warning #1{\PackageWarning {Advi}{#1}}
+\def \advi@undefinedenv {\advi@error {Environment \@currenvir\space undefined.
+Maybe you mean \@currenvir ing}}
+\def \advi@special@ {\advi@ifadvi{\special}{\advi@ignore}}
+\def \advi@special #1{\advi@special@ {advi: #1}}
+\def \advi@export #1#2{\@ifdefinable #1{\let #1#2}}
+\def \advi@exportenv #1#2{%
+ \@ifundefined {#1}{\expandafter \let \csname #1\expandafter \endcsname
+ \csname end#1\endcsname }\relax
+ \expandafter \@ifdefinable \csname #1\endcsname
+ {\expandafter \let \csname #1\expandafter \endcsname \csname #2\endcsname
+ \expandafter \let \csname end#1\expandafter \endcsname
+ \csname end#2\endcsname}}
+
+\def \advi@ignore #1{}
+\def \advi@id #1{#1}
+
+\def \advi@ifadvi {\ifadvi@ignore
+ \expandafter \@secondoftwo \else \expandafter \@firstoftwo \fi}
+\advi@export \adviignore \advi@ignoretrue
+\advi@export \ifadvi \advi@ifadvi
+
+%%% Record and play
+
+\newif \ifadvi@recording
+\def \advi@ifrecording {\ifadvi@recording
+ \expandafter \@firstoftwo \else \expandafter \@secondoftwo \fi}
+\def \advi@ifrecordenv {\ifx \@currenvir \advi@recordenv
+ \expandafter \@firstoftwo \else \expandafter \@secondoftwo \fi}
+
+\def \advi@start {start}
+\def \advi@startplay {start play}
+\define@key{advi@record}{play}[]{\let \advi@do \advi@startplay}
+\def \advi@recordenv {advirecord}
+
+\newenvironment{advi@recording}[2][]%
+ {\begingroup
+ \let \advi@do \advi@start \setkeys{advi@record}{#1}%
+ \advi@special {proc=#2 record=\advi@do}%
+ \endgroup}
+ {\advi@special {proc record=end}}
+\newcommand {\advi@record}[3][]{\advi@recording[#1]{#2}#3\endadvi@recording}
+
+\newcommand {\advi@play}[2][]%
+ {\begingroup
+ \advi@ifempty{#1}{}{\color {#1}}{\advi@special {proc=#2 play}}%
+ \endgroup}
+
+\advi@exportenv {advirecording}{advi@recording}
+\advi@export \advirecord \advi@record
+\let \endadvirecord \advi@undefinedenv
+\advi@export \adviplay \advi@play
+
+
+%%% Embedded applications
+
+\def \advi@embed@name{anonymous}
+\def \advi@embed@mode{ephemeral}
+\def \advi@embed@width{0pt}
+\def \advi@embed@height{0pt}
+\define@key {advi@embed}{name}{\def \advi@embed@name {#1}}
+\define@key {advi@embed}{width}%
+ {\@tempdima#1\relax \edef \advi@embed@width {\the\@tempdima}}
+\define@key {advi@embed}{height}%
+ {\@tempdima#1\relax \edef \advi@embed@height {\the\@tempdima}}
+\def \advi@definemode #1{%
+ \define@key {advi@embed}{#1}[anonymous]{%
+ \def \advi@embed@mode {#1}\def\advi@embed@name {##1}%
+ }}
+\advi@definemode{ephemeral}
+\advi@definemode{persistent}
+\advi@definemode{sticky}
+
+\def \advi@embed@ #1#2#3#4#5{%
+ \mbox{\advi@special
+ {embed name="#1" mode=#2 width=#3 height=#4 command="#5"}%
+ {\vbox to #4{\hbox to #3{}}}}}
+\def \advi@length #1{\@tempdima #1\relax \the\@tempdima}
+\newcommand{\advi@embed}[2][]{%
+ \mbox {\setkeys {advi@embed}{#1}%
+ \advi@embed@ {\advi@embed@name}{\advi@embed@mode}
+ {\advi@embed@width}{\advi@embed@height}{#2}}}
+
+\newcommand{\advi@killembed}[2][]{\advi@special {kill name="#2" signal="#1"}}
+
+\advi@export \adviembed \advi@embed
+
+\advi@export \advikillembed \advi@killembed
+
+
+%%% Background colors and images
+
+\def \do #1{\expandafter \def \csname advi@geom@#1@\endcsname {#1}}
+\do {center}
+\do {left}
+\do {right}
+\do {bottom}
+\do {top}
+\do {topleft}
+\do {topright}
+\do {bottomleft}
+\do {bottomright}
+\let \do \relax
+\def \advi@ifnine #1#2#3{\@ifundefined {advi@geom@#1@}{#3}{#2}}
+
+\let \advi@global \relax
+\def \advi@global@ {global}
+\newif \ifadvi@bgactive
+
+\def \advi@bg@do
+ {\do\advi@bgcolor \do\advi@bgimage \do \advi@bgalpha \do\advi@bgblend}
+\def \advi@auto@ { fit=auto}
+\def \advi@bgreset
+ {\def \do ##1{\expandafter \advi@global
+ \expandafter \let \noexpand ##1\advi@empty}\advi@bg@do
+ \advi@global \let \advi@bgfit \advi@auto@
+ \advi@global \advi@bgactivefalse}
+\advi@bgreset
+
+\def \advi@none@ {none}
+\def \advi@ifnone #1{\def \@test{#1}\ifx \@test \advi@none@
+ \let \@test \advi@empty \fi \ifx \@test \advi@empty
+ \expandafter \@firstoftwo \else \expandafter \@secondoftwo \fi}
+
+\def \advi@setbg #1#2#3{\advi@ifnone {#1}
+ {\advi@global \expandafter \let \noexpand #1\advi@empty}
+ {\advi@global \expandafter \def \noexpand #1{ #2=#3}%
+ \advi@global \advi@bgactivetrue}}
+\define@key {advi@bg}{color}[]{\advi@setbg{\advi@bgcolor}{color}{#1}}
+\define@key {advi@bg}{image}[]{\advi@setbg{\advi@bgimage}{image}{#1}}
+\define@key {advi@bg}{alpha}[]{\advi@setbg{\advi@bgalpha}{alpha}{#1}}
+\define@key {advi@bg}{blend}[]{\advi@setbg{\advi@bgblend}{blend}{#1}}
+\define@key {advi@bg}{fit}[auto]{\def \advi@bgfit {#1}%
+ \ifx \advi@bgfit \advi@auto@ \else
+ \advi@ifnine {\advi@bgfit}
+ {\advi@global \def \advi@bgfit{ fit=#1}}
+ {\advi@error {Ill formed background fit=#1}}%
+ \fi}
+\def \advi@bgset #1{\advi@ifnone {#1}{\advi@bgreset}{\setkeys {advi@bg}{#1}}}
+
+%\define@key {advi@bg}{inherit}[]{\advi@special{setbg inherit}}
+
+\def \advi@bgemit
+ {\advi@special
+ {setbg \advi@bgcolor \advi@bgimage \advi@bgalpha \advi@bgblend
+ \advi@bgfit
+ }}
+\newif \ifadvi@bglocal
+
+\newcommand{\advi@bg}[2][]{%
+ \begingroup
+ \def \@test {#1}\ifx \@test \advi@global@ \let \advi@global \global
+ \advi@bgset {#2}\else
+ \ifx \@test \advi@empty \else \advi@warning
+ {Optional argument [#1] to \string \advibg ignored}\fi
+ \global \advi@bglocaltrue
+ \advi@bgset{#2}\advi@bgemit \fi
+ \endgroup}
+\def \advi@bgpage
+ {\ifadvi@bgactive \ifadvi@bglocal\else \advi@bgemit \fi\fi
+ \global \advi@bglocalfalse}
+
+\advi@export \advibg \advi@bg
+
+%%% Pausing and waiting
+
+\def\advi@pause {\advi@special{pause}}
+\def\advi@wait#1{\advi@special{wait sec=#1}}
+
+%% export
+\newcommand {\adviwait}[1][]%
+ {\advi@ifempty {#1}{\advi@pause}{\advi@wait {#1}}}
+
+%%% Transparency and alpha blending
+%%% To be revisited.
+
+\def\advi@epstransparent
+ {\advi@special{epstransparent push true}%
+ \aftergroup \advi@resetepstransparent}
+\def\advi@epswhite
+ {\advi@special{epstransparent push false}%
+ \aftergroup \advi@resetepstransparent}
+\def\advi@setalpha#1%
+ {\advi@special{alpha push #1}%
+ \aftergroup \advi@resetalpha}
+\def\advi@setblend#1%
+ {\advi@special{blend push #1}%
+ \aftergroup\advi@resetblend}
+\def\advi@resetepstransparent {\advi@special{epstransparent pop}}
+\def\advi@resetalpha {\advi@special{alpha pop}}
+\def\advi@resetblend {\advi@special{blend pop}}
+
+\advi@export \epstransparent \advi@epstransparent
+\advi@export \epswhite \advi@epswhite
+\advi@export \setalpha \advi@setalpha
+\advi@export \setblend \advi@setblend
+
+%%% Animated transitions
+
+\def \advi@transfrom{}
+\def \advi@transsteps{}
+\def \advi@settrans {\advi@global \def}
+\define@key {advi@trans}{none} []{\advi@settrans \advi@transmode {none}}
+\define@key {advi@trans}{slide}[]{\advi@settrans \advi@transmode {slide}}
+\define@key {advi@trans}{block}[]{\advi@settrans \advi@transmode {block}}
+\define@key {advi@trans}{wipe} []{\advi@settrans \advi@transmode {wipe}}
+\define@key {advi@trans}{from} {\advi@settrans \advi@transfrom { from=#1}}
+\define@key {advi@trans}{steps}{\advi@settrans \advi@transsteps { steps=#1}}
+
+\def \advi@transemit
+ {\advi@special{trans \advi@transmode \advi@transfrom \advi@transsteps}}
+\newif \ifadvi@translocal
+\newcommand {\advi@transition}[2][]{%
+ \begingroup
+ \def \@test {#1}\ifx \@test \advi@global@ \let \advi@global \global
+ \setkeys {advi@trans}{#2}\else
+ \ifx \@test \advi@empty \else \advi@warning
+ {Optional argument [#1] to \string \advitransition ignored}\fi
+ \global \advi@translocaltrue
+ \setkeys {advi@trans}{#2}\advi@transemit \fi
+ \endgroup}
+
+\def \advi@transpage
+ {\@ifundefined {advi@transmode}{}
+ {\ifadvi@translocal\else \advi@transemit \fi}%
+ \global \advi@translocalfalse}
+
+%% Hook \advi@setpagesetyle at \@begindvi that run at every page
+
+\def \advi@setpagestyle {\advi@bgpage \advi@transpage}
+\def \endpage@hook {}
+\def \AtEndPage {\g@addto@macro \endpage@hook}
+\AtEndPage {\advi@setpagestyle}
+
+% We must patch \@begindvi to put out hook.
+% However, hyperref may patch it as well. So we should do it at begin
+% document to have the control (no one after us).
+% Howver, one must be careful, because \@begindvi redefines itself at the
+% first call to its prerecorded final value.
+% So our first patch will be overridden with the value that it was
+% meant to have after the first page.
+% Hence, we patch it a second time to put our hook to this final value.
+
+% we can use \g@addto@macro which redefines #1 to so that it procedes as
+% before and then execute #2 at the end.
+
+\def \advi@begindvi@patch
+ {\g@addto@macro \@begindvi
+ {\endpage@hook \g@addto@macro \@begindvi {\endpage@hook}}}
+
+\AtBeginDocument {\advi@begindvi@patch}
+
+% {\let \advi@begindvi@save \@begindvi %% value at begindocument
+% \def \@begindvi %% our new value
+% {\advi@begindvi@save %% may redefine \@begindvi
+% \global\let \advi@begindvi@save %% so we this new value
+% \@begindvi
+% \gdef \@begindvi %% now and forever
+% {\advi@begindvi@save \endpage@hook}%
+% \endpage@hook %% our hook for the
+% }}
+
+
+
+%% Transitions
+
+\def\advi@transbox@save#1#2#3{\advi@special
+ {transbox save width=#1 height=#2 depth=#3}}
+\def\advi@transbox@go#1{\advi@special{transbox go #1}}
+
+\def \advi@transslide {slide}
+\def \advi@transbox #1{%
+ \def \advi@afterbox
+ {\hbox {\advi@transbox@save{\the\wd0 }{\the\ht0 }{\the\dp0}%
+ \unhbox0\setkeys {advi@trans}{#1}%
+ \advi@transbox@go
+ {\advi@transmode \advi@transfrom \advi@transsteps}}}%
+ \def \advi@@afterbox {\aftergroup \advi@afterbox}
+ \afterassignment \advi@@afterbox \setbox0 \hbox }
+
+\advi@export \advitransition \advi@transition
+\advi@export \advitransbox \advi@transbox
+
+%%% For PS Tricks
+
+\def \advi@moveto {\advi@special {moveto}}
+\def\advi@psput@special#1{%
+\hbox{%
+\pst@Verb{{ \pst@coor }
+dup exec 2 copy moveto advi@Dict begin printpos end
+\tx@PutCoor
+\tx@PutBegin}
+\hbox {\advi@moveto \box#1}%
+\pst@Verb{\tx@PutEnd}}}
+
+\def\advi@ncput@iii{%
+\leavevmode
+\hbox{%
+\pst@Verb{%
+\pst@nodedict
+/t \psk@npos def
+tx@NodeDict /LPutPos known { LPutPos } { CP /Y ED /X ED /NAngle 0
+def } ifelse
+LPutCoor
+end
+\tx@PutBegin
+}%
+\hbox {\box\pst@hbox}%
+\pst@Verb{\tx@PutEnd}}}
+
+\def \advi@pstricks@patch
+ {\@ifundefined {psput@special}{}
+ {\let \psput@special \advi@psput@special
+ %\@ifundefined {ncput@iii}{}{\let \ncput@iii \advi@ncput@iii}%
+ \pstheader {advi.pro}}}
+\AtBeginDocument {\advi@pstricks@patch}
+
+
+%%% Active DVI
+
+\def \advi@over@ {over}
+\def \advi@click@ {click}
+\def \advi@null {\hbox {}}
+
+\newenvironment {advi@anchoring}[2][over]{%
+ \begingroup
+ \def \@test {#1}\ifx \@test \advi@over@
+ \advi@special@ {html:<a advi="#2">}\else
+ \ifx \@test \advi@click@
+ \advi@special@ {html:<a hdvi="#2">}\else
+ \advi@error {Incorect anchor mode #1}\fi \fi\endgroup}
+ {\advi@special@ {html:</a>}}
+\newcommand {\advi@anchor}[3][over]%
+ {\advi@anchoring[#1]{#2}#3\endadvi@anchoring}
+
+\def \advi@endanchor #1{#1\endadvi@anchor \endgroup}
+\advi@exportenv {advianchoring}{advi@anchoring}
+\advi@export \advianchor \advi@anchor
+\let \endadvianchor \advi@undefinedenv
+
+%%% Partial patch for overlays -- 0 will be shown > 0 will not be shown
+
+\def \advi@max {0}
+\def \advi@overlay #1{%
+ \advi@ifadvi
+ {%\advance \c@overlay by 1
+ \ifnum \c@overlay>\advi@max \global \xdef \advi@max {\the \c@overlay}\fi
+ \advi@recording {overlay@#1}\aftergroup \endadvi@recording}
+ {\latex@overlay {#1}}}
+
+\def \advi@overlay@loop
+ {\advi@ifadvi
+ {\begingroup
+ \c@overlay=0
+ \@whilenum\c@overlay<\advi@max
+ \do {\advance \c@overlay by 1%
+ \adviwait \adviplay{overlay@\the\c@overlay}}%
+ \endgroup
+ \gdef \advi@max {0}}
+ {\latex@overlay@loop}}
+
+\def \advi@end@slide
+ {\advi@ifadvi {\overlay@loop}{}\latex@end@slide}
+
+\def \advi@overlay@patch {%
+ \let \latex@overlay \@overlay
+ \let \latex@end@slide \end@slide
+ \let \latex@overlay@loop \overlay@loop
+ \let \@overlay \advi@overlay
+ \let \overlay@loop \advi@overlay@loop
+ \let \end@slide \advi@end@slide
+ }
+
+\@ifundefined {overlay}{}
+ {\AtBeginDocument {\advi@overlay@patch}}
+
+
+\endinput
diff --git a/skribe/examples/slide/ex/skribe.skb b/skribe/examples/slide/ex/skribe.skb
new file mode 100644
index 0000000..d1a525e
--- /dev/null
+++ b/skribe/examples/slide/ex/skribe.skb
@@ -0,0 +1,11 @@
+(slide :title [Skribe]
+ (st [Skribe:])
+ (itemize (item [A functional programming language based on Scheme])
+ (item [A markup language ,(emph [� la]) XML])
+ (item [A document ,(blue [is]) a program,
+ a program ,(blue [looks like]) a text with markups]))
+
+ (p [
+ ,(st [Example:])
+ ,(slide-pause)
+ ,(skribe-prgm :file "ex/skribe.skb")]))
diff --git a/skribe/examples/slide/ex/syntax.scr b/skribe/examples/slide/ex/syntax.scr
new file mode 100644
index 0000000..8590f4a
--- /dev/null
+++ b/skribe/examples/slide/ex/syntax.scr
@@ -0,0 +1 @@
+[text goodies: ,(bold "bold") and ,(it "italic").]
diff --git a/skribe/examples/slide/skb/slides.skb b/skribe/examples/slide/skb/slides.skb
new file mode 100644
index 0000000..c13b102
--- /dev/null
+++ b/skribe/examples/slide/skb/slides.skb
@@ -0,0 +1,286 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/examples/slide/skb/slides.skb */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Oct 8 16:04:59 2003 */
+;* Last change : Fri Oct 24 13:32:37 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe slide example */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Style */
+;*---------------------------------------------------------------------*/
+(case *mode*
+ ((advi)
+ (skribe-load "slide.skr" :advi #t))
+ ((prosper)
+ (skribe-load "slide.skr" :prosper #t))
+ (else
+ (skribe-load "slide.skr")))
+
+(skribe-load "local.skr")
+
+;*---------------------------------------------------------------------*/
+;* latex configuration ... */
+;*---------------------------------------------------------------------*/
+(let ((le (find-engine 'latex)))
+ (engine-custom-set! le 'transition 'slide)
+ (engine-custom-set! le 'usepackage
+ (string-append (engine-custom le 'usepackage)
+ "\\usepackage{pstricks,pst-node,pst-text,pst-3d}\n")))
+
+;*---------------------------------------------------------------------*/
+;* sk-expression ... */
+;*---------------------------------------------------------------------*/
+(define (sk-expression)
+ (it "sk-expression"))
+(define (sk-expressions)
+ (it "sk-expressions"))
+
+;*---------------------------------------------------------------------*/
+;* The document */
+;*---------------------------------------------------------------------*/
+(document
+:title (red (sf (font :size +2. "This is Skribe!")))
+:author (author :name (it (magenta "Manuel Serrano, Erick Gallesio"))
+ :affiliation [Inria Sophia Antipolis, University of Nice]
+ :address (list "" (tt (skribe-url))))
+
+;*---------------------------------------------------------------------*/
+;* First slide */
+;*---------------------------------------------------------------------*/
+(include "ex/skribe.skb")
+
+;* {*---------------------------------------------------------------------*} */
+;* {* Overview *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Skribe overview" */
+;* (center (image :width 90. :file "fig/overview.fig"))) */
+
+;* {*---------------------------------------------------------------------*} */
+;* {* Examples *} */
+;* {*---------------------------------------------------------------------*} */
+;* (if (or (skribe-mgp?) (and (skribe-tex?) *skribe-slide-advi*)) */
+;* (slide :title "Skribe examples" */
+;* */
+;* (%embed :geometry *xterm.geo* *xterm*) */
+;* (%embed :geometry *xdvi.geo* *xdvi*) */
+;* */
+;* (st [1 Skribe document, 2 targets:]) */
+;* */
+;* (%vspace 0.0) */
+;* (itemize (item [A ,(sc [Nroff]) target:])) */
+;* (%vspace 3) */
+;* (itemize (item [A ,(sc [Dvi]) target:])))) */
+
+;* {*---------------------------------------------------------------------*} */
+;* {* Skribe gallery *} */
+;* {*---------------------------------------------------------------------*} */
+;* {*--- math ------------------------------------------------------------*} */
+;* (slide :title "Gallery (1/2)" */
+;* */
+;* (st [Math skills:]) */
+;* (itemize (item [A ,(LaTeX) math formula in:])) */
+;* (p (font :size -3 */
+;* (color :bg *display-bg* */
+;* (center */
+;* (hook :after */
+;* (lambda () */
+;* (if (skribe-tex?) */
+;* (display "\\(\\sum_{i=1}^{n} x_{i} = \\int_{0}^{1} f\\)") */
+;* (display "∑<sub><font size='-2'>i=1</font></sub><sup><font size='-2'>i=1</font></sup> = ∫<sub><font size='-2'>0</font></sub><sup><font size='-2'>1</font></sup>f")))))))) */
+;* (itemize (item [Denotational semantics:])) */
+;* (p (font :size -3 */
+;* (color :bg *display-bg* */
+;* (prgm :language denotation :monospace (skribe-html?) */
+;* (map (lambda (d) */
+;* (from-file "scm/eval.scm" :definition d)) */
+;* '("ev-lambda1" "ev-funcall1")))))) */
+;* (itemize (item [SOS rule:])) */
+;* (p (font :size -4 */
+;* (color :bg *display-bg* */
+;* (labeled-component */
+;* "Assignment" */
+;* (rule */
+;* (evaluate "exp" "sched, env" "val" "sched', env'") */
+;* (rewrite "var = exp, sched, env" (TERM) "nothing, sched', env'<var = val>"))))))) */
+;* */
+;* {*--- misc ------------------------------------------------------------*} */
+;* (slide :title "Gallery (2/2)" */
+;* */
+;* (st [Misc:]) */
+;* (itemize (item [A computer program:])) */
+;* (p (font :size -1 (prgm :bg *example-bg* :language c :lnum 1 (from-file "ex/C-code.c")))) */
+;* (itemize (item [Images: */
+;* ,(p (image :width 75 :height 50 :file "img/img.jpg") */
+;* (hook :after (lambda () */
+;* (cond */
+;* ((skribe-tex?) */
+;* (display "\\ \\ \\ \\ ")) */
+;* (else */
+;* (display " "))))) */
+;* (image :width 25 :height 50 :file "img/img.jpg") */
+;* (hook :after (lambda () */
+;* (cond */
+;* ((skribe-tex?) */
+;* (display "\\ \\ \\ \\ ")) */
+;* (else */
+;* (display " "))))) */
+;* (image :width 150 :height 50 :file "img/img.jpg"))]))) */
+;* */
+;*---------------------------------------------------------------------*/
+;* Syntax */
+;*---------------------------------------------------------------------*/
+(slide :title "Skribe Syntax" :vspace 0.3
+
+(st [,(sk-expression):])
+
+(slide-pause)
+(itemize (item [An ,(emph "atom") (a ,(red (it "string")), a ,(red (it "number")), ...)] (slide-pause))
+ (item [A ,(emph "list") of ,(!latex "{\\rnode{NA}{$1}}" (sk-expressions))] (slide-pause))
+ (item [A ,(emph "text") (,(red (tt [ ,(char "[")... ,(blue [,(char ",")(,(it "<expr>"))]) ...,(char "]") ])))] (slide-pause)))
+
+(slide-vspace 0.3)
+(p [,(!latex "{\\rnode{NB}{$1}}" (st [Example:]))
+ ,(slide-pause)
+ ,(!latex "{\\nccurve[linecolor=red,angleA=90,angleB=270]{->}{NB}{NA}}")
+ ,(skribe-prgm :fsize 0 (source :file "ex/syntax.scr"))])
+
+(p [is equivalent to:
+ ,(slide-pause)
+ ,(skribe-prgm :fsize 0 [(list "text goodies: " (bold "bold") "and" (it "italic") ".")])]))
+
+;* {*---------------------------------------------------------------------*} */
+;* {* Skribe documents *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Skribe Documents (1/2)" :vspace 0.5 */
+;* */
+;* (st [Skribe Document Structure:]) */
+;* (p (skribe-prgm [,(from-file "ex/skel.scr")]))) */
+;* */
+;* {*--- markup ----------------------------------------------------------*} */
+;* (slide :title "Skribe Documents (2/2)" :vspace 0.5 */
+;* (st [XML markup:]) */
+;* (p (prgm :language xml :bg *example-bg* [ */
+;* <elmt1 attr="val"> */
+;* Some text */
+;* <elmt2> */
+;* for the example */
+;* </elmt2> */
+;* </elmt1>])) */
+;* (%vspace 0.3) */
+;* (st [Sc-markup:]) */
+;* (p (skribe-prgm [,(from-file "ex/xml.scr")]))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Libraries *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Skribe Libraries" */
+;* */
+;* (st [A set of libraries containing the ,(q "usual") facilities. For instance:]) */
+;* */
+;* (p (skribe-prgm [,(from-file "ex/itemize.scr")])) */
+;* (%vspace 0.1) */
+;* (st [Produces the following output text:]) */
+;* (center (color :bg *display-bg* (font :size -2 (include "ex/itemize.scr"))))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Dynamic texts *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Dynamic texts (1/3)" :vspace 0.2 */
+;* */
+;* (st [Let us assume the factorial table:]) */
+;* (%vspace 0.5) */
+;* */
+;* (center (font :size -1 (color :bg *display-bg* (include "ex/fact.scr"))))) */
+;* */
+;* {*--- dynamic texts: the usual solution -------------------------------*} */
+;* (slide :title "Dynamic texts (2/3)" */
+;* */
+;* (st [The usual solution:]) */
+;* (p (skribe-prgm :fsize -1 (from-file "ex/factb.scr")))) */
+;* */
+;* {*--- dynamic texts: a better solution --------------------------------*} */
+;* (slide :title "Dynamic texts (3/3)" */
+;* */
+;* (st [A better solution:]) */
+;* (p (skribe-prgm (from-file "ex/fact.scr")))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Introspection *} */
+;* {*---------------------------------------------------------------------*} */
+;* {*--- Introspection ---------------------------------------------------*} */
+;* (slide :title "Introspection" */
+;* */
+;* (color :bg *image-bg* */
+;* (center (image :width 1. :file "fig/skribe.fig")))) */
+;* */
+;* {*--- Number of slides ------------------------------------------------*} */
+;* (slide :title "Introspection: an example (1/2)" */
+;* */
+;* (p (color :bg *display-bg* (include "ex/slide.scr")))) */
+;* */
+;* {*--- Number of slides (2/2) ------------------------------------------*} */
+;* (slide :title "Introspection: an example (2/2)" :vspace 0.5 */
+;* */
+;* (st [The previous output is produced with:]) */
+;* (p (skribe-prgm (from-file "ex/slide.scr")))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Conditional evaluation *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Conditional evaluation" :vspace 0.5 */
+;* */
+;* (st [Some features are dependent of the target format:]) */
+;* (itemize (item [Only specific back-ends may support specific features]) */
+;* (item [It is in charge of the back-ends to implement */
+;* ,(emph "reasonable") behaviors for unsupported features. */
+;* Examples: */
+;* ,(itemize (item [Hyper links]) */
+;* (item [Images]) */
+;* (item [...]))]) */
+;* (item [Skribe enables conditional evaluation: */
+;* ,(itemize (item [according to the target format]) */
+;* (item [enabling target format commands]))]))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Extensibility *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Extensibility" */
+;* */
+;* (st [User level:]) */
+;* (itemize (item [New markups can be defined in a document]) */
+;* (item [A markup is a Skribe (Scheme) function]) */
+;* (item [Example: the ,(code "(%pause)") slide facility:])) */
+;* */
+;* (p (skribe-prgm [ */
+;* (define (%pause) */
+;* (cond */
+;* ((skribe-mgp?) (hook :after (lambda () (display "%pause")))) */
+;* ((skribe-advi-tex?) (hook :after (lambda () (print "\\adviwait")))) */
+;* (else (linebreak))))])) */
+;* (%pause) */
+;* */
+;* (st [System level:]) */
+;* (itemize (item [New back-ends can be dynamically added]) */
+;* (item [The ,(sc-ast) can be extended]))) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* Conclusion *} */
+;* {*---------------------------------------------------------------------*} */
+;* (slide :title "Conclusion" :vspace 0.5 */
+;* */
+;* (st [Status:]) */
+;* (itemize (item [Available on-line: ,(ref :url (skribe-url))]) */
+;* (item [Available since a couple of months]) */
+;* (item [Used, by the authors, on a daily basis]) */
+;* (item [,(magenta (bold [Still too young])) ,(symbol '=>) */
+;* ,(itemize (item [Very few styles have been implemented]) */
+;* (item [It is still necessary to be aware of the */
+;* targets idiosyncrasies]) */
+;* (item [Difficult to tame the fix-point */
+;* iteration of the computation model]))])))) */
+
+)
diff --git a/skribe/examples/slide/skr/local.skr b/skribe/examples/slide/skr/local.skr
new file mode 100644
index 0000000..2802a53
--- /dev/null
+++ b/skribe/examples/slide/skr/local.skr
@@ -0,0 +1,73 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/examples/slide/skr/local.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Jun 3 15:32:25 2002 */
+;* Last change : Wed Oct 8 16:22:42 2003 (serrano) */
+;* Copyright : 2002-03 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The local style of the presentation */
+;*=====================================================================*/
+
+;* {*---------------------------------------------------------------------*} */
+;* {* fg ... *} */
+;* {*---------------------------------------------------------------------*} */
+;* (define (fg c . body) */
+;* (apply color :fg c body)) */
+;* */
+;* {*---------------------------------------------------------------------*} */
+;* {* bg ... *} */
+;* {*---------------------------------------------------------------------*} */
+;* (define (bg c . body) */
+;* (apply color :bg c body)) */
+;* */
+;*---------------------------------------------------------------------*/
+;* colors ... */
+;*---------------------------------------------------------------------*/
+(define (green body)
+ (fg "darkgreen" body))
+(define (red body)
+ (fg "red" body))
+(define (blue body)
+ (bold (fg "darkblue" body)))
+(define (magenta body)
+ (fg "darkmagenta" body))
+(define (orange body)
+ (fg "darkorange" body))
+
+;*---------------------------------------------------------------------*/
+;* em ... */
+;*---------------------------------------------------------------------*/
+(define (em body)
+ (bold (magenta body)))
+
+;*---------------------------------------------------------------------*/
+;* st ... */
+;*---------------------------------------------------------------------*/
+(define (st body)
+ (sf (red body)))
+
+;*---------------------------------------------------------------------*/
+;* citem ... */
+;*---------------------------------------------------------------------*/
+(define-markup (citem #!rest opt #!key (color "black") (shape (math 'bullet)))
+ (item (list (fg color shape) " " (the-body opt))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-prgm ... */
+;*---------------------------------------------------------------------*/
+(define-markup (skribe-prgm #!rest opt #!key file definition)
+ (cond
+ ((and definition file)
+ (font :size -4
+ (color :bg "#ccffcc" (prog (source :language skribe
+ :file file
+ :definition definition)))))
+ (file
+ (font :size -4
+ (color :bg "#ccffcc" (prog (source :language skribe
+ :file file)))))
+ (else
+ (font :size -4
+ (color :bg "#ccffcc" (prog (source :language skribe
+ (the-body opt))))))))
diff --git a/skribe/skr/Makefile b/skribe/skr/Makefile
new file mode 100644
index 0000000..dcc3e77
--- /dev/null
+++ b/skribe/skr/Makefile
@@ -0,0 +1,43 @@
+#*=====================================================================*/
+#* 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/skribe/skr/acmproc.skr b/skribe/skr/acmproc.skr
new file mode 100644
index 0000000..4accc7c
--- /dev/null
+++ b/skribe/skr/acmproc.skr
@@ -0,0 +1,155 @@
+;*=====================================================================*/
+;* 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/skribe/skr/base.skr b/skribe/skr/base.skr
new file mode 100644
index 0000000..ec987ec
--- /dev/null
+++ b/skribe/skr/base.skr
@@ -0,0 +1,464 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/skr/base.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Jul 26 12:39:30 2003 */
+;* Last change : Wed Oct 27 11:24:20 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* BASE Skribe engine */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* base-engine ... */
+;*---------------------------------------------------------------------*/
+(define base-engine
+ (default-engine-set!
+ (make-engine 'base
+ :version 'plain
+ :symbol-table '(("iexcl" "!")
+ ("cent" "c")
+ ("lguillemet" "\"")
+ ("not" "!")
+ ("registered" "(r)")
+ ("degree" "o")
+ ("plusminus" "+/-")
+ ("micro" "o")
+ ("paragraph" "p")
+ ("middot" ".")
+ ("rguillemet" "\"")
+ ("iquestion" "?")
+ ("Agrave" "�")
+ ("Aacute" "A")
+ ("Acircumflex" "�")
+ ("Atilde" "A")
+ ("Amul" "A")
+ ("Aring" "A")
+ ("AEligature" "AE")
+ ("Oeligature" "OE")
+ ("Ccedilla" "�")
+ ("Egrave" "�")
+ ("Eacute" "�")
+ ("Ecircumflex" "�")
+ ("Euml" "E")
+ ("Igrave" "I")
+ ("Iacute" "I")
+ ("Icircumflex" "�")
+ ("Iuml" "I")
+ ("ETH" "D")
+ ("Ntilde" "N")
+ ("Ograve" "O")
+ ("Oacute" "O")
+ ("Ocurcumflex" "O")
+ ("Otilde" "O")
+ ("Ouml" "O")
+ ("times" "x")
+ ("Oslash" "O")
+ ("Ugrave" "�")
+ ("Uacute" "U")
+ ("Ucircumflex" "�")
+ ("Uuml" "�")
+ ("Yacute" "Y")
+ ("agrave" "�")
+ ("aacute" "a")
+ ("acircumflex" "�")
+ ("atilde" "a")
+ ("amul" "a")
+ ("aring" "a")
+ ("aeligature" "�")
+ ("oeligature" "oe")
+ ("ccedilla" "�")
+ ("egrave" "�")
+ ("eacute" "�")
+ ("ecircumflex" "�")
+ ("euml" "e")
+ ("igrave" "i")
+ ("iacute" "i")
+ ("icircumflex" "�")
+ ("iuml" "i")
+ ("ntilde" "n")
+ ("ograve" "o")
+ ("oacute" "o")
+ ("ocurcumflex" "o")
+ ("otilde" "o")
+ ("ouml" "o")
+ ("divide" "/")
+ ("oslash" "o")
+ ("ugrave" "�")
+ ("uacute" "u")
+ ("ucircumflex" "�")
+ ("uuml" "�")
+ ("yacute" "y")
+ ("ymul" "y")
+ ;; punctuation
+ ("bullet" ".")
+ ("ellipsis" "...")
+ ("<-" "<-")
+ ("<--" "<--")
+ ("uparrow" "^;")
+ ("->" "->")
+ ("-->" "-->")
+ ("downarrow" "v")
+ ("<->" "<->")
+ ("<-->" "<-->")
+ ("<+" "<+")
+ ("<=" "<=;")
+ ("<==" "<==")
+ ("Uparrow" "^")
+ ("=>" "=>")
+ ("==>" "==>")
+ ("Downarrow" "v")
+ ("<=>" "<=>")
+ ("<==>" "<==>")
+ ;; Mathematical operators
+ ("asterisk" "*")
+ ("angle" "<")
+ ("and" "^;")
+ ("or" "v")
+ ("models" "|=")
+ ("vdash" "|-")
+ ("dashv" "-|")
+ ("sim" "~")
+ ("mid" "|")
+ ("langle" "<")
+ ("rangle" ">")
+ ;; LaTeX
+ ("circ" "o")
+ ("top" "T")
+ ("lhd" "<")
+ ("rhd" ">")
+ ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;* mark ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'symbol
+ :action (lambda (n e)
+ (let* ((s (markup-body n))
+ (c (assoc s (engine-symbol-table e))))
+ (if (pair? c)
+ (display (cadr c))
+ (output s e)))))
+
+;*---------------------------------------------------------------------*/
+;* unref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'unref
+ :options 'all
+ :action (lambda (n e)
+ (let* ((s (markup-option n :skribe))
+ (k (markup-option n 'kind))
+ (f (cond
+ (s
+ (format "?~a@~a " k s))
+ (else
+ (format "?~a " k))))
+ (msg (list f (markup-body n)))
+ (n (list "[" (color :fg "red" (bold msg)) "]")))
+ (skribe-eval n e))))
+
+;*---------------------------------------------------------------------*/
+;* &the-bibliography ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+ :before (lambda (n e)
+ (let ((w (markup-writer-get 'table e)))
+ (and (writer? w) (invoke (writer-before w) n e))))
+ :action (lambda (n e)
+ (when (pair? (markup-body n))
+ (for-each (lambda (i) (output i e)) (markup-body n))))
+ :after (lambda (n e)
+ (let ((w (markup-writer-get 'table e)))
+ (and (writer? w) (invoke (writer-after w) n e)))))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+ :options '(:title)
+ :before (lambda (n e)
+ (invoke (writer-before (markup-writer-get 'tr e)) n e))
+ :action (lambda (n e)
+ (let ((wtc (markup-writer-get 'tc e)))
+ ;; the label
+ (markup-option-add! n :valign 'top)
+ (markup-option-add! n :align 'right)
+ (invoke (writer-before wtc) n e)
+ (output n e (markup-writer-get '&bib-entry-label e))
+ (invoke (writer-after wtc) n e)
+ ;; the body
+ (markup-option-add! n :valign 'top)
+ (markup-option-add! n :align 'left)
+ (invoke (writer-before wtc) n e)
+ (output n e (markup-writer-get '&bib-entry-body))
+ (invoke (writer-after wtc) n e)))
+ :after (lambda (n e)
+ (invoke (writer-after (markup-writer-get 'tr e)) n e)))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-label ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+ :options '(:title)
+ :before "["
+ :action (lambda (n e) (output (markup-option n :title) e))
+ :after "]")
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-body ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-body
+ :action (lambda (n e)
+ (define (output-fields descr)
+ (let loop ((descr descr)
+ (pending #f)
+ (armed #f))
+ (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)
+ (let ((o2 (caddr (car descr))))
+ (loop (cons o2 (cdr descr))
+ pending
+ armed))))
+ (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))
+ (loop (cdr descr) pending armed)))))
+ ((symbol? (car descr))
+ (let ((o (markup-option n (car descr))))
+ (if o
+ (begin
+ (if (and armed pending)
+ (output pending e))
+ (output o e)
+ (loop (cdr descr) #f #t))
+ (loop (cdr descr) pending armed))))
+ ((null? (cdr descr))
+ (output (car descr) e))
+ ((string? (car descr))
+ (loop (cdr descr)
+ (if pending pending (car descr))
+ armed))
+ (else
+ (skribe-error 'output-bib-fields
+ "Illegal description"
+ (car descr))))))
+ (output-fields
+ (case (markup-option n 'kind)
+ ((techreport)
+ `(author " -- " (or title url documenturl) " -- "
+ number ", " institution ", "
+ address ", " month ", " year ", "
+ ("pp. " pages) "."))
+ ((article)
+ `(author " -- " (or title url documenturl) " -- "
+ journal ", " volume "" ("(" number ")") ", "
+ address ", " month ", " year ", "
+ ("pp. " pages) "."))
+ ((inproceedings)
+ `(author " -- " (or title url documenturl) " -- "
+ booktitle ", " series ", " ("(" number ")") ", "
+ address ", " month ", " year ", "
+ ("pp. " pages) "."))
+ ((book)
+ '(author " -- " (or title url documenturl) " -- "
+ publisher ", " address
+ ", " month ", " year ", " ("pp. " pages) "."))
+ ((phdthesis)
+ '(author " -- " (or title url documenturl) " -- " type ", "
+ school ", " address
+ ", " month ", " year"."))
+ ((misc)
+ '(author " -- " (or title url documenturl) " -- "
+ publisher ", " address
+ ", " month ", " year"."))
+ (else
+ '(author " -- " (or title url documenturl) " -- "
+ publisher ", " address
+ ", " month ", " year ", " ("pp. " pages) "."))))))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-ident ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-ident
+ :action (lambda (n e)
+ (output (markup-option n 'number) e)))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-title ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+ :action (lambda (n e)
+ (skribe-eval (bold (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-publisher ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-publisher
+ :action (lambda (n e)
+ (skribe-eval (it (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;* &the-index ... @label the-index@ */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index
+ :options '(:column)
+ :before (lambda (n e)
+ (output (markup-option n 'header) e))
+ :action (lambda (n e)
+ (define (make-mark-entry n fst)
+ (let ((l (tr :class 'index-mark-entry
+ (td :colspan 2 :align 'left
+ (bold (it (sf n)))))))
+ (if fst
+ (list l)
+ (list (tr (td :colspan 2)) l))))
+ (define (make-primary-entry n p)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n))
+ (c (if note
+ (list b
+ (it (list " (" note ")")))
+ b)))
+ (when p
+ (markup-option-add! b :text
+ (list (markup-option b :text)
+ ", p."))
+ (markup-option-add! b :page #t))
+ (tr :class 'index-primary-entry
+ (td :colspan 2 :valign 'top :align 'left c))))
+ (define (make-secondary-entry n p)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n))
+ (bb (markup-body b)))
+ (cond
+ ((not (or bb (is-markup? b 'url-ref)))
+ (skribe-error 'the-index
+ "Illegal entry"
+ b))
+ (note
+ (let ((r (if bb
+ (it (ref :class "the-index-secondary"
+ :handle bb
+ :page p
+ :text (if p
+ (list note ", p.")
+ note)))
+ (it (ref :class "the-index-secondary"
+ :url (markup-option b :url)
+ :page p
+ :text (if p
+ (list note ", p.")
+ note))))))
+ (tr :class 'index-secondary-entry
+ (td :valign 'top :align 'right :width 1. " ...")
+ (td :valign 'top :align 'left r))))
+ (else
+ (let ((r (if bb
+ (ref :class "the-index-secondary"
+ :handle bb
+ :page p
+ :text (if p " ..., p." " ..."))
+ (ref :class "the-index-secondary"
+ :url (markup-option b :url)
+ :page p
+ :text (if p " ..., p." " ...")))))
+ (tr :class 'index-secondary-entry
+ (td :valign 'top :align 'right :width 1.)
+ (td :valign 'top :align 'left r)))))))
+ (define (make-column ie p)
+ (let loop ((ie ie)
+ (f #t))
+ (cond
+ ((null? ie)
+ '())
+ ((not (pair? (car ie)))
+ (append (make-mark-entry (car ie) f)
+ (loop (cdr ie) #f)))
+ (else
+ (cons (make-primary-entry (caar ie) p)
+ (append (map (lambda (x)
+ (make-secondary-entry x p))
+ (cdar ie))
+ (loop (cdr ie) #f)))))))
+ (define (make-sub-tables ie nc p)
+ (let* ((l (length ie))
+ (w (/ 100. nc))
+ (iepc (let ((d (/ l nc)))
+ (if (integer? d)
+ (inexact->exact d)
+ (+ 1 (inexact->exact (truncate d))))))
+ (split (list-split ie iepc)))
+ (tr (map (lambda (ies)
+ (td :valign 'top :width w
+ (if (pair? ies)
+ (table :width 100. (make-column ies p))
+ "")))
+ split))))
+ (let* ((ie (markup-body n))
+ (nc (markup-option n :column))
+ (loc (ast-loc n))
+ (pref (eq? (engine-custom e 'index-page-ref) #t))
+ (t (cond
+ ((null? ie)
+ "")
+ ((or (not (integer? nc)) (= nc 1))
+ (table :width 100.
+ :&skribe-eval-location loc
+ :class "index-table"
+ (make-column ie pref)))
+ (else
+ (table :width 100.
+ :&skribe-eval-location loc
+ :class "index-table"
+ (make-sub-tables ie nc pref))))))
+ (output (skribe-eval t e) e))))
+
+;*---------------------------------------------------------------------*/
+;* &the-index-header ... */
+;* ------------------------------------------------------------- */
+;* The index header is only useful for targets that support */
+;* hyperlinks such as HTML. */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header
+ :action (lambda (n e) #f))
+
+;*---------------------------------------------------------------------*/
+;* &prog-line ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+ :before (lambda (n e)
+ (let ((n (markup-ident n)))
+ (if n (skribe-eval (it (list n) ": ") e))))
+ :after "\n")
+
+;*---------------------------------------------------------------------*/
+;* line-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+ :options '(:offset)
+ :action (lambda (n e)
+ (let ((o (markup-option n :offset))
+ (n (markup-ident (handle-body (markup-body n)))))
+ (skribe-eval (it (if (integer? o) (+ o n) n)) e))))
+
+
+
+;;;; A VIRER (mais handle-body n'est pas d�fini)
+(markup-writer 'line-ref
+ :options '(:offset)
+ :action #f)
diff --git a/skribe/skr/context.skr b/skribe/skr/context.skr
new file mode 100644
index 0000000..5bc5316
--- /dev/null
+++ b/skribe/skr/context.skr
@@ -0,0 +1,1380 @@
+;;;;
+;;;; context.skr -- ConTeXt mode for Skribe
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 23-Sep-2004 17:21 (eg)
+;;;; Last file update: 3-Nov-2004 12:54 (eg)
+;;;;
+
+;;;; ======================================================================
+;;;; context-customs ...
+;;;; ======================================================================
+(define context-customs
+ '((source-comment-color "#ffa600")
+ (source-error-color "red")
+ (source-define-color "#6959cf")
+ (source-module-color "#1919af")
+ (source-markup-color "#1919af")
+ (source-thread-color "#ad4386")
+ (source-string-color "red")
+ (source-bracket-color "red")
+ (source-type-color "#00cf00")
+ (index-page-ref #t)
+ (image-format ("jpg"))
+ (font-size 11)
+ (font-type "roman")
+ (user-style #f)
+ (document-style "book")))
+
+;;;; ======================================================================
+;;;; context-encoding ...
+;;;; ======================================================================
+(define context-encoding
+ '((#\# "\\type{#}")
+ (#\| "\\type{|}")
+ (#\{ "$\\{$")
+ (#\} "$\\}$")
+ (#\~ "\\type{~}")
+ (#\& "\\type{&}")
+ (#\_ "\\type{_}")
+ (#\^ "\\type{^}")
+ (#\[ "\\type{[}")
+ (#\] "\\type{]}")
+ (#\< "\\type{<}")
+ (#\> "\\type{>}")
+ (#\$ "\\type{$}")
+ (#\% "\\%")
+ (#\\ "$\\backslash$")))
+
+;;;; ======================================================================
+;;;; context-pre-encoding ...
+;;;; ======================================================================
+(define context-pre-encoding
+ (append '((#\space "~")
+ (#\~ "\\type{~}"))
+ context-encoding))
+
+
+;;;; ======================================================================
+;;;; context-symbol-table ...
+;;;; ======================================================================
+(define (context-symbol-table math)
+ `(("iexcl" "!`")
+ ("cent" "c")
+ ("pound" "\\pounds")
+ ("yen" "Y")
+ ("section" "\\S")
+ ("mul" ,(math "^-"))
+ ("copyright" "\\copyright")
+ ("lguillemet" ,(math "\\ll"))
+ ("not" ,(math "\\neg"))
+ ("degree" ,(math "^{\\small{o}}"))
+ ("plusminus" ,(math "\\pm"))
+ ("micro" ,(math "\\mu"))
+ ("paragraph" "\\P")
+ ("middot" ,(math "\\cdot"))
+ ("rguillemet" ,(math "\\gg"))
+ ("1/4" ,(math "\\frac{1}{4}"))
+ ("1/2" ,(math "\\frac{1}{2}"))
+ ("3/4" ,(math "\\frac{3}{4}"))
+ ("iquestion" "?`")
+ ("Agrave" "\\`{A}")
+ ("Aacute" "\\'{A}")
+ ("Acircumflex" "\\^{A}")
+ ("Atilde" "\\~{A}")
+ ("Amul" "\\\"{A}")
+ ("Aring" "{\\AA}")
+ ("AEligature" "{\\AE}")
+ ("Oeligature" "{\\OE}")
+ ("Ccedilla" "{\\c{C}}")
+ ("Egrave" "{\\`{E}}")
+ ("Eacute" "{\\'{E}}")
+ ("Ecircumflex" "{\\^{E}}")
+ ("Euml" "\\\"{E}")
+ ("Igrave" "{\\`{I}}")
+ ("Iacute" "{\\'{I}}")
+ ("Icircumflex" "{\\^{I}}")
+ ("Iuml" "\\\"{I}")
+ ("ETH" "D")
+ ("Ntilde" "\\~{N}")
+ ("Ograve" "\\`{O}")
+ ("Oacute" "\\'{O}")
+ ("Ocurcumflex" "\\^{O}")
+ ("Otilde" "\\~{O}")
+ ("Ouml" "\\\"{O}")
+ ("times" ,(math "\\times"))
+ ("Oslash" "\\O")
+ ("Ugrave" "\\`{U}")
+ ("Uacute" "\\'{U}")
+ ("Ucircumflex" "\\^{U}")
+ ("Uuml" "\\\"{U}")
+ ("Yacute" "\\'{Y}")
+ ("szlig" "\\ss")
+ ("agrave" "\\`{a}")
+ ("aacute" "\\'{a}")
+ ("acircumflex" "\\^{a}")
+ ("atilde" "\\~{a}")
+ ("amul" "\\\"{a}")
+ ("aring" "\\aa")
+ ("aeligature" "\\ae")
+ ("oeligature" "{\\oe}")
+ ("ccedilla" "{\\c{c}}")
+ ("egrave" "{\\`{e}}")
+ ("eacute" "{\\'{e}}")
+ ("ecircumflex" "{\\^{e}}")
+ ("euml" "\\\"{e}")
+ ("igrave" "{\\`{\\i}}")
+ ("iacute" "{\\'{\\i}}")
+ ("icircumflex" "{\\^{\\i}}")
+ ("iuml" "\\\"{\\i}")
+ ("ntilde" "\\~{n}")
+ ("ograve" "\\`{o}")
+ ("oacute" "\\'{o}")
+ ("ocurcumflex" "\\^{o}")
+ ("otilde" "\\~{o}")
+ ("ouml" "\\\"{o}")
+ ("divide" ,(math "\\div"))
+ ("oslash" "\\o")
+ ("ugrave" "\\`{u}")
+ ("uacute" "\\'{u}")
+ ("ucircumflex" "\\^{u}")
+ ("uuml" "\\\"{u}")
+ ("yacute" "\\'{y}")
+ ("ymul" "\\\"{y}")
+ ;; Greek
+ ("Alpha" "A")
+ ("Beta" "B")
+ ("Gamma" ,(math "\\Gamma"))
+ ("Delta" ,(math "\\Delta"))
+ ("Epsilon" "E")
+ ("Zeta" "Z")
+ ("Eta" "H")
+ ("Theta" ,(math "\\Theta"))
+ ("Iota" "I")
+ ("Kappa" "K")
+ ("Lambda" ,(math "\\Lambda"))
+ ("Mu" "M")
+ ("Nu" "N")
+ ("Xi" ,(math "\\Xi"))
+ ("Omicron" "O")
+ ("Pi" ,(math "\\Pi"))
+ ("Rho" "P")
+ ("Sigma" ,(math "\\Sigma"))
+ ("Tau" "T")
+ ("Upsilon" ,(math "\\Upsilon"))
+ ("Phi" ,(math "\\Phi"))
+ ("Chi" "X")
+ ("Psi" ,(math "\\Psi"))
+ ("Omega" ,(math "\\Omega"))
+ ("alpha" ,(math "\\alpha"))
+ ("beta" ,(math "\\beta"))
+ ("gamma" ,(math "\\gamma"))
+ ("delta" ,(math "\\delta"))
+ ("epsilon" ,(math "\\varepsilon"))
+ ("zeta" ,(math "\\zeta"))
+ ("eta" ,(math "\\eta"))
+ ("theta" ,(math "\\theta"))
+ ("iota" ,(math "\\iota"))
+ ("kappa" ,(math "\\kappa"))
+ ("lambda" ,(math "\\lambda"))
+ ("mu" ,(math "\\mu"))
+ ("nu" ,(math "\\nu"))
+ ("xi" ,(math "\\xi"))
+ ("omicron" ,(math "\\o"))
+ ("pi" ,(math "\\pi"))
+ ("rho" ,(math "\\rho"))
+ ("sigmaf" ,(math "\\varsigma"))
+ ("sigma" ,(math "\\sigma"))
+ ("tau" ,(math "\\tau"))
+ ("upsilon" ,(math "\\upsilon"))
+ ("phi" ,(math "\\varphi"))
+ ("chi" ,(math "\\chi"))
+ ("psi" ,(math "\\psi"))
+ ("omega" ,(math "\\omega"))
+ ("thetasym" ,(math "\\vartheta"))
+ ("piv" ,(math "\\varpi"))
+ ;; punctuation
+ ("bullet" ,(math "\\bullet"))
+ ("ellipsis" ,(math "\\ldots"))
+ ("weierp" ,(math "\\wp"))
+ ("image" ,(math "\\Im"))
+ ("real" ,(math "\\Re"))
+ ("tm" ,(math "^{\\sc\\tiny{tm}}"))
+ ("alef" ,(math "\\aleph"))
+ ("<-" ,(math "\\leftarrow"))
+ ("<--" ,(math "\\longleftarrow"))
+ ("uparrow" ,(math "\\uparrow"))
+ ("->" ,(math "\\rightarrow"))
+ ("-->" ,(math "\\longrightarrow"))
+ ("downarrow" ,(math "\\downarrow"))
+ ("<->" ,(math "\\leftrightarrow"))
+ ("<-->" ,(math "\\longleftrightarrow"))
+ ("<+" ,(math "\\hookleftarrow"))
+ ("<=" ,(math "\\Leftarrow"))
+ ("<==" ,(math "\\Longleftarrow"))
+ ("Uparrow" ,(math "\\Uparrow"))
+ ("=>" ,(math "\\Rightarrow"))
+ ("==>" ,(math "\\Longrightarrow"))
+ ("Downarrow" ,(math "\\Downarrow"))
+ ("<=>" ,(math "\\Leftrightarrow"))
+ ("<==>" ,(math "\\Longleftrightarrow"))
+ ;; Mathematical operators
+ ("forall" ,(math "\\forall"))
+ ("partial" ,(math "\\partial"))
+ ("exists" ,(math "\\exists"))
+ ("emptyset" ,(math "\\emptyset"))
+ ("infinity" ,(math "\\infty"))
+ ("nabla" ,(math "\\nabla"))
+ ("in" ,(math "\\in"))
+ ("notin" ,(math "\\notin"))
+ ("ni" ,(math "\\ni"))
+ ("prod" ,(math "\\Pi"))
+ ("sum" ,(math "\\Sigma"))
+ ("asterisk" ,(math "\\ast"))
+ ("sqrt" ,(math "\\surd"))
+ ("propto" ,(math "\\propto"))
+ ("angle" ,(math "\\angle"))
+ ("and" ,(math "\\wedge"))
+ ("or" ,(math "\\vee"))
+ ("cap" ,(math "\\cap"))
+ ("cup" ,(math "\\cup"))
+ ("integral" ,(math "\\int"))
+ ("models" ,(math "\\models"))
+ ("vdash" ,(math "\\vdash"))
+ ("dashv" ,(math "\\dashv"))
+ ("sim" ,(math "\\sim"))
+ ("cong" ,(math "\\cong"))
+ ("approx" ,(math "\\approx"))
+ ("neq" ,(math "\\neq"))
+ ("equiv" ,(math "\\equiv"))
+ ("le" ,(math "\\leq"))
+ ("ge" ,(math "\\geq"))
+ ("subset" ,(math "\\subset"))
+ ("supset" ,(math "\\supset"))
+ ("subseteq" ,(math "\\subseteq"))
+ ("supseteq" ,(math "\\supseteq"))
+ ("oplus" ,(math "\\oplus"))
+ ("otimes" ,(math "\\otimes"))
+ ("perp" ,(math "\\perp"))
+ ("mid" ,(math "\\mid"))
+ ("lceil" ,(math "\\lceil"))
+ ("rceil" ,(math "\\rceil"))
+ ("lfloor" ,(math "\\lfloor"))
+ ("rfloor" ,(math "\\rfloor"))
+ ("langle" ,(math "\\langle"))
+ ("rangle" ,(math "\\rangle"))
+ ;; Misc
+ ("loz" ,(math "\\diamond"))
+ ("spades" ,(math "\\spadesuit"))
+ ("clubs" ,(math "\\clubsuit"))
+ ("hearts" ,(math "\\heartsuit"))
+ ("diams" ,(math "\\diamondsuit"))
+ ("euro" "\\euro{}")
+ ;; ConTeXt
+ ("dag" "\\dag")
+ ("ddag" "\\ddag")
+ ("circ" ,(math "\\circ"))
+ ("top" ,(math "\\top"))
+ ("bottom" ,(math "\\bot"))
+ ("lhd" ,(math "\\triangleleft"))
+ ("rhd" ,(math "\\triangleright"))
+ ("parallel" ,(math "\\parallel"))))
+
+;;;; ======================================================================
+;;;; context-width
+;;;; ======================================================================
+(define (context-width width)
+ (cond
+ ((string? width)
+ width)
+ ((and (number? width) (inexact? width))
+ (string-append (number->string (/ width 100.)) "\\textwidth"))
+ (else
+ (string-append (number->string width) "pt"))))
+
+;;;; ======================================================================
+;;;; context-dim
+;;;; ======================================================================
+(define (context-dim dimension)
+ (cond
+ ((string? dimension)
+ dimension)
+ ((number? dimension)
+ (string-append (number->string (inexact->exact (round dimension)))
+ "pt"))))
+
+;;;; ======================================================================
+;;;; context-url
+;;;; ======================================================================
+(define(context-url url text e)
+ (let ((name (gensym 'url))
+ (text (or text url)))
+ (printf "\\useURL[~A][~A][][" name url)
+ (output text e)
+ (printf "]\\from[~A]" name)))
+
+;;;; ======================================================================
+;;;; Color Management ...
+;;;; ======================================================================
+(define *skribe-context-color-table* (make-hashtable))
+
+(define (skribe-color->context-color spec)
+ (receive (r g b)
+ (skribe-color->rgb spec)
+ (let ((ff (exact->inexact #xff)))
+ (format "r=~a,g=~a,b=~a"
+ (number->string (/ r ff))
+ (number->string (/ g ff))
+ (number->string (/ b ff))))))
+
+
+(define (skribe-declare-used-colors)
+ (printf "\n%%Colors\n")
+ (for-each (lambda (spec)
+ (let ((c (hashtable-get *skribe-context-color-table* spec)))
+ (unless (string? c)
+ ;; Color was never used before
+ (let ((name (symbol->string (gensym 'col))))
+ (hashtable-put! *skribe-context-color-table* spec name)
+ (printf "\\definecolor[~A][~A]\n"
+ name
+ (skribe-color->context-color spec))))))
+ (skribe-get-used-colors))
+ (newline))
+
+(define (skribe-declare-standard-colors engine)
+ (for-each (lambda (x)
+ (skribe-use-color! (engine-custom engine x)))
+ '(source-comment-color source-define-color source-module-color
+ source-markup-color source-thread-color source-string-color
+ source-bracket-color source-type-color)))
+
+(define (skribe-get-color spec)
+ (let ((c (and (hashtable? *skribe-context-color-table*)
+ (hashtable-get *skribe-context-color-table* spec))))
+ (if (not (string? c))
+ (skribe-error 'context "Can't find color" spec)
+ c)))
+
+;;;; ======================================================================
+;;;; context-engine ...
+;;;; ======================================================================
+(define context-engine
+ (default-engine-set!
+ (make-engine 'context
+ :version 1.0
+ :format "context"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace context-encoding)
+ :symbol-table (context-symbol-table (lambda (m) (format "$~a$" m)))
+ :custom context-customs)))
+
+;;;; ======================================================================
+;;;; document ...
+;;;; ======================================================================
+(markup-writer 'document
+ :options '(:title :subtitle :author :ending :env)
+ :before (lambda (n e)
+ ;; Prelude
+ (printf "% interface=en output=pdftex\n")
+ (display "%%%% -*- TeX -*-\n")
+ (printf "%%%% File automatically generated by Skribe ~A on ~A\n\n"
+ (skribe-release) (date))
+ ;; Make URLs active
+ (printf "\\setupinteraction[state=start]\n")
+ ;; Choose the document font
+ (printf "\\setupbodyfont[~a,~apt]\n" (engine-custom e 'font-type)
+ (engine-custom e 'font-size))
+ ;; Color
+ (display "\\setupcolors[state=start]\n")
+ ;; Load Style
+ (printf "\\input skribe-context-~a.tex\n"
+ (engine-custom e 'document-style))
+ ;; Insert User customization
+ (let ((s (engine-custom e 'user-style)))
+ (when s (printf "\\input ~a\n" s)))
+ ;; Output used colors
+ (skribe-declare-standard-colors e)
+ (skribe-declare-used-colors)
+
+ (display "\\starttext\n\\StartTitlePage\n")
+ ;; title
+ (let ((t (markup-option n :title)))
+ (when t
+ (skribe-eval (new markup
+ (markup '&context-title)
+ (body t)
+ (options
+ `((subtitle ,(markup-option n :subtitle)))))
+ e
+ :env `((parent ,n)))))
+ ;; author(s)
+ (let ((a (markup-option n :author)))
+ (when a
+ (if (list? a)
+ ;; List of authors. Use multi-columns
+ (begin
+ (printf "\\defineparagraphs[Authors][n=~A]\n" (length a))
+ (display "\\startAuthors\n")
+ (let Loop ((l a))
+ (unless (null? l)
+ (output (car l) e)
+ (unless (null? (cdr l))
+ (display "\\nextAuthors\n")
+ (Loop (cdr l)))))
+ (display "\\stopAuthors\n\n"))
+ ;; One author, that's easy
+ (output a e))))
+ ;; End of the title
+ (display "\\StopTitlePage\n"))
+ :after (lambda (n e)
+ (display "\n\\stoptext\n")))
+
+
+
+;;;; ======================================================================
+;;;; &context-title ...
+;;;; ======================================================================
+(markup-writer '&context-title
+ :before "{\\DocumentTitle{"
+ :action (lambda (n e)
+ (output (markup-body n) e)
+ (let ((sub (markup-option n 'subtitle)))
+ (when sub
+ (display "\\\\\n\\switchtobodyfont[16pt]\\it{")
+ (output sub e)
+ (display "}\n"))))
+ :after "}}")
+
+;;;; ======================================================================
+;;;; author ...
+;;;; ======================================================================
+(markup-writer 'author
+ :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+ :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))
+ (out (lambda (n)
+ (output n e)
+ (display "\\\\\n"))))
+ (display "{\\midaligned{")
+ (when name (out name))
+ (when title (out title))
+ (when affiliation (out affiliation))
+ (when (pair? address) (for-each out address))
+ (when phone (out phone))
+ (when email (out email))
+ (when url (out url))
+ (display "}}\n"))))
+
+
+;;;; ======================================================================
+;;;; toc ...
+;;;; ======================================================================
+(markup-writer 'toc
+ :options '()
+ :action (lambda (n e) (display "\\placecontent\n")))
+
+;;;; ======================================================================
+;;;; context-block-before ...
+;;;; ======================================================================
+(define (context-block-before name name-unnum)
+ (lambda (n e)
+ (let ((num (markup-option n :number)))
+ (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+ (printf "\\~a[~a]{" (if num name name-unnum)
+ (string-canonicalize (markup-ident n)))
+ (output (markup-option n :title) e)
+ (display "}\n"))))
+
+
+;;;; ======================================================================
+;;;; chapter, section, ...
+;;;; ======================================================================
+(markup-writer 'chapter
+ :options '(:title :number :toc :file :env)
+ :before (context-block-before 'chapter 'title))
+
+
+(markup-writer 'section
+ :options '(:title :number :toc :file :env)
+ :before (context-block-before 'section 'subject))
+
+
+(markup-writer 'subsection
+ :options '(:title :number :toc :file :env)
+ :before (context-block-before 'subsection 'subsubject))
+
+
+(markup-writer 'subsubsection
+ :options '(:title :number :toc :file :env)
+ :before (context-block-before 'subsubsection 'subsubsubject))
+
+;;;; ======================================================================
+;;;; paragraph ...
+;;;; ======================================================================
+(markup-writer 'paragraph
+ :options '(:title :number :toc :env)
+ :after "\\par\n")
+
+;;;; ======================================================================
+;;;; footnote ...
+;;;; ======================================================================
+(markup-writer 'footnote
+ :before "\\footnote{"
+ :after "}")
+
+;;;; ======================================================================
+;;;; linebreak ...
+;;;; ======================================================================
+(markup-writer 'linebreak
+ :action "\\crlf ")
+
+;;;; ======================================================================
+;;;; hrule ...
+;;;; ======================================================================
+(markup-writer 'hrule
+ :options '(:width :height)
+ :before (lambda (n e)
+ (printf "\\blackrule[width=~A,height=~A]\n"
+ (context-width (markup-option n :width))
+ (context-dim (markup-option n :height)))))
+
+;;;; ======================================================================
+;;;; color ...
+;;;; ======================================================================
+(markup-writer 'color
+ :options '(:bg :fg :width :margin :border)
+ :before (lambda (n e)
+ (let ((bg (markup-option n :bg))
+ (fg (markup-option n :fg))
+ (w (markup-option n :width))
+ (m (markup-option n :margin))
+ (b (markup-option n :border))
+ (c (markup-option n :round-corner)))
+ (if (or bg w m b)
+ (begin
+ (printf "\\startframedtext[width=~a" (if w
+ (context-width w)
+ "fit"))
+ (printf ",rulethickness=~A" (if b (context-width b) "0pt"))
+ (when m
+ (printf ",offset=~A" (context-width m)))
+ (when bg
+ (printf ",background=color,backgroundcolor=~A"
+ (skribe-get-color bg)))
+ (when fg
+ (printf ",foregroundcolor=~A"
+ (skribe-get-color fg)))
+ (when c
+ (display ",framecorner=round"))
+ (printf "]\n"))
+ ;; Probably just a foreground was specified
+ (when fg
+ (printf "\\startcolor[~A] " (skribe-get-color fg))))))
+ :after (lambda (n e)
+ (let ((bg (markup-option n :bg))
+ (fg (markup-option n :fg))
+ (w (markup-option n :width))
+ (m (markup-option n :margin))
+ (b (markup-option n :border)))
+ (if (or bg w m b)
+ (printf "\\stopframedtext ")
+ (when fg
+ (printf "\\stopcolor "))))))
+;;;; ======================================================================
+;;;; frame ...
+;;;; ======================================================================
+(markup-writer 'frame
+ :options '(:width :border :margin)
+ :before (lambda (n e)
+ (let ((m (markup-option n :margin))
+ (w (markup-option n :width))
+ (b (markup-option n :border))
+ (c (markup-option n :round-corner)))
+ (printf "\\startframedtext[width=~a" (if w
+ (context-width w)
+ "fit"))
+ (printf ",rulethickness=~A" (context-dim b))
+ (printf ",offset=~A" (context-width m))
+ (when c
+ (display ",framecorner=round"))
+ (printf "]\n")))
+ :after "\\stopframedtext ")
+
+;;;; ======================================================================
+;;;; font ...
+;;;; ======================================================================
+(markup-writer 'font
+ :options '(:size)
+ :action (lambda (n e)
+ (let* ((size (markup-option n :size))
+ (cs (engine-custom e 'font-size))
+ (ns (cond
+ ((and (integer? size) (exact? size))
+ (if (> size 0)
+ size
+ (+ cs size)))
+ ((and (number? size) (inexact? size))
+ (+ cs (inexact->exact size)))
+ ((string? size)
+ (let ((nb (string->number size)))
+ (if (not (number? nb))
+ (skribe-error
+ 'font
+ (format "Illegal font size ~s" size)
+ nb)
+ (+ cs nb))))))
+ (ne (make-engine (gensym 'context)
+ :delegate e
+ :filter (engine-filter e)
+ :symbol-table (engine-symbol-table e)
+ :custom `((font-size ,ns)
+ ,@(engine-customs e)))))
+ (printf "{\\switchtobodyfont[~apt]" ns)
+ (output (markup-body n) ne)
+ (display "}"))))
+
+
+;;;; ======================================================================
+;;;; flush ...
+;;;; ======================================================================
+(markup-writer 'flush
+ :options '(:side)
+ :before (lambda (n e)
+ (case (markup-option n :side)
+ ((center)
+ (display "\n\n\\midaligned{"))
+ ((left)
+ (display "\n\n\\leftaligned{"))
+ ((right)
+ (display "\n\n\\rightaligned{"))))
+ :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;* center ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+ :before "\n\n\\midaligned{"
+ :after "}\n")
+
+;;;; ======================================================================
+;;;; pre ...
+;;;; ======================================================================
+(markup-writer 'pre
+ :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+ :action (lambda (n e)
+ (let ((ne (make-engine
+ (gensym 'context)
+ :delegate e
+ :filter (make-string-replace context-pre-encoding)
+ :symbol-table (engine-symbol-table e)
+ :custom (engine-customs e))))
+ (output (markup-body n) ne)))
+ :after "\n\\stoplines\n}")
+
+;;;; ======================================================================
+;;;; prog ...
+;;;; ======================================================================
+(markup-writer 'prog
+ :options '(:line :mark)
+ :before "{\\tt\n\\startlines\n\\fixedspaces\n"
+ :action (lambda (n e)
+ (let ((ne (make-engine
+ (gensym 'context)
+ :delegate e
+ :filter (make-string-replace context-pre-encoding)
+ :symbol-table (engine-symbol-table e)
+ :custom (engine-customs e))))
+ (output (markup-body n) ne)))
+ :after "\n\\stoplines\n}")
+
+
+;;;; ======================================================================
+;;;; itemize, enumerate ...
+;;;; ======================================================================
+(define (context-itemization-action n e descr?)
+ (let ((symbol (markup-option n :symbol)))
+ (for-each (lambda (item)
+ (if symbol
+ (begin
+ (display "\\sym{")
+ (output symbol e)
+ (display "}"))
+ ;; output a \item iff not a description
+ (unless descr?
+ (display " \\item ")))
+ (output item e)
+ (newline))
+ (markup-body n))))
+
+(markup-writer 'itemize
+ :options '(:symbol)
+ :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+ :action (lambda (n e) (context-itemization-action n e #f))
+ :after "\\stopitemize\n\\stopnarrower\n")
+
+
+(markup-writer 'enumerate
+ :options '(:symbol)
+ :before "\\startnarrower[left]\n\\startitemize[n][standard]\n"
+ :action (lambda (n e) (context-itemization-action n e #f))
+ :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;; description ...
+;;;; ======================================================================
+(markup-writer 'description
+ :options '(:symbol)
+ :before "\\startnarrower[left]\n\\startitemize[serried]\n"
+ :action (lambda (n e) (context-itemization-action n e #t))
+ :after "\\stopitemize\n\\stopnarrower\n")
+
+;;;; ======================================================================
+;;;; item ...
+;;;; ======================================================================
+(markup-writer 'item
+ :options '(:key)
+ :action (lambda (n e)
+ (let ((k (markup-option n :key)))
+ (when k
+ ;; Output the key(s)
+ (let Loop ((l (if (pair? k) k (list k))))
+ (unless (null? l)
+ (output (bold (car l)) e)
+ (unless (null? (cdr l))
+ (display "\\crlf\n"))
+ (Loop (cdr l))))
+ (display "\\nowhitespace\\startnarrower[left]\n"))
+ ;; Output body
+ (output (markup-body n) e)
+ ;; Terminate
+ (when k
+ (display "\n\\stopnarrower\n")))))
+
+;;;; ======================================================================
+;;;; blockquote ...
+;;;; ======================================================================
+(markup-writer 'blockquote
+ :before "\n\\startnarrower[left,right]\n"
+ :after "\n\\stopnarrower\n")
+
+
+;;;; ======================================================================
+;;;; figure ...
+;;;; ======================================================================
+(markup-writer 'figure
+ :options '(:legend :number :multicolumns)
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (unless number
+ (display "{\\setupcaptions[number=off]\n"))
+ (display "\\placefigure\n")
+ (printf " [~a]\n" (string-canonicalize ident))
+ (display " {") (output legend e) (display "}\n")
+ (display " {") (output (markup-body n) e) (display "}")
+ (unless number
+ (display "}\n")))))
+
+;;;; ======================================================================
+;;;; table ...
+;;;; ======================================================================
+ ;; width doesn't work
+(markup-writer 'table
+ :options '(:width :border :frame :rules :cellpadding)
+ :before (lambda (n e)
+ (let ((width (markup-option n :width))
+ (border (markup-option n :border))
+ (frame (markup-option n :frame))
+ (rules (markup-option n :rules))
+ (cstyle (markup-option n :cellstyle))
+ (cp (markup-option n :cellpadding))
+ (cs (markup-option n :cellspacing)))
+ (printf "\n{\\bTABLE\n")
+ (printf "\\setupTABLE[")
+ (printf "width=~A" (if width (context-width width) "fit"))
+ (when border
+ (printf ",rulethickness=~A" (context-dim border)))
+ (when cp
+ (printf ",offset=~A" (context-width cp)))
+ (printf ",frame=off]\n")
+
+ (when rules
+ (let ((hor "\\setupTABLE[row][bottomframe=on,topframe=on]\n")
+ (vert "\\setupTABLE[c][leftframe=on,rightframe=on]\n"))
+ (case rules
+ ((rows) (display hor))
+ ((cols) (display vert))
+ ((all) (display hor) (display vert)))))
+
+ (when frame
+ ;; hsides, vsides, lhs, rhs, box, border
+ (let ((top "\\setupTABLE[row][first][frame=off,topframe=on]\n")
+ (bot "\\setupTABLE[row][last][frame=off,bottomframe=on]\n")
+ (left "\\setupTABLE[c][first][frame=off,leftframe=on]\n")
+ (right "\\setupTABLE[c][last][frame=off,rightframe=on]\n"))
+ (case frame
+ ((above) (display top))
+ ((below) (display bot))
+ ((hsides) (display top) (display bot))
+ ((lhs) (display left))
+ ((rhs) (display right))
+ ((vsides) (display left) (diplay right))
+ ((box border) (display top) (display bot)
+ (display left) (display right)))))))
+
+ :after (lambda (n e)
+ (printf "\\eTABLE}\n")))
+
+
+;;;; ======================================================================
+;;;; tr ...
+;;;; ======================================================================
+(markup-writer 'tr
+ :options '(:bg)
+ :before (lambda (n e)
+ (display "\\bTR")
+ (let ((bg (markup-option n :bg)))
+ (when bg
+ (printf "[background=color,backgroundcolor=~A]"
+ (skribe-get-color bg)))))
+ :after "\\eTR\n")
+
+
+;;;; ======================================================================
+;;;; tc ...
+;;;; ======================================================================
+(markup-writer 'tc
+ :options '(:width :align :valign :colspan)
+ :before (lambda (n e)
+ (let ((th? (eq? 'th (markup-option n 'markup)))
+ (width (markup-option n :width))
+ (align (markup-option n :align))
+ (valign (markup-option n :valign))
+ (colspan (markup-option n :colspan))
+ (rowspan (markup-option n :rowspan))
+ (bg (markup-option n :bg)))
+ (printf "\\bTD[")
+ (printf "width=~a" (if width (context-width width) "fit"))
+ (when valign
+ ;; This is buggy. In fact valign an align can't be both
+ ;; specified in ConTeXt
+ (printf ",align=~a" (case valign
+ ((center) 'lohi)
+ ((bottom) 'low)
+ ((top) 'high))))
+ (when align
+ (printf ",align=~a" (case align
+ ((left) 'right) ; !!!!
+ ((right) 'left) ; !!!!
+ (else 'middle))))
+ (unless (equal? colspan 1)
+ (printf ",nx=~a" colspan))
+ (display "]")
+ (when th?
+ ;; This is a TH, output is bolded
+ (display "{\\bf{"))))
+
+ :after (lambda (n e)
+ (when (equal? (markup-option n 'markup) 'th)
+ ;; This is a TH, output is bolded
+ (display "}}"))
+ (display "\\eTD")))
+
+;;;; ======================================================================
+;;;; image ...
+;;;; ======================================================================
+(markup-writer 'image
+ :options '(:file :url :width :height :zoom)
+ :action (lambda (n e)
+ (let* ((file (markup-option n :file))
+ (url (markup-option n :url))
+ (width (markup-option n :width))
+ (height (markup-option n :height))
+ (zoom (markup-option n :zoom))
+ (body (markup-body n))
+ (efmt (engine-custom e 'image-format))
+ (img (or url (convert-image file
+ (if (list? efmt)
+ efmt
+ '("jpg"))))))
+ (if (not (string? img))
+ (skribe-error 'context "Illegal image" file)
+ (begin
+ (printf "\\externalfigure[~A][frame=off" (strip-ref-base img))
+ (if zoom (printf ",factor=~a" (inexact->exact zoom)))
+ (if width (printf ",width=~a" (context-width width)))
+ (if height (printf ",height=~apt" (context-dim height)))
+ (display "]"))))))
+
+
+;;;; ======================================================================
+;;;; Ornaments ...
+;;;; ======================================================================
+(markup-writer 'roman :before "{\\rm{" :after "}}")
+(markup-writer 'bold :before "{\\bf{" :after "}}")
+(markup-writer 'underline :before "{\\underbar{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\it{" :after "}}")
+(markup-writer 'code :before "{\\tt{" :after "}}")
+(markup-writer 'var :before "{\\tt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+;;//(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "{\\low{" :after "}}")
+(markup-writer 'sup :before "{\\high{" :after "}}")
+
+
+;;//
+;;//(markup-writer 'tt
+;;// :before "{\\texttt{"
+;;// :action (lambda (n e)
+;;// (let ((ne (make-engine
+;;// (gensym 'latex)
+;;// :delegate e
+;;// :filter (make-string-replace latex-tt-encoding)
+;;// :custom (engine-customs e)
+;;// :symbol-table (engine-symbol-table e))))
+;;// (output (markup-body n) ne)))
+;;// :after "}}")
+
+;;;; ======================================================================
+;;;; q ...
+;;;; ======================================================================
+(markup-writer 'q
+ :before "\\quotation{"
+ :after "}")
+
+;;;; ======================================================================
+;;;; mailto ...
+;;;; ======================================================================
+(markup-writer 'mailto
+ :options '(:text)
+ :action (lambda (n e)
+ (let ((text (markup-option n :text))
+ (url (markup-body n)))
+ (when (pair? url)
+ (context-url (format "mailto:~A" (car url))
+ (or text
+ (car url))
+ e)))))
+;;;; ======================================================================
+;;;; mark ...
+;;;; ======================================================================
+(markup-writer 'mark
+ :before (lambda (n e)
+ (printf "\\reference[~a]{}\n"
+ (string-canonicalize (markup-ident n)))))
+
+;;;; ======================================================================
+;;;; ref ...
+;;;; ======================================================================
+(markup-writer 'ref
+ :options '(:text :chapter :section :subsection :subsubsection
+ :figure :mark :handle :page)
+ :action (lambda (n e)
+ (let* ((text (markup-option n :text))
+ (page (markup-option n :page))
+ (c (handle-ast (markup-body n)))
+ (id (markup-ident c)))
+ (cond
+ (page ;; Output the page only (this is a hack)
+ (when text (output text e))
+ (printf "\\at[~a]"
+ (string-canonicalize id)))
+ ((or (markup-option n :chapter)
+ (markup-option n :section)
+ (markup-option n :subsection)
+ (markup-option n :subsubsection))
+ (if text
+ (printf "\\goto{~a}[~a]" (or text id)
+ (string-canonicalize id))
+ (printf "\\in[~a]" (string-canonicalize id))))
+ ((markup-option n :mark)
+ (printf "\\goto{~a}[~a]"
+ (or text id)
+ (string-canonicalize id)))
+ (else ;; Output a little image indicating the direction
+ (printf "\\in[~a]" (string-canonicalize id)))))))
+
+;;;; ======================================================================
+;;;; bib-ref ...
+;;;; ======================================================================
+(markup-writer 'bib-ref
+ :options '(:text :bib)
+ :before (lambda (n e) (output "[" e))
+ :action (lambda (n e)
+ (let* ((obj (handle-ast (markup-body n)))
+ (title (markup-option obj :title))
+ (ref (markup-option title 'number))
+ (ident (markup-ident obj)))
+ (printf "\\goto{~a}[~a]" ref (string-canonicalize ident))))
+ :after (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;; bib-ref+ ...
+;;;; ======================================================================
+(markup-writer 'bib-ref+
+ :options '(:text :bib)
+ :before (lambda (n e) (output "[" e))
+ :action (lambda (n e)
+ (let loop ((rs (markup-body n)))
+ (cond
+ ((null? rs)
+ #f)
+ (else
+ (if (is-markup? (car rs) 'bib-ref)
+ (invoke (writer-action (markup-writer-get 'bib-ref e))
+ (car rs)
+ e)
+ (output (car rs) e))
+ (if (pair? (cdr rs))
+ (begin
+ (display ",")
+ (loop (cdr rs))))))))
+ :after (lambda (n e) (output "]" e)))
+
+;;;; ======================================================================
+;;;; url-ref ...
+;;;; ======================================================================
+(markup-writer 'url-ref
+ :options '(:url :text)
+ :action (lambda (n e)
+ (context-url (markup-option n :url) (markup-option n :text) e)))
+
+;;//;*---------------------------------------------------------------------*/
+;;//;* line-ref ... */
+;;//;*---------------------------------------------------------------------*/
+;;//(markup-writer 'line-ref
+;;// :options '(:offset)
+;;// :before "{\\textit{"
+;;// :action (lambda (n e)
+;;// (let ((o (markup-option n :offset))
+;;// (v (string->number (markup-option n :text))))
+;;// (cond
+;;// ((and (number? o) (number? v))
+;;// (display (+ o v)))
+;;// (else
+;;// (display v)))))
+;;// :after "}}")
+
+
+;;;; ======================================================================
+;;;; &the-bibliography ...
+;;;; ======================================================================
+(markup-writer '&the-bibliography
+ :before "\n% Bibliography\n\n")
+
+
+;;;; ======================================================================
+;;;; &bib-entry ...
+;;;; ======================================================================
+(markup-writer '&bib-entry
+ :options '(:title)
+ :action (lambda (n e)
+ (skribe-eval (mark (markup-ident n)) e)
+ (output n e (markup-writer-get '&bib-entry-label e))
+ (output n e (markup-writer-get '&bib-entry-body e)))
+ :after "\n\n")
+
+;;;; ======================================================================
+;;;; &bib-entry-label ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-label
+ :options '(:title)
+ :before (lambda (n e) (output "[" e))
+ :action (lambda (n e) (output (markup-option n :title) e))
+ :after (lambda (n e) (output "] "e)))
+
+;;;; ======================================================================
+;;;; &bib-entry-title ...
+;;;; ======================================================================
+(markup-writer '&bib-entry-title
+ :action (lambda (n e)
+ (let* ((t (bold (markup-body n)))
+ (en (handle-ast (ast-parent n)))
+ (url #f ) ;;;;;;;;;;;;;;;// (markup-option en 'url))
+ (ht (if url (ref :url (markup-body url) :text t) t)))
+ (skribe-eval ht e))))
+
+
+;;//;*---------------------------------------------------------------------*/
+;;//;* &bib-entry-url ... */
+;;//;*---------------------------------------------------------------------*/
+;;//(markup-writer '&bib-entry-url
+;;// :action (lambda (n e)
+;;// (let* ((en (handle-ast (ast-parent n)))
+;;// (url (markup-option en 'url))
+;;// (t (bold (markup-body url))))
+;;// (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+
+;;;; ======================================================================
+;;;; &the-index ...
+;;;; ======================================================================
+(markup-writer '&the-index
+ :options '(:column)
+ :action
+ (lambda (n e)
+ (define (make-mark-entry n)
+ (display "\\blank[medium]\n{\\bf\\it\\tfc{")
+ (skribe-eval (bold n) e)
+ (display "}}\\crlf\n"))
+
+ (define (make-primary-entry n)
+ (let ((b (markup-body n)))
+ (markup-option-add! b :text (list (markup-option b :text) ", "))
+ (markup-option-add! b :page #t)
+ (output n e)))
+
+ (define (make-secondary-entry n)
+ (let* ((note (markup-option n :note))
+ (b (markup-body n))
+ (bb (markup-body b)))
+ (if note
+ (begin ;; This is another entry
+ (display "\\crlf\n ... ")
+ (markup-option-add! b :text (list note ", ")))
+ (begin ;; another line on an entry
+ (markup-option-add! b :text ", ")))
+ (markup-option-add! b :page #t)
+ (output n e)))
+
+ ;; Writer body starts here
+ (let ((col (markup-option n :column)))
+ (when col
+ (printf "\\startcolumns[n=~a]\n" col))
+ (for-each (lambda (item)
+ ;;(DEBUG "ITEM= ~S" item)
+ (if (pair? item)
+ (begin
+ (make-primary-entry (car item))
+ (for-each (lambda (x) (make-secondary-entry x))
+ (cdr item)))
+ (make-mark-entry item))
+ (display "\\crlf\n"))
+ (markup-body n))
+ (when col
+ (printf "\\stopcolumns\n")))))
+
+;;;; ======================================================================
+;;;; &source-comment ...
+;;;; ======================================================================
+(markup-writer '&source-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (it (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-line-comment ...
+;;;; ======================================================================
+(markup-writer '&source-line-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-keyword ...
+;;;; ======================================================================
+(markup-writer '&source-keyword
+ :action (lambda (n e)
+ (skribe-eval (it (markup-body n)) e)))
+
+;;;; ======================================================================
+;;;; &source-error ...
+;;;; ======================================================================
+(markup-writer '&source-error
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-error-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'error-color) cc)
+ (color :fg cc (it n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-define ...
+;;;; ======================================================================
+(markup-writer '&source-define
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-define-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-module ...
+;;;; ======================================================================
+(markup-writer '&source-module
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-module-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-markup ...
+;;;; ======================================================================
+(markup-writer '&source-markup
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-markup-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-thread ...
+;;;; ======================================================================
+(markup-writer '&source-thread
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-thread-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-string ...
+;;;; ======================================================================
+(markup-writer '&source-string
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-string-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-bracket ...
+;;;; ======================================================================
+(markup-writer '&source-bracket
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-bracket-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-type ...
+;;;; ======================================================================
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-key ...
+;;;; ======================================================================
+(markup-writer '&source-key
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;;;; ======================================================================
+;;;; &source-type ...
+;;;; ======================================================================
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg "red" (bold n1))
+ (bold n1))))
+ (skribe-eval n2 e))))
+
+
+
+;;;; ======================================================================
+;;;; Context Only Markups
+;;;; ======================================================================
+
+;;;
+;;; Margin -- put text in the margin
+;;;
+(define-markup (margin #!rest opts #!key (ident #f) (class "margin")
+ (side 'right) text)
+ (new markup
+ (markup 'margin)
+ (ident (or ident (symbol->string (gensym 'ident))))
+ (class class)
+ (required-options '(:text))
+ (options (the-options opts :ident :class))
+ (body (the-body opts))))
+
+(markup-writer 'margin
+ :options '(:text)
+ :before (lambda (n e)
+ (display
+ "\\setupinmargin[align=right,style=\\tfx\\setupinterlinespace]\n")
+ (display "\\inright{")
+ (output (markup-option n :text) e)
+ (display "}{"))
+ :after "}")
+
+;;;
+;;; ConTeXt and TeX
+;;;
+(define-markup (ConTeXt #!key (space #t))
+ (if (engine-format? "context")
+ (! (if space "\\CONTEXT\\ " "\\CONTEXT"))
+ "ConTeXt"))
+
+(define-markup (TeX #!key (space #t))
+ (if (engine-format? "context")
+ (! (if space "\\TEX\\ " "\\TEX"))
+ "ConTeXt"))
+
+;;;; ======================================================================
+;;;; Restore the base engine
+;;;; ======================================================================
+(default-engine-set! (find-engine 'base))
diff --git a/skribe/skr/french.skr b/skribe/skr/french.skr
new file mode 100644
index 0000000..373d076
--- /dev/null
+++ b/skribe/skr/french.skr
@@ -0,0 +1,19 @@
+;*=====================================================================*/
+;* 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/skribe/skr/html.skr b/skribe/skr/html.skr
new file mode 100644
index 0000000..ebac5f2
--- /dev/null
+++ b/skribe/skr/html.skr
@@ -0,0 +1,2251 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/skr/html.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Jul 26 12:28:57 2003 */
+;* Last change : Thu Jun 2 10:57:42 2005 (serrano) */
+;* Copyright : 2003-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* HTML Skribe engine */
+;* ------------------------------------------------------------- */
+;* Implementation: */
+;* common: @path ../src/common/api.src@ */
+;* bigloo: @path ../src/bigloo/api.bgl@ */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/htmle.skb:ref@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* html-engine ... */
+;*---------------------------------------------------------------------*/
+(define html-engine
+ ;; setup the html engine
+ (default-engine-set!
+ (make-engine 'html
+ :version 1.0
+ :format "html"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)
+ (#\@ "@")))
+ :custom `(;; the icon associated with the URL
+ (favicon #f)
+ ;; charset used
+ (charset "ISO-8859-1")
+ ;; enable/disable Javascript
+ (javascript #f)
+ ;; user html head
+ (head #f)
+ ;; user CSS
+ (css ())
+ ;; user inlined CSS
+ (inline-css ())
+ ;; user JS
+ (js ())
+ ;; emit-sui
+ (emit-sui #f)
+ ;; the body
+ (background "#ffffff")
+ (foreground #f)
+ ;; the margins
+ (margin-padding 3)
+ (left-margin #f)
+ (chapter-left-margin #f)
+ (section-left-margin #f)
+ (left-margin-font #f)
+ (left-margin-size 17.)
+ (left-margin-background "#dedeff")
+ (left-margin-foreground #f)
+ (right-margin #f)
+ (chapter-right-margin #f)
+ (section-right-margin #f)
+ (right-margin-font #f)
+ (right-margin-size 17.)
+ (right-margin-background "#dedeff")
+ (right-margin-foreground #f)
+ ;; author configuration
+ (author-font #f)
+ ;; title configuration
+ (title-font #f)
+ (title-background "#8381de")
+ (title-foreground #f)
+ (file-title-separator " -- ")
+ ;; index configuration
+ (index-header-font-size +2.)
+ ;; chapter configuration
+ (chapter-number->string number->string)
+ (chapter-file #f)
+ ;; section configuration
+ (section-title-start "<h3>")
+ (section-title-stop "</h3>")
+ (section-title-background "#dedeff")
+ (section-title-foreground "black")
+ (section-title-number-separator " ")
+ (section-number->string number->string)
+ (section-file #f)
+ ;; subsection configuration
+ (subsection-title-start "<h3>")
+ (subsection-title-stop "</h3>")
+ (subsection-title-background "#ffffff")
+ (subsection-title-foreground "#8381de")
+ (subsection-title-number-separator " ")
+ (subsection-number->string number->string)
+ (subsection-file #f)
+ ;; subsubsection configuration
+ (subsubsection-title-start "<h4>")
+ (subsubsection-title-stop "</h4>")
+ (subsubsection-title-background #f)
+ (subsubsection-title-foreground "#8381de")
+ (subsubsection-title-number-separator " ")
+ (subsubsection-number->string number->string)
+ (subsubsection-file #f)
+ ;; source fontification
+ (source-color #t)
+ (source-comment-color "#ffa600")
+ (source-error-color "red")
+ (source-define-color "#6959cf")
+ (source-module-color "#1919af")
+ (source-markup-color "#1919af")
+ (source-thread-color "#ad4386")
+ (source-string-color "red")
+ (source-bracket-color "red")
+ (source-type-color "#00cf00")
+ ;; image
+ (image-format ("png" "gif" "jpg" "jpeg")))
+ :symbol-table '(("iexcl" "¡")
+ ("cent" "¢")
+ ("pound" "£")
+ ("currency" "¤")
+ ("yen" "¥")
+ ("section" "§")
+ ("mul" "¨")
+ ("copyright" "©")
+ ("female" "ª")
+ ("lguillemet" "«")
+ ("not" "¬")
+ ("registered" "®")
+ ("degree" "°")
+ ("plusminus" "±")
+ ("micro" "µ")
+ ("paragraph" "¶")
+ ("middot" "·")
+ ("male" "¸")
+ ("rguillemet" "»")
+ ("1/4" "¼")
+ ("1/2" "½")
+ ("3/4" "¾")
+ ("iquestion" "¿")
+ ("Agrave" "À")
+ ("Aacute" "Á")
+ ("Acircumflex" "Â")
+ ("Atilde" "Ã")
+ ("Amul" "Ä")
+ ("Aring" "Å")
+ ("AEligature" "Æ")
+ ("Oeligature" "Œ")
+ ("Ccedilla" "Ç")
+ ("Egrave" "È")
+ ("Eacute" "É")
+ ("Ecircumflex" "Ê")
+ ("Euml" "Ë")
+ ("Igrave" "Ì")
+ ("Iacute" "Í")
+ ("Icircumflex" "Î")
+ ("Iuml" "Ï")
+ ("ETH" "Ð")
+ ("Ntilde" "Ñ")
+ ("Ograve" "Ò")
+ ("Oacute" "Ó")
+ ("Ocurcumflex" "Ô")
+ ("Otilde" "Õ")
+ ("Ouml" "Ö")
+ ("times" "×")
+ ("Oslash" "Ø")
+ ("Ugrave" "Ù")
+ ("Uacute" "Ú")
+ ("Ucircumflex" "Û")
+ ("Uuml" "Ü")
+ ("Yacute" "Ý")
+ ("THORN" "Þ")
+ ("szlig" "ß")
+ ("agrave" "à")
+ ("aacute" "á")
+ ("acircumflex" "â")
+ ("atilde" "ã")
+ ("amul" "ä")
+ ("aring" "å")
+ ("aeligature" "æ")
+ ("oeligature" "œ")
+ ("ccedilla" "ç")
+ ("egrave" "è")
+ ("eacute" "é")
+ ("ecircumflex" "ê")
+ ("euml" "ë")
+ ("igrave" "ì")
+ ("iacute" "í")
+ ("icircumflex" "î")
+ ("iuml" "ï")
+ ("eth" "ð")
+ ("ntilde" "ñ")
+ ("ograve" "ò")
+ ("oacute" "ó")
+ ("ocurcumflex" "ô")
+ ("otilde" "õ")
+ ("ouml" "ö")
+ ("divide" "÷")
+ ("oslash" "ø")
+ ("ugrave" "ù")
+ ("uacute" "ú")
+ ("ucircumflex" "û")
+ ("uuml" "ü")
+ ("yacute" "ý")
+ ("thorn" "þ")
+ ("ymul" "ÿ")
+ ;; Greek
+ ("Alpha" "Α")
+ ("Beta" "Β")
+ ("Gamma" "Γ")
+ ("Delta" "Δ")
+ ("Epsilon" "Ε")
+ ("Zeta" "Ζ")
+ ("Eta" "Η")
+ ("Theta" "Θ")
+ ("Iota" "Ι")
+ ("Kappa" "Κ")
+ ("Lambda" "Λ")
+ ("Mu" "Μ")
+ ("Nu" "Ν")
+ ("Xi" "Ξ")
+ ("Omicron" "Ο")
+ ("Pi" "Π")
+ ("Rho" "Ρ")
+ ("Sigma" "Σ")
+ ("Tau" "Τ")
+ ("Upsilon" "Υ")
+ ("Phi" "Φ")
+ ("Chi" "Χ")
+ ("Psi" "Ψ")
+ ("Omega" "Ω")
+ ("alpha" "α")
+ ("beta" "β")
+ ("gamma" "γ")
+ ("delta" "δ")
+ ("epsilon" "ε")
+ ("zeta" "ζ")
+ ("eta" "η")
+ ("theta" "θ")
+ ("iota" "ι")
+ ("kappa" "κ")
+ ("lambda" "λ")
+ ("mu" "μ")
+ ("nu" "ν")
+ ("xi" "ξ")
+ ("omicron" "ο")
+ ("pi" "π")
+ ("rho" "ρ")
+ ("sigmaf" "ς")
+ ("sigma" "σ")
+ ("tau" "τ")
+ ("upsilon" "υ")
+ ("phi" "φ")
+ ("chi" "χ")
+ ("psi" "ψ")
+ ("omega" "ω")
+ ("thetasym" "ϑ")
+ ("piv" "ϖ")
+ ;; punctuation
+ ("bullet" "•")
+ ("ellipsis" "…")
+ ("weierp" "℘")
+ ("image" "ℑ")
+ ("real" "ℜ")
+ ("tm" "™")
+ ("alef" "ℵ")
+ ("<-" "←")
+ ("<--" "←")
+ ("uparrow" "↑")
+ ("->" "→")
+ ("-->" "→")
+ ("downarrow" "↓")
+ ("<->" "↔")
+ ("<-->" "↔")
+ ("<+" "↵")
+ ("<=" "⇐")
+ ("<==" "⇐")
+ ("Uparrow" "⇑")
+ ("=>" "⇒")
+ ("==>" "⇒")
+ ("Downarrow" "⇓")
+ ("<=>" "⇔")
+ ("<==>" "⇔")
+ ;; Mathematical operators
+ ("forall" "∀")
+ ("partial" "∂")
+ ("exists" "∃")
+ ("emptyset" "∅")
+ ("infinity" "∞")
+ ("nabla" "∇")
+ ("in" "∈")
+ ("notin" "∉")
+ ("ni" "∋")
+ ("prod" "∏")
+ ("sum" "∑")
+ ("asterisk" "∗")
+ ("sqrt" "√")
+ ("propto" "∝")
+ ("angle" "∠")
+ ("and" "∧")
+ ("or" "∨")
+ ("cap" "∩")
+ ("cup" "∪")
+ ("integral" "∫")
+ ("therefore" "∴")
+ ("models" "|=")
+ ("vdash" "|-")
+ ("dashv" "-|")
+ ("sim" "∼")
+ ("cong" "≅")
+ ("approx" "≈")
+ ("neq" "≠")
+ ("equiv" "≡")
+ ("le" "≤")
+ ("ge" "≥")
+ ("subset" "⊂")
+ ("supset" "⊃")
+ ("nsupset" "⊃")
+ ("subseteq" "⊆")
+ ("supseteq" "⊇")
+ ("oplus" "⊕")
+ ("otimes" "⊗")
+ ("perp" "⊥")
+ ("mid" "|")
+ ("lceil" "⌈")
+ ("rceil" "⌉")
+ ("lfloor" "⌊")
+ ("rfloor" "⌋")
+ ("langle" "〈")
+ ("rangle" "〉")
+ ;; Misc
+ ("loz" "◊")
+ ("spades" "♠")
+ ("clubs" "♣")
+ ("hearts" "♥")
+ ("diams" "♦")
+ ("euro" "ℐ")
+ ;; LaTeX
+ ("dag" "dag")
+ ("ddag" "ddag")
+ ("circ" "o")
+ ("top" "T")
+ ("bottom" "⊥")
+ ("lhd" "<")
+ ("rhd" ">")
+ ("parallel" "||")))))
+
+;*---------------------------------------------------------------------*/
+;* html-title-engine ... */
+;*---------------------------------------------------------------------*/
+(define html-title-engine
+ (copy-engine 'html-title base-engine
+ :filter (make-string-replace '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)))))
+
+;*---------------------------------------------------------------------*/
+;* html-browser-title ... */
+;*---------------------------------------------------------------------*/
+(define (html-browser-title n)
+ (and (markup? n)
+ (or (markup-option n :html-title)
+ (if (document? n)
+ (markup-option n :title)
+ (html-browser-title (ast-parent n))))))
+
+;*---------------------------------------------------------------------*/
+;* html-file ... */
+;*---------------------------------------------------------------------*/
+(define html-file
+ (let ((table '())
+ (filename (gensym)))
+ (define (get-file-name base suf)
+ (let* ((c (assoc base table))
+ (n (if (pair? c)
+ (let ((n (+ 1 (cdr c))))
+ (set-cdr! c n)
+ n)
+ (begin
+ (set! table (cons (cons base 1) table))
+ 1))))
+ (format "~a-~a.~a" base n suf)))
+ (lambda (node e)
+ (let ((f (markup-option node filename))
+ (file (markup-option node :file)))
+ (cond
+ ((string? f)
+ f)
+ ((string? file)
+ file)
+ ((or file
+ (and (is-markup? node 'chapter)
+ (engine-custom e 'chapter-file))
+ (and (is-markup? node 'section)
+ (engine-custom e 'section-file))
+ (and (is-markup? node 'subsection)
+ (engine-custom e 'subsection-file))
+ (and (is-markup? node 'subsubsection)
+ (engine-custom e 'subsubsection-file)))
+ (let* ((b (or (and (string? *skribe-dest*)
+ (prefix *skribe-dest*))
+ ""))
+ (s (or (and (string? *skribe-dest*)
+ (suffix *skribe-dest*))
+ "html"))
+ (nm (get-file-name b s)))
+ (markup-option-add! node filename nm)
+ nm))
+ ((document? node)
+ *skribe-dest*)
+ (else
+ (let ((p (ast-parent node)))
+ (if (container? p)
+ (let ((file (html-file p e)))
+ (if (string? file)
+ (begin
+ (markup-option-add! node filename file)
+ file)
+ #f))
+ #f))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-container-number ... */
+;* ------------------------------------------------------------- */
+;* Returns a string representing the container number */
+;*---------------------------------------------------------------------*/
+(define (html-container-number c e)
+ (define (html-number n proc)
+ (cond
+ ((string? n)
+ n)
+ ((number? n)
+ (if (procedure? proc)
+ (proc n)
+ (number->string n)))
+ (else
+ "")))
+ (define (html-chapter-number c)
+ (html-number (markup-option c :number)
+ (engine-custom e 'chapter-number->string)))
+ (define (html-section-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'section-number->string))))
+ (cond
+ ((is-markup? p 'chapter)
+ (string-append (html-chapter-number p) "." s))
+ (else
+ (string-append s)))))
+ (define (html-subsection-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'subsection-number->string))))
+ (cond
+ ((is-markup? p 'section)
+ (string-append (html-section-number p) "." s))
+ (else
+ (string-append "." s)))))
+ (define (html-subsubsection-number c)
+ (let ((p (ast-parent c))
+ (s (html-number (markup-option c :number)
+ (engine-custom e 'subsubsection-number->string))))
+ (cond
+ ((is-markup? p 'subsection)
+ (string-append (html-subsection-number p) "." s))
+ (else
+ (string-append ".." s)))))
+ (define (inner-html-container-number c)
+ (html-number (markup-option c :number) #f))
+ (let ((n (markup-option c :number)))
+ (if (not n)
+ ""
+ (case (markup-markup c)
+ ((chapter)
+ (html-chapter-number c))
+ ((section)
+ (html-section-number c))
+ ((subsection)
+ (html-subsection-number c))
+ ((subsubsection)
+ (html-subsubsection-number c))
+ (else
+ (if (container? c)
+ (inner-html-container-number c)
+ (skribe-error 'html-container-number
+ "Not a container"
+ (markup-markup c))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-counter ... */
+;*---------------------------------------------------------------------*/
+(define (html-counter cnts)
+ (cond
+ ((not cnts)
+ "")
+ ((null? cnts)
+ "")
+ ((not (pair? cnts))
+ cnts)
+ ((null? (cdr cnts))
+ (format "~a." (car cnts)))
+ (else
+ (let loop ((cnts cnts))
+ (if (null? (cdr cnts))
+ (format "~a" (car cnts))
+ (format "~a.~a" (car cnts) (loop (cdr cnts))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-width ... */
+;*---------------------------------------------------------------------*/
+(define (html-width width)
+ (cond
+ ((and (integer? width) (exact? width))
+ (format "~A" width))
+ ((real? width)
+ (format "~A%" (inexact->exact (round width))))
+ ((string? width)
+ width)
+ (else
+ (skribe-error 'html-width "bad width" width))))
+
+;*---------------------------------------------------------------------*/
+;* html-class ... */
+;*---------------------------------------------------------------------*/
+(define (html-class m)
+ (if (markup? m)
+ (let ((c (markup-class m)))
+ (if (or (string? c) (symbol? c) (number? c))
+ (printf " class=\"~a\"" c)))))
+
+;*---------------------------------------------------------------------*/
+;* html-markup-class ... */
+;*---------------------------------------------------------------------*/
+(define (html-markup-class m)
+ (lambda (n e)
+ (printf "<~a" m)
+ (html-class n)
+ (display ">")))
+
+;*---------------------------------------------------------------------*/
+;* html-color-spec? ... */
+;*---------------------------------------------------------------------*/
+(define (html-color-spec? v)
+ (and v
+ (not (unspecified? v))
+ (or (not (string? v)) (> (string-length v) 0))))
+
+;*---------------------------------------------------------------------*/
+;* document ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+ :options '(:title :author :ending :html-title :env)
+ :action (lambda (n e)
+ (let* ((id (markup-ident n))
+ (title (new markup
+ (markup '&html-document-title)
+ (parent n)
+ (ident (string-append id "-title"))
+ (class (markup-class n))
+ (options `((author ,(markup-option n :author))))
+ (body (markup-option n :title)))))
+ (&html-generic-document n title e)))
+ :after (lambda (n e)
+ (if (engine-custom e 'emit-sui)
+ (document-sui n e))))
+
+;*---------------------------------------------------------------------*/
+;* &html-html ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-html
+ :before "<!-- 95% W3C COMPLIANT, 95% CSS FREE, RAW HTML -->
+<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+ :after "</html>")
+
+;*---------------------------------------------------------------------*/
+;* &html-head ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-head
+ :before (lambda (n e)
+ (printf "<head>\n")
+ (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;")
+ (printf "charset=~A\">\n" (engine-custom (find-engine 'html)
+ 'charset)))
+ :after "</head>\n\n")
+
+;*---------------------------------------------------------------------*/
+;* &html-body ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-body
+ :before (lambda (n e)
+ (let ((bg (engine-custom e 'background)))
+ (display "<body")
+ (html-class n)
+ (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+ (display ">\n")))
+ :after "</body>\n")
+
+;*---------------------------------------------------------------------*/
+;* &html-page ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-page
+ :action (lambda (n e)
+ (define (html-margin m fn size bg fg cla)
+ (printf "<td align=\"left\" valign=\"top\" class=\"~a\"" cla)
+ (if size
+ (printf " width=\"~a\"" (html-width size)))
+ (if (html-color-spec? bg)
+ (printf " bgcolor=\"~a\">" bg)
+ (display ">"))
+ (printf "<div class=\"~a\">\n" cla)
+ (cond
+ ((and (string? fg) (string? fn))
+ (printf "<font color=\"~a\" \"~a\">" fg fn))
+ ((string? fg)
+ (printf "<font color=\"~a\">" fg))
+ ((string? fn)
+ (printf "<font \"~a\">" fn)))
+ (if (procedure? m)
+ (skribe-eval (m n e) e)
+ (output m e))
+ (if (or (string? fg) (string? fn))
+ (display "</font>"))
+ (display "</div></td>\n"))
+ (let ((body (markup-body n))
+ (lm (engine-custom e 'left-margin))
+ (lmfn (engine-custom e 'left-margin-font))
+ (lms (engine-custom e 'left-margin-size))
+ (lmbg (engine-custom e 'left-margin-background))
+ (lmfg (engine-custom e 'left-margin-foreground))
+ (rm (engine-custom e 'right-margin))
+ (rmfn (engine-custom e 'right-margin-font))
+ (rms (engine-custom e 'right-margin-size))
+ (rmbg (engine-custom e 'right-margin-background))
+ (rmfg (engine-custom e 'right-margin-foreground)))
+ (cond
+ ((and lm rm)
+ (let* ((ep (engine-custom e 'margin-padding))
+ (ac (if (number? ep) ep 0)))
+ (printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n" ac))
+ (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+ (html-margin body #f #f #f #f "skribe-body")
+ (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+ (display "</tr></table>"))
+ (lm
+ (let* ((ep (engine-custom e 'margin-padding))
+ (ac (if (number? ep) ep 0)))
+ (printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n" ac))
+ (html-margin lm lmfn lms lmbg lmfg "skribe-left-margin")
+ (html-margin body #f #f #f #f "skribe-body")
+ (display "</tr></table>"))
+ (rm
+ (let* ((ep (engine-custom e 'margin-padding))
+ (ac (if (number? ep) ep 0)))
+ (printf "<table cellpadding=\"~a\" cellspacing=\"0\" width=\"100%\" class=\"skribe-margins\"><tr>\n"))
+ (html-margin body #f #f #f #f "skribe-body")
+ (html-margin rm rmfn rms rmbg rmfg "skribe-right-margin")
+ (display "</tr></table>"))
+ (else
+ (display "<div class=\"skribe-body\">\n")
+ (output body e)
+ (display "</div>\n"))))))
+
+;*---------------------------------------------------------------------*/
+;* &html-generic-header ... */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-header n e)
+ (let* ((ic (engine-custom e 'favicon))
+ (id (markup-ident n)))
+ (unless (string? id)
+ (skribe-error '&html-generic-header
+ (format "Illegal identifier `~a'" id)
+ n))
+ ;; title
+ (output (new markup
+ (markup '&html-header-title)
+ (parent n)
+ (ident (string-append id "-title"))
+ (class (markup-class n))
+ (body (markup-body n)))
+ e)
+ ;; favicon
+ (output (new markup
+ (markup '&html-header-favicon)
+ (parent n)
+ (ident (string-append id "-favicon"))
+ (body (cond
+ ((string? ic)
+ ic)
+ ((procedure? ic)
+ (ic d e)))))
+ e)
+ ;; style
+ (output (new markup
+ (markup '&html-header-style)
+ (parent n)
+ (ident (string-append id "-style"))
+ (class (markup-class n)))
+ e)
+ ;; css
+ (output (new markup
+ (markup '&html-header-css)
+ (parent n)
+ (ident (string-append id "-css"))
+ (body (let ((c (engine-custom e 'css)))
+ (if (string? c)
+ (list c)
+ c))))
+ e)
+ ;; javascript
+ (output (new markup
+ (markup '&html-header-javascript)
+ (parent n)
+ (ident (string-append id "-javascript")))
+ e)))
+
+(markup-writer '&html-header-title
+ :before "<title>"
+ :action (lambda (n e)
+ (output (markup-body n) html-title-engine))
+ :after "</title>\n")
+
+(markup-writer '&html-header-favicon
+ :action (lambda (n e)
+ (let ((i (markup-body n)))
+ (when i
+ (printf " <link rel=\"shortcut icon\" href=~s>\n" i)))))
+
+(markup-writer '&html-header-css
+ :action (lambda (n e)
+ (let ((css (markup-body n)))
+ (when (pair? css)
+ (for-each (lambda (css)
+ (printf " <link href=~s rel=\"stylesheet\" type=\"text/css\">\n" css))
+ css)))))
+
+(markup-writer '&html-header-style
+ :before " <style type=\"text/css\">\n <!--\n"
+ :action (lambda (n e)
+ (let ((hd (engine-custom e 'head))
+ (icss (let ((ic (engine-custom e 'inline-css)))
+ (if (string? ic)
+ (list ic)
+ ic))))
+ (display " pre { font-family: monospace }\n")
+ (display " tt { font-family: monospace }\n")
+ (display " code { font-family: monospace }\n")
+ (display " p.flushright { text-align: right }\n")
+ (display " p.flushleft { text-align: left }\n")
+ (display " span.sc { font-variant: small-caps }\n")
+ (display " span.sf { font-family: sans-serif }\n")
+ (display " span.skribetitle { font-family: sans-serif; font-weight: bolder; font-size: x-large; }\n")
+ (when hd (display (format " ~a\n" hd)))
+ (when (pair? icss)
+ (for-each (lambda (css)
+ (let ((p (open-input-file css)))
+ (if (not (input-port? p))
+ (skribe-error
+ 'html-css
+ "Can't open CSS file for input"
+ css)
+ (begin
+ (let loop ((l (read-line p)))
+ (unless (eof-object? l)
+ (display l)
+ (newline)
+ (loop (read-line p))))
+ (close-input-port p)))))
+ icss))))
+ :after " -->\n </style>\n")
+
+(markup-writer '&html-header-javascript
+ :action (lambda (n e)
+ (when (engine-custom e 'javascript)
+ (display " <script language=\"JavaScript\" type=\"text/javascript\">\n")
+ (display " <!--\n")
+ (display " function skribenospam( n, d, f ) {\n")
+ (display " nn=n.replace( / /g , \".\" );\n" )
+ (display " dd=d.replace( / /g , \".\" );\n" )
+ (display " document.write( \"<a href=\\\"mailto:\" + nn + \"@\" + dd + \"\\\">\" );\n")
+ (display " if( f ) {\n")
+ (display " document.write( \"<tt>\" + nn + \"@\" + dd + \"</\" + \"tt><\" + \"/a>\" );\n")
+ (display " }\n")
+ (display " }\n")
+ (display " -->\n")
+ (display " </script>\n"))
+ (let* ((ejs (engine-custom e 'js))
+ (js (cond
+ ((string? ejs)
+ (list ejs))
+ ((list? ejs)
+ ejs)
+ (else
+ '()))))
+ (for-each (lambda (s)
+ (printf "<script type=\"text/javascript\" src=\"~a\"></script>" s))
+ js))))
+
+
+;*---------------------------------------------------------------------*/
+;* &html-header ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-header :action &html-generic-header)
+(markup-writer '&html-chapter-header :action &html-generic-header)
+(markup-writer '&html-section-header :action &html-generic-header)
+(markup-writer '&html-subsection-header :action &html-generic-header)
+(markup-writer '&html-subsubsection-header :action &html-generic-header)
+
+;*---------------------------------------------------------------------*/
+;* &html-ending ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-ending
+ :before "<div class=\"skribe-ending\">"
+ :action (lambda (n e)
+ (let ((body (markup-body n)))
+ (if body
+ (output body #t)
+ (skribe-eval [
+,(hrule)
+,(p :class "ending" (font :size -1 [
+This ,(sc "Html") page has been produced by
+,(ref :url (skribe-url) :text "Skribe").
+,(linebreak)
+Last update ,(it (date)).]))] e))))
+ :after "</div>\n")
+
+;*---------------------------------------------------------------------*/
+;* &html-generic-title ... */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-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)))
+ (when title
+ (display "<table width=\"100%\" class=\"skribetitle\" cellspacing=\"0\" cellpadding=\"0\"><tbody>\n<tr>")
+ (if (html-color-spec? tbg)
+ (printf "<td align=\"center\" bgcolor=\"~a\">" tbg)
+ (display "<td align=\"center\">"))
+ (if (string? tfg)
+ (printf "<font color=\"~a\">" tfg))
+ (when title
+ (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>"))))
+ (if (not authors)
+ (display "\n")
+ (html-title-authors authors e))
+ (if (string? tfg)
+ (display "</font>"))
+ (display "</td></tr></tbody></table>\n"))))
+
+;*---------------------------------------------------------------------*/
+;* &html-document-title ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-document-title :action &html-generic-title)
+(markup-writer '&html-chapter-title :action &html-generic-title)
+(markup-writer '&html-section-title :action &html-generic-title)
+(markup-writer '&html-subsection-title :action &html-generic-title)
+(markup-writer '&html-subsubsection-title :action &html-generic-title)
+
+;*---------------------------------------------------------------------*/
+;* &html-footnotes */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-footnotes
+ :before (lambda (n e)
+ (let ((footnotes (markup-body n)))
+ (when (pair? footnotes)
+ (display "<div class=\"footnote\">")
+ (display "<br><br>\n")
+ (display "<hr width='20%' size='2' align='left'>\n"))))
+ :action (lambda (n e)
+ (let ((footnotes (markup-body n)))
+ (when (pair? footnotes)
+ (let loop ((fns footnotes))
+ (if (pair? fns)
+ (let ((fn (car fns)))
+ (printf "<a name=\"footnote-~a\">"
+ (string-canonicalize
+ (container-ident fn)))
+ (printf "<sup><small>~a</small></sup></a>: "
+ (markup-option fn :number))
+ (output (markup-body fn) e)
+ (display "\n<br>\n")
+ (loop (cdr fns)))))
+ (display "<div>")))))
+
+;*---------------------------------------------------------------------*/
+;* html-title-authors ... */
+;*---------------------------------------------------------------------*/
+(define (html-title-authors authors e)
+ (define (html-authorsN authors cols first)
+ (define (make-row authors . opt)
+ (tr (map (lambda (v)
+ (apply td :align 'center :valign 'top v opt))
+ authors)))
+ (define (make-rows authors)
+ (let loop ((authors authors)
+ (rows '())
+ (row '())
+ (cnum 0))
+ (cond
+ ((null? authors)
+ (reverse! (cons (make-row (reverse! row)) rows)))
+ ((= cnum cols)
+ (loop authors
+ (cons (make-row (reverse! row)) rows)
+ '()
+ 0))
+ (else
+ (loop (cdr authors)
+ rows
+ (cons (car authors) row)
+ (+ cnum 1))))))
+ (output (table :cellpadding 10
+ (if first
+ (cons (make-row (list (car authors)) :colspan cols)
+ (make-rows (cdr authors)))
+ (make-rows authors)))
+ e))
+ (cond
+ ((pair? authors)
+ (display "<center>\n")
+ (let ((len (length authors)))
+ (case len
+ ((1)
+ (output (car authors) e))
+ ((2 3)
+ (html-authorsN authors len #f))
+ ((4)
+ (html-authorsN authors 2 #f))
+ (else
+ (html-authorsN authors 3 #t))))
+ (display "</center>\n"))
+ (else
+ (html-title-authors (list authors) e))))
+
+;*---------------------------------------------------------------------*/
+;* document-sui ... */
+;*---------------------------------------------------------------------*/
+(define (document-sui n e)
+ (define (sui)
+ (display "(sui \"")
+ (skribe-eval (markup-option n :title) html-title-engine)
+ (display "\"\n")
+ (printf " :file ~s\n" (sui-referenced-file n e))
+ (sui-marks n e)
+ (sui-blocks 'chapter n e)
+ (sui-blocks 'section n e)
+ (sui-blocks 'subsection n e)
+ (sui-blocks 'subsubsection n e)
+ (display " )\n"))
+ (if (string? *skribe-dest*)
+ (let ((f (format "~a.sui" (prefix *skribe-dest*))))
+ (with-output-to-file f sui))
+ (sui)))
+
+;*---------------------------------------------------------------------*/
+;* sui-referenced-file ... */
+;*---------------------------------------------------------------------*/
+(define (sui-referenced-file n e)
+ (let ((file (html-file n e)))
+ (if (member (suffix file) '("skb" "sui" "skr" "html"))
+ (string-append (strip-ref-base (prefix file)) ".html")
+ file)))
+
+;*---------------------------------------------------------------------*/
+;* sui-marks ... */
+;*---------------------------------------------------------------------*/
+(define (sui-marks n e)
+ (printf " (marks")
+ (for-each (lambda (m)
+ (printf "\n (~s" (markup-ident m))
+ (printf " :file ~s" (sui-referenced-file m e))
+ (printf " :mark ~s" (markup-ident m))
+ (when (markup-class m)
+ (printf " :class ~s" (markup-class m)))
+ (display ")"))
+ (search-down (lambda (n) (is-markup? n 'mark)) n))
+ (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;* sui-blocks ... */
+;*---------------------------------------------------------------------*/
+(define (sui-blocks kind n e)
+ (printf " (~as" kind)
+ (for-each (lambda (chap)
+ (display "\n (\"")
+ (skribe-eval (markup-option chap :title) html-title-engine)
+ (printf "\" :file ~s" (sui-referenced-file chap e))
+ (printf " :mark ~s" (markup-ident chap))
+ (when (markup-class chap)
+ (printf " :class ~s" (markup-class chap)))
+ (display ")"))
+ (container-search-down (lambda (n) (is-markup? n kind)) n))
+ (display ")\n"))
+
+;*---------------------------------------------------------------------*/
+;* author ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+ :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+ :before (lambda (n e)
+ (display "<table")
+ (html-class n)
+ (display "><tbody>\n"))
+ :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))
+ (nfn (engine-custom e 'author-font))
+ (align (markup-option n :align)))
+ (define (row n)
+ (printf "<tr><td align=\"~a\">" align)
+ (output n e)
+ (display "</td></tr>"))
+ ;; name
+ (printf "<tr><td align=\"~a\">" align)
+ (if nfn
+ (printf "<font ~a>\n" nfn)
+ (display "<font size=\"+2\"><i>\n"))
+ (output name e)
+ (if nfn
+ (printf "</font>\n")
+ (display "</i></font>\n"))
+ (display "</td></tr>")
+ ;; 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))))
+ :after "</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;* author ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+ :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+ :predicate (lambda (n e) (markup-option n :photo))
+ :before (lambda (n e)
+ (display "<table")
+ (html-class n)
+ (display "><tbody>\n<tr>"))
+ :action (lambda (n e)
+ (let ((photo (markup-option n :photo)))
+ (display "<td>")
+ (output photo e)
+ (display "</td><td>")
+ (markup-option-add! n :photo #f)
+ (output n e)
+ (markup-option-add! n :photo photo)
+ (display "</td>")))
+ :after "</tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;* toc ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+ :options 'all
+ :action (lambda (n e)
+ (define (col n)
+ (let loop ((i 0))
+ (if (< i n)
+ (begin
+ (display "<td></td>")
+ (loop (+ i 1))))))
+ (define (toc-entry fe level)
+ (let* ((c (car fe))
+ (ch (cdr fe))
+ (t (markup-option c :title))
+ (id (markup-ident c))
+ (f (html-file c e)))
+ (unless (string? id)
+ (skribe-error 'toc
+ (format "Illegal identifier `~a'" id)
+ c))
+ (display " <tr>")
+ ;; blank columns
+ (col level)
+ ;; number
+ (printf "<td valign=\"top\" align=\"left\">~a</td>"
+ (html-container-number c e))
+ ;; title
+ (printf "<td colspan=\"~a\" width=\"100%\">"
+ (- 4 level))
+ (printf "<a href=\"~a#~a\">"
+ (if (string=? f *skribe-dest*)
+ ""
+ (strip-ref-base (or f *skribe-dest* "")))
+ (string-canonicalize id))
+ (output (markup-option c :title) e)
+ (display "</a></td>")
+ (display "</tr>\n")
+ ;; the children
+ (for-each (lambda (n) (toc-entry n (+ 1 level))) ch)))
+ (define (symbol->keyword s)
+ (cond-expand
+ (stklos
+ (make-keyword s))
+ (bigloo
+ (string->keyword (string-append ":" (symbol->string s))))))
+ (let* ((c (markup-option n :chapter))
+ (s (markup-option n :section))
+ (ss (markup-option n :subsection))
+ (sss (markup-option n :subsubsection))
+ (b (markup-body n))
+ (bb (if (handle? b)
+ (handle-ast b)
+ b)))
+ (if (not (container? bb))
+ (error 'toc
+ "Illegal body (container expected)"
+ (if (markup? bb)
+ (markup-markup bb)
+ "???"))
+ (let ((lst (find-down (lambda (x)
+ (and (markup? x)
+ (markup-option x :toc)
+ (or (and sss (is-markup? x 'subsubsection))
+ (and ss (is-markup? x 'subsection))
+ (and s (is-markup? x 'section))
+ (and c (is-markup? x 'chapter))
+ (markup-option n (symbol->keyword
+ (markup-markup x))))))
+ (container-body bb))))
+ ;; avoid to produce an empty table
+ (unless (null? lst)
+ (display "<table cellspacing=\"1\" cellpadding=\"1\" width=\"100%\"")
+ (html-class n)
+ (display ">\n<tbody>\n")
+
+ (for-each (lambda (n) (toc-entry n 0)) lst)
+
+ (display "</tbody>\n</table>\n")))))))
+
+;*---------------------------------------------------------------------*/
+;* &html-generic-document ... */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-document n title e)
+ (let* ((id (markup-ident n))
+ (header (new markup
+ (markup '&html-chapter-header)
+ (ident (string-append id "-header"))
+ (class (markup-class n))
+ (parent n)
+ (body (html-browser-title n))))
+ (head (new markup
+ (markup '&html-head)
+ (ident (string-append id "-head"))
+ (class (markup-class n))
+ (parent n)
+ (body header)))
+ (ftnote (new markup
+ (markup '&html-footnotes)
+ (ident (string-append id "-footnote"))
+ (class (markup-class n))
+ (parent n)
+ (body (reverse!
+ (container-env-get n 'footnote-env)))))
+ (page (new markup
+ (markup '&html-page)
+ (ident (string-append id "-page"))
+ (class (markup-class n))
+ (parent n)
+ (body (list (markup-body n) ftnote))))
+ (ending (new markup
+ (markup '&html-ending)
+ (ident (string-append id "-ending"))
+ (class (markup-class n))
+ (parent n)
+ (body (or (markup-option n :ending)
+ (let ((p (ast-document n)))
+ (and p (markup-option p :ending)))))))
+ (body (new markup
+ (markup '&html-body)
+ (ident (string-append id "-body"))
+ (class (markup-class n))
+ (parent n)
+ (body (list title page ending))))
+ (html (new markup
+ (markup '&html-html)
+ (ident (string-append id "-html"))
+ (class (markup-class n))
+ (parent n)
+ (body (list head body)))))
+ ;; No file must be opened for documents. These files are
+ ;; directly opened by Skribe
+ (if (document? n)
+ (output html e)
+ (with-output-to-file (html-file n e)
+ (lambda ()
+ (output html e))))))
+
+;*---------------------------------------------------------------------*/
+;* &html-generic-subdocument ... */
+;*---------------------------------------------------------------------*/
+(define (&html-generic-subdocument n e)
+ (let* ((p (ast-document n))
+ (id (markup-ident n))
+ (ti (let* ((nb (html-container-number n e))
+ (tc (markup-option n :title))
+ (ti (if (document? p)
+ (list (markup-option p :title)
+ (engine-custom e 'file-title-separator)
+ tc)
+ tc))
+ (sep (engine-custom
+ e
+ (symbol-append (markup-markup n)
+ '-title-number-separator)))
+ (nti (and tc
+ (if (and nb (not (equal? nb "")))
+ (list nb
+ (if (unspecified? sep) ". " sep)
+ ti)
+ ti))))
+ (new markup
+ (markup (symbol-append '&html- (markup-markup n) '-title))
+ (ident (string-append id "-title"))
+ (parent n)
+ (options '((author ())))
+ (body nti)))))
+ (case (markup-markup n)
+ ((chapter)
+ (skribe-message " [~s chapter: ~a]\n" (engine-ident e) id))
+ ((section)
+ (skribe-message " [~s section: ~a]\n" (engine-ident e) id)))
+ (&html-generic-document n ti e)))
+
+;*---------------------------------------------------------------------*/
+;* chapter ... @label chapter@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+ :options '(:title :number :file :toc :html-title :env)
+ :before (lambda (n e)
+ (let ((title (markup-option n :title))
+ (ident (markup-ident n)))
+ (display "<!-- ")
+ (output title html-title-engine)
+ (display " -->\n")
+ (display "<a name=\"")
+ (display (string-canonicalize ident))
+ (display "\"></a>\n")
+ (display "<center><h1")
+ (html-class n)
+ (display ">")
+ (output (html-container-number n e) e)
+ (display " ")
+ (output (markup-option n :title) e)
+ (display "</h1></center>")))
+ :after "<br>")
+
+;; This writer is invoked only for chapters rendered inside separate files!
+(markup-writer 'chapter
+ :options '(:title :number :file :toc :html-title :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'chapter-file)))
+ :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;* html-section-title ... */
+;*---------------------------------------------------------------------*/
+(define (html-section-title n e)
+ (let* ((title (markup-option n :title))
+ (number (markup-option n :number))
+ (c (markup-class n))
+ (ident (markup-ident n))
+ (kind (markup-markup n))
+ (tbg (engine-custom e (symbol-append kind '-title-background)))
+ (tfg (engine-custom e (symbol-append kind '-title-foreground)))
+ (tstart (engine-custom e (symbol-append kind '-title-start)))
+ (tstop (engine-custom e (symbol-append kind '-title-stop)))
+ (nsep (engine-custom e (symbol-append kind '-title-number-separator))))
+ ;; the section header
+ (display "<!-- ")
+ (output title html-title-engine)
+ (display " -->\n")
+ (display "<a name=\"")
+ (display (string-canonicalize ident))
+ (display "\"></a>\n")
+ (if c
+ (printf "<div class=\"~a-atitle\">" c)
+ (printf "<div class=\"skribe~atitle\">" (markup-markup n)))
+ (when (html-color-spec? tbg)
+ (display "<table width=\"100%\">")
+ (printf "<tr><td bgcolor=\"~a\">" tbg))
+ (display tstart)
+ (if tfg (printf "<font color=\"~a\">" tfg))
+ (if number
+ (begin
+ (output (html-container-number n e) e)
+ (output nsep e)))
+ (output title e)
+ (if tfg (display "</font>\n"))
+ (display tstop)
+ (when (and (string? tbg) (> (string-length tbg) 0))
+ (display "</td></tr></table>\n"))
+ (display "</div>")
+ (display "<div")
+ (html-class n)
+ (display ">"))
+ (newline))
+
+;*---------------------------------------------------------------------*/
+;* section ... @label section@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+ :options '(:title :html-title :number :toc :file :env)
+ :before html-section-title
+ :after "</div><br>\n")
+
+;; on-file section writer
+(markup-writer 'section
+ :options '(:title :html-title :number :toc :file :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'section-file)))
+ :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;* subsection ... @label subsection@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+ :options '(:title :html-title :number :toc :env :file)
+ :before html-section-title
+ :after "</div>\n")
+
+;; on-file subsection writer
+(markup-writer 'section
+ :options '(:title :html-title :number :toc :file :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'subsection-file)))
+ :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;* subsubsection ... @label subsubsection@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+ :options '(:title :html-title :number :toc :env :file)
+ :before html-section-title
+ :after "</div>\n")
+
+;; on-file subsection writer
+(markup-writer 'section
+ :options '(:title :html-title :number :toc :file :env)
+ :predicate (lambda (n e)
+ (or (markup-option n :file)
+ (engine-custom e 'subsubsection-file)))
+ :action &html-generic-subdocument)
+
+;*---------------------------------------------------------------------*/
+;* paragraph ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+ :before (lambda (n e)
+ (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+ (printf "<span style=\"display: block; position: relative; left: -2cm; font-size: x-small; font-style: italic; color: ff8e1e;\">~a</span>"
+ (ast-location n)))
+ ((html-markup-class "p") n e))
+ :after "</p>")
+
+;*---------------------------------------------------------------------*/
+;* footnote ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+ :options '(:number)
+ :action (lambda (n e)
+ (printf "<a href=\"#footnote-~a\"><sup><small>~a</small></sup></a>"
+ (string-canonicalize (container-ident n))
+ (markup-option n :number))))
+
+;*---------------------------------------------------------------------*/
+;* linebreak ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+ :before (lambda (n e)
+ (display "<br")
+ (html-class n)
+ (display "/>")))
+
+;*---------------------------------------------------------------------*/
+;* hrule ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule
+ :options '(:width :height)
+ :before (lambda (n e)
+ (let ((width (markup-option n :width))
+ (height (markup-option n :height)))
+ (display "<hr")
+ (html-class n)
+ (if (< width 100)
+ (printf " width=\"~a\"" (html-width width)))
+ (if (> height 1)
+ (printf " size=\"~a\"" height))
+ (display ">"))))
+
+;*---------------------------------------------------------------------*/
+;* color ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+ :options '(:bg :fg :width :margin)
+ :before (lambda (n e)
+ (let ((m (markup-option n :margin))
+ (w (markup-option n :width))
+ (bg (markup-option n :bg))
+ (fg (markup-option n :fg)))
+ (when (html-color-spec? bg)
+ (display "<table cellspacing=\"0\"")
+ (html-class n)
+ (printf " cellpadding=\"~a\"" (if m m 0))
+ (if w (printf " width=\"~a\"" (html-width w)))
+ (display "><tbody>\n<tr>")
+ (display "<td bgcolor=\"")
+ (output bg e)
+ (display "\">"))
+ (when (html-color-spec? fg)
+ (display "<font color=\"")
+ (output fg e)
+ (display "\">"))))
+ :after (lambda (n e)
+ (when (html-color-spec? (markup-option n :fg))
+ (display "</font>"))
+ (when (html-color-spec? (markup-option n :bg))
+ (display "</td></tr>\n</tbody></table>"))))
+
+;*---------------------------------------------------------------------*/
+;* frame ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+ :options '(:width :margin :border)
+ :before (lambda (n e)
+ (let ((m (markup-option n :margin))
+ (b (markup-option n :border))
+ (w (markup-option n :width)))
+ (display "<table cellspacing=\"0\"")
+ (html-class n)
+ (printf " cellpadding=\"~a\"" (if m m 0))
+ (printf " border=\"~a\"" (if b b 0))
+ (if w (printf " width=\"~a\"" (html-width w)))
+ (display "><tbody>\n<tr><td>")))
+ :after "</td></tr>\n</tbody></table>")
+
+;*---------------------------------------------------------------------*/
+;* font ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+ :options '(:size :face)
+ :before (lambda (n e)
+ (let ((size (markup-option n :size))
+ (face (markup-option n :face)))
+ (when (and (number? size) (inexact? size))
+ (let ((s (if (> size 0) "<big>" "<small>"))
+ (d (if (> size 0) 1 -1)))
+ (do ((i (inexact->exact size) (- i d)))
+ ((= i 0))
+ (display s))))
+ (when (or (and (number? size) (exact? size)) face)
+ (display "<font")
+ (html-class n)
+ (when (and (number? size) (exact? size) (not (= size 0)))
+ (printf " size=\"~a\"" size))
+ (when face (printf " face=\"~a\"" face))
+ (display ">"))))
+ :after (lambda (n e)
+ (let ((size (markup-option n :size))
+ (face (markup-option n :face)))
+ (when (or (and (number? size) (exact? size) (not (= size 0)))
+ face)
+ (display "</font>"))
+ (when (and (number? size) (inexact? size))
+ (let ((s (if (> size 0) "</big>" "</small>"))
+ (d (if (> size 0) 1 -1)))
+ (do ((i (inexact->exact size) (- i d)))
+ ((= i 0))
+ (display s)))))))
+
+;*---------------------------------------------------------------------*/
+;* flush ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+ :options '(:side)
+ :before (lambda (n e)
+ (case (markup-option n :side)
+ ((center)
+ (display "<center")
+ (html-class n)
+ (display ">\n"))
+ ((left)
+ (display "<p style=\"text-align:left;\"")
+ (html-class n)
+ (display ">\n"))
+ ((right)
+ (display "<table ")
+ (html-class n)
+ (display "width=\"100%\" cellpadding=\"0\" cellspacing=\"0\" border=\"0\"><tr><td align=\"right\">"))
+ (else
+ (skribe-error 'flush
+ "Illegal side"
+ (markup-option n :side)))))
+ :after (lambda (n e)
+ (case (markup-option n :side)
+ ((center)
+ (display "</center>\n"))
+ ((right)
+ (display "</td></tr></table>\n"))
+ ((left)
+ (display "</p>\n")))))
+
+;*---------------------------------------------------------------------*/
+;* center ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+ :before (html-markup-class "center")
+ :after "</center>\n")
+
+;*---------------------------------------------------------------------*/
+;* pre ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre :before (html-markup-class "pre") :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;* prog ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+ :options '(:line :mark)
+ :before (html-markup-class "pre")
+ :after "</pre>\n")
+
+;*---------------------------------------------------------------------*/
+;* itemize ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+ :options '(:symbol)
+ :before (html-markup-class "ul")
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (display "<li")
+ (html-class item)
+ (display ">")
+ (output item e)
+ (display "</li>\n"))
+ (markup-body n)))
+ :after "</ul>")
+
+;*---------------------------------------------------------------------*/
+;* enumerate ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+ :options '(:symbol)
+ :before (html-markup-class "ol")
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (display "<li")
+ (html-class item)
+ (display ">")
+ (output item e)
+ (display "</li>\n"))
+ (markup-body n)))
+ :after "</ol>")
+
+;*---------------------------------------------------------------------*/
+;* description ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+ :options '(:symbol)
+ :before (html-markup-class "dl")
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (let ((k (markup-option item :key)))
+ (for-each (lambda (i)
+ (display " <dt")
+ (html-class i)
+ (display ">")
+ (output i e)
+ (display "</dt>"))
+ (if (pair? k) k (list k)))
+ (display "<dd")
+ (html-class item)
+ (display ">")
+ (output (markup-body item) e)
+ (display "</dd>\n")))
+ (markup-body n)))
+ :after "</dl>")
+
+;*---------------------------------------------------------------------*/
+;* item ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+ :options '(:key)
+ :action (lambda (n e)
+ (let ((k (markup-option n :key)))
+ (if k
+ (begin
+ (display "<b")
+ (html-class n)
+ (display ">")
+ (output k e)
+ (display "</b> "))))
+ (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;* blockquote ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+ :options '()
+ :before (lambda (n e)
+ (display "<blockquote ")
+ (html-class n)
+ (display ">\n"))
+ :after "\n</blockquote>\n")
+
+;*---------------------------------------------------------------------*/
+;* figure ... @label figure@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+ :options '(:legend :number :multicolumns :legend-width)
+ :before (html-markup-class "br")
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (display "<a name=\"")
+ (display (string-canonicalize ident))
+ (display "\"></a>\n")
+ (output (markup-body n) e)
+ (display "<br>\n")
+ (output (new markup
+ (markup '&html-figure-legend)
+ (parent n)
+ (ident (string-append ident "-legend"))
+ (class (markup-class n))
+ (options `((:number ,number)))
+ (body legend))
+ e)))
+ :after "<br>")
+
+;*---------------------------------------------------------------------*/
+;* &html-figure-legend ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-legend
+ :options '(:number)
+ :before (lambda (n e)
+ (display "<center>")
+ (let ((number (markup-option n :number))
+ (legend (markup-option n :legend)))
+ (if number
+ (printf "<strong>Fig. ~a:</strong> " number)
+ (printf "<strong>Fig. :</strong> "))))
+ :after "</center>")
+
+;*---------------------------------------------------------------------*/
+;* table ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+ :options '(:border :width :frame :rules :cellstyle :cellpadding :cellspacing)
+ :before (lambda (n e)
+ (let ((width (markup-option n :width))
+ (border (markup-option n :border))
+ (frame (markup-option n :frame))
+ (rules (markup-option n :rules))
+ (cstyle (markup-option n :cellstyle))
+ (cp (markup-option n :cellpadding))
+ (cs (markup-option n :cellspacing)))
+ (display "<table")
+ (html-class n)
+ (if width (printf " width=\"~a\"" (html-width width)))
+ (if border (printf " border=\"~a\"" border))
+ (if (and (number? cp) (>= cp 0))
+ (printf " cellpadding=\"~a\"" cp))
+ (if (and (number? cs) (>= cs 0))
+ (printf " cellspacing=\"~a\"" cs))
+ (cond
+ ((symbol? cstyle)
+ (printf " style=\"border-collapse: ~a;\"" cstyle))
+ ((string? cstyle)
+ (printf " style=\"border-collapse: separate; border-spacing=~a\"" cstyle))
+ ((number? cstyle)
+ (printf " style=\"border-collapse: separate; border-spacing=~apt\"" cstyle)))
+ (if frame
+ (printf " frame=\"~a\""
+ (if (eq? frame 'none) "void" frame)))
+ (if (and rules (not (eq? rules 'header)))
+ (printf " rules=\"~a\"" rules))
+ (display "><tbody>\n")))
+ :after "</tbody></table>\n")
+
+;*---------------------------------------------------------------------*/
+;* tr ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+ :options '(:bg)
+ :before (lambda (n e)
+ (let ((bg (markup-option n :bg)))
+ (display "<tr")
+ (html-class n)
+ (when (html-color-spec? bg) (printf " bgcolor=\"~a\"" bg))
+ (display ">")))
+ :after "</tr>\n")
+
+;*---------------------------------------------------------------------*/
+;* tc ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+ :options '(markup :width :align :valign :colspan :rowspan :bg)
+ :before (lambda (n e)
+ (let ((markup (or (markup-option n 'markup) 'td))
+ (width (markup-option n :width))
+ (align (markup-option n :align))
+ (valign (let ((v (markup-option n :valign)))
+ (cond
+ ((or (eq? v 'center)
+ (equal? v "center"))
+ "middle")
+ (else
+ v))))
+ (colspan (markup-option n :colspan))
+ (rowspan (markup-option n :rowspan))
+ (bg (markup-option n :bg)))
+ (printf "<~a" markup)
+ (html-class n)
+ (if width (printf " width=\"~a\"" (html-width width)))
+ (if align (printf " align=\"~a\"" align))
+ (if valign (printf " valign=\"~a\"" valign))
+ (if colspan (printf " colspan=\"~a\"" colspan))
+ (if rowspan (printf " rowspan=\"~a\"" rowspan))
+ (when (html-color-spec? bg)
+ (printf " bgcolor=\"~a\"" bg))
+ (display ">")))
+ :after (lambda (n e)
+ (let ((markup (or (markup-option n 'markup) 'td)))
+ (printf "</~a>" markup))))
+
+;*---------------------------------------------------------------------*/
+;* image ... @label image@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+ :options '(:file :url :width :height)
+ :action (lambda (n e)
+ (let* ((file (markup-option n :file))
+ (url (markup-option n :url))
+ (width (markup-option n :width))
+ (height (markup-option n :height))
+ (body (markup-body n))
+ (efmt (engine-custom e 'image-format))
+ (img (or url (convert-image file
+ (if (list? efmt)
+ efmt
+ '("gif" "jpg" "png"))))))
+ (if (not (string? img))
+ (skribe-error 'html "Illegal image" file)
+ (begin
+ (printf "<img src=\"~a\" border=\"0\"" img)
+ (html-class n)
+ (if body
+ (begin
+ (display " alt=\"")
+ (output body e)
+ (display "\""))
+ (printf " alt=\"~a\"" file))
+ (if width (printf " width=\"~a\"" (html-width width)))
+ (if height (printf " height=\"~a\"" height))
+ (display ">"))))))
+
+;*---------------------------------------------------------------------*/
+;* Ornaments ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "")
+(markup-writer 'bold :before (html-markup-class "strong") :after "</strong>")
+(markup-writer 'underline :before (html-markup-class "u") :after "</u>")
+(markup-writer 'strike :before (html-markup-class "strike") :after "</strike>")
+(markup-writer 'emph :before (html-markup-class "em") :after "</em>")
+(markup-writer 'kbd :before (html-markup-class "kbd") :after "</kbd>")
+(markup-writer 'it :before (html-markup-class "em") :after "</em>")
+(markup-writer 'tt :before (html-markup-class "tt") :after "</tt>")
+(markup-writer 'code :before (html-markup-class "code") :after "</code>")
+(markup-writer 'var :before (html-markup-class "var") :after "</var>")
+(markup-writer 'samp :before (html-markup-class "samp") :after "</samp>")
+(markup-writer 'sc :before "<span class=\"sc\">" :after "</span>")
+(markup-writer 'sf :before "<span class=\"sf\">" :after "</span>")
+(markup-writer 'sub :before (html-markup-class "sub") :after "</sub>")
+(markup-writer 'sup :before (html-markup-class "sup") :after "</sup>")
+
+;*---------------------------------------------------------------------*/
+;* q ... @label q@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+ :before "\""
+ :after "\"")
+
+;*---------------------------------------------------------------------*/
+;* mailto ... @label mailto@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+ :options '(:text)
+ :action (lambda (n e)
+ (let ((text (markup-option n :text)))
+ (display "<a href=\"mailto:")
+ (output (markup-body n) e)
+ (display #\")
+ (html-class n)
+ (display #\>)
+ (if text
+ (output text e)
+ (skribe-eval (tt (markup-body n)) e))
+ (display "</a>"))))
+
+;*---------------------------------------------------------------------*/
+;* mailto ... @label mailto@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+ :options '(:text)
+ :predicate (lambda (n e)
+ (and (engine-custom e 'javascript)
+ (or (string? (markup-body n))
+ (and (pair? (markup-body n))
+ (null? (cdr (markup-body n)))
+ (string? (car (markup-body n)))))))
+ :action (lambda (n e)
+ (let* ((body (markup-body n))
+ (email (if (string? body) body (car body)))
+ (split (pregexp-split "@" email))
+ (na (car split))
+ (do (if (pair? (cdr split)) (cadr split) ""))
+ (nn (pregexp-replace* "[.]" na " "))
+ (dd (pregexp-replace* "[.]" do " "))
+ (text (markup-option n :text)))
+ (display "<script language=\"JavaScript\" type=\"text/javascript\"")
+ (if (not text)
+ (printf ">skribenospam( ~s, ~s, true )" nn dd)
+ (begin
+ (printf ">skribenospam( ~s, ~s, false )" nn dd)
+ (display "</script>")
+ (output text e)
+ (display "<script language=\"JavaScript\" type=\"text/javascript\">document.write(\"</\" + \"a>\")")))
+ (display "</script>\n"))))
+
+;*---------------------------------------------------------------------*/
+;* mark ... @label mark@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+ :before (lambda (n e)
+ (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+ (html-class n)
+ (display ">"))
+ :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;* ref ... @label ref@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+ :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle)
+ :before (lambda (n e)
+ (let* ((c (handle-ast (markup-body n)))
+ (id (markup-ident c))
+ (f (html-file c e))
+ (class (if (markup-class n)
+ (markup-class n)
+ "inbound")))
+ (printf "<a href=\"~a#~a\" class=\"~a\""
+ (if (string=? f *skribe-dest*)
+ ""
+ (strip-ref-base (or f *skribe-dest* "")))
+ (string-canonicalize id)
+ class)
+ (display ">")))
+ :action (lambda (n e)
+ (let ((t (markup-option n :text))
+ (m (markup-option n 'mark))
+ (f (markup-option n :figure))
+ (c (markup-option n :chapter))
+ (s (markup-option n :section))
+ (ss (markup-option n :subsection))
+ (sss (markup-option n :subsubsection)))
+ (cond
+ (t
+ (output t e))
+ (f
+ (output (new markup
+ (markup '&html-figure-ref)
+ (body (markup-body n)))
+ e))
+ ((or c s ss sss)
+ (output (new markup
+ (markup '&html-section-ref)
+ (body (markup-body n)))
+ e))
+
+ ((not m)
+ (output (new markup
+ (markup '&html-unmark-ref)
+ (body (markup-body n)))
+ e))
+ (else
+ (display m)))))
+ :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;* &html-figure-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-figure-ref
+ :action (lambda (n e)
+ (let ((c (handle-ast (markup-body n))))
+ (if (or (not (markup? c))
+ (not (is-markup? c 'figure)))
+ (display "???")
+ (output (markup-option c :number) e)))))
+
+;*---------------------------------------------------------------------*/
+;* &html-section-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-section-ref
+ :action (lambda (n e)
+ (let ((c (handle-ast (markup-body n))))
+ (if (not (markup? c))
+ (display "???")
+ (output (markup-option c :title) e)))))
+
+;*---------------------------------------------------------------------*/
+;* &html-unmark-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-unmark-ref
+ :action (lambda (n e)
+ (let ((c (handle-ast (markup-body n))))
+ (if (not (markup? c))
+ (display "???")
+ (let ((t (markup-option c :title)))
+ (if t
+ (output t e)
+ (let ((l (markup-option c :legend)))
+ (if l
+ (output t e)
+ (display
+ (string-canonicalize
+ (markup-ident c)))))))))))
+
+;*---------------------------------------------------------------------*/
+;* bib-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+ :options '(:text :bib)
+ :before "["
+ :action (lambda (n e) (output n e (markup-writer-get 'ref e)))
+ :after "]")
+
+;*---------------------------------------------------------------------*/
+;* bib-ref+ ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+ :options '(:text :bib)
+ :before "["
+ :action (lambda (n e)
+ (let loop ((rs (markup-body n)))
+ (cond
+ ((null? rs)
+ #f)
+ (else
+ (if (is-markup? (car rs) 'bib-ref)
+ (output (car rs) e (markup-writer-get 'ref e))
+ (output (car rs) e))
+ (if (pair? (cdr rs))
+ (begin
+ (display ",")
+ (loop (cdr rs))))))))
+ :after "]")
+
+;*---------------------------------------------------------------------*/
+;* url-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+ :options '(:url :text)
+ :before (lambda (n e)
+ (let* ((url (markup-option n :url))
+ (class (cond
+ ((markup-class n)
+ (markup-class n))
+ ((not (string? url))
+ #f)
+ (else
+ (let ((l (string-length url)))
+ (let loop ((i 0))
+ (cond
+ ((= i l)
+ #f)
+ ((char=? (string-ref url i) #\:)
+ (substring url 0 i))
+ (else
+ (loop (+ i 1))))))))))
+ (display "<a href=\"")
+ (output url html-title-engine)
+ (display "\"")
+ (when class (printf " class=\"~a\"" class))
+ (display ">")))
+ :action (lambda (n e)
+ (let ((v (markup-option n :text)))
+ (output (or v (markup-option n :url)) e)))
+ :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;* line-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+ :options '(:offset)
+ :before (html-markup-class "i")
+ :action (lambda (n e)
+ (let ((o (markup-option n :offset))
+ (v (string->number (markup-option n :text))))
+ (if (and (number? o) (number? v))
+ (markup-option-add! n :text (+ o v)))
+ (output n e (markup-writer-get 'ref e))
+ (if (and (number? o) (number? v))
+ (markup-option-add! n :text v))))
+ :after "</i>")
+
+;*---------------------------------------------------------------------*/
+;* page-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'page-ref
+ :options '(:mark :handle)
+ :action (lambda (n e)
+ (error 'page-ref:html "Not implemented yet" n)))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-label ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+ :options '(:title)
+ :before (lambda (n e)
+ (printf "<a name=\"~a\"" (string-canonicalize (markup-ident n)))
+ (html-class n)
+ (display ">"))
+ :action (lambda (n e)
+ (output n e (markup-writer-get '&bib-entry-label base-engine)))
+ :after "</a>")
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-title ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+ :action (lambda (n e)
+ (let* ((t (bold (markup-body n)))
+ (en (handle-ast (ast-parent n)))
+ (url (or (markup-option en 'url)
+ (markup-option en 'documenturl)))
+ (ht (if url (ref :url (markup-body url) :text t) t)))
+ (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-url ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+ :action (lambda (n e)
+ (let* ((en (handle-ast (ast-parent n)))
+ (url (markup-option en 'url))
+ (t (bold (markup-body url))))
+ (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+;*---------------------------------------------------------------------*/
+;* &the-index-header ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-index-header
+ :action (lambda (n e)
+ (display "<center")
+ (html-class n)
+ (display ">")
+ (for-each (lambda (h)
+ (let ((f (engine-custom e 'index-header-font-size)))
+ (if f
+ (skribe-eval (font :size f (bold (it h))) e)
+ (output h e))
+ (display " ")))
+ (markup-body n))
+ (display "</center>")
+ (skribe-eval (linebreak 2) e)))
+
+;*---------------------------------------------------------------------*/
+;* &source-comment ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (it (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-line-comment ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-line-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-keyword ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-keyword
+ :action (lambda (n e)
+ (skribe-eval (bold (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;* &source-error ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-error
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-error-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-define ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-define
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-define-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-module ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-module
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-module-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-markup ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-markup
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-markup-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-thread ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-thread
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-thread-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-string ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-string
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-string-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-bracket ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-bracket-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (bold n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-type ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-key ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-key
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-type ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg "red" (bold n1))
+ (bold n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* Restore the base engine */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/skribe/skr/html4.skr b/skribe/skr/html4.skr
new file mode 100644
index 0000000..acb7068
--- /dev/null
+++ b/skribe/skr/html4.skr
@@ -0,0 +1,165 @@
+;;;;
+;;;; html4.skr -- HTML 4.01 Engine
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 18-Feb-2004 11:58 (eg)
+;;;; Last file update: 26-Feb-2004 21:09 (eg)
+;;;;
+
+(define (find-children node)
+ (define (flat l)
+ (cond
+ ((null? l) l)
+ ((pair? l) (append (flat (car l))
+ (flat (cdr l))))
+ (else (list l))))
+
+ (if (markup? node)
+ (flat (markup-body node))
+ node))
+
+;;; ======================================================================
+
+(let ((le (find-engine 'html)))
+ ;;----------------------------------------------------------------------
+ ;; Customizations
+ ;;----------------------------------------------------------------------
+ (engine-custom-set! le 'html-variant "html4")
+ (engine-custom-set! le 'html4-logo "http://www.w3.org/Icons/valid-html401")
+ (engine-custom-set! le 'html4-validator "http://validator.w3.org/check/referer")
+
+ ;;----------------------------------------------------------------------
+ ;; &html-html ...
+ ;;----------------------------------------------------------------------
+ (markup-writer '&html-html le
+ :before "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
+<html>\n"
+ :after "</html>")
+
+ ;;----------------------------------------------------------------------
+ ;; &html-ending
+ ;;----------------------------------------------------------------------
+ (let* ((img (engine-custom le 'html4-logo))
+ (url (engine-custom le 'html4-validator))
+ (bottom (list (hrule)
+ (table :width 100.
+ (tr
+ (td :align 'left
+ (font :size -1 [
+ This ,(sc "Html") page has been produced by
+ ,(ref :url (skribe-url) :text "Skribe").
+ ,(linebreak)
+ Last update ,(it (date)).]))
+ (td :align 'right :valign 'top
+ (ref :url url
+ :text (image :url img :width 88 :height 31))))))))
+ (markup-writer '&html-ending le
+ :before "<div class=\"skribe-ending\">"
+ :action (lambda (n e)
+ (let ((body (markup-body n)))
+ (if body
+ (output body #t)
+ (skribe-eval bottom e))))
+ :after "</div>\n"))
+
+ ;;----------------------------------------------------------------------
+ ;; color ...
+ ;;----------------------------------------------------------------------
+ (markup-writer 'color le
+ :options '(:bg :fg :width :margin)
+ :before (lambda (n e)
+ (let ((m (markup-option n :margin))
+ (w (markup-option n :width))
+ (bg (markup-option n :bg))
+ (fg (markup-option n :fg)))
+ (when bg
+ (display "<table cellspacing=\"0\"")
+ (html-class n)
+ (printf " cellpadding=\"~a\"" (if m m 0))
+ (if w (printf " width=\"~a\"" (html-width w)))
+ (display "><tbody>\n<tr>")
+ (display "<td bgcolor=\"")
+ (output bg e)
+ (display "\">"))
+ (when fg
+ (display "<span style=\"color:")
+ (output fg e)
+ (display ";\">"))))
+ :after (lambda (n e)
+ (when (markup-option n :fg)
+ (display "</span>"))
+ (when (markup-option n :bg)
+ (display "</td></tr>\n</tbody></table>"))))
+
+ ;;----------------------------------------------------------------------
+ ;; font ...
+ ;;----------------------------------------------------------------------
+ (markup-writer 'font le
+ :options '(:size :face)
+ :before (lambda (n e)
+ (let ((face (markup-option n :face))
+ (size (let ((sz (markup-option n :size)))
+ (cond
+ ((or (unspecified? sz) (not sz))
+ #f)
+ ((and (number? sz) (or (inexact? sz) (negative? sz)))
+ (format "~a%"
+ (+ 100
+ (* 20 (inexact->exact (truncate sz))))))
+ ((number? sz)
+ sz)
+ (else
+ (skribe-error 'font
+ (format "Illegal font size ~s" sz)
+ n))))))
+ (display "<span ")
+ (html-class n)
+ (display "style=\"")
+ (if size (printf "font-size: ~a; " size))
+ (if face (printf "font-family:'~a'; " face))
+ (display "\">")))
+ :after "</span>")
+
+ ;;----------------------------------------------------------------------
+ ;; paragraph ...
+ ;;----------------------------------------------------------------------
+ (copy-markup-writer 'paragraph le
+ :validate (lambda (n e)
+ (let ((pred (lambda (x)
+ (and (container? x)
+ (not (memq (markup-markup x) '(font color)))))))
+ (not (any pred (find-children n))))))
+
+ ;;----------------------------------------------------------------------
+ ;; roman ...
+ ;;----------------------------------------------------------------------
+ (markup-writer 'roman le
+ :before "<span style=\"font-family: serif\">"
+ :after "</span>")
+
+ ;;----------------------------------------------------------------------
+ ;; table ...
+ ;;----------------------------------------------------------------------
+ (let ((old-writer (markup-writer-get 'table le)))
+ (copy-markup-writer 'table le
+ :validate (lambda (n e)
+ (not (null? (markup-body n))))))
+)
diff --git a/skribe/skr/jfp.skr b/skribe/skr/jfp.skr
new file mode 100644
index 0000000..60b40f2
--- /dev/null
+++ b/skribe/skr/jfp.skr
@@ -0,0 +1,317 @@
+;*=====================================================================*/
+;* 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/skribe/skr/latex-simple.skr b/skribe/skr/latex-simple.skr
new file mode 100644
index 0000000..dd2eccb
--- /dev/null
+++ b/skribe/skr/latex-simple.skr
@@ -0,0 +1,101 @@
+;;;
+;;; LES CUSTOMS SONT TROP SPECIFIQUES POUR LA DISTRIBS. NE DOIT PAS VIRER
+;;; CE FICHIER (sion simplifie il ne rest plus grand chose)
+;;; Erick 27-10-04
+;;;
+
+
+;*=====================================================================*/
+;* scmws04/src/latex-style.skr */
+;* ------------------------------------------------------------- */
+;* Author : Damien Ciabrini */
+;* Creation : Tue Aug 24 19:17:04 2004 */
+;* Last change : Thu Oct 28 21:45:25 2004 (eg) */
+;* Copyright : 2004 Damien Ciabrini, see LICENCE file */
+;* ------------------------------------------------------------- */
+;* Custom style for Latex... */
+;*=====================================================================*/
+
+(let* ((le (find-engine 'latex))
+ (oa (markup-writer-get 'author le)))
+ ; latex class & package for the workshop
+ (engine-custom-set! le 'documentclass "\\documentclass[letterpaper]{sigplan-proc}")
+ (engine-custom-set! le 'usepackage
+ "\\usepackage{epsfig}
+\\usepackage{workshop}
+\\conferenceinfo{Fifth Workshop on Scheme and Functional Programming.}
+ {September 22, 2004, Snowbird, Utah, USA.}
+\\CopyrightYear{2004}
+\\CopyrightHolder{Damien Ciabrini}
+\\renewcommand{\\ttdefault}{cmtt}
+")
+ (engine-custom-set! le 'image-format '("eps"))
+ (engine-custom-set! le 'source-define-color "#000080")
+ (engine-custom-set! le 'source-thread-color "#8080f0")
+ (engine-custom-set! le 'source-string-color "#000000")
+
+ ; hyperref options
+ (engine-custom-set! le 'hyperref #t)
+ (engine-custom-set! le 'hyperref-usepackage
+ "\\usepackage[bookmarksopen=true, bookmarksopenlevel=2,bookmarksnumbered=true,colorlinks,linkcolor=blue,citecolor=blue,pdftitle={Debugging Scheme Fair Threads}, pdfsubject={debugging cooperative threads based on reactive programming}, pdfkeywords={debugger, functional, reactive programming, Scheme}, pdfauthor={Damien Ciabrini}]{hyperref}")
+ ; nbsp with ~ char
+ (set! latex-encoding (delete! (assoc #\~ latex-encoding) latex-encoding))
+
+ ; let latex process citations
+ (markup-writer 'bib-ref le
+ :options '(:text :bib)
+ :before "\\cite{"
+ :action (lambda (n e) (display (markup-option n :bib)))
+ :after "}")
+ (markup-writer 'bib-ref+ le
+ :options '(:text :bib)
+ :before "\\cite{"
+ :action (lambda (n e)
+ (let loop ((bibs (markup-option n :bib)))
+ (if (pair? bibs)
+ (begin
+ (display (car bibs))
+ (if (pair? (cdr bibs)) (display ", "))
+ (loop (cdr bibs))))))
+ :after "}")
+ (markup-writer '&the-bibliography le
+ :action (lambda (n e)
+ (print "\\bibliographystyle{abbrv}")
+ (display "\\bibliography{biblio}")))
+
+ ; ACM-style for authors
+ (markup-writer '&latex-author le
+ :before (lambda (n e)
+ (let ((body (markup-body n)))
+ (if (pair? body)
+ (print "\\numberofauthors{" (length body) "}"))
+ (print "\\author{")))
+ :after "}\n")
+ (markup-writer 'author le
+ :options (writer-options oa)
+ :before ""
+ :action (lambda (n e)
+ (let ((name (markup-option n :name))
+ (affiliation (markup-option n :affiliation))
+ (address (markup-option n :address))
+ (email (markup-option n :email)))
+ (define (row pre n post)
+ (display pre)
+ (output n e)
+ (display post)
+ (display "\\\\\n"))
+ ;; name
+ (if name (row "\\alignauthor " name ""))
+ ;; affiliation
+ (if affiliation (row "\\affaddr{" affiliation "}"))
+ ;; address
+ (if (pair? address)
+ (for-each (lambda (x)
+ (row "\\affaddr{" x "}")) address))
+ ;; email
+ (if email (row "\\email{" email "}"))))
+ :after "")
+)
+
+(define (include-biblio)
+ (the-bibliography))
diff --git a/skribe/skr/latex.skr b/skribe/skr/latex.skr
new file mode 100644
index 0000000..bc20493
--- /dev/null
+++ b/skribe/skr/latex.skr
@@ -0,0 +1,1780 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/skr/latex.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 2 09:46:09 2003 */
+;* Last change : Thu May 26 12:59:47 2005 (serrano) */
+;* Copyright : 2003-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* LaTeX Skribe engine */
+;* ------------------------------------------------------------- */
+;* Implementation: */
+;* common: @path ../src/common/api.src@ */
+;* bigloo: @path ../src/bigloo/api.bgl@ */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/latexe.skb:ref@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* latex-verbatim-encoding ... */
+;*---------------------------------------------------------------------*/
+(define latex-verbatim-encoding
+ '((#\\ "{\\char92}")
+ (#\^ "{\\char94}")
+ (#\{ "\\{")
+ (#\} "\\}")
+ (#\& "\\&")
+ (#\$ "\\$")
+ (#\# "\\#")
+ (#\_ "\\_")
+ (#\% "\\%")
+ (#\~ "$_{\\mbox{\\char126}}$")
+ (#\� "\\c{c}")
+ (#\� "\\c{C}")
+ (#\� "\\^{a}")
+ (#\� "\\^{A}")
+ (#\� "\\`{a}")
+ (#\� "\\`{A}")
+ (#\� "\\'{e}")
+ (#\� "\\'{E}")
+ (#\� "\\`{e}")
+ (#\� "\\`{E}")
+ (#\� "\\^{e}")
+ (#\� "\\^{E}")
+ (#\� "\\`{u}")
+ (#\� "\\`{U}")
+ (#\� "\\^{u}")
+ (#\� "\\^{U}")
+ (#\� "{\\o}")
+ (#\� "\\^{o}")
+ (#\� "\\^{O}")
+ (#\� "\\\"{o}")
+ (#\� "\\\"{O}")
+ (#\� "\\^{\\i}")
+ (#\� "\\^{I}")
+ (#\� "\\\"{\\i}")
+ (#\� "\\\"{I}")
+ (#\] "{\\char93}")
+ (#\[ "{\\char91}")
+ (#\� "\\,{\\tiny{$^{\\gg}$}}")
+ (#\� "{\\tiny{$^{\\ll}$}}\\,")))
+
+;*---------------------------------------------------------------------*/
+;* latex-encoding ... */
+;*---------------------------------------------------------------------*/
+(define latex-encoding
+ (append '((#\| "$|$")
+ (#\< "$<$")
+ (#\> "$>$")
+ (#\: "{\\char58}")
+ (#\# "{\\char35}")
+ (#\Newline " %\n"))
+ latex-verbatim-encoding))
+
+;*---------------------------------------------------------------------*/
+;* latex-tt-encoding ... */
+;*---------------------------------------------------------------------*/
+(define latex-tt-encoding
+ (append '((#\. ".\\-")
+ (#\/ "/\\-"))
+ latex-encoding))
+
+;*---------------------------------------------------------------------*/
+;* latex-pre-encoding ... */
+;*---------------------------------------------------------------------*/
+(define latex-pre-encoding
+ (append '((#\Space "\\ ")
+ (#\Newline "\\\\\n"))
+ latex-encoding))
+
+;*---------------------------------------------------------------------*/
+;* latex-symbol-table ... */
+;*---------------------------------------------------------------------*/
+(define (latex-symbol-table math)
+ `(("iexcl" "!`")
+ ("cent" "c")
+ ("pound" "\\pounds")
+ ("yen" "Y")
+ ("section" "\\S")
+ ("mul" ,(math "^-"))
+ ("copyright" "\\copyright")
+ ("lguillemet" ,(math "\\ll"))
+ ("not" ,(math "\\neg"))
+ ("degree" ,(math "^{\\small{o}}"))
+ ("plusminus" ,(math "\\pm"))
+ ("micro" ,(math "\\mu"))
+ ("paragraph" "\\P")
+ ("middot" ,(math "\\cdot"))
+ ("rguillemet" ,(math "\\gg"))
+ ("1/4" ,(math "\\frac{1}{4}"))
+ ("1/2" ,(math "\\frac{1}{2}"))
+ ("3/4" ,(math "\\frac{3}{4}"))
+ ("iquestion" "?`")
+ ("Agrave" "\\`{A}")
+ ("Aacute" "\\'{A}")
+ ("Acircumflex" "\\^{A}")
+ ("Atilde" "\\~{A}")
+ ("Amul" "\\\"{A}")
+ ("Aring" "{\\AA}")
+ ("AEligature" "{\\AE}")
+ ("Oeligature" "{\\OE}")
+ ("Ccedilla" "{\\c{C}}")
+ ("Egrave" "{\\`{E}}")
+ ("Eacute" "{\\'{E}}")
+ ("Ecircumflex" "{\\^{E}}")
+ ("Euml" "\\\"{E}")
+ ("Igrave" "{\\`{I}}")
+ ("Iacute" "{\\'{I}}")
+ ("Icircumflex" "{\\^{I}}")
+ ("Iuml" "\\\"{I}")
+ ("ETH" "D")
+ ("Ntilde" "\\~{N}")
+ ("Ograve" "\\`{O}")
+ ("Oacute" "\\'{O}")
+ ("Ocurcumflex" "\\^{O}")
+ ("Otilde" "\\~{O}")
+ ("Ouml" "\\\"{O}")
+ ("times" ,(math "\\times"))
+ ("Oslash" "\\O")
+ ("Ugrave" "\\`{U}")
+ ("Uacute" "\\'{U}")
+ ("Ucircumflex" "\\^{U}")
+ ("Uuml" "\\\"{U}")
+ ("Yacute" "\\'{Y}")
+ ("szlig" "\\ss")
+ ("agrave" "\\`{a}")
+ ("aacute" "\\'{a}")
+ ("acircumflex" "\\^{a}")
+ ("atilde" "\\~{a}")
+ ("amul" "\\\"{a}")
+ ("aring" "\\aa")
+ ("aeligature" "\\ae")
+ ("oeligature" "{\\oe}")
+ ("ccedilla" "{\\c{c}}")
+ ("egrave" "{\\`{e}}")
+ ("eacute" "{\\'{e}}")
+ ("ecircumflex" "{\\^{e}}")
+ ("euml" "\\\"{e}")
+ ("igrave" "{\\`{\\i}}")
+ ("iacute" "{\\'{\\i}}")
+ ("icircumflex" "{\\^{\\i}}")
+ ("iuml" "\\\"{\\i}")
+ ("ntilde" "\\~{n}")
+ ("ograve" "\\`{o}")
+ ("oacute" "\\'{o}")
+ ("ocurcumflex" "\\^{o}")
+ ("otilde" "\\~{o}")
+ ("ouml" "\\\"{o}")
+ ("divide" ,(math "\\div"))
+ ("oslash" "\\o")
+ ("ugrave" "\\`{u}")
+ ("uacute" "\\'{u}")
+ ("ucircumflex" "\\^{u}")
+ ("uuml" "\\\"{u}")
+ ("yacute" "\\'{y}")
+ ("ymul" "\\\"{y}")
+ ;; Greek
+ ("Alpha" "A")
+ ("Beta" "B")
+ ("Gamma" ,(math "\\Gamma"))
+ ("Delta" ,(math "\\Delta"))
+ ("Epsilon" "E")
+ ("Zeta" "Z")
+ ("Eta" "H")
+ ("Theta" ,(math "\\Theta"))
+ ("Iota" "I")
+ ("Kappa" "K")
+ ("Lambda" ,(math "\\Lambda"))
+ ("Mu" "M")
+ ("Nu" "N")
+ ("Xi" ,(math "\\Xi"))
+ ("Omicron" "O")
+ ("Pi" ,(math "\\Pi"))
+ ("Rho" "P")
+ ("Sigma" ,(math "\\Sigma"))
+ ("Tau" "T")
+ ("Upsilon" ,(math "\\Upsilon"))
+ ("Phi" ,(math "\\Phi"))
+ ("Chi" "X")
+ ("Psi" ,(math "\\Psi"))
+ ("Omega" ,(math "\\Omega"))
+ ("alpha" ,(math "\\alpha"))
+ ("beta" ,(math "\\beta"))
+ ("gamma" ,(math "\\gamma"))
+ ("delta" ,(math "\\delta"))
+ ("epsilon" ,(math "\\varepsilon"))
+ ("zeta" ,(math "\\zeta"))
+ ("eta" ,(math "\\eta"))
+ ("theta" ,(math "\\theta"))
+ ("iota" ,(math "\\iota"))
+ ("kappa" ,(math "\\kappa"))
+ ("lambda" ,(math "\\lambda"))
+ ("mu" ,(math "\\mu"))
+ ("nu" ,(math "\\nu"))
+ ("xi" ,(math "\\xi"))
+ ("omicron" ,(math "\\o"))
+ ("pi" ,(math "\\pi"))
+ ("rho" ,(math "\\rho"))
+ ("sigmaf" ,(math "\\varsigma"))
+ ("sigma" ,(math "\\sigma"))
+ ("tau" ,(math "\\tau"))
+ ("upsilon" ,(math "\\upsilon"))
+ ("phi" ,(math "\\varphi"))
+ ("chi" ,(math "\\chi"))
+ ("psi" ,(math "\\psi"))
+ ("omega" ,(math "\\omega"))
+ ("thetasym" ,(math "\\vartheta"))
+ ("piv" ,(math "\\varpi"))
+ ;; punctuation
+ ("bullet" ,(math "\\bullet"))
+ ("ellipsis" ,(math "\\ldots"))
+ ("weierp" ,(math "\\wp"))
+ ("image" ,(math "\\Im"))
+ ("real" ,(math "\\Re"))
+ ("tm" ,(math "^{\\sc\\tiny{tm}}"))
+ ("alef" ,(math "\\aleph"))
+ ("<-" ,(math "\\leftarrow"))
+ ("<--" ,(math "\\longleftarrow"))
+ ("uparrow" ,(math "\\uparrow"))
+ ("->" ,(math "\\rightarrow"))
+ ("-->" ,(math "\\longrightarrow"))
+ ("downarrow" ,(math "\\downarrow"))
+ ("<->" ,(math "\\leftrightarrow"))
+ ("<-->" ,(math "\\longleftrightarrow"))
+ ("<+" ,(math "\\hookleftarrow"))
+ ("<=" ,(math "\\Leftarrow"))
+ ("<==" ,(math "\\Longleftarrow"))
+ ("Uparrow" ,(math "\\Uparrow"))
+ ("=>" ,(math "\\Rightarrow"))
+ ("==>" ,(math "\\Longrightarrow"))
+ ("Downarrow" ,(math "\\Downarrow"))
+ ("<=>" ,(math "\\Leftrightarrow"))
+ ("<==>" ,(math "\\Longleftrightarrow"))
+ ;; Mathematical operators
+ ("forall" ,(math "\\forall"))
+ ("partial" ,(math "\\partial"))
+ ("exists" ,(math "\\exists"))
+ ("emptyset" ,(math "\\emptyset"))
+ ("infinity" ,(math "\\infty"))
+ ("nabla" ,(math "\\nabla"))
+ ("in" ,(math "\\in"))
+ ("notin" ,(math "\\notin"))
+ ("ni" ,(math "\\ni"))
+ ("prod" ,(math "\\Pi"))
+ ("sum" ,(math "\\Sigma"))
+ ("asterisk" ,(math "\\ast"))
+ ("sqrt" ,(math "\\surd"))
+ ("propto" ,(math "\\propto"))
+ ("angle" ,(math "\\angle"))
+ ("and" ,(math "\\wedge"))
+ ("or" ,(math "\\vee"))
+ ("cap" ,(math "\\cap"))
+ ("cup" ,(math "\\cup"))
+ ("integral" ,(math "\\int"))
+ ("models" ,(math "\\models"))
+ ("vdash" ,(math "\\vdash"))
+ ("dashv" ,(math "\\dashv"))
+ ("sim" ,(math "\\sim"))
+ ("cong" ,(math "\\cong"))
+ ("approx" ,(math "\\approx"))
+ ("neq" ,(math "\\neq"))
+ ("equiv" ,(math "\\equiv"))
+ ("le" ,(math "\\leq"))
+ ("ge" ,(math "\\geq"))
+ ("subset" ,(math "\\subset"))
+ ("supset" ,(math "\\supset"))
+ ("subseteq" ,(math "\\subseteq"))
+ ("supseteq" ,(math "\\supseteq"))
+ ("oplus" ,(math "\\oplus"))
+ ("otimes" ,(math "\\otimes"))
+ ("perp" ,(math "\\perp"))
+ ("mid" ,(math "\\mid"))
+ ("lceil" ,(math "\\lceil"))
+ ("rceil" ,(math "\\rceil"))
+ ("lfloor" ,(math "\\lfloor"))
+ ("rfloor" ,(math "\\rfloor"))
+ ("langle" ,(math "\\langle"))
+ ("rangle" ,(math "\\rangle"))
+ ;; Misc
+ ("loz" ,(math "\\diamond"))
+ ("spades" ,(math "\\spadesuit"))
+ ("clubs" ,(math "\\clubsuit"))
+ ("hearts" ,(math "\\heartsuit"))
+ ("diams" ,(math "\\diamondsuit"))
+ ("euro" "\\euro{}")
+ ;; LaTeX
+ ("dag" "\\dag")
+ ("ddag" "\\ddag")
+ ("circ" ,(math "\\circ"))
+ ("top" ,(math "\\top"))
+ ("bottom" ,(math "\\bot"))
+ ("lhd" ,(math "\\triangleleft"))
+ ("rhd" ,(math "\\triangleright"))
+ ("parallel" ,(math "\\parallel"))))
+
+;*---------------------------------------------------------------------*/
+;* latex-engine ... */
+;*---------------------------------------------------------------------*/
+(define latex-engine
+ (default-engine-set!
+ (make-engine 'latex
+ :version 1.0
+ :format "latex"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace latex-encoding)
+ :custom '((documentclass "\\documentclass{article}")
+ (usepackage "\\usepackage{epsfig}\n")
+ (predocument "\\newdimen\\oldframetabcolsep\n\\newdimen\\oldcolortabcolsep\n\\newdimen\\oldpretabcolsep\n")
+ (postdocument #f)
+ (maketitle "\\date{}\n\\maketitle")
+ (%font-size 0)
+ ;; color
+ (color #t)
+ (color-usepackage "\\usepackage{color}\n")
+ ;; hyperref
+ (hyperref #t)
+ (hyperref-usepackage "\\usepackage[setpagesize=false]{hyperref}\n")
+ ;; source fontification
+ (source-color #t)
+ (source-comment-color "#ffa600")
+ (source-error-color "red")
+ (source-define-color "#6959cf")
+ (source-module-color "#1919af")
+ (source-markup-color "#1919af")
+ (source-thread-color "#ad4386")
+ (source-string-color "red")
+ (source-bracket-color "red")
+ (source-type-color "#00cf00")
+ (image-format ("eps"))
+ (index-page-ref #t))
+ :symbol-table (latex-symbol-table
+ (lambda (m)
+ (format "\\begin{math}~a\\end{math}" m))))))
+
+;*---------------------------------------------------------------------*/
+;* latex-title-engine ... */
+;*---------------------------------------------------------------------*/
+(define latex-title-engine
+ (make-engine 'latex-title
+ :version 1.0
+ :format "latex-title"
+ :delegate latex-engine
+ :filter (make-string-replace latex-encoding)
+ :symbol-table (latex-symbol-table (lambda (m) (format "$~a$" m)))))
+
+;*---------------------------------------------------------------------*/
+;* latex-color? ... */
+;*---------------------------------------------------------------------*/
+(define (latex-color? e)
+ (engine-custom e 'color))
+
+;*---------------------------------------------------------------------*/
+;* LaTeX ... */
+;*---------------------------------------------------------------------*/
+(define-markup (LaTeX #!key (space #t))
+ (if (engine-format? "latex")
+ (! (if space "\\LaTeX\\ " "\\LaTeX"))
+ "LaTeX"))
+
+;*---------------------------------------------------------------------*/
+;* TeX ... */
+;*---------------------------------------------------------------------*/
+(define-markup (TeX #!key (space #t))
+ (if (engine-format? "latex")
+ (! (if space "\\TeX\\ " "\\TeX"))
+ "TeX"))
+
+;*---------------------------------------------------------------------*/
+;* latex ... */
+;*---------------------------------------------------------------------*/
+(define-markup (!latex fmt #!rest opt)
+ (if (engine-format? "latex")
+ (apply ! fmt opt)
+ #f))
+
+;*---------------------------------------------------------------------*/
+;* latex-width ... */
+;*---------------------------------------------------------------------*/
+(define (latex-width width)
+ (if (and (number? width) (inexact? width))
+ (string-append (number->string (/ width 100.)) "\\linewidth")
+ (string-append (number->string width) "pt")))
+
+;*---------------------------------------------------------------------*/
+;* latex-font-size ... */
+;*---------------------------------------------------------------------*/
+(define (latex-font-size size)
+ (case size
+ ((4) "Huge")
+ ((3) "huge")
+ ((2) "Large")
+ ((1) "large")
+ ((0) "normalsize")
+ ((-1) "small")
+ ((-2) "footnotesize")
+ ((-3) "scriptsize")
+ ((-4) "tiny")
+ (else (if (number? size)
+ (if (< size 0) "tiny" "Huge")
+ "normalsize"))))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-latex-color-table* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-latex-color-table* #f)
+
+;*---------------------------------------------------------------------*/
+;* latex-declare-color ... */
+;*---------------------------------------------------------------------*/
+(define (latex-declare-color name rgb)
+ (printf "\\definecolor{~a}{rgb}{~a}\n" name rgb))
+
+;*---------------------------------------------------------------------*/
+;* skribe-get-latex-color ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-get-latex-color spec)
+ (let ((c (and (hashtable? *skribe-latex-color-table*)
+ (hashtable-get *skribe-latex-color-table* spec))))
+ (if (not (string? c))
+ (skribe-error 'latex "Can't find color" spec)
+ c)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-color->latex-rgb ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-color->latex-rgb spec)
+ (receive (r g b)
+ (skribe-color->rgb spec)
+ (cond
+ ((and (= r 0) (= g 0) (= b 0))
+ "0.,0.,0.")
+ ((and (= r #xff) (= g #xff) (= b #xff))
+ "1.,1.,1.")
+ (else
+ (let ((ff (exact->inexact #xff)))
+ (format "~a,~a,~a"
+ (number->string (/ r ff))
+ (number->string (/ g ff))
+ (number->string (/ b ff))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-latex-declare-colors ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-latex-declare-colors colors)
+ (set! *skribe-latex-color-table* (make-hashtable))
+ (for-each (lambda (spec)
+ (let ((old (hashtable-get *skribe-latex-color-table* spec)))
+ (if (not (string? old))
+ (let ((name (symbol->string (gensym 'c))))
+ ;; bind the color
+ (hashtable-put! *skribe-latex-color-table* spec name)
+ ;; and emit a latex declaration
+ (latex-declare-color
+ name
+ (skribe-color->latex-rgb spec))))))
+ colors))
+
+;*---------------------------------------------------------------------*/
+;* &~ ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&~
+ :before "~"
+ :action #f)
+
+;*---------------------------------------------------------------------*/
+;* &latex-table-start */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-start
+ :options '()
+ :action (lambda (n e)
+ (let ((width (markup-option n 'width)))
+ (if (number? width)
+ (printf "\\begin{tabular*}{~a}" (latex-width width))
+ (display "\\begin{tabular}")))))
+
+;*---------------------------------------------------------------------*/
+;* &latex-table-stop */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-stop
+ :options '()
+ :action (lambda (n e)
+ (let ((width (markup-option n 'width)))
+ (if (number? width)
+ (display "\\end{tabular*}\n")
+ (display "\\end{tabular}\n")))))
+
+;*---------------------------------------------------------------------*/
+;* document ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'document
+ :options '(:title :author :ending :env)
+ :before (lambda (n e)
+ ;; documentclass
+ (let ((dc (engine-custom e 'documentclass)))
+ (if dc
+ (begin (display dc) (newline))
+ (display "\\documentclass{article}\n")))
+ (if (latex-color? e)
+ (display (engine-custom e 'color-usepackage)))
+ (if (engine-custom e 'hyperref)
+ (display (engine-custom e 'hyperref-usepackage)))
+ ;; usepackage
+ (let ((pa (engine-custom e 'usepackage)))
+ (if pa (begin (display pa) (newline))))
+ ;; colors
+ (if (latex-color? e)
+ (begin
+ (skribe-use-color! (engine-custom e 'source-comment-color))
+ (skribe-use-color! (engine-custom e 'source-define-color))
+ (skribe-use-color! (engine-custom e 'source-module-color))
+ (skribe-use-color! (engine-custom e 'source-markup-color))
+ (skribe-use-color! (engine-custom e 'source-thread-color))
+ (skribe-use-color! (engine-custom e 'source-string-color))
+ (skribe-use-color! (engine-custom e 'source-bracket-color))
+ (skribe-use-color! (engine-custom e 'source-type-color))
+ (display "\n%% colors\n")
+ (skribe-latex-declare-colors (skribe-get-used-colors))
+ (display "\n\n")))
+ ;; predocument
+ (let ((pd (engine-custom e 'predocument)))
+ (when pd (display pd) (newline)))
+ ;; title
+ (let ((t (markup-option n :title)))
+ (when t
+ (skribe-eval (new markup
+ (markup '&latex-title)
+ (body t))
+ e
+ :env `((parent ,n)))))
+ ;; author
+ (let ((a (markup-option n :author)))
+ (when a
+ (skribe-eval (new markup
+ (markup '&latex-author)
+ (body a))
+ e
+ :env `((parent ,n)))))
+ ;; document
+ (display "\\begin{document}\n")
+ ;; postdocument
+ (let ((pd (engine-custom e 'postdocument)))
+ (if pd (begin (display pd) (newline))))
+ ;; maketitle
+ (let ((mt (engine-custom e 'maketitle)))
+ (if mt (begin (display mt) (newline)))))
+ :action (lambda (n e)
+ (output (markup-body n) e))
+ :after (lambda (n e)
+ (display "\n\\end{document}\n")))
+
+;*---------------------------------------------------------------------*/
+;* &latex-title ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-title
+ :before "\\title{"
+ :after "}\n")
+
+;*---------------------------------------------------------------------*/
+;* &latex-author ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-author
+ :before "\\author{\\centerline{\n"
+ :action (lambda (n e)
+ (let ((body (markup-body n)))
+ (if (pair? body)
+ (begin
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "&latex-author-table"))
+ e)
+ (printf "{~a}\n" (make-string (length body) #\c))
+ (let loop ((as body))
+ (output (car as) e)
+ (if (pair? (cdr as))
+ (begin
+ (display " & ")
+ (loop (cdr as)))))
+ (display "\\\\\n")
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "&latex-author-table"))
+ e))
+ (output body e))))
+ :after "}}\n")
+
+;*---------------------------------------------------------------------*/
+;* author ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+ :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+ :before (lambda (n e)
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "author"))
+ e)
+ (printf "{~a}\n"
+ (case (markup-option n :align)
+ ((left) "l")
+ ((right) "r")
+ (else "c"))))
+ :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)
+ (display "\\\\\n"))
+ ;; name
+ (if name (row name))
+ ;; title
+ (if title (row title))
+ ;; affiliation
+ (if affiliation (row affiliation))
+ ;; address
+ (cond
+ ((pair? address)
+ (for-each row address))
+ ((string? address)
+ (row address)))
+ ;; telephone
+ (if phone (row phone))
+ ;; email
+ (if email (row email))
+ ;; url
+ (if url (row url))))
+ :after (lambda (n e)
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "author"))
+ e)))
+
+;*---------------------------------------------------------------------*/
+;* author ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'author
+ :options '(:name :title :affiliation :email :url :address :phone :photo :align)
+ :predicate (lambda (n e) (markup-option n :photo))
+ :before (lambda (n e)
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "author"))
+ e)
+ (printf "{cc}\n"))
+ :action (lambda (n e)
+ (let ((photo (markup-option n :photo)))
+ (output photo e)
+ (display " & ")
+ (markup-option-add! n :photo #f)
+ (output n e)
+ (markup-option-add! n :photo photo)
+ (display "\\\\\n")))
+ :after (lambda (n e)
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "author"))
+ e)))
+
+;*---------------------------------------------------------------------*/
+;* toc ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'toc
+ :options '()
+ :action (lambda (n e) (display "\\tableofcontents\n")))
+
+;*---------------------------------------------------------------------*/
+;* latex-block-before ... */
+;*---------------------------------------------------------------------*/
+(define (latex-block-before m)
+ (lambda (n e)
+ (let ((num (markup-option n :number)))
+ (printf "\n\n%% ~a\n" (string-canonicalize (markup-ident n)))
+ (printf "\\~a~a{" m (if (not num) "*" ""))
+ (output (markup-option n :title) latex-title-engine)
+ (display "}\n")
+ (when num
+ (printf "\\label{~a}\n" (string-canonicalize (markup-ident n)))))))
+
+;*---------------------------------------------------------------------*/
+;* section ... .. @label chapter@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'chapter
+ :options '(:title :number :toc :file :env)
+ :before (latex-block-before 'chapter))
+
+;*---------------------------------------------------------------------*/
+;* section ... . @label section@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'section
+ :options '(:title :number :toc :file :env)
+ :before (latex-block-before 'section))
+
+;*---------------------------------------------------------------------*/
+;* subsection ... @label subsection@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsection
+ :options '(:title :number :toc :file :env)
+ :before (latex-block-before 'subsection))
+
+;*---------------------------------------------------------------------*/
+;* subsubsection ... @label subsubsection@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'subsubsection
+ :options '(:title :number :toc :file :env)
+ :before (latex-block-before 'subsubsection))
+
+;*---------------------------------------------------------------------*/
+;* paragraph ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'paragraph
+ :options '(:title :number :toc :env)
+ :before (lambda (n e)
+ (when (and (>= (skribe-debug) 2) (location? (ast-loc n)))
+ (printf "\n\\makebox[\\linewidth][l]{\\hspace{-1.5cm}\\footnotesize{$\\triangleright$\\textit{~a}}}\n"
+ (ast-location n)))
+ (display "\\noindent "))
+ :after "\\par\n")
+
+;*---------------------------------------------------------------------*/
+;* footnote ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'footnote
+ :before "\\footnote{"
+ :after "}")
+
+;*---------------------------------------------------------------------*/
+;* linebreak ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'linebreak
+ :action (lambda (n e)
+ (display "\\makebox[\\linewidth]{}")))
+
+;*---------------------------------------------------------------------*/
+;* hrule ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'hrule
+ :options '()
+ :before "\\hrulefill"
+ :action #f)
+
+;*---------------------------------------------------------------------*/
+;* latex-color-counter */
+;*---------------------------------------------------------------------*/
+(define latex-color-counter 1)
+
+;*---------------------------------------------------------------------*/
+;* latex-color ... */
+;*---------------------------------------------------------------------*/
+(define latex-color
+ (lambda (bg fg n e)
+ (if (not (latex-color? e))
+ (output n e)
+ (begin
+ (if bg
+ (printf "\\setbox~a \\vbox \\bgroup " latex-color-counter))
+ (set! latex-color-counter (+ latex-color-counter 1))
+ (if fg
+ (begin
+ (printf "\\textcolor{~a}{" (skribe-get-latex-color fg))
+ (output n e)
+ (display "}"))
+ (output n e))
+ (set! latex-color-counter (- latex-color-counter 1))
+ (if bg
+ (printf "\\egroup\\colorbox{~a}{\\box~a}%\n"
+ (skribe-get-latex-color bg) latex-color-counter))))))
+
+;*---------------------------------------------------------------------*/
+;* color ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'color
+ :options '(:bg :fg :width)
+ :action (lambda (n e)
+ (let* ((w (markup-option n :width))
+ (bg (markup-option n :bg))
+ (fg (markup-option n :fg))
+ (m (markup-option n :margin))
+ (tw (cond
+ ((not w)
+ #f)
+ ((and (integer? w) (exact? w))
+ w)
+ ((real? w)
+ (latex-width w)))))
+ (when bg
+ (display "\\setlength{\\oldcolortabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n")
+ (when m
+ (printf "\\addtolength{\\tabcolsep}{~a}"
+ (latex-width m)))
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "color"))
+ e)
+ (if tw
+ (printf "{p{~a}}\n" tw)
+ (printf "{l}\n")))
+ (latex-color bg fg (markup-body n) e)
+ (when bg
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "color"))
+ e)
+ (display "\\setlength{\\tabcolsep}{\\oldcolortabcolsep}\n")))))
+
+;*---------------------------------------------------------------------*/
+;* frame ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'frame
+ :options '(:width :border :margin)
+ :before (lambda (n e)
+ (display "\\setlength{\\oldframetabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}")
+ (let ((m (markup-option n :margin)))
+ (when m
+ (printf "\\addtolength{\\tabcolsep}{~a}" (latex-width m))))
+ (newline))
+ :action (lambda (n e)
+ (let* ((b (markup-option n :border))
+ (w (markup-option n :width))
+ (tw (cond
+ ((not w)
+ ".96\\linewidth")
+ ((and (integer? w) (exact? w))
+ w)
+ ((real? w)
+ (latex-width w)))))
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "frame"))
+ e)
+ (if (and (integer? b) (> b 0))
+ (begin
+ (printf "{|p{~a}|}\\hline\n" tw)
+ (output (markup-body n) e)
+ (display "\\\\\\hline\n"))
+ (begin
+ (printf "{p{~a}}\n" tw)
+ (output (markup-body n) e)))
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "author"))
+ e)))
+ :after "\\setlength{\\tabcolsep}{\\oldframetabcolsep}\n")
+
+;*---------------------------------------------------------------------*/
+;* font ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'font
+ :options '(:size)
+ :action (lambda (n e)
+ (let* ((size (markup-option n :size))
+ (cs (let ((n (engine-custom e '%font-size)))
+ (if (number? n)
+ n
+ 0)))
+ (ns (cond
+ ((and (integer? size) (exact? size))
+ (if (> size 0)
+ size
+ (+ cs size)))
+ ((and (number? size) (inexact? size))
+ (+ cs (inexact->exact size)))
+ ((string? size)
+ (let ((nb (string->number size)))
+ (if (not (number? nb))
+ (skribe-error
+ 'font
+ (format "Illegal font size ~s" size)
+ nb)
+ (+ cs nb))))))
+ (ne (make-engine (gensym 'latex)
+ :delegate e
+ :filter (engine-filter e)
+ :symbol-table (engine-symbol-table e)
+ :custom `((%font-size ,ns)
+ ,@(engine-customs e)))))
+ (printf "{\\~a{" (latex-font-size ns))
+ (output (markup-body n) ne)
+ (display "}}"))))
+
+;*---------------------------------------------------------------------*/
+;* flush ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'flush
+ :options '(:side)
+ :before (lambda (n e)
+ (case (markup-option n :side)
+ ((center)
+ (display "\\begin{center}\n"))
+ ((left)
+ (display "\\begin{flushleft}"))
+ ((right)
+ (display "\\begin{flushright}"))))
+ :after (lambda (n e)
+ (case (markup-option n :side)
+ ((center)
+ (display "\\end{center}\n"))
+ ((left)
+ (display "\\end{flushleft}\n"))
+ ((right)
+ (display "\\end{flushright}\n")))))
+
+;*---------------------------------------------------------------------*/
+;* center ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'center
+ :before "\\begin{center}\n"
+ :after "\\end{center}\n")
+
+;*---------------------------------------------------------------------*/
+;* pre ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'pre
+ :before (lambda (n e)
+ (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \n\\bgroup\n{\\noindent \\texttt{"
+ latex-color-counter)
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "pre"))
+ e)
+ (display "{l}\n")
+ (set! latex-color-counter (+ latex-color-counter 1)))
+ :action (lambda (n e)
+ (let ((ne (make-engine
+ (gensym 'latex)
+ :delegate e
+ :filter (make-string-replace latex-pre-encoding)
+ :symbol-table (engine-symbol-table e)
+ :custom (engine-customs e))))
+ (output (markup-body n) ne)))
+ :after (lambda (n e)
+ (set! latex-color-counter (- latex-color-counter 1))
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "pre"))
+ e)
+ (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;* prog ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'prog
+ :options '(:line :mark)
+ :before (lambda (n e)
+ (printf "\\setlength{\\oldpretabcolsep}{\\tabcolsep}\n\\addtolength{\\tabcolsep}{-\\tabcolsep}\n{\\setbox~a \\vbox \\bgroup\n{\\noindent \\texttt{"
+ latex-color-counter)
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "pre"))
+ e)
+ (display "{l}\n")
+ (set! latex-color-counter (+ latex-color-counter 1)))
+ :action (lambda (n e)
+ (let ((ne (make-engine
+ (gensym 'latex)
+ :delegate e
+ :filter (make-string-replace latex-pre-encoding)
+ :symbol-table (engine-symbol-table e)
+ :custom (engine-customs e))))
+ (output (markup-body n) ne)))
+ :after (lambda (n e)
+ (set! latex-color-counter (- latex-color-counter 1))
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "prog"))
+ e)
+ (printf "}}\n\\egroup{\\box~a}}%\n\\setlength{\\tabcolsep}{\\oldpretabcolsep}\n" latex-color-counter)))
+
+;*---------------------------------------------------------------------*/
+;* &prog-line ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&prog-line
+ :before (lambda (n e)
+ (let ((n (markup-ident n)))
+ (if n (skribe-eval (it (list n) ": ") e))))
+ :after "\\\\\n")
+
+;*---------------------------------------------------------------------*/
+;* itemize ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'itemize
+ :options '(:symbol)
+ :before "\\begin{itemize}\n"
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (display " \\item ")
+ (output item e)
+ (newline))
+ (markup-body n)))
+ :after "\\end{itemize} ")
+
+(markup-writer 'itemize
+ :predicate (lambda (n e) (markup-option n :symbol))
+ :options '(:symbol)
+ :before (lambda (n e)
+ (display "\\begin{list}{")
+ (output (markup-option n :symbol) e)
+ (display "}{}")
+ (newline))
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (display " \\item ")
+ (output item e)
+ (newline))
+ (markup-body n)))
+ :after "\\end{list}\n")
+
+;*---------------------------------------------------------------------*/
+;* enumerate ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'enumerate
+ :options '(:symbol)
+ :before "\\begin{enumerate}\n"
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (display " \\item ")
+ (output item e)
+ (newline))
+ (markup-body n)))
+ :after "\\end{enumerate}\n")
+
+;*---------------------------------------------------------------------*/
+;* description ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'description
+ :options '(:symbol)
+ :before "\\begin{description}\n"
+ :action (lambda (n e)
+ (for-each (lambda (item)
+ (let ((k (markup-option item :key)))
+ (for-each (lambda (i)
+ (display " \\item[")
+ (output i e)
+ (display "]\n"))
+ (if (pair? k) k (list k)))
+ (output (markup-body item) e)))
+ (markup-body n)))
+ :after "\\end{description}\n")
+
+;*---------------------------------------------------------------------*/
+;* item ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'item
+ :options '(:key)
+ :action (lambda (n e)
+ (let ((k (markup-option n :key)))
+ (if k
+ (begin
+ (display "[")
+ (output k e)
+ (display "] "))))
+ (output (markup-body n) e)))
+
+;*---------------------------------------------------------------------*/
+;* blockquote ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'blockquote
+ :before "\n\\begin{quote}\n"
+ :after "\n\\end{quote}")
+
+;*---------------------------------------------------------------------*/
+;* figure ... @label figure@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'figure
+ :options '(:legend :number :multicolumns)
+ :action (lambda (n e)
+ (let ((ident (markup-ident n))
+ (number (markup-option n :number))
+ (legend (markup-option n :legend))
+ (mc (markup-option n :multicolumns)))
+ (display (if mc
+ "\\begin{figure*}[!th]\n"
+ "\\begin{figure}[ht]\n"))
+ (output (markup-body n) e)
+ (printf "\\caption{\\label{~a}" (string-canonicalize ident))
+ (output legend e)
+ (display (if mc
+ "}\\end{figure*}\n"
+ "}\\end{figure}\n")))))
+
+;*---------------------------------------------------------------------*/
+;* table-column-number ... */
+;* ------------------------------------------------------------- */
+;* Computes how many columns are contained in a table. */
+;*---------------------------------------------------------------------*/
+(define (table-column-number t)
+ (define (row-columns row)
+ (let luup ((cells (markup-body row))
+ (nbcols 0))
+ (cond
+ ((null? cells)
+ nbcols)
+ ((pair? cells)
+ (luup (cdr cells)
+ (+ nbcols (markup-option (car cells) :colspan))))
+ (else
+ (skribe-type-error 'tr "Illegal tr body, " row "pair")))))
+ (let loop ((rows (markup-body t))
+ (nbcols 0))
+ (if (null? rows)
+ nbcols
+ (loop (cdr rows)
+ (max (row-columns (car rows)) nbcols)))))
+
+;*---------------------------------------------------------------------*/
+;* table ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'table
+ :options '(:width :frame :rules :cellstyle)
+ :before (lambda (n e)
+ (let ((width (markup-option n :width))
+ (frame (markup-option n :frame))
+ (rules (markup-option n :rules))
+ (cstyle (markup-option n :cellstyle))
+ (nbcols (table-column-number n))
+ (id (markup-ident n))
+ (cla (markup-class n))
+ (rows (markup-body n)))
+ ;; the table header
+ (output (new markup
+ (markup '&latex-table-start)
+ (class "table")
+ (options `((width ,width))))
+ e)
+ ;; store the actual number of columns
+ (markup-option-add! n '&nbcols nbcols)
+ ;; compute the table header
+ (let ((cols (cond
+ ((= nbcols 0)
+ (skribe-error 'table
+ "Illegal empty table"
+ n))
+ ((or (not width) (= nbcols 1))
+ (make-string nbcols #\c))
+ (else
+ (let ((v (make-vector
+ (- nbcols 1)
+ "@{\\extracolsep{\\fill}}c")))
+ (apply string-append
+ (cons "c" (vector->list v))))))))
+ (case frame
+ ((none)
+ (printf "{~a}\n" cols))
+ ((border box)
+ (printf "{|~a|}" cols)
+ (markup-option-add! n '&lhs #t)
+ (markup-option-add! n '&rhs #t)
+ (output (new markup
+ (markup '&latex-table-hline)
+ (parent n)
+ (ident (format "~a-above" id))
+ (class "table-line-above"))
+ e))
+ ((above hsides)
+ (printf "{~a}" cols)
+ (output (new markup
+ (markup '&latex-table-hline)
+ (parent n)
+ (ident (format "~a-above" id))
+ (class "table-line-above"))
+ e))
+ ((vsides)
+ (markup-option-add! n '&lhs #t)
+ (markup-option-add! n '&rhs #t)
+ (printf "{|~a|}\n" cols))
+ ((lhs)
+ (markup-option-add! n '&lhs #t)
+ (printf "{|~a}\n" cols))
+ ((rhs)
+ (markup-option-add! n '&rhs #t)
+ (printf "{~a|}\n" cols))
+ (else
+ (printf "{~a}\n" cols)))
+ ;; mark each row with appropriate '&tl (top-line)
+ ;; and &bl (bottom-line) options
+ (when (pair? rows)
+ (if (and (memq rules '(rows all))
+ (or (not (eq? cstyle 'collapse))
+ (not (memq frame '(border box above hsides)))))
+ (let ((frow (car rows)))
+ (if (is-markup? frow 'tr)
+ (markup-option-add! frow '&tl #t))))
+ (if (eq? rules 'header)
+ (let ((frow (car rows)))
+ (if (is-markup? frow 'tr)
+ (markup-option-add! frow '&bl #t))))
+ (when (and (pair? (cdr rows))
+ (memq rules '(rows all)))
+ (for-each (lambda (row)
+ (if (is-markup? row 'tr)
+ (markup-option-add! row '&bl #t)))
+ rows)
+ (markup-option-add! (car (last-pair rows)) '&bl #f))
+ (if (and (memq rules '(rows all))
+ (or (not (eq? cstyle 'collapse))
+ (not (memq frame '(border box above hsides)))))
+ (let ((lrow (car (last-pair rows))))
+ (if (is-markup? lrow 'tr)
+ (markup-option-add! lrow '&bl #t))))))))
+ :after (lambda (n e)
+ (case (markup-option n :frame)
+ ((hsides below box border)
+ (output (new markup
+ (markup '&latex-table-hline)
+ (parent n)
+ (ident (format "~a-below" (markup-ident n)))
+ (class "table-hline-below"))
+ e)))
+ (output (new markup
+ (markup '&latex-table-stop)
+ (class "table")
+ (options `((width ,(markup-option n :width)))))
+ e)))
+
+;*---------------------------------------------------------------------*/
+;* &latex-table-hline */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-table-hline
+ :action "\\hline\n")
+
+;*---------------------------------------------------------------------*/
+;* tr ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tr
+ :options '()
+ :action (lambda (n e)
+ (let* ((parent (ast-parent n))
+ (_ (if (not (is-markup? parent 'table))
+ (skribe-type-error 'tr "Illegal parent, " parent
+ "#<table>")))
+ (nbcols (markup-option parent '&nbcols))
+ (lhs (markup-option parent '&lhs))
+ (rhs (markup-option parent '&rhs))
+ (rules (markup-option parent :rules))
+ (collapse (eq? (markup-option parent :cellstyle)
+ 'collapse))
+ (vrules (memq rules '(cols all)))
+ (cells (markup-body n)))
+ (if (markup-option n '&tl)
+ (output (new markup
+ (markup '&latex-table-hline)
+ (parent n)
+ (ident (markup-ident n))
+ (class (markup-class n)))
+ e))
+ (if (> nbcols 0)
+ (let laap ((nbc nbcols)
+ (cs cells))
+ (if (null? cs)
+ (when (> nbc 1)
+ (display " & ")
+ (laap (- nbc 1) cs))
+ (let* ((c (car cs))
+ (nc (- nbc (markup-option c :colspan))))
+ (when (= nbcols nbc)
+ (cond
+ ((and lhs vrules (not collapse))
+ (markup-option-add! c '&lhs "||"))
+ ((or lhs vrules)
+ (markup-option-add! c '&lhs #\|))))
+ (when (= nc 0)
+ (cond
+ ((and rhs vrules (not collapse))
+ (markup-option-add! c '&rhs "||"))
+ ((or rhs vrules)
+ (markup-option-add! c '&rhs #\|))))
+ (when (and vrules (> nc 0) (< nc nbcols))
+ (markup-option-add! c '&rhs #\|))
+ (output c e)
+ (when (> nc 0)
+ (display " & ")
+ (laap nc (cdr cs)))))))))
+ :after (lambda (n e)
+ (display "\\\\")
+ (if (markup-option n '&bl)
+ (output (new markup
+ (markup '&latex-table-hline)
+ (parent n)
+ (ident (markup-ident n))
+ (class (markup-class n)))
+ e)
+ (newline))))
+
+;*---------------------------------------------------------------------*/
+;* tc */
+;*---------------------------------------------------------------------*/
+(markup-writer 'tc
+ :options '(:width :align :valign :colspan)
+ :action (lambda (n e)
+ (let ((id (markup-ident n))
+ (cla (markup-class n)))
+ (let* ((o0 (markup-body n))
+ (o1 (if (eq? (markup-option n 'markup) 'th)
+ (new markup
+ (markup '&latex-th)
+ (parent n)
+ (ident id)
+ (class cla)
+ (options (markup-options n))
+ (body o0))
+ o0))
+ (o2 (if (markup-option n :width)
+ (new markup
+ (markup '&latex-tc-parbox)
+ (parent n)
+ (ident id)
+ (class cla)
+ (options (markup-options n))
+ (body o1))
+ o1))
+ (o3 (if (or (> (markup-option n :colspan) 1)
+ (not (eq? (markup-option n :align)
+ 'center))
+ (markup-option n '&lhs)
+ (markup-option n '&rhs))
+ (new markup
+ (markup '&latex-tc-multicolumn)
+ (parent n)
+ (ident id)
+ (class cla)
+ (options (markup-options n))
+ (body o2))
+ o2)))
+ (output o3 e)))))
+
+;*---------------------------------------------------------------------*/
+;* &latex-th ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-th
+ :before "\\textsf{"
+ :after "}")
+
+;*---------------------------------------------------------------------*/
+;* &latex-tc-parbox ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-parbox
+ :before (lambda (n e)
+ (let ((width (markup-option n :width))
+ (valign (markup-option n :valign)))
+ (printf "\\parbox{~a}{" (latex-width width))))
+ :after "}")
+
+;*---------------------------------------------------------------------*/
+;* &latex-tc-multicolumn ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&latex-tc-multicolumn
+ :before (lambda (n e)
+ (let ((colspan (markup-option n :colspan))
+ (lhs (or (markup-option n '&lhs) ""))
+ (rhs (or (markup-option n '&rhs) ""))
+ (align (case (markup-option n :align)
+ ((left) #\l)
+ ((center) #\c)
+ ((right) #\r)
+ (else #\c))))
+ (printf "\\multicolumn{~a}{~a~a~a}{" colspan lhs align rhs)))
+ :after "}")
+
+;*---------------------------------------------------------------------*/
+;* image ... @label image@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'image
+ :options '(:file :url :width :height :zoom)
+ :action (lambda (n e)
+ (let* ((file (markup-option n :file))
+ (url (markup-option n :url))
+ (width (markup-option n :width))
+ (height (markup-option n :height))
+ (zoom (markup-option n :zoom))
+ (body (markup-body n))
+ (efmt (engine-custom e 'image-format))
+ (img (or url (convert-image file
+ (if (list? efmt)
+ efmt
+ '("eps"))))))
+ (if (not (string? img))
+ (skribe-error 'latex "Illegal image" file)
+ (begin
+ (printf "\\epsfig{file=~a" (strip-ref-base img))
+ (if width (printf ", width=~a" (latex-width width)))
+ (if height (printf ", height=~apt" height))
+ (if zoom (printf ", zoom=\"~a\"" zoom))
+ (display "}"))))))
+
+;*---------------------------------------------------------------------*/
+;* Ornaments ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'roman :before "{\\textrm{" :after "}}")
+(markup-writer 'bold :before "{\\textbf{" :after "}}")
+(markup-writer 'underline :before "{\\underline{" :after "}}")
+(markup-writer 'emph :before "{\\em{" :after "}}")
+(markup-writer 'it :before "{\\textit{" :after "}}")
+(markup-writer 'code :before "{\\texttt{" :after "}}")
+(markup-writer 'var :before "{\\texttt{" :after "}}")
+(markup-writer 'sc :before "{\\sc{" :after "}}")
+(markup-writer 'sf :before "{\\sf{" :after "}}")
+(markup-writer 'sub :before "\\begin{math}\\sb{\\mbox{" :after "}}\\end{math}")
+(markup-writer 'sup :before "\\begin{math}\\sp{\\mbox{" :after "}}\\end{math}")
+
+(markup-writer 'tt
+ :before "{\\texttt{"
+ :action (lambda (n e)
+ (let ((ne (make-engine
+ (gensym 'latex)
+ :delegate e
+ :filter (make-string-replace latex-tt-encoding)
+ :custom (engine-customs e)
+ :symbol-table (engine-symbol-table e))))
+ (output (markup-body n) ne)))
+ :after "}}")
+
+;*---------------------------------------------------------------------*/
+;* q ... @label q@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'q
+ :before "``"
+ :after "''")
+
+;*---------------------------------------------------------------------*/
+;* mailto ... @label mailto@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mailto
+ :options '(:text)
+ :before "{\\texttt{"
+ :action (lambda (n e)
+ (let ((text (markup-option n :text)))
+ (output (or text (markup-body n)) e)))
+ :after "}}")
+
+;*---------------------------------------------------------------------*/
+;* mark ... @label mark@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'mark
+ :before (lambda (n e)
+ (printf "\\label{~a}" (string-canonicalize (markup-ident n)))))
+
+;*---------------------------------------------------------------------*/
+;* ref ... @label ref@ */
+;*---------------------------------------------------------------------*/
+(markup-writer 'ref
+ :options '(:text :chapter :section :subsection :subsubsection :figure :mark :handle :page)
+ :action (lambda (n e)
+ (let ((t (markup-option n :text)))
+ (if t
+ (begin
+ (output t e)
+ (output "~" e (markup-writer-get '&~ e))))))
+ :after (lambda (n e)
+ (let* ((c (handle-ast (markup-body n)))
+ (id (markup-ident c)))
+ (if (markup-option n :page)
+ (printf "\\begin{math}{\\pageref{~a}}\\end{math}"
+ (string-canonicalize id))
+ (printf "\\ref{~a}"
+ (string-canonicalize id))))))
+
+;*---------------------------------------------------------------------*/
+;* bib-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref
+ :options '(:text :bib)
+ :before "["
+ :action (lambda (n e)
+ (output (markup-option (handle-ast (markup-body n)) :title) e))
+ :after "]")
+
+;*---------------------------------------------------------------------*/
+;* bib-ref+ ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'bib-ref+
+ :options '(:text :bib)
+ :before "["
+ :action (lambda (n e)
+ (let loop ((rs (markup-body n)))
+ (cond
+ ((null? rs)
+ #f)
+ (else
+ (if (is-markup? (car rs) 'bib-ref)
+ (invoke (writer-action (markup-writer-get 'bib-ref e))
+ (car rs)
+ e)
+ (output (car rs) e))
+ (if (pair? (cdr rs))
+ (begin
+ (display ",")
+ (loop (cdr rs))))))))
+ :after "]")
+
+;*---------------------------------------------------------------------*/
+;* url-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+ :options '(:url :text)
+ :action (lambda (n e)
+ (let ((text (markup-option n :text))
+ (url (markup-option n :url)))
+ (if (not text)
+ (output url e)
+ (output text e)))))
+
+;*---------------------------------------------------------------------*/
+;* url-ref hyperref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'url-ref
+ :options '(:url :text)
+ :predicate (lambda (n e)
+ (engine-custom e 'hyperref))
+ :action (lambda (n e)
+ (let ((body (markup-option n :text))
+ (url (markup-option n :url)))
+ (if (and body (not (equal? body url)))
+ (begin
+ (display "\\href{")
+ (display url)
+ (display "}{")
+ (output body e)
+ (display "}"))
+ (begin
+ (display "\\href{")
+ (display url)
+ (printf "}{~a}" url))))))
+
+;*---------------------------------------------------------------------*/
+;* line-ref ... */
+;*---------------------------------------------------------------------*/
+(markup-writer 'line-ref
+ :options '(:offset)
+ :before "{\\textit{"
+ :action (lambda (n e)
+ (let ((o (markup-option n :offset))
+ (v (string->number (markup-option n :text))))
+ (cond
+ ((and (number? o) (number? v))
+ (display (+ o v)))
+ (else
+ (display v)))))
+ :after "}}")
+
+;*---------------------------------------------------------------------*/
+;* &the-bibliography ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&the-bibliography
+ :before (lambda (n e)
+ (display "{%
+\\sloppy
+\\sfcode`\\.=1000\\relax
+\\newdimen\\bibindent
+\\bibindent=0em
+\\begin{list}{}{%
+ \\settowidth\\labelwidth{[21]}%
+ \\leftmargin\\labelwidth
+ \\advance\\leftmargin\\labelsep
+ \\advance\\leftmargin\\bibindent
+ \\itemindent -\\bibindent
+ \\listparindent \\itemindent
+ \\itemsep 0pt
+ }%\n"))
+ :after (lambda (n e)
+ (display "\n\\end{list}}\n")))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry
+ :options '(:title)
+ :action (lambda (n e)
+ (output n e (markup-writer-get '&bib-entry-label e))
+ (output n e (markup-writer-get '&bib-entry-body e)))
+ :after "\n")
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-title ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-title
+ :predicate (lambda (n e)
+ (engine-custom e 'hyperref))
+ :action (lambda (n e)
+ (let* ((t (bold (markup-body n)))
+ (en (handle-ast (ast-parent n)))
+ (url (markup-option en 'url))
+ (ht (if url (ref :url (markup-body url) :text t) t)))
+ (skribe-eval ht e))))
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-label ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-label
+ :options '(:title)
+ :before "\\item[{\\char91}"
+ :action (lambda (n e) (output (markup-option n :title) e))
+ :after "{\\char93}] ")
+
+;*---------------------------------------------------------------------*/
+;* &bib-entry-url ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+ :action (lambda (n e)
+ (let* ((en (handle-ast (ast-parent n)))
+ (url (markup-option en 'url))
+ (t (bold (markup-body url))))
+ (skribe-eval (ref :url (markup-body url) :text t) e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-comment ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (it (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-line-comment ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-line-comment
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-comment-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-keyword ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-keyword
+ :action (lambda (n e)
+ (skribe-eval (underline (markup-body n)) e)))
+
+;*---------------------------------------------------------------------*/
+;* &source-error ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-error
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-error-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'error-color) cc)
+ (color :fg cc (underline n1))
+ (underline n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-define ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-define
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-define-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-module ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-module
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-module-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-markup ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-markup
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-markup-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-thread ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-thread
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-thread-color))
+ (n1 (bold (markup-body n)))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-string ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-string
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-string-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ n1)))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-bracket ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-bracket
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-bracket-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-type ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc n1)
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-key ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-key
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg cc (bold n1))
+ (it n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* &source-type ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&source-type
+ :action (lambda (n e)
+ (let* ((cc (engine-custom e 'source-type-color))
+ (n1 (markup-body n))
+ (n2 (if (and (engine-custom e 'source-color) cc)
+ (color :fg "red" (bold n1))
+ (bold n1))))
+ (skribe-eval n2 e))))
+
+;*---------------------------------------------------------------------*/
+;* Restore the base engine */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/skribe/skr/letter.skr b/skribe/skr/letter.skr
new file mode 100644
index 0000000..17a0058
--- /dev/null
+++ b/skribe/skr/letter.skr
@@ -0,0 +1,146 @@
+;*=====================================================================*/
+;* 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/skribe/skr/lncs.skr b/skribe/skr/lncs.skr
new file mode 100644
index 0000000..4668404
--- /dev/null
+++ b/skribe/skr/lncs.skr
@@ -0,0 +1,147 @@
+;*=====================================================================*/
+;* 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/skribe/skr/scribe.skr b/skribe/skr/scribe.skr
new file mode 100644
index 0000000..d9e3bb8
--- /dev/null
+++ b/skribe/skr/scribe.skr
@@ -0,0 +1,229 @@
+;*=====================================================================*/
+;* 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/skribe/skr/sigplan.skr b/skribe/skr/sigplan.skr
new file mode 100644
index 0000000..9bdb939
--- /dev/null
+++ b/skribe/skr/sigplan.skr
@@ -0,0 +1,155 @@
+;*=====================================================================*/
+;* 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/skribe/skr/skribe.skr b/skribe/skr/skribe.skr
new file mode 100644
index 0000000..86425ac
--- /dev/null
+++ b/skribe/skr/skribe.skr
@@ -0,0 +1,76 @@
+;*=====================================================================*/
+;* 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/skribe/skr/slide.skr b/skribe/skr/slide.skr
new file mode 100644
index 0000000..f8638ad
--- /dev/null
+++ b/skribe/skr/slide.skr
@@ -0,0 +1,664 @@
+;*=====================================================================*/
+;* 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/skribe/skr/web-article.skr b/skribe/skr/web-article.skr
new file mode 100644
index 0000000..e33328b
--- /dev/null
+++ b/skribe/skr/web-article.skr
@@ -0,0 +1,230 @@
+;*=====================================================================*/
+;* 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/skribe/skr/web-book.skr b/skribe/skr/web-book.skr
new file mode 100644
index 0000000..f907c8b
--- /dev/null
+++ b/skribe/skr/web-book.skr
@@ -0,0 +1,107 @@
+;*=====================================================================*/
+;* 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)))))
+
diff --git a/skribe/skr/xml.skr b/skribe/skr/xml.skr
new file mode 100644
index 0000000..784b6f0
--- /dev/null
+++ b/skribe/skr/xml.skr
@@ -0,0 +1,111 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/skr/xml.skr */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 2 09:46:09 2003 */
+;* Last change : Sat Mar 6 11:22:05 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Generic XML Skribe engine */
+;* ------------------------------------------------------------- */
+;* Implementation: */
+;* common: @path ../src/common/api.src@ */
+;* bigloo: @path ../src/bigloo/api.bgl@ */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/xmle.skb:ref@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* xml-engine ... */
+;*---------------------------------------------------------------------*/
+(define xml-engine
+ ;; setup the xml engine
+ (default-engine-set!
+ (make-engine 'xml
+ :version 1.0
+ :format "html"
+ :delegate (find-engine 'base)
+ :filter (make-string-replace '((#\< "<")
+ (#\> ">")
+ (#\& "&")
+ (#\" """)
+ (#\@ "@"))))))
+
+;*---------------------------------------------------------------------*/
+;* markup ... */
+;*---------------------------------------------------------------------*/
+(let ((xml-margin 0))
+ (define (make-margin)
+ (make-string xml-margin #\space))
+ (define (xml-attribute? val)
+ (cond
+ ((or (string? val) (number? val) (boolean? val))
+ #t)
+ ((list? val)
+ (every? xml-attribute? val))
+ (else
+ #f)))
+ (define (xml-attribute att val)
+ (let ((s (keyword->string att)))
+ (printf " ~a=\"" (substring s 1 (string-length s)))
+ (let loop ((val val))
+ (cond
+ ((or (string? val) (number? val))
+ (display val))
+ ((boolean? val)
+ (display (if val "true" "false")))
+ ((pair? val)
+ (for-each loop val))
+ (else
+ #f)))
+ (display #\")))
+ (define (xml-option opt val e)
+ (let* ((m (make-margin))
+ (ks (keyword->string opt))
+ (s (substring ks 1 (string-length ks))))
+ (printf "~a<~a>\n" m s)
+ (output val e)
+ (printf "~a</~a>\n" m s)))
+ (define (xml-options n e)
+ ;; display the true options
+ (let ((opts (filter (lambda (o)
+ (and (keyword? (car o))
+ (not (xml-attribute? (cadr o)))))
+ (markup-options n))))
+ (if (pair? opts)
+ (let ((m (make-margin)))
+ (display m)
+ (display "<options>\n")
+ (set! xml-margin (+ xml-margin 1))
+ (for-each (lambda (o)
+ (xml-option (car o) (cadr o) e))
+ opts)
+ (set! xml-margin (- xml-margin 1))
+ (display m)
+ (display "</options>\n")))))
+ (markup-writer #t
+ :options 'all
+ :before (lambda (n e)
+ (printf "~a<~a" (make-margin) (markup-markup n))
+ ;; display the xml attributes
+ (for-each (lambda (o)
+ (if (and (keyword? (car o))
+ (xml-attribute? (cadr o)))
+ (xml-attribute (car o) (cadr o))))
+ (markup-options n))
+ (set! xml-margin (+ xml-margin 1))
+ (display ">\n"))
+ :action (lambda (n e)
+ ;; options
+ (xml-options n e)
+ ;; body
+ (output (markup-body n) e))
+ :after (lambda (n e)
+ (printf "~a</~a>\n" (make-margin) (markup-markup n))
+ (set! xml-margin (- xml-margin 1)))))
+
+;*---------------------------------------------------------------------*/
+;* Restore the base engine */
+;*---------------------------------------------------------------------*/
+(default-engine-set! (find-engine 'base))
diff --git a/skribe/skribe.prj b/skribe/skribe.prj
new file mode 100644
index 0000000..1539075
--- /dev/null
+++ b/skribe/skribe.prj
@@ -0,0 +1,332 @@
+;; -*- Prcs -*-
+(Created-By-Prcs-Version 1 3 3)
+(Project-Description "")
+(Project-Version skribe 1.2d 2)
+(Parent-Version skribe 1.2d 1)
+(Version-Log "")
+(New-Version-Log "")
+(Checkin-Time "Fri, 03 Jun 2005 16:52:04 +0200")
+(Checkin-Login serrano)
+(Populate-Ignore ("\\.o$" "\\~$" "\\.log$" "\\.ps$" "\\.aux$" "\\.date_of_backup$" "\\.so$" "\\.a$" "if_not_there$" "if_mach$" "threadlibs$"))
+(Project-Keywords)
+(Files
+;; This is a comment. Fill in files here.
+;; For example: (prcs/checkout.cc ())
+
+;; Files added by populate at Thu, 18 Dec 2003 10:00:47 +0100,
+;; to version 0.0(w), by serrano:
+
+ (tools/Makefile (skribe/10_Makefile 1.3 640))
+ (src/stklos/xml.stk (skribe/11_xml.stk 1.2 644))
+ (src/stklos/writer.stk (skribe/12_writer.stk 1.3 644))
+ (src/stklos/verify.stk (skribe/13_verify.stk 1.4 644))
+ (src/stklos/vars.stk (skribe/14_vars.stk 1.3 644))
+ (src/stklos/types.stk (skribe/16_types.stk 1.4 644))
+ (src/stklos/source.stk (skribe/17_source.stk 1.3 644))
+ (src/stklos/runtime.stk (skribe/18_runtime.st 1.4 644))
+ (src/stklos/resolve.stk (skribe/19_resolve.st 1.2 644))
+ (src/stklos/reader.stk (skribe/20_reader.stk 1.2 644))
+ (src/stklos/prog.stk (skribe/21_prog.stk 1.1 644))
+ (src/stklos/output.stk (skribe/22_output.stk 1.3 644))
+ (src/stklos/main.stk (skribe/23_main.stk 1.3 644))
+ (src/stklos/lisp.stk (skribe/24_lisp.stk 1.4 644))
+ (src/stklos/lib.stk (skribe/25_lib.stk 1.4 644))
+ (src/stklos/eval.stk (skribe/26_eval.stk 1.4 644))
+ (src/stklos/engine.stk (skribe/27_engine.stk 1.4 644))
+ (src/stklos/debug.stk (skribe/28_debug.stk 1.3 644))
+ (src/stklos/color.stk (skribe/29_color.stk 1.2 644))
+ (src/stklos/biblio.stk (skribe/30_biblio.stk 1.3 644))
+ (src/stklos/Makefile.in (skribe/31_Makefile.i 1.3 644))
+ (src/common/param.scm (skribe/32_param.scm 1.2 640))
+ (src/common/lib.scm (skribe/33_lib.scm 1.4 640))
+ (src/common/index.scm (skribe/34_index.scm 1.2 640))
+ (src/common/configure.scm.in (skribe/35_configure. 1.3 640))
+ (src/common/bib.scm (skribe/36_bib.scm 1.2 640))
+ (src/common/api.scm (skribe/37_api.scm 1.9 640))
+ (src/bigloo/xml.scm (skribe/38_xml.scm 1.3 640))
+ (src/bigloo/writer.scm (skribe/39_writer.scm 1.3 640))
+ (src/bigloo/verify.scm (skribe/40_verify.scm 1.6 640))
+ (src/bigloo/types.scm (skribe/42_types.scm 1.6 640))
+ (src/bigloo/source.scm (skribe/43_source.scm 1.5 640))
+ (src/bigloo/resolve.scm (skribe/44_resolve.sc 1.4 640))
+ (src/bigloo/read.scm (skribe/45_read.scm 1.2 640))
+ (src/bigloo/prog.scm (skribe/46_prog.scm 1.3 640))
+ (src/bigloo/param.bgl (skribe/48_param.bgl 1.4 640))
+ (src/bigloo/output.scm (skribe/49_output.scm 1.3 640))
+ (src/bigloo/new.sch (skribe/50_new.sch 1.1 640))
+ (src/bigloo/main.scm (skribe/51_main.scm 1.4 640))
+ (src/bigloo/lisp.scm (skribe/b/0_lisp.scm 1.5 640))
+ (src/bigloo/lib.bgl (skribe/b/1_lib.bgl 1.5 640))
+ (src/bigloo/index.bgl (skribe/b/2_index.bgl 1.2 640))
+ (src/bigloo/evapi.scm (skribe/b/3_evapi.scm 1.6 640))
+ (src/bigloo/eval.scm (skribe/b/4_eval.scm 1.7 640))
+ (src/bigloo/engine.scm (skribe/b/5_engine.scm 1.4 640))
+ (src/bigloo/debug.scm (skribe/b/6_debug.scm 1.2 640))
+ (src/bigloo/debug.sch (skribe/b/7_debug.sch 1.2 640))
+ (src/bigloo/configure.bgl (skribe/b/8_configure. 1.3 640))
+ (src/bigloo/color.scm (skribe/b/9_color.scm 1.2 640))
+ (src/bigloo/c.scm (skribe/b/10_c.scm 1.4 640))
+ (src/bigloo/bib.bgl (skribe/b/11_bib.bgl 1.4 640))
+ (src/bigloo/api.sch (skribe/b/12_api.sch 1.5 640))
+ (src/bigloo/api.bgl (skribe/b/13_api.bgl 1.2 640))
+ (src/bigloo/Makefile (skribe/b/14_Makefile 1.6 640))
+ (src/Makefile (skribe/b/15_Makefile 1.2 640))
+ (skr/xml.skr (skribe/b/16_xml.skr 1.2 640))
+ (skr/web-book.skr (skribe/b/17_web-book.s 1.5 640))
+ (skr/slide.skr (skribe/b/19_slide.skr 1.6 640))
+ (skr/skribe.skr (skribe/b/20_skribe.skr 1.4 640))
+ (skr/scribe.skr (skribe/b/21_scribe.skr 1.1 640))
+ (skr/lncs.skr (skribe/b/22_lncs.skr 1.2 640))
+ (skr/letter.skr (skribe/b/23_letter.skr 1.3 640))
+ (skr/latex.skr (skribe/b/24_latex.skr 1.6 640))
+ (skr/jfp.skr (skribe/b/25_jfp.skr 1.4 640))
+ (skr/html.skr (skribe/b/26_html.skr 1.8 640))
+ (skr/french.skr (skribe/b/27_french.skr 1.1 640))
+ (skr/base.skr (skribe/b/28_base.skr 1.6 640))
+ (skr/acmproc.skr (skribe/b/29_acmproc.sk 1.4 640))
+ (skr/Makefile (skribe/b/30_Makefile 1.6 640))
+ (examples/slide/skr/local.skr (skribe/b/34_local.skr 1.1 640))
+ (examples/slide/skb/slides.skb (skribe/b/35_slides.skb 1.1 640))
+ (examples/slide/ex/syntax.scr (skribe/b/36_syntax.scr 1.1 640))
+ (examples/slide/ex/skribe.skb (skribe/b/37_skribe.skb 1.1 640))
+ (examples/slide/advi.sty (skribe/b/38_advi.sty 1.1 640))
+ (examples/slide/README (skribe/b/39_README 1.1 640))
+ (examples/slide/PPRskribe.sty (skribe/b/40_PPRskribe. 1.1 640))
+ (examples/slide/Makefile (skribe/b/41_Makefile 1.1 640))
+ (examples/Makefile (skribe/b/42_Makefile 1.2 640))
+ (etc/stklos/configure.in (skribe/b/43_configure. 1.2 640))
+ (etc/stklos/configure (skribe/b/44_configure 1.2 751))
+ (etc/stklos/Makefile.skb.in (skribe/b/45_Makefile.s 1.1 644))
+ (etc/stklos/Makefile.in (skribe/b/46_Makefile.i 1.1 640))
+ (etc/stklos/Makefile.config.in (skribe/b/47_Makefile.c 1.1 644))
+ (etc/skribe-config.in (skribe/b/48_skribe-con 1.2 644))
+ (etc/bigloo/configure (skribe/b/49_configure 1.6 740))
+ (etc/bigloo/autoconf/gmaketest (skribe/b/50_gmaketest 1.1 750))
+ (etc/bigloo/autoconf/getbversion (skribe/b/51_getbversio 1.1 750))
+ (etc/bigloo/autoconf/bversion (skribe/c/0_bversion 1.1 750))
+ (etc/bigloo/autoconf/blibdir (skribe/c/1_blibdir 1.1 750))
+ (etc/bigloo/autoconf/bfildir (skribe/c/2_bfildir 1.1 750))
+ (etc/bigloo/autoconf/Makefile (skribe/c/3_Makefile 1.1 640))
+ (etc/bigloo/Makefile.tpl (skribe/c/4_Makefile.t 1.3 640))
+ (etc/bigloo/Makefile (skribe/c/5_Makefile 1.4 640))
+ (etc/Makefile (skribe/c/6_Makefile 1.3 640))
+ (emacs/skribe.el.in (skribe/c/7_skribe.el. 1.6 640))
+ (emacs/Makefile (skribe/c/8_Makefile 1.2 640))
+ (doc/user/user.skb (skribe/c/9_user.skb 1.5 640))
+ (doc/user/toc.skb (skribe/c/10_toc.skb 1.1 640))
+ (doc/user/table.skb (skribe/c/11_table.skb 1.4 640))
+ (doc/user/syntax.skb (skribe/c/12_syntax.skb 1.3 640))
+ (doc/user/start.skb (skribe/c/13_start.skb 1.3 640))
+ (doc/user/src/start5.skb (skribe/c/14_start5.skb 1.1 644))
+ (doc/user/src/start4.skb (skribe/c/15_start4.skb 1.1 640))
+ (doc/user/src/start3.skb (skribe/c/16_start3.skb 1.1 640))
+ (doc/user/src/start2.skb (skribe/c/17_start2.skb 1.1 640))
+ (doc/user/src/start1.skb (skribe/c/18_start1.skb 1.1 640))
+ (doc/user/src/prgm3.skb (skribe/c/19_prgm3.skb 1.2 640))
+ (doc/user/src/prgm2.skb (skribe/c/20_prgm2.skb 1.2 640))
+ (doc/user/src/prgm1.skb (skribe/c/21_prgm1.skb 1.1 640))
+ (doc/user/src/links2.skb (skribe/c/22_links2.skb 1.1 640))
+ (doc/user/src/links1.skb (skribe/c/23_links1.skb 1.1 640))
+ (doc/user/src/index3.skb (skribe/c/24_index3.skb 1.1 640))
+ (doc/user/src/index2.skb (skribe/c/25_index2.skb 1.1 640))
+ (doc/user/src/index1.skb (skribe/c/26_index1.skb 1.1 640))
+ (doc/user/src/bib6.skb (skribe/c/27_bib6.skb 1.1 640))
+ (doc/user/src/bib5.skb (skribe/c/28_bib5.skb 1.1 640))
+ (doc/user/src/bib4.skb (skribe/c/29_bib4.skb 1.1 640))
+ (doc/user/src/bib3.skb (skribe/c/30_bib3.skb 1.1 640))
+ (doc/user/src/bib2.skb (skribe/c/31_bib2.skb 1.1 640))
+ (doc/user/src/bib1.sbib (skribe/c/32_bib1.sbib 1.1 640))
+ (doc/user/src/api9.skb (skribe/c/33_api9.skb 1.1 640))
+ (doc/user/src/api8.skb (skribe/c/34_api8.skb 1.1 640))
+ (doc/user/src/api7.skb (skribe/c/35_api7.skb 1.1 640))
+ (doc/user/src/api6.skb (skribe/c/36_api6.skb 1.1 640))
+ (doc/user/src/api5.skb (skribe/c/37_api5.skb 1.1 640))
+ (doc/user/src/api4.skb (skribe/c/38_api4.skb 1.1 640))
+ (doc/user/src/api3.skb (skribe/c/39_api3.skb 1.1 640))
+ (doc/user/src/api20.skb (skribe/c/40_api20.skb 1.3 640))
+ (doc/user/src/api2.skb (skribe/c/41_api2.skb 1.1 640))
+ (doc/user/src/api19.skb (skribe/c/42_api19.skb 1.1 640))
+ (doc/user/src/api18.skb (skribe/c/43_api18.skb 1.1 640))
+ (doc/user/src/api17.skb (skribe/c/44_api17.skb 1.2 640))
+ (doc/user/src/api16.skb (skribe/c/45_api16.skb 1.1 640))
+ (doc/user/src/api15.skb (skribe/c/46_api15.skb 1.1 640))
+ (doc/user/src/api14.skb (skribe/c/47_api14.skb 1.1 640))
+ (doc/user/src/api13.skb (skribe/c/48_api13.skb 1.3 640))
+ (doc/user/src/api12.skb (skribe/c/49_api12.skb 1.1 640))
+ (doc/user/src/api11.skb (skribe/c/50_api11.skb 1.1 640))
+ (doc/user/src/api10.skb (skribe/c/51_api10.skb 1.2 640))
+ (doc/user/src/api1.skb (skribe/d/0_api1.skb 1.1 640))
+ (doc/user/skribeinfo.skb (skribe/d/1_skribeinfo 1.1 640))
+ (doc/user/skribec.skb (skribe/d/2_skribec.sk 1.3 640))
+ (doc/user/sectioning.skb (skribe/d/3_sectioning 1.3 640))
+ (doc/user/prgm.skb (skribe/d/4_prgm.skb 1.4 640))
+ (doc/user/ornament.skb (skribe/d/5_ornament.s 1.1 640))
+ (doc/user/markup.skb (skribe/d/6_markup.skb 1.2 640))
+ (doc/user/links.skb (skribe/d/7_links.skb 1.5 640))
+ (doc/user/line.skb (skribe/d/8_line.skb 1.1 640))
+ (doc/user/lib.skb (skribe/d/9_lib.skb 1.3 644))
+ (doc/user/latexe.skb (skribe/d/10_latexe.skb 1.4 640))
+ (doc/user/justify.skb (skribe/d/11_justify.sk 1.1 640))
+ (doc/user/index.skb (skribe/d/12_index.skb 1.4 640))
+ (doc/user/image.skb (skribe/d/13_image.skb 1.3 640))
+ (doc/user/htmle.skb (skribe/d/14_htmle.skb 1.6 640))
+ (doc/user/footnote.skb (skribe/d/15_footnote.s 1.1 640))
+ (doc/user/font.skb (skribe/d/16_font.skb 1.1 640))
+ (doc/user/figure.skb (skribe/d/17_figure.skb 1.1 640))
+ (doc/user/examples.skb (skribe/d/18_examples.s 1.2 640))
+ (doc/user/enumeration.skb (skribe/d/19_enumeratio 1.1 640))
+ (doc/user/engine.skb (skribe/d/20_engine.skb 1.4 640))
+ (doc/user/emacs.skb (skribe/d/21_emacs.skb 1.3 640))
+ (doc/user/document.skb (skribe/d/22_document.s 1.2 640))
+ (doc/user/colframe.skb (skribe/d/23_colframe.s 1.3 640))
+ (doc/user/char.skb (skribe/d/24_char.skb 1.2 640))
+ (doc/user/bib.skb (skribe/d/25_bib.skb 1.5 640))
+ (doc/img/linux.gif (skribe/d/29_linux.gif 1.2 640) :no-keywords)
+ (doc/img/lambda.gif (skribe/d/30_lambda.gif 1.1 640) :no-keywords)
+ (doc/img/bsd.gif (skribe/d/31_bsd.gif 1.1 640) :no-keywords)
+ (doc/Makefile (skribe/d/32_Makefile 1.6 640))
+ (configure (skribe/d/33_configure 1.5 750))
+ (README.java (skribe/d/34_README.jav 1.2 640))
+ (README (skribe/d/35_README 1.1 640))
+ (LICENSE (skribe/d/36_LICENSE 1.2 640))
+ (INSTALL (skribe/d/37_INSTALL 1.2 640))
+ (Makefile (skribe/d/38_Makefile 1.5 640))
+
+;; Files added by populate at Sat, 17 Jan 2004 08:29:33 +0100,
+;; to version 1.0b.1(w), by serrano:
+
+ (src/common/sui.scm (skribe/d/39_sui.scm 1.2 640))
+ (src/bigloo/sui.bgl (skribe/d/40_sui.bgl 1.1 640))
+ (etc/ChangeLog (skribe/d/41_ChangeLog 1.11 640))
+ (doc/user/src/slides.skb (skribe/d/42_slides.skb 1.2 640))
+ (doc/user/slide.skb (skribe/d/43_slide.skb 1.4 640))
+ (doc/user/skribe-config.skb (skribe/d/44_skribe-con 1.2 640))
+ (doc/skr/manual.skr (skribe/d/45_manual.skr 1.3 640))
+ (doc/skr/extension.skr (skribe/d/46_extension. 1.1 640))
+ (doc/skr/env.skr (skribe/d/47_env.skr 1.2 640))
+ (doc/skr/api.skr (skribe/d/48_api.skr 1.5 640))
+ (doc/dir/dir.skb (skribe/d/49_dir.skb 1.1 640))
+ (doc/Makefile.dir (skribe/d/50_Makefile.d 1.2 640))
+
+;; Files added by populate at Sun, 18 Jan 2004 12:46:07 +0100,
+;; to version 1.0b.4(w), by serrano:
+
+ (src/bigloo/asm.scm (skribe/d/51_asm.scm 1.2 640))
+
+;; Files added by populate at Wed, 18 Feb 2004 21:22:35 +0100,
+;; to version 1.0b.5(w), by serrano:
+
+ (src/stklos/xml-lex.l (skribe/e/0_xml-lex.l 1.1 644))
+ (src/stklos/configure.stk (skribe/e/1_configure. 1.1 644))
+ (doc/user/xmle.skb (skribe/e/2_xmle.skb 1.2 640))
+ (contribs/tools/skribeinfo/src/Makefile (skribe/e/3_Makefile 1.2 640))
+ (contribs/tools/skribeinfo/skr/skribeinfo.skr (skribe/e/4_skribeinfo 1.1 640))
+ (contribs/tools/skribeinfo/doc/pckg/skribeinfo.skb (skribe/e/5_skribeinfo 1.1 640))
+ (contribs/tools/skribeinfo/configure (skribe/e/6_configure 1.2 750))
+ (contribs/tools/skribeinfo/README (skribe/e/7_README 1.2 640))
+ (contribs/tools/skribeinfo/Makefile.in (skribe/e/8_Makefile.i 1.3 640))
+ (contribs/tools/Makefile (skribe/e/9_Makefile 1.3 640))
+ (contribs/ext/bc-table/src/skribebctable.scm (skribe/e/10_skribebcta 1.2 640))
+ (contribs/ext/bc-table/src/example.bc (skribe/e/11_example.bc 1.1 640))
+ (contribs/ext/bc-table/src/Makefile (skribe/e/12_Makefile 1.2 640))
+ (contribs/ext/bc-table/skr/bc-table.skr (skribe/e/13_bc-table.s 1.4 640))
+ (contribs/ext/bc-table/example/example.skb (skribe/e/14_example.sk 1.2 640))
+ (contribs/ext/bc-table/doc/pckg/bc-table.skb (skribe/e/15_bc-table.s 1.2 640))
+ (contribs/ext/bc-table/configure (skribe/e/16_configure 1.2 750))
+ (contribs/ext/bc-table/README (skribe/e/17_README 1.1 640))
+ (contribs/ext/bc-table/Makefile.in (skribe/e/18_Makefile.i 1.2 640))
+ (contribs/ext/Makefile (skribe/e/19_Makefile 1.3 640))
+ (contribs/Makefile (skribe/e/20_Makefile 1.1 640))
+
+;; Files added by populate at Wed, 18 Feb 2004 21:24:57 +0100,
+;; to version 1.0b.6(w), by serrano:
+
+ (contribs/ext/longtable/skr/longtable.skr (skribe/e/21_longtable. 1.1 640))
+ (contribs/ext/longtable/example/example.skb (skribe/e/22_example.sk 1.1 640))
+ (contribs/ext/longtable/doc/pckg/longtable.skb (skribe/e/23_longtable. 1.1 640))
+ (contribs/ext/longtable/configure (skribe/e/24_configure 1.2 750))
+ (contribs/ext/longtable/README (skribe/e/25_README 1.1 640))
+ (contribs/ext/longtable/Makefile.in (skribe/e/26_Makefile.i 1.3 640))
+
+;; Files added by populate at Sat, 21 Feb 2004 10:39:55 +0100,
+;; to version 1.0b.8(w), by serrano:
+
+ (doc/user/package.skb (skribe/e/27_package.sk 1.3 640))
+ (contribs/tools/skribeinfo/example/example.skb (skribe/e/28_example.sk 1.2 640))
+ (contribs/ext/html-navbar/skr/html-navbar.skr (skribe/e/29_html-navba 1.2 640))
+ (contribs/ext/html-navbar/example/example.skb (skribe/e/30_example.sk 1.2 640))
+ (contribs/ext/html-navbar/doc/pckg/html-navbar.skb (skribe/e/31_html-navba 1.2 640))
+ (contribs/ext/html-navbar/configure (skribe/e/32_configure 1.1 750))
+ (contribs/ext/html-navbar/README (skribe/e/33_README 1.1 640))
+ (contribs/ext/html-navbar/Makefile.in (skribe/e/34_Makefile.i 1.2 640))
+ (contribs/ext/html-gui/skr/html-gui.skr (skribe/e/35_html-gui.s 1.3 640))
+ (contribs/ext/html-gui/example/example.skb (skribe/e/36_example.sk 1.2 640))
+ (contribs/ext/html-gui/doc/pckg/html-gui.skb (skribe/e/37_html-gui.s 1.2 640))
+ (contribs/ext/html-gui/configure (skribe/e/38_configure 1.2 755))
+ (contribs/ext/html-gui/README (skribe/e/39_README 1.1 640))
+ (contribs/ext/html-gui/Makefile.in (skribe/e/40_Makefile.i 1.2 640))
+
+;; Files added by populate at Wed, 19 May 2004 14:41:48 +0200,
+;; to version 1.0b.9(w), by serrano:
+
+ (src/stklos/lisp-lex.l (skribe/e/41_lisp-lex.l 1.2 644))
+ (src/stklos/c.stk (skribe/e/42_c.stk 1.1 644))
+ (src/stklos/c-lex.l (skribe/e/43_c-lex.l 1.1 644))
+ (skr/web-article.skr (skribe/e/44_web-articl 1.1 640))
+ (skr/html4.skr (skribe/e/45_html4.skr 1.1 644))
+ (contribs/tools/skribeinfo/CONTRIB.skb (skribe/e/46_CONTRIB.sk 1.1 640))
+ (contribs/tools/skribecolsel/src/skribecolsel.scm (skribe/e/47_skribecols 1.1 640))
+ (contribs/tools/skribecolsel/src/Makefile (skribe/e/48_Makefile 1.1 640))
+ (contribs/tools/skribecolsel/emacs/skribecolsel.el (skribe/e/49_skribecols 1.1 640))
+ (contribs/tools/skribecolsel/configure (skribe/e/50_configure 1.1 750))
+ (contribs/tools/skribecolsel/README (skribe/e/51_README 1.1 640))
+ (contribs/tools/skribecolsel/Makefile.in (skribe/f/0_Makefile.i 1.1 640))
+ (contribs/tools/skribecolsel/CONTRIB.skb (skribe/f/1_CONTRIB.sk 1.1 640))
+ (contribs/ext/longtable/CONTRIB.skb (skribe/f/2_CONTRIB.sk 1.1 640))
+ (contribs/ext/js-tricks/skr/js-tricks.skr (skribe/f/3_js-tricks. 1.1 640))
+ (contribs/ext/js-tricks/example/example.skb (skribe/f/4_example.sk 1.2 640))
+ (contribs/ext/js-tricks/doc/pckg/js-tricks.skb (skribe/f/5_js-tricks. 1.1 640))
+ (contribs/ext/js-tricks/configure (skribe/f/6_configure 1.1 750))
+ (contribs/ext/js-tricks/README (skribe/f/7_README 1.1 640))
+ (contribs/ext/js-tricks/Makefile.in (skribe/f/8_Makefile.i 1.1 640))
+ (contribs/ext/html-navtabs/skr/html-navtabs.skr (skribe/f/9_html-navta 1.1 640))
+ (contribs/ext/html-navtabs/example/example.skb (skribe/f/10_example.sk 1.1 640))
+ (contribs/ext/html-navtabs/doc/pckg/html-navtabs.skb (skribe/f/11_html-navta 1.1 640))
+ (contribs/ext/html-navtabs/configure (skribe/f/12_configure 1.1 750))
+ (contribs/ext/html-navtabs/README (skribe/f/13_README 1.1 640))
+ (contribs/ext/html-navtabs/Makefile.in (skribe/f/14_Makefile.i 1.1 640))
+ (contribs/ext/html-navtabs/CONTRIB.skb (skribe/f/15_CONTRIB.sk 1.1 640))
+ (contribs/ext/html-gui/CONTRIB.skb (skribe/f/16_CONTRIB.sk 1.1 640))
+ (contribs/ext/fontsample/skr/fontsample.skr (skribe/f/17_fontsample 1.1 640))
+ (contribs/ext/fontsample/example/example.skb (skribe/f/18_example.sk 1.1 640))
+ (contribs/ext/fontsample/doc/pckg/fontsample.skb (skribe/f/19_fontsample 1.1 640))
+ (contribs/ext/fontsample/configure (skribe/f/20_configure 1.1 750))
+ (contribs/ext/fontsample/README (skribe/f/21_README 1.1 640))
+ (contribs/ext/fontsample/Makefile.in (skribe/f/22_Makefile.i 1.1 640))
+ (contribs/ext/fontsample/CONTRIB.skb (skribe/f/23_CONTRIB.sk 1.1 640))
+
+;; Files added by populate at Wed, 22 Sep 2004 02:17:27 +0200,
+;; to version 1.1b.2(w), by serrano:
+
+ (src/bigloo/parseargs.scm (skribe/f/24_parseargs. 1.2 640))
+
+;; Files added by populate at Wed, 22 Sep 2004 14:53:18 +0200,
+;; to version 1.1b.5(w), by serrano:
+
+ (skr/latex-simple.skr (skribe/f/25_latex-simp 1.2 640))
+
+;; Files added by populate at Fri, 03 Jun 2005 16:47:11 +0200,
+;; to version 1.1b.7(w), by serrano:
+
+ (tools/skribebibtex/stklos/main.stk (skribe/f/26_main.stk 1.1 644))
+ (tools/skribebibtex/stklos/bibtex-parser.y (skribe/f/27_bibtex-par 1.1 644))
+ (tools/skribebibtex/stklos/bibtex-lex.l (skribe/f/28_bibtex-lex 1.1 644))
+ (tools/skribebibtex/stklos/Makefile (skribe/f/29_Makefile 1.1 644))
+ (tools/skribebibtex/bigloo/skribebibtex.scm (skribe/f/30_skribebibt 1.1 640))
+ (tools/skribebibtex/bigloo/main.scm (skribe/f/31_main.scm 1.1 640))
+ (tools/skribebibtex/bigloo/Makefile (skribe/f/32_Makefile 1.1 640))
+ (skr/sigplan.skr (skribe/f/33_sigplan.sk 1.1 640))
+ (skr/context.skr (skribe/f/34_context.sk 1.1 644))
+)
+(Merge-Parents)
+(New-Merge-Parents)
diff --git a/skribe/src/Makefile b/skribe/src/Makefile
new file mode 100644
index 0000000..09e96d5
--- /dev/null
+++ b/skribe/src/Makefile
@@ -0,0 +1,41 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/src/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Sat Oct 25 08:15:57 2003 */
+#* Last change : Mon Jan 5 09:55:27 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The meta Makefile for the sources */
+#*=====================================================================*/
+include ../etc/Makefile.config
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo src/Makefile
+ @ (cd bigloo && $(MAKE) pop)
+ @ (cd stklos && $(MAKE) pop)
+
+#*---------------------------------------------------------------------*/
+#* Install/Uinstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install:
+ (cd $(SYSTEM) && $(MAKE) install)
+
+uninstall:
+ (cd $(SYSTEM) && $(MAKE) uninstall)
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean
+
+clean:
+ (cd $(SYSTEM) && $(MAKE) clean)
+
diff --git a/skribe/src/bigloo/Makefile b/skribe/src/bigloo/Makefile
new file mode 100644
index 0000000..02d2b6a
--- /dev/null
+++ b/skribe/src/bigloo/Makefile
@@ -0,0 +1,271 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/src/bigloo/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Mon Jul 21 18:21:11 2003 */
+#* Last change : Fri Jun 4 10:10:50 2004 (serrano) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to build the Bigloo API */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* General inclusion */
+#*---------------------------------------------------------------------*/
+include ../../etc/bigloo/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* Compilers and tools */
+#*---------------------------------------------------------------------*/
+BSKBFLAGS = -I $(SRCDIR)/bigloo
+
+#*---------------------------------------------------------------------*/
+#* Targets ... */
+#*---------------------------------------------------------------------*/
+PROJECT = skribe
+CTARGET = $(SKRIBEBINDIR)/skribe.bigloo
+JVMTARGET = $(SKRIBEBINDIR)/skribe.zip
+
+PBASE = bigloo.$(PROJECT)
+ODIR = o
+CLASSDIR = class_s/bigloo/$(PROJECT)
+OBJDIR = obj/bigloo/$(PROJECT)
+
+#*---------------------------------------------------------------------*/
+#* Objects */
+#*---------------------------------------------------------------------*/
+SRCDIR = ..
+SKRIBECOMMON = param api bib index lib sui
+SKRIBEBGL = types parseargs main eval evapi \
+ output resolve verify debug read prog source \
+ lisp xml c asm engine writer color
+SKRIBEINCLUDE = api new debug
+
+MODULES = $(SKRIBEBGL:%=%.scm) \
+ $(SKRIBECOMMON:%=%.bgl) \
+ configure.bgl
+INCLUDES = $(SKRIBEINCLUDE:%=%.sch)
+SOURCES = $(MODULES) \
+ $(SKRIBECOMMON:%=$(SRCDIR)/common/%.scm) \
+ $(SRCDIR)/common/configure.scm \
+ $(INCLUDES)
+OBJECTS = $(SKRIBECOMMON) $(SKRIBEBGL) configure
+COBJECTS = $(OBJECTS:%=$(ODIR)/%.o)
+JVMCLASSES = $(OBJECTS:%=$(ODIR)/class_s/bigloo/$(PROJECT)/%.class)
+
+#*---------------------------------------------------------------------*/
+#* Population */
+#*---------------------------------------------------------------------*/
+POPULATIONBGL = $(MODULES) $(INCLUDES) Makefile
+POPULATIONSCM = $(SKRIBECOMMON:%=%.scm) configure.scm.in
+
+#*---------------------------------------------------------------------*/
+#* Suffixes */
+#*---------------------------------------------------------------------*/
+.SUFFIXES:
+.SUFFIXES: .scm .bgl .class .o .obj
+
+#*---------------------------------------------------------------------*/
+#* All */
+#*---------------------------------------------------------------------*/
+.PHONY: c jvm dotnet
+
+all: $(TARGET)
+
+c: $(CTARGET)
+jvm: $(JVMTARGET)
+dotnet:
+ echo "Not implemented yet"
+
+#*--- c ---------------------------------------------------------------*/
+$(CTARGET): $(SKRIBEBINDIR) .afile $(ODIR) $(COBJECTS)
+ $(BIGLOO) $(BLINKFLAGS) -o $@ $(COBJECTS)
+
+#*--- jvm -------------------------------------------------------------*/
+$(JVMTARGET): $(SKRIBEBINDIR) .afile .jfile $(ODIR) $(JVMCLASSES)
+ $(RM) -f $(JVMTARGET)
+ (cd $(ODIR)/class_s && \
+ $(ZIP) -q $(ZFLAGS) $(JVMTARGET) -r .)
+
+$(SKRIBEBINDIR):
+ mkdir -p $(SKRIBEBINDIR)
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ echo $(POPULATIONSCM:%=src/common/%)
+ @ echo $(POPULATIONBGL:%=src/bigloo/%)
+
+#*---------------------------------------------------------------------*/
+#* ude */
+#*---------------------------------------------------------------------*/
+.PHONY: ude .etags .afile
+
+ude:
+ @ $(MAKE) -f Makefile .afile .etags dep
+
+.afile:
+ @ $(AFILE) -o .afile $(MODULES)
+
+.jfile:
+ @ $(JFILE) -I src -o .jfile -pbase $(PBASE) $(MODULES)
+
+.etags:
+ @ $(BTAGS) -o .etags $(SOURCES)
+
+dep:
+ @(num=`grep -n '^#bdepend start' Makefile | awk -F: '{ print $$1}' -`;\
+ head -`expr $$num - 1` Makefile > /tmp/Makefile.aux)
+ @ $(BDEPEND) -search-path ../common \
+ -search-path ../bigloo \
+ -strict-obj-dir $(ODIR) \
+ -strict-class-dir $(CLASSDIR) \
+ -fno-mco $(SOURCES) >> /tmp/Makefile.aux
+ @ mv /tmp/Makefile.aux Makefile
+
+getbinary:
+ @ echo $(PROJECT)
+
+getsources:
+ @ echo $(SOURCES)
+
+#*---------------------------------------------------------------------*/
+#* The implicit rules */
+#*---------------------------------------------------------------------*/
+$(ODIR)/%.o: $(SRCDIR)/bigloo/%.bgl $(SRCDIR)/common/%.scm
+ $(BIGLOO) $(BCFLAGS) $(BSKBFLAGS) $(BCOMMONFLAGS) -c \
+ $(SRCDIR)/bigloo/$*.bgl $(SRCDIR)/common/$*.scm -o $@
+
+$(ODIR)/%.o: $(SRCDIR)/bigloo/%.scm
+ $(BIGLOO) $(BCFLAGS) $(BSKBFLAGS) $(BCOMMONFLAGS) -c \
+ $(SRCDIR)/bigloo/$*.scm -o $@
+
+$(ODIR)/class_s/bigloo/$(PROJECT)/%.class: \
+ $(SRCDIR)/bigloo/%.bgl $(SRCDIR)/common/%.scm
+ $(BIGLOO) $(BJVMFLAGS) $(BSKBFLAGS) $(BCOMMONFLAGS) -c \
+ $(SRCDIR)/bigloo/$*.bgl $(SRCDIR)/common/$*.scm -o $@
+
+$(ODIR)/class_s/bigloo/$(PROJECT)/%.class: $(SRCDIR)/bigloo/%.scm
+ $(BIGLOO) $(BJVMFLAGS) $(BSKBFLAGS) $(BCOMMONFLAGS) -c \
+ $(SRCDIR)/bigloo/$*.scm -o $@
+
+$(OBJDIR)/%.obj: src/%.scm
+ $(BIGLOO) $(BDNFLAGS) $(BCOMMONFLAGS) -c $< -o $@
+
+#*---------------------------------------------------------------------*/
+#* Ad hoc rules */
+#*---------------------------------------------------------------------*/
+$(ODIR):
+ mkdir -p $(ODIR)
+
+$(CLASSDIR):
+ mkdir -p $(CLASSDIR)
+
+$(OBJDIR):
+ mkdir -p $(OBJDIR)
+
+
+#*---------------------------------------------------------------------*/
+#* install/uninstall */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall install-c uninstall-c install-jvm uninstall-jvm
+
+install:
+ $(MAKE) install-$(TARGET)
+
+uninstall:
+ $(MAKE) uninstall-$(TARGET)
+
+install-c: $(DESTDIR)$(INSTALL_BINDIR)
+ cp $(CTARGET) $(DESTDIR)$(INSTALL_BINDIR)/skribe.bigloo \
+ && chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)/skribe.bigloo
+ $(RM) -f $(DESTDIR)$(INSTALL_BINDIR)/skribe
+ ln -s skribe.bigloo $(DESTDIR)$(INSTALL_BINDIR)/skribe
+
+uninstall-c:
+ $(RM) -f $(DESTDIR)$(INSTALL_BINDIR)/skribe.bigloo
+ $(RM) -f $(DESTDIR)$(INSTALL_BINDIR)/skribe
+
+install-jvm: $(DESTDIR)$(INSTALL_FILDIR)
+ cp $(JVMTARGET) $(DESTDIR)$(INSTALL_FILDIR)/skribe.zip
+ cp $(FILDIR)/bigloo_s.zip $(DESTDIR)$(INSTALL_FILDIR)
+
+uninstall-jvm:
+ $(RM) -f $(DESTDIR)$(INSTALL_FILDIR)/skribe.zip
+ $(RM) -f $(DESTDIR)$(INSTALL_FILDIR)/bigloo_s.zip
+
+$(DESTDIR)$(INSTALL_BINDIR):
+ mkdir -p $(DESTDIR)$(INSTALL_BINDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_BINDIR)
+
+$(DESTDIR)$(INSTALL_FILDIR):
+ mkdir -p $(DESTDIR)$(INSTALL_FILDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_FILDIR)
+
+#*---------------------------------------------------------------------*/
+#* Clean */
+#*---------------------------------------------------------------------*/
+clean:
+ $(RM) -f .afile
+ $(RM) -f .jfile
+ $(RM) -rf $(ODIR)
+ $(RM) -f $(CTARGET)
+ $(RM) -f $(JVMTARGET)
+
+#*---------------------------------------------------------------------*/
+#* Cleanall */
+#*---------------------------------------------------------------------*/
+cleanall: clean
+
+#*---------------------------------------------------------------------*/
+#* Manual dependency */
+#*---------------------------------------------------------------------*/
+o/eval.o o/class/bigloo/skribe/eval.class: \
+ $(SRCDIR)/bigloo/api.bgl $(SRCDIR)/common/api.scm
+
+#bdepend start (don't edit)
+#*---------------------------------------------------------------------*/
+#* Dependencies ... */
+#*---------------------------------------------------------------------*/
+o/index.o class_s/bigloo/skribe/index.class: ../bigloo/new.sch
+o/bib.o class_s/bigloo/skribe/bib.class: ../bigloo/new.sch
+o/writer.o class_s/bigloo/skribe/writer.class: ../bigloo/debug.sch
+o/lisp.o class_s/bigloo/skribe/lisp.class: ../bigloo/new.sch
+o/lib.o class_s/bigloo/skribe/lib.class: ../bigloo/debug.sch
+o/resolve.o class_s/bigloo/skribe/resolve.class: ../bigloo/debug.sch
+o/api.o class_s/bigloo/skribe/api.class: ../bigloo/new.sch \
+ ../bigloo/api.sch
+o/eval.o class_s/bigloo/skribe/eval.class: ../bigloo/debug.sch
+o/xml.o class_s/bigloo/skribe/xml.class: ../bigloo/new.sch
+o/parseargs.o class_s/bigloo/skribe/parseargs.class: ../bigloo/debug.sch
+o/prog.o class_s/bigloo/skribe/prog.class: ../bigloo/new.sch
+o/verify.o class_s/bigloo/skribe/verify.class: ../bigloo/debug.sch
+o/sui.o class_s/bigloo/skribe/sui.class: ../bigloo/debug.sch
+o/verify.o class_s/bigloo/skribe/verify.class: ../bigloo/debug.sch
+o/source.o class_s/bigloo/skribe/source.class: ../bigloo/new.sch
+o/bib.o class_s/bigloo/skribe/bib.class: ../bigloo/new.sch
+o/asm.o class_s/bigloo/skribe/asm.class: ../bigloo/new.sch
+o/source.o class_s/bigloo/skribe/source.class: ../bigloo/new.sch
+o/engine.o class_s/bigloo/skribe/engine.class: ../bigloo/debug.sch
+o/engine.o class_s/bigloo/skribe/engine.class: ../bigloo/debug.sch
+o/lib.o class_s/bigloo/skribe/lib.class: ../bigloo/debug.sch
+o/c.o class_s/bigloo/skribe/c.class: ../bigloo/new.sch
+o/writer.o class_s/bigloo/skribe/writer.class: ../bigloo/debug.sch
+o/xml.o class_s/bigloo/skribe/xml.class: ../bigloo/new.sch
+o/main.o class_s/bigloo/skribe/main.class: ../bigloo/debug.sch
+o/output.o class_s/bigloo/skribe/output.class: ../bigloo/debug.sch
+o/prog.o class_s/bigloo/skribe/prog.class: ../bigloo/new.sch
+o/output.o class_s/bigloo/skribe/output.class: ../bigloo/debug.sch
+o/resolve.o class_s/bigloo/skribe/resolve.class: ../bigloo/debug.sch
+o/sui.o class_s/bigloo/skribe/sui.class: ../bigloo/debug.sch
+o/asm.o class_s/bigloo/skribe/asm.class: ../bigloo/new.sch
+o/eval.o class_s/bigloo/skribe/eval.class: ../bigloo/debug.sch
+o/c.o class_s/bigloo/skribe/c.class: ../bigloo/new.sch
+o/index.o class_s/bigloo/skribe/index.class: ../bigloo/new.sch
+o/lisp.o class_s/bigloo/skribe/lisp.class: ../bigloo/new.sch
+o/api.o class_s/bigloo/skribe/api.class: ../bigloo/new.sch \
+ ../bigloo/api.sch
+o/parseargs.o class_s/bigloo/skribe/parseargs.class: ../bigloo/debug.sch
+
+#bdepend stop
diff --git a/skribe/src/bigloo/api.bgl b/skribe/src/bigloo/api.bgl
new file mode 100644
index 0000000..55493b0
--- /dev/null
+++ b/skribe/src/bigloo/api.bgl
@@ -0,0 +1,117 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/api.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Jul 21 18:21:34 2003 */
+;* Last change : Wed Dec 31 13:07:10 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Bigloo header for the API. */
+;* ------------------------------------------------------------- */
+;* Implementation: @label api@ */
+;* bigloo: @path ../common/api.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_api
+
+ (include "new.sch"
+ "api.sch")
+
+ (import skribe_param
+ skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_bib
+ skribe_index
+ skribe_prog
+ skribe_source
+ skribe_engine
+ skribe_color
+ skribe_sui)
+
+ (export (include string)
+
+ (document::%markup . opts)
+ (author::%markup . opts)
+ (toc::%markup . opts)
+
+ (chapter::%markup . opts)
+ (section::%markup . opts)
+ (subsection::%markup . opts)
+ (subsubsection::%markup . opts)
+ (paragraph::%markup . opts)
+
+ (footnote::%markup . opts)
+
+ (linebreak . opts)
+ (hrule::%markup . opts)
+
+ (color::%markup . opts)
+ (frame::%markup . opts)
+ (font::%markup . opts)
+
+ (flush::%markup . opts)
+ (center::%markup . opts)
+ (pre::%markup . opts)
+ (prog::%markup . opts)
+ (source::obj . opts)
+ (language::obj . opts)
+
+ (itemize::%markup . opts)
+ (enumerate::%markup . opts)
+ (description::%markup . opts)
+ (item::%markup . opts)
+
+ (figure::%markup . opts)
+
+ (table::%markup . opts)
+ (tr::%markup . opts)
+ (td::%markup . opts)
+ (th::%markup . opts)
+
+ (image::%markup . opts)
+
+ (blockquote::%markup . opts)
+
+ (roman::%markup . opts)
+ (bold::%markup . opts)
+ (underline::%markup . opts)
+ (strike::%markup . opts)
+ (emph::%markup . opts)
+ (kbd::%markup . opts)
+ (it::%markup . opts)
+ (tt::%markup . opts)
+ (code::%markup . opts)
+ (var::%markup . opts)
+ (samp::%markup . opts)
+ (sf::%markup . opts)
+ (sc::%markup . opts)
+ (sub::%markup . opts)
+ (sup::%markup . opts)
+
+ (mailto::%markup . opts)
+ (mark::%markup . opts)
+
+ (handle . obj)
+ (ref::%ast . obj)
+ (resolve::%ast ::procedure)
+
+ (bibliography . files)
+ (the-bibliography . opts)
+
+ (make-index ::bstring)
+ (index . args)
+ (the-index . args)
+
+ (char::bstring char)
+ (symbol::%markup symbol)
+ (!::%command string . args)
+
+ (processor::%processor . opts)
+
+ (html-processor::%processor . opts)
+ (tex-processor::%processor . opts)))
diff --git a/skribe/src/bigloo/api.sch b/skribe/src/bigloo/api.sch
new file mode 100644
index 0000000..390b8fa
--- /dev/null
+++ b/skribe/src/bigloo/api.sch
@@ -0,0 +1,91 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/api.sch */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Jul 21 18:15:25 2003 */
+;* Last change : Wed Oct 27 12:43:23 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Bigloo macros for the API implementation */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* define-pervasive-macro ... */
+;*---------------------------------------------------------------------*/
+(define-macro (define-pervasive-macro proto . body)
+ `(begin
+ (eval '(define-macro ,proto ,@body))
+ (define-macro ,proto ,@body)))
+
+;*---------------------------------------------------------------------*/
+;* define-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-markup proto . body)
+ (define (s2k symbol)
+ (string->keyword (string-append ":" (symbol->string symbol))))
+ (if (not (pair? proto))
+ (error 'define-markup "Illegal markup definition" proto)
+ (let* ((id (car proto))
+ (args (cdr proto))
+ (dargs (dsssl-formals->scheme-formals args error)))
+ `(begin
+ ,(if (and (memq #!key args)
+ (memq '&skribe-eval-location args))
+ `(define-expander ,id
+ (lambda (x e)
+ (append
+ (cons ',id (map (lambda (x) (e x e)) (cdr x)))
+ (list :&skribe-eval-location
+ '(skribe-eval-location)))))
+ #unspecified)
+ (define ,(cons id dargs)
+ ,(make-dsssl-function-prelude proto
+ args `(begin ,@body)
+ error s2k))))))
+
+;*---------------------------------------------------------------------*/
+;* define-simple-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-simple-markup markup)
+ `(define-markup (,markup #!rest opts #!key ident class loc)
+ (new markup
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* define-simple-container ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-simple-container markup)
+ `(define-markup (,markup #!rest opts #!key ident class loc)
+ (new container
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* define-processor-markup ... */
+;*---------------------------------------------------------------------*/
+(define-pervasive-macro (define-processor-markup proc)
+ `(define-markup (,proc #!rest opts)
+ (new processor
+ (engine (find-engine ',proc))
+ (body (the-body opts))
+ (options (the-options opts)))))
+
+;*---------------------------------------------------------------------*/
+;* new (at runtime) */
+;*---------------------------------------------------------------------*/
+(eval '(define-macro (new id . inits)
+ (cons (symbol-append 'new- id)
+ (map (lambda (i)
+ (list 'list (list 'quote (car i)) (cadr i)))
+ inits))))
diff --git a/skribe/src/bigloo/asm.scm b/skribe/src/bigloo/asm.scm
new file mode 100644
index 0000000..03196ac
--- /dev/null
+++ b/skribe/src/bigloo/asm.scm
@@ -0,0 +1,99 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/asm.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 12:08:39 2003 */
+;* Last change : Tue Jan 20 06:07:44 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* ASM fontification */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_asm
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api
+ skribe_param
+ skribe_source)
+
+ (export asm))
+
+;*---------------------------------------------------------------------*/
+;* asm ... */
+;*---------------------------------------------------------------------*/
+(define asm
+ (new language
+ (name "asm")
+ (fontifier asm-fontifier)
+ (extractor #f)))
+
+;*---------------------------------------------------------------------*/
+;* asm-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (asm-fontifier s)
+ (let ((g (regular-grammar ()
+ ((: "/*" (* (or (out #\*) (: (+ #\*) (out #\/ #\*))))
+ (+ #\*) "/")
+ ;; bold comments
+ (let ((c (new markup
+ (markup '&source-line-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((: "//" (* all))
+ ;; italic comments
+ (let ((c (new markup
+ (markup '&source-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((: "#" (* all))
+ ;; italic comments
+ (let ((c (new markup
+ (markup '&source-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((+ (or #\Newline #\Space))
+ ;; separators
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ ((: (* (in #\tab #\space))
+ (+ (out #\: #\Space #\Tab #\Newline)) #\:)
+ ;; labels
+ (let ((c (new markup
+ (markup '&source-define)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((or (in "<>=!/\\+*-([])")
+ #\/
+ (+ (out #\; #\Space #\Tab #\Newline #\( #\) #\[ #\] #\" #\< #\> #\= #\! #\/ #\/ #\+ #\* #\-)))
+ ;; regular text
+ (let ((s (the-string)))
+ (cons s (ignore))))
+ ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ ;; strings
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-string)
+ (body s))))
+ str)
+ (ignore))))
+ ((+ (or #\; #\" #\# #\tab))
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ '()
+ (error "source(asm)" "Unexpected character" c)))))))
+ (read/rp g (open-input-string s))))
+
diff --git a/skribe/src/bigloo/bib.bgl b/skribe/src/bigloo/bib.bgl
new file mode 100644
index 0000000..6b0f7dd
--- /dev/null
+++ b/skribe/src/bigloo/bib.bgl
@@ -0,0 +1,161 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/bib.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Dec 7 06:12:29 2001 */
+;* Last change : Tue Nov 2 17:14:02 2004 (serrano) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe Bibliography */
+;* ------------------------------------------------------------- */
+;* Implementation: @label bib@ */
+;* bigloo: @path ../common/bib.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_bib
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_read)
+
+ (export (bib-table?::bool ::obj)
+ (make-bib-table ::bstring)
+ (default-bib-table)
+ (bib-load! ::obj ::bstring ::obj)
+ (bib-add! ::obj . entries)
+ (resolve-bib ::obj ::obj)
+ (resolve-the-bib ::obj ::obj ::procedure ::obj ::symbol ::pair-nil)
+ (bib-sort/authors::pair-nil ::pair-nil)
+ (bib-sort/idents::pair-nil ::pair-nil)
+ (bib-sort/dates::pair-nil ::pair-nil)))
+
+;*---------------------------------------------------------------------*/
+;* bib-table? ... */
+;*---------------------------------------------------------------------*/
+(define (bib-table? obj)
+ (hashtable? obj))
+
+;*---------------------------------------------------------------------*/
+;* *bib-table* ... */
+;*---------------------------------------------------------------------*/
+(define *bib-table* #f)
+
+;*---------------------------------------------------------------------*/
+;* make-bib-table ... */
+;*---------------------------------------------------------------------*/
+(define (make-bib-table ident)
+ (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* default-bib-table ... */
+;*---------------------------------------------------------------------*/
+(define (default-bib-table)
+ (if (not *bib-table*)
+ (set! *bib-table* (make-bib-table "default-bib-table")))
+ *bib-table*)
+
+;*---------------------------------------------------------------------*/
+;* bib-parse-error ... */
+;*---------------------------------------------------------------------*/
+(define (bib-parse-error entry)
+ (if (epair? entry)
+ (match-case (cer entry)
+ ((at ?fname ?pos ?-)
+ (error/location "parse-biblio"
+ "bibliography syntax error"
+ entry
+ fname
+ pos))
+ (else
+ (error 'bib-parse "bibliography syntax error" entry)))
+ (error 'bib-parse "bibliography syntax error" entry)))
+
+;*---------------------------------------------------------------------*/
+;* bib-duplicate ... */
+;*---------------------------------------------------------------------*/
+(define (bib-duplicate ident from old)
+ (let ((ofrom (markup-option old 'from)))
+ (skribe-warning 2
+ 'bib
+ (format "Duplicated bibliographic entry ~a'.\n" ident)
+ (if ofrom
+ (format " Using version of `~a'.\n" ofrom)
+ "")
+ (if from
+ (format " Ignoring version of `~a'." from)
+ " Ignoring redefinition."))))
+
+;*---------------------------------------------------------------------*/
+;* parse-bib ... */
+;*---------------------------------------------------------------------*/
+(define (parse-bib table port)
+ (if (not (bib-table? table))
+ (skribe-error 'parse-bib "Illegal bibliography table" table)
+ (let ((from (input-port-name port)))
+ (let loop ((entry (skribe-read port)))
+ (if (not (eof-object? entry))
+ (match-case entry
+ (((and (? symbol?) ?kind) (and (? symbol?) ?ident) . ?fds)
+ (let* ((ident (symbol->string ident))
+ (old (hashtable-get table ident)))
+ (if old
+ (bib-duplicate ident from old)
+ (hashtable-put! table
+ ident
+ (make-bib-entry kind
+ ident
+ fds
+ from))))
+ (loop (skribe-read port)))
+ (((and (? symbol?) ?kind) (and (? string?) ?ident) . ?fds)
+ (let ((old (hashtable-get table ident)))
+ (if old
+ (bib-duplicate ident from old)
+ (hashtable-put! table
+ ident
+ (make-bib-entry kind
+ ident
+ fds
+ from))))
+ (loop (skribe-read port)))
+ (else
+ (bib-parse-error entry))))))))
+
+;*---------------------------------------------------------------------*/
+;* bib-add! ... */
+;*---------------------------------------------------------------------*/
+(define (bib-add! table . entries)
+ (if (not (bib-table? table))
+ (skribe-error 'bib-add! "Illegal bibliography table" table)
+ (for-each (lambda (entry)
+ (match-case entry
+ (((and (? symbol?) ?kind) (and (? symbol?) ?ident) . ?fs)
+ (let* ((ident (symbol->string ident))
+ (old (hashtable-get table ident)))
+ (if old
+ (bib-duplicate ident #f old)
+ (hashtable-put! table
+ ident
+ (make-bib-entry kind
+ ident fs #f)))))
+ (((and (? symbol?) ?kind) (and (? string?) ?ident) . ?fs)
+ (let ((old (hashtable-get table ident)))
+ (if old
+ (bib-duplicate ident #f old)
+ (hashtable-put! table
+ ident
+ (make-bib-entry kind
+ ident fs #f)))))
+ (else
+ (bib-parse-error entry))))
+ entries)))
+
+
+
diff --git a/skribe/src/bigloo/c.scm b/skribe/src/bigloo/c.scm
new file mode 100644
index 0000000..07290ce
--- /dev/null
+++ b/skribe/src/bigloo/c.scm
@@ -0,0 +1,134 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/c.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 12:08:39 2003 */
+;* Last change : Thu May 27 10:11:24 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* C fontification */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_c
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api
+ skribe_param
+ skribe_source)
+
+ (export C))
+
+;*---------------------------------------------------------------------*/
+;* C stamps */
+;*---------------------------------------------------------------------*/
+(define *keyword* (gensym))
+(define *cpp* (gensym))
+
+;*---------------------------------------------------------------------*/
+;* C keywords */
+;*---------------------------------------------------------------------*/
+(for-each (lambda (symbol)
+ (putprop! symbol *keyword* #t))
+ '(for class template while return try catch break continue
+ do if else typedef struct union goto switch case
+ static extern default finally throw))
+(let ((sharp (string->symbol "#")))
+ (for-each (lambda (symbol)
+ (putprop! (symbol-append sharp symbol) *cpp* #t))
+ '(include define if ifdef ifdef else endif)))
+
+;*---------------------------------------------------------------------*/
+;* C ... */
+;*---------------------------------------------------------------------*/
+(define C
+ (new language
+ (name "C")
+ (fontifier c-fontifier)
+ (extractor #f)))
+
+;*---------------------------------------------------------------------*/
+;* c-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (c-fontifier s)
+ (let ((g (regular-grammar ()
+ ((: "/*" (* (or (out #\*) (: (+ #\*) (out #\/ #\*))))
+ (+ #\*) "/")
+ ;; bold comments
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-line-comment)
+ (body s))))
+ str)
+ (ignore))))
+ ((: "//" (* all))
+ ;; italic comments
+ (let ((c (new markup
+ (markup '&source-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((+ (or #\Newline #\Space))
+ ;; separators
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ ((in "{}")
+ ;; brackets
+ (let ((str (the-string)))
+ (let ((c (new markup
+ (markup '&source-bracket)
+ (body (the-string)))))
+ (cons c (ignore)))))
+ ((+ (out #\; #\Space #\Tab #\Newline #\( #\) #\{ #\} #\[ #\] #\" #\< #\> #\= #\! #\/ #\/ #\+ #\* #\-))
+ ;; keywords
+ (let* ((string (the-string))
+ (symbol (the-symbol)))
+ (cond
+ ((getprop symbol *keyword*)
+ (let ((c (new markup
+ (markup '&source-keyword)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ ((getprop symbol *cpp*)
+ (let ((c (new markup
+ (markup '&source-module)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ (else
+ (cons string (ignore))))))
+ ((in "<>=!/\\+*-([])")
+ ;; regular text
+ (let ((s (the-string)))
+ (cons s (ignore))))
+ ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ ;; strings
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-string)
+ (body s))))
+ str)
+ (ignore))))
+ ((+ (or #\; #\" #\# #\tab))
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ '()
+ (error "source(C)" "Unexpected character" c)))))))
+ (read/rp g (open-input-string s))))
+
diff --git a/skribe/src/bigloo/color.scm b/skribe/src/bigloo/color.scm
new file mode 100644
index 0000000..e40638b
--- /dev/null
+++ b/skribe/src/bigloo/color.scm
@@ -0,0 +1,702 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/color.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Apr 10 13:46:50 2002 */
+;* Last change : Wed Jan 7 11:39:58 2004 (serrano) */
+;* Copyright : 2002-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Tex color manager */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_color
+ (import skribe_configure)
+ (export (skribe-color->rgb ::obj)
+ (skribe-get-used-colors)
+ (skribe-use-color! color)))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-rgb-string* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-rgb-string*
+ "255 250 250 snow
+248 248 255 ghostwhite
+245 245 245 whitesmoke
+220 220 220 gainsboro
+255 250 240 floralwhite
+253 245 230 oldlace
+250 240 230 linen
+250 235 215 antiquewhite
+255 239 213 papayawhip
+255 235 205 blanchedalmond
+255 228 196 bisque
+255 218 185 peachpuff
+255 222 173 navajowhite
+255 228 181 moccasin
+255 248 220 cornsilk
+255 255 240 ivory
+255 250 205 lemonchiffon
+255 245 238 seashell
+240 255 240 honeydew
+245 255 250 mintcream
+240 255 255 azure
+240 248 255 aliceblue
+230 230 250 lavender
+255 240 245 lavenderblush
+255 228 225 mistyrose
+255 255 255 white
+0 0 0 black
+47 79 79 darkslategrey
+105 105 105 dimgrey
+112 128 144 slategrey
+119 136 153 lightslategrey
+190 190 190 grey
+211 211 211 lightgrey
+25 25 112 midnightblue
+0 0 128 navy
+0 0 128 navyblue
+100 149 237 cornflowerblue
+72 61 139 darkslateblue
+106 90 205 slateblue
+123 104 238 mediumslateblue
+132 112 255 lightslateblue
+0 0 205 mediumblue
+65 105 225 royalblue
+0 0 255 blue
+30 144 255 dodgerblue
+0 191 255 deepskyblue
+135 206 235 skyblue
+135 206 250 lightskyblue
+70 130 180 steelblue
+176 196 222 lightsteelblue
+173 216 230 lightblue
+176 224 230 powderblue
+175 238 238 paleturquoise
+0 206 209 darkturquoise
+72 209 204 mediumturquoise
+64 224 208 turquoise
+0 255 255 cyan
+224 255 255 lightcyan
+95 158 160 cadetblue
+102 205 170 mediumaquamarine
+127 255 212 aquamarine
+0 100 0 darkgreen
+85 107 47 darkolivegreen
+143 188 143 darkseagreen
+46 139 87 seagreen
+60 179 113 mediumseagreen
+32 178 170 lightseagreen
+152 251 152 palegreen
+0 255 127 springgreen
+124 252 0 lawngreen
+0 255 0 green
+127 255 0 chartreuse
+0 250 154 mediumspringgreen
+173 255 47 greenyellow
+50 205 50 limegreen
+154 205 50 yellowgreen
+34 139 34 forestgreen
+107 142 35 olivedrab
+189 183 107 darkkhaki
+240 230 140 khaki
+238 232 170 palegoldenrod
+250 250 210 lightgoldenrodyellow
+255 255 224 lightyellow
+255 255 0 yellow
+255 215 0 gold
+238 221 130 lightgoldenrod
+218 165 32 goldenrod
+184 134 11 darkgoldenrod
+188 143 143 rosybrown
+205 92 92 indianred
+139 69 19 saddlebrown
+160 82 45 sienna
+205 133 63 peru
+222 184 135 burlywood
+245 245 220 beige
+245 222 179 wheat
+244 164 96 sandybrown
+210 180 140 tan
+210 105 30 chocolate
+178 34 34 firebrick
+165 42 42 brown
+233 150 122 darksalmon
+250 128 114 salmon
+255 160 122 lightsalmon
+255 165 0 orange
+255 140 0 darkorange
+255 127 80 coral
+240 128 128 lightcoral
+255 99 71 tomato
+255 69 0 orangered
+255 0 0 red
+255 105 180 hotpink
+255 20 147 deeppink
+255 192 203 pink
+255 182 193 lightpink
+219 112 147 palevioletred
+176 48 96 maroon
+199 21 133 mediumvioletred
+208 32 144 violetred
+255 0 255 magenta
+238 130 238 violet
+221 160 221 plum
+218 112 214 orchid
+186 85 211 mediumorchid
+153 50 204 darkorchid
+148 0 211 darkviolet
+138 43 226 blueviolet
+160 32 240 purple
+147 112 219 mediumpurple
+216 191 216 thistle
+255 250 250 snow1
+238 233 233 snow2
+205 201 201 snow3
+139 137 137 snow4
+255 245 238 seashell1
+238 229 222 seashell2
+205 197 191 seashell3
+139 134 130 seashell4
+255 239 219 antiquewhite1
+238 223 204 antiquewhite2
+205 192 176 antiquewhite3
+139 131 120 antiquewhite4
+255 228 196 bisque1
+238 213 183 bisque2
+205 183 158 bisque3
+139 125 107 bisque4
+255 218 185 peachpuff1
+238 203 173 peachpuff2
+205 175 149 peachpuff3
+139 119 101 peachpuff4
+255 222 173 navajowhite1
+238 207 161 navajowhite2
+205 179 139 navajowhite3
+139 121 94 navajowhite4
+255 250 205 lemonchiffon1
+238 233 191 lemonchiffon2
+205 201 165 lemonchiffon3
+139 137 112 lemonchiffon4
+255 248 220 cornsilk1
+238 232 205 cornsilk2
+205 200 177 cornsilk3
+139 136 120 cornsilk4
+255 255 240 ivory1
+238 238 224 ivory2
+205 205 193 ivory3
+139 139 131 ivory4
+240 255 240 honeydew1
+224 238 224 honeydew2
+193 205 193 honeydew3
+131 139 131 honeydew4
+255 240 245 lavenderblush1
+238 224 229 lavenderblush2
+205 193 197 lavenderblush3
+139 131 134 lavenderblush4
+255 228 225 mistyrose1
+238 213 210 mistyrose2
+205 183 181 mistyrose3
+139 125 123 mistyrose4
+240 255 255 azure1
+224 238 238 azure2
+193 205 205 azure3
+131 139 139 azure4
+131 111 255 slateblue1
+122 103 238 slateblue2
+105 89 205 slateblue3
+71 60 139 slateblue4
+72 118 255 royalblue1
+67 110 238 royalblue2
+58 95 205 royalblue3
+39 64 139 royalblue4
+0 0 255 blue1
+0 0 238 blue2
+0 0 205 blue3
+0 0 139 blue4
+30 144 255 dodgerblue1
+28 134 238 dodgerblue2
+24 116 205 dodgerblue3
+16 78 139 dodgerblue4
+99 184 255 steelblue1
+92 172 238 steelblue2
+79 148 205 steelblue3
+54 100 139 steelblue4
+0 191 255 deepskyblue1
+0 178 238 deepskyblue2
+0 154 205 deepskyblue3
+0 104 139 deepskyblue4
+135 206 255 skyblue1
+126 192 238 skyblue2
+108 166 205 skyblue3
+74 112 139 skyblue4
+176 226 255 lightskyblue1
+164 211 238 lightskyblue2
+141 182 205 lightskyblue3
+96 123 139 lightskyblue4
+202 225 255 lightsteelblue1
+188 210 238 lightsteelblue2
+162 181 205 lightsteelblue3
+110 123 139 lightsteelblue4
+191 239 255 lightblue1
+178 223 238 lightblue2
+154 192 205 lightblue3
+104 131 139 lightblue4
+224 255 255 lightcyan1
+209 238 238 lightcyan2
+180 205 205 lightcyan3
+122 139 139 lightcyan4
+187 255 255 paleturquoise1
+174 238 238 paleturquoise2
+150 205 205 paleturquoise3
+102 139 139 paleturquoise4
+152 245 255 cadetblue1
+142 229 238 cadetblue2
+122 197 205 cadetblue3
+83 134 139 cadetblue4
+0 245 255 turquoise1
+0 229 238 turquoise2
+0 197 205 turquoise3
+0 134 139 turquoise4
+0 255 255 cyan1
+0 238 238 cyan2
+0 205 205 cyan3
+0 139 139 cyan4
+127 255 212 aquamarine1
+118 238 198 aquamarine2
+102 205 170 aquamarine3
+69 139 116 aquamarine4
+193 255 193 darkseagreen1
+180 238 180 darkseagreen2
+155 205 155 darkseagreen3
+105 139 105 darkseagreen4
+84 255 159 seagreen1
+78 238 148 seagreen2
+67 205 128 seagreen3
+46 139 87 seagreen4
+154 255 154 palegreen1
+144 238 144 palegreen2
+124 205 124 palegreen3
+84 139 84 palegreen4
+0 255 127 springgreen1
+0 238 118 springgreen2
+0 205 102 springgreen3
+0 139 69 springgreen4
+0 255 0 green1
+0 238 0 green2
+0 205 0 green3
+0 139 0 green4
+127 255 0 chartreuse1
+118 238 0 chartreuse2
+102 205 0 chartreuse3
+69 139 0 chartreuse4
+192 255 62 olivedrab1
+179 238 58 olivedrab2
+154 205 50 olivedrab3
+105 139 34 olivedrab4
+202 255 112 darkolivegreen1
+188 238 104 darkolivegreen2
+162 205 90 darkolivegreen3
+110 139 61 darkolivegreen4
+255 246 143 khaki1
+238 230 133 khaki2
+205 198 115 khaki3
+139 134 78 khaki4
+255 236 139 lightgoldenrod1
+238 220 130 lightgoldenrod2
+205 190 112 lightgoldenrod3
+139 129 76 lightgoldenrod4
+255 255 224 lightyellow1
+238 238 209 lightyellow2
+205 205 180 lightyellow3
+139 139 122 lightyellow4
+255 255 0 yellow1
+238 238 0 yellow2
+205 205 0 yellow3
+139 139 0 yellow4
+255 215 0 gold1
+238 201 0 gold2
+205 173 0 gold3
+139 117 0 gold4
+255 193 37 goldenrod1
+238 180 34 goldenrod2
+205 155 29 goldenrod3
+139 105 20 goldenrod4
+255 185 15 darkgoldenrod1
+238 173 14 darkgoldenrod2
+205 149 12 darkgoldenrod3
+139 101 8 darkgoldenrod4
+255 193 193 rosybrown1
+238 180 180 rosybrown2
+205 155 155 rosybrown3
+139 105 105 rosybrown4
+255 106 106 indianred1
+238 99 99 indianred2
+205 85 85 indianred3
+139 58 58 indianred4
+255 130 71 sienna1
+238 121 66 sienna2
+205 104 57 sienna3
+139 71 38 sienna4
+255 211 155 burlywood1
+238 197 145 burlywood2
+205 170 125 burlywood3
+139 115 85 burlywood4
+255 231 186 wheat1
+238 216 174 wheat2
+205 186 150 wheat3
+139 126 102 wheat4
+255 165 79 tan1
+238 154 73 tan2
+205 133 63 tan3
+139 90 43 tan4
+255 127 36 chocolate1
+238 118 33 chocolate2
+205 102 29 chocolate3
+139 69 19 chocolate4
+255 48 48 firebrick1
+238 44 44 firebrick2
+205 38 38 firebrick3
+139 26 26 firebrick4
+255 64 64 brown1
+238 59 59 brown2
+205 51 51 brown3
+139 35 35 brown4
+255 140 105 salmon1
+238 130 98 salmon2
+205 112 84 salmon3
+139 76 57 salmon4
+255 160 122 lightsalmon1
+238 149 114 lightsalmon2
+205 129 98 lightsalmon3
+139 87 66 lightsalmon4
+255 165 0 orange1
+238 154 0 orange2
+205 133 0 orange3
+139 90 0 orange4
+255 127 0 darkorange1
+238 118 0 darkorange2
+205 102 0 darkorange3
+139 69 0 darkorange4
+255 114 86 coral1
+238 106 80 coral2
+205 91 69 coral3
+139 62 47 coral4
+255 99 71 tomato1
+238 92 66 tomato2
+205 79 57 tomato3
+139 54 38 tomato4
+255 69 0 orangered1
+238 64 0 orangered2
+205 55 0 orangered3
+139 37 0 orangered4
+255 0 0 red1
+238 0 0 red2
+205 0 0 red3
+139 0 0 red4
+255 20 147 deeppink1
+238 18 137 deeppink2
+205 16 118 deeppink3
+139 10 80 deeppink4
+255 110 180 hotpink1
+238 106 167 hotpink2
+205 96 144 hotpink3
+139 58 98 hotpink4
+255 181 197 pink1
+238 169 184 pink2
+205 145 158 pink3
+139 99 108 pink4
+255 174 185 lightpink1
+238 162 173 lightpink2
+205 140 149 lightpink3
+139 95 101 lightpink4
+255 130 171 palevioletred1
+238 121 159 palevioletred2
+205 104 137 palevioletred3
+139 71 93 palevioletred4
+255 52 179 maroon1
+238 48 167 maroon2
+205 41 144 maroon3
+139 28 98 maroon4
+255 62 150 violetred1
+238 58 140 violetred2
+205 50 120 violetred3
+139 34 82 violetred4
+255 0 255 magenta1
+238 0 238 magenta2
+205 0 205 magenta3
+139 0 139 magenta4
+255 131 250 orchid1
+238 122 233 orchid2
+205 105 201 orchid3
+139 71 137 orchid4
+255 187 255 plum1
+238 174 238 plum2
+205 150 205 plum3
+139 102 139 plum4
+224 102 255 mediumorchid1
+209 95 238 mediumorchid2
+180 82 205 mediumorchid3
+122 55 139 mediumorchid4
+191 62 255 darkorchid1
+178 58 238 darkorchid2
+154 50 205 darkorchid3
+104 34 139 darkorchid4
+155 48 255 purple1
+145 44 238 purple2
+125 38 205 purple3
+85 26 139 purple4
+171 130 255 mediumpurple1
+159 121 238 mediumpurple2
+137 104 205 mediumpurple3
+93 71 139 mediumpurple4
+255 225 255 thistle1
+238 210 238 thistle2
+205 181 205 thistle3
+139 123 139 thistle4
+0 0 0 grey0
+3 3 3 grey1
+5 5 5 grey2
+8 8 8 grey3
+10 10 10 grey4
+13 13 13 grey5
+15 15 15 grey6
+18 18 18 grey7
+20 20 20 grey8
+23 23 23 grey9
+26 26 26 grey10
+28 28 28 grey11
+31 31 31 grey12
+33 33 33 grey13
+36 36 36 grey14
+38 38 38 grey15
+41 41 41 grey16
+43 43 43 grey17
+46 46 46 grey18
+48 48 48 grey19
+51 51 51 grey20
+54 54 54 grey21
+56 56 56 grey22
+59 59 59 grey23
+61 61 61 grey24
+64 64 64 grey25
+66 66 66 grey26
+69 69 69 grey27
+71 71 71 grey28
+74 74 74 grey29
+77 77 77 grey30
+79 79 79 grey31
+82 82 82 grey32
+84 84 84 grey33
+87 87 87 grey34
+89 89 89 grey35
+92 92 92 grey36
+94 94 94 grey37
+97 97 97 grey38
+99 99 99 grey39
+102 102 102 grey40
+105 105 105 grey41
+107 107 107 grey42
+110 110 110 grey43
+112 112 112 grey44
+115 115 115 grey45
+117 117 117 grey46
+120 120 120 grey47
+122 122 122 grey48
+125 125 125 grey49
+127 127 127 grey50
+130 130 130 grey51
+133 133 133 grey52
+135 135 135 grey53
+138 138 138 grey54
+140 140 140 grey55
+143 143 143 grey56
+145 145 145 grey57
+148 148 148 grey58
+150 150 150 grey59
+153 153 153 grey60
+156 156 156 grey61
+158 158 158 grey62
+161 161 161 grey63
+163 163 163 grey64
+166 166 166 grey65
+168 168 168 grey66
+171 171 171 grey67
+173 173 173 grey68
+176 176 176 grey69
+179 179 179 grey70
+181 181 181 grey71
+184 184 184 grey72
+186 186 186 grey73
+189 189 189 grey74
+191 191 191 grey75
+194 194 194 grey76
+196 196 196 grey77
+199 199 199 grey78
+201 201 201 grey79
+204 204 204 grey80
+207 207 207 grey81
+209 209 209 grey82
+212 212 212 grey83
+214 214 214 grey84
+217 217 217 grey85
+219 219 219 grey86
+222 222 222 grey87
+224 224 224 grey88
+227 227 227 grey89
+229 229 229 grey90
+232 232 232 grey91
+235 235 235 grey92
+237 237 237 grey93
+240 240 240 grey94
+242 242 242 grey95
+245 245 245 grey96
+247 247 247 grey97
+250 250 250 grey98
+252 252 252 grey99
+255 255 255 grey100
+169 169 169 darkgrey
+0 0 139 darkblue
+0 139 139 darkcyan
+139 0 139 darkmagenta
+139 0 0 darkred
+144 238 144 lightgreen")
+
+;*---------------------------------------------------------------------*/
+;* *rgb-port* ... */
+;*---------------------------------------------------------------------*/
+(define *rgb-port* #unspecified)
+
+;*---------------------------------------------------------------------*/
+;* same-color? ... */
+;*---------------------------------------------------------------------*/
+(define (same-color? s1 s2)
+ (define (skip-rgb s)
+ (let ((l (string-length s)))
+ (let loop ((i 0))
+ (if (=fx i l)
+ l
+ (let ((c (string-ref s i)))
+ (if (or (char-numeric? c) (char-whitespace? c))
+ (loop (+fx i 1))
+ i))))))
+ (let ((l1 (string-length s1))
+ (l2 (string-length s2)))
+ (if (>fx l1 l2)
+ (let ((lc (skip-rgb s1)))
+ (and (=fx (-fx l1 lc) l2)
+ (let loop ((i1 (-fx l1 l2))
+ (i2 0))
+ (cond
+ ((=fx i1 l1)
+ #t)
+ ((char-ci=? (string-ref s1 i1) (string-ref s2 i2))
+ (loop (+fx i1 1) (+fx i2 1)))
+ (else
+ #f))))))))
+
+;*---------------------------------------------------------------------*/
+;* rgb-grep ... */
+;*---------------------------------------------------------------------*/
+(define (rgb-grep symbol)
+ (let ((parser (regular-grammar ()
+ ((bol (: #\! (* all)))
+ (ignore))
+ ((+ #\Newline)
+ (ignore))
+ ((: (* (in #\space #\tab))
+ (+ digit)
+ (+ (in #\space #\tab))
+ (+ digit)
+ (+ (in #\space #\tab))
+ (+ digit)
+ (+ (in #\space #\tab))
+ (+ all))
+ (let ((s (the-string)))
+ (if (same-color? s symbol)
+ (let ((m (pregexp-match "[ \t]*([0-9]+)[ \t]+([0-9]+)[ \t]+([0-9]+)[ \t]+.+" s)))
+ (values (string->number (cadr m))
+ (string->number (caddr m))
+ (string->number (cadddr m))))
+ (ignore))))
+ (else
+ (values 0 0 0)))))
+ ;; initialization the port reading rgb.txt file
+ (with-input-from-string *skribe-rgb-string*
+ (lambda ()
+ (read/rp parser (current-input-port))))))
+
+;*---------------------------------------------------------------------*/
+;* *color-parser* ... */
+;*---------------------------------------------------------------------*/
+(define *color-parser*
+ (regular-grammar ((blank* (* blank))
+ (blank+ (+ blank)))
+
+ ;; rgb color
+ ((: #\# (+ xdigit))
+ (let ((val (the-substring 1 (the-length))))
+ (cond
+ ((=fx (string-length val) 6)
+ (values (string->integer (substring val 0 2) 16)
+ (string->integer (substring val 2 4) 16)
+ (string->integer (substring val 4 6) 16)))
+ ((=fx (string-length val) 12)
+ (values (string->integer (substring val 0 2) 16)
+ (string->integer (substring val 4 6) 16)
+ (string->integer (substring val 8 10) 16)))
+ (else
+ (values 0 0 0)))))
+
+ ;; symbolic names
+ ((+ (out #\Newline))
+ (let ((name (the-string)))
+ (cond
+ ((string-ci=? name "none")
+ (values 0 0 0))
+ ((string-ci=? name "black")
+ (values #xff #xff #xff))
+ ((string-ci=? name "white")
+ (values 0 0 0))
+ (else
+ (rgb-grep name)))))
+
+ ;; error
+ (else
+ (values 0 0 0))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-color->rgb ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-color->rgb spec)
+ (cond
+ ((string? spec)
+ (with-input-from-string spec
+ (lambda ()
+ (read/rp *color-parser* (current-input-port)))))
+ ((fixnum? spec)
+ (values (bit-and #xff (bit-rsh spec 16))
+ (bit-and #xff (bit-rsh spec 8))
+ (bit-and #xff spec)))
+ (else
+ (values 0 0 0))))
+
+;*---------------------------------------------------------------------*/
+;* *used-colors* ... */
+;*---------------------------------------------------------------------*/
+(define *used-colors* '())
+
+;*---------------------------------------------------------------------*/
+;* skribe-get-used-colors ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-get-used-colors)
+ *used-colors*)
+
+;*---------------------------------------------------------------------*/
+;* skribe-use-color! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-use-color! color)
+ (set! *used-colors* (cons color *used-colors*))
+ color)
diff --git a/skribe/src/bigloo/configure.bgl b/skribe/src/bigloo/configure.bgl
new file mode 100644
index 0000000..e100d8d
--- /dev/null
+++ b/skribe/src/bigloo/configure.bgl
@@ -0,0 +1,90 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/configure.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 18:42:21 2003 */
+;* Last change : Mon Feb 9 06:51:11 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The general configuration options. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_configure
+ (export (skribe-release)
+ (skribe-url)
+ (skribe-doc-dir)
+ (skribe-ext-dir)
+ (skribe-default-path)
+ (skribe-scheme)
+
+ (skribe-configure . opt)
+ (skribe-enforce-configure . opt)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-configuration ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-configuration)
+ `((:release ,(skribe-release))
+ (:scheme ,(skribe-scheme))
+ (:url ,(skribe-url))
+ (:doc-dir ,(skribe-doc-dir))
+ (:ext-dir ,(skribe-ext-dir))
+ (:default-path ,(skribe-default-path))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-configure ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-configure . opt)
+ (let ((conf (skribe-configuration)))
+ (cond
+ ((null? opt)
+ conf)
+ ((null? (cdr opt))
+ (let ((cell (assq (car opt) conf)))
+ (if (pair? cell)
+ (cadr cell)
+ 'void)))
+ (else
+ (let loop ((opt opt))
+ (cond
+ ((null? opt)
+ #t)
+ ((not (keyword? (car opt)))
+ #f)
+ ((or (null? (cdr opt)) (keyword? (cadr opt)))
+ #f)
+ (else
+ (let ((cell (assq (car opt) conf)))
+ (if (and (pair? cell)
+ (if (procedure? (cadr opt))
+ ((cadr opt) (cadr cell))
+ (equal? (cadr opt) (cadr cell))))
+ (loop (cddr opt))
+ #f)))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-enforce-configure ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-enforce-configure . opt)
+ (let loop ((o opt))
+ (when (pair? o)
+ (cond
+ ((or (not (keyword? (car o)))
+ (null? (cdr o)))
+ (error 'skribe-enforce-configure
+ "Illegal enforcement"
+ opt))
+ ((skribe-configure (car o) (cadr o))
+ (loop (cddr o)))
+ (else
+ (error 'skribe-enforce-configure
+ (format "Configuration mismatch: ~a" (car o))
+ (if (procedure? (cadr o))
+ (format "provided `~a'"
+ (skribe-configure (car o)))
+ (format "provided `~a', required `~a'"
+ (skribe-configure (car o))
+ (cadr o)))))))))
diff --git a/skribe/src/bigloo/debug.sch b/skribe/src/bigloo/debug.sch
new file mode 100644
index 0000000..9b53c84
--- /dev/null
+++ b/skribe/src/bigloo/debug.sch
@@ -0,0 +1,54 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/debug.sch */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Thu May 29 06:46:33 2003 */
+;* Last change : Tue Nov 2 14:31:45 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Simple debug facilities */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* directives */
+;*---------------------------------------------------------------------*/
+(directives
+ (import skribe_debug))
+
+;*---------------------------------------------------------------------*/
+;* when-debug ... */
+;*---------------------------------------------------------------------*/
+(define-macro (when-debug level . exp)
+ (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+ `(if (>= *skribe-debug* ,level) (begin ,@exp))
+ #unspecified))
+
+;*---------------------------------------------------------------------*/
+;* with-debug ... */
+;*---------------------------------------------------------------------*/
+(define-macro (with-debug level lbl . arg*)
+ (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+ `(%with-debug ,level ,lbl (lambda () (begin ,@arg*)))
+ `(begin ,@arg*)))
+
+;*---------------------------------------------------------------------*/
+;* with-push-trace ... */
+;*---------------------------------------------------------------------*/
+(define-macro (with-push-trace lbl . arg*)
+ (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+ (let ((r (gensym)))
+ `(let ()
+ (c-push-trace ,lbl)
+ (let ((,r ,@arg*))
+ (c-pop-trace)
+ ,r)))
+ `(begin ,@arg*)))
+
+;*---------------------------------------------------------------------*/
+;* debug-item ... */
+;*---------------------------------------------------------------------*/
+(define-expander debug-item
+ (lambda (x e)
+ (if (and (number? *compiler-debug*) (> *compiler-debug* 0))
+ `(debug-item ,@(map (lambda (x) (e x e)) (cdr x)))
+ #unspecified)))
diff --git a/skribe/src/bigloo/debug.scm b/skribe/src/bigloo/debug.scm
new file mode 100644
index 0000000..8f1691c
--- /dev/null
+++ b/skribe/src/bigloo/debug.scm
@@ -0,0 +1,188 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/debug.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jun 11 10:01:47 2003 */
+;* Last change : Thu Oct 28 21:33:00 2004 (eg) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Simple debug facilities */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_debug
+
+ (export *skribe-debug*
+ *skribe-debug-symbols*
+ *skribe-debug-color*
+
+ (skribe-debug::int)
+ (debug-port::output-port . ::obj)
+ (debug-margin::bstring)
+ (debug-color::bstring ::int . ::obj)
+ (debug-bold::bstring . ::obj)
+ (debug-string ::obj)
+ (debug-item . ::obj)
+
+ (%with-debug ::obj ::obj ::procedure)))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-debug* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-debug* 0)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-debug-symbols* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-debug-symbols* '())
+
+;*---------------------------------------------------------------------*/
+;* *skribe-debug-color* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-debug-color* #t)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-debug-item* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-debug-item* #f)
+
+;*---------------------------------------------------------------------*/
+;* *debug-port* ... */
+;*---------------------------------------------------------------------*/
+(define *debug-port* (current-error-port))
+
+;*---------------------------------------------------------------------*/
+;* *debug-depth* ... */
+;*---------------------------------------------------------------------*/
+(define *debug-depth* 0)
+
+;*---------------------------------------------------------------------*/
+;* *debug-margin* ... */
+;*---------------------------------------------------------------------*/
+(define *debug-margin* "")
+
+;*---------------------------------------------------------------------*/
+;* *skribe-margin-debug-level* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-margin-debug-level* 0)
+
+;*---------------------------------------------------------------------*/
+;* skribe-debug ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-debug)
+ *skribe-debug*)
+
+;*---------------------------------------------------------------------*/
+;* debug-port ... */
+;*---------------------------------------------------------------------*/
+(define (debug-port . o)
+ (cond
+ ((null? o)
+ *debug-port*)
+ ((output-port? (car o))
+ (set! *debug-port* o)
+ o)
+ (else
+ (error 'debug-port "Illegal debug port" (car o)))))
+
+;*---------------------------------------------------------------------*/
+;* debug-margin ... */
+;*---------------------------------------------------------------------*/
+(define (debug-margin)
+ *debug-margin*)
+
+;*---------------------------------------------------------------------*/
+;* debug-color ... */
+;*---------------------------------------------------------------------*/
+(define (debug-color col::int . o)
+ (with-output-to-string
+ (if *skribe-debug-color*
+ (lambda ()
+ (display* "[0m[1;" (+ 31 col) "m")
+ (apply display* o)
+ (display "[0m"))
+ (lambda ()
+ (apply display* o)))))
+
+;*---------------------------------------------------------------------*/
+;* debug-bold ... */
+;*---------------------------------------------------------------------*/
+(define (debug-bold . o)
+ (apply debug-color -30 o))
+
+;*---------------------------------------------------------------------*/
+;* debug-item ... */
+;*---------------------------------------------------------------------*/
+(define (debug-item . args)
+ (if (or (>= *skribe-debug* *skribe-margin-debug-level*)
+ *skribe-debug-item*)
+ (begin
+ (display (debug-margin) *debug-port*)
+ (display (debug-color (-fx *debug-depth* 1) "- "))
+ (for-each (lambda (a) (display a *debug-port*)) args)
+ (newline *debug-port*))))
+
+;*---------------------------------------------------------------------*/
+;* %with-debug-margin ... */
+;*---------------------------------------------------------------------*/
+(define (%with-debug-margin margin thunk)
+ (let ((om *debug-margin*))
+ (set! *debug-depth* (+fx *debug-depth* 1))
+ (set! *debug-margin* (string-append om margin))
+ (let ((res (thunk)))
+ (set! *debug-depth* (-fx *debug-depth* 1))
+ (set! *debug-margin* om)
+ res)))
+
+;*---------------------------------------------------------------------*/
+;* %with-debug ... */
+;*---------------------------------------------------------------------*/
+(define (%with-debug lvl lbl thunk)
+ (let ((ol *skribe-margin-debug-level*)
+ (oi *skribe-debug-item*))
+ (set! *skribe-margin-debug-level* lvl)
+ (let ((r (if (or (and (number? lvl) (>= *skribe-debug* lvl))
+ (and (symbol? lbl)
+ (memq lbl *skribe-debug-symbols*)
+ (set! *skribe-debug-item* #t)))
+ (with-output-to-port *debug-port*
+ (lambda ()
+ (display (debug-margin))
+ (display (if (= *debug-depth* 0)
+ (debug-color *debug-depth* "+ " lbl)
+ (debug-color *debug-depth* "--+ " lbl)))
+ (newline)
+ (%with-debug-margin (debug-color *debug-depth* " |")
+ thunk)))
+ (thunk))))
+ (set! *skribe-debug-item* oi)
+ (set! *skribe-margin-debug-level* ol)
+ r)))
+
+;*---------------------------------------------------------------------*/
+;* debug-string ... */
+;*---------------------------------------------------------------------*/
+(define (debug-string o)
+ (with-output-to-string
+ (lambda ()
+ (write o))))
+
+;*---------------------------------------------------------------------*/
+;* example */
+;*---------------------------------------------------------------------*/
+;; (%with-debug 0 'foo1.1
+;; (lambda ()
+;; (debug-item 'foo2.1)
+;; (debug-item 'foo2.2)
+;; (%with-debug 0 'foo2.3
+;; (lambda ()
+;; (debug-item 'foo3.1)
+;; (%with-debug 0 'foo3.2
+;; (lambda ()
+;; (debug-item 'foo4.1)
+;; (debug-item 'foo4.2)))
+;; (debug-item 'foo3.3)))
+;; (debug-item 'foo2.4)))
+
diff --git a/skribe/src/bigloo/engine.scm b/skribe/src/bigloo/engine.scm
new file mode 100644
index 0000000..bd8a027
--- /dev/null
+++ b/skribe/src/bigloo/engine.scm
@@ -0,0 +1,262 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/engine.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 9 08:01:30 2003 */
+;* Last change : Fri May 21 16:12:32 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe engines */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_engine
+
+ (option (set! dsssl-symbol->keyword
+ (lambda (s)
+ (string->keyword
+ (string-append ":" (symbol->string s))))))
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_eval
+ skribe_param
+ skribe_output)
+
+ (export (make-engine::%engine ::symbol #!key v fmt in fi cu st if)
+ (copy-engine::%engine ::symbol ::%engine #!key v in fi cu st)
+ (find-engine ::symbol #!key version)
+
+ (default-engine::obj)
+ (default-engine-set! ::%engine)
+ (push-default-engine ::%engine)
+ (pop-default-engine)
+
+ (processor-get-engine ::obj ::obj ::%engine)
+
+ (engine-format? ::bstring . e)
+
+ (engine-custom::obj ::%engine ::symbol)
+ (engine-custom-set! ::%engine ::symbol ::obj)
+
+ (engine-add-writer! ::%engine ::obj ::procedure ::obj
+ ::obj ::obj ::obj ::obj ::obj ::obj)))
+
+;*---------------------------------------------------------------------*/
+;* *engines* ... */
+;*---------------------------------------------------------------------*/
+(define *engines* '())
+
+;*---------------------------------------------------------------------*/
+;* *default-engine* ... */
+;*---------------------------------------------------------------------*/
+(define *default-engine* #f)
+(define *default-engines* '())
+
+;*---------------------------------------------------------------------*/
+;* default-engine-set! ... */
+;*---------------------------------------------------------------------*/
+(define (default-engine-set! e)
+ (if (not (engine? e))
+ (skribe-type-error 'default-engine-set! "engine" e (find-runtime-type e))
+ (begin
+ (set! *default-engine* e)
+ (set! *default-engines* (cons *default-engine* *default-engines*))
+ e)))
+
+;*---------------------------------------------------------------------*/
+;* default-engine ... */
+;*---------------------------------------------------------------------*/
+(define (default-engine)
+ *default-engine*)
+
+;*---------------------------------------------------------------------*/
+;* push-default-engine ... */
+;*---------------------------------------------------------------------*/
+(define (push-default-engine e)
+ (set! *default-engines* (cons e *default-engines*))
+ (default-engine-set! e))
+
+;*---------------------------------------------------------------------*/
+;* pop-default-engine ... */
+;*---------------------------------------------------------------------*/
+(define (pop-default-engine)
+ (if (null? *default-engines*)
+ (skribe-error 'pop-default-engine "Empty engine stack" '())
+ (begin
+ (set! *default-engines* (cdr *default-engines*))
+ (if (pair? *default-engines*)
+ (default-engine-set! (car *default-engines*))
+ (set! *default-engine* #f)))))
+
+;*---------------------------------------------------------------------*/
+;* processor-get-engine ... */
+;*---------------------------------------------------------------------*/
+(define (processor-get-engine combinator newe olde)
+ (cond
+ ((procedure? combinator)
+ (combinator newe olde))
+ ((engine? newe)
+ newe)
+ (else
+ olde)))
+
+;*---------------------------------------------------------------------*/
+;* engine-format? ... */
+;*---------------------------------------------------------------------*/
+(define (engine-format? fmt . e)
+ (let ((e (cond
+ ((pair? e) (car e))
+ ((%engine? *skribe-engine*) *skribe-engine*)
+ (else (find-engine *skribe-engine*)))))
+ (if (not (%engine? e))
+ (skribe-error 'engine-format? "No engine" e)
+ (string=? fmt (%engine-format e)))))
+
+;*---------------------------------------------------------------------*/
+;* make-engine ... */
+;*---------------------------------------------------------------------*/
+(define (make-engine ident
+ #!key
+ (version #unspecified)
+ (format "raw")
+ (filter #f)
+ (delegate #f)
+ (symbol-table '())
+ (custom '())
+ (info '()))
+ (let ((e (instantiate::%engine
+ (ident ident)
+ (version version)
+ (format format)
+ (filter filter)
+ (delegate delegate)
+ (symbol-table symbol-table)
+ (customs custom)
+ (info info))))
+ ;; store the engine in the global table
+ (set! *engines* (cons e *engines*))
+ ;; return it
+ e))
+
+;*---------------------------------------------------------------------*/
+;* copy-engine ... */
+;*---------------------------------------------------------------------*/
+(define (copy-engine ident
+ e
+ #!key
+ (version #unspecified)
+ (filter #f)
+ (delegate #f)
+ (symbol-table #f)
+ (custom #f))
+ (let ((e (duplicate::%engine e
+ (ident ident)
+ (version version)
+ (filter (or filter (%engine-filter e)))
+ (delegate (or delegate (%engine-delegate e)))
+ (symbol-table (or symbol-table (%engine-symbol-table e)))
+ (customs (or custom (%engine-customs e))))))
+ (set! *engines* (cons e *engines*))
+ e))
+
+;*---------------------------------------------------------------------*/
+;* find-loaded-engine ... */
+;*---------------------------------------------------------------------*/
+(define (find-loaded-engine id version)
+ (let loop ((es *engines*))
+ (cond
+ ((null? es)
+ #f)
+ ((eq? (%engine-ident (car es)) id)
+ (cond
+ ((eq? version #unspecified)
+ (car es))
+ ((eq? version (%engine-version (car es)))
+ (car es))
+ (else
+ (loop (cdr es)))))
+ (else
+ (loop (cdr es))))))
+
+;*---------------------------------------------------------------------*/
+;* find-engine ... */
+;*---------------------------------------------------------------------*/
+(define (find-engine id #!key (version #unspecified))
+ (with-debug 5 'find-engine
+ (debug-item "id=" id " version=" version)
+ (or (find-loaded-engine id version)
+ (let ((c (assq id *skribe-auto-load-alist*)))
+ (debug-item "c=" c)
+ (if (and (pair? c) (string? (cdr c)))
+ (begin
+ (skribe-load (cdr c) :engine 'base)
+ (find-loaded-engine id version))
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* engine-custom ... */
+;*---------------------------------------------------------------------*/
+(define (engine-custom e id)
+ (with-access::%engine e (customs)
+ (let ((c (assq id customs)))
+ (if (pair? c)
+ (cadr c)
+ #unspecified))))
+
+;*---------------------------------------------------------------------*/
+;* engine-custom-set! ... */
+;*---------------------------------------------------------------------*/
+(define (engine-custom-set! e id val)
+ (with-access::%engine e (customs)
+ (let ((c (assq id customs)))
+ (if (pair? c)
+ (set-car! (cdr c) val)
+ (set! customs (cons (list id val) customs))))))
+
+;*---------------------------------------------------------------------*/
+;* engine-add-writer! ... */
+;*---------------------------------------------------------------------*/
+(define (engine-add-writer! e id pred upred opt before action after class va)
+ ;; check the arity of a procedure
+ (define (check-procedure name proc arity)
+ (cond
+ ((not (procedure? proc))
+ (skribe-error id "Illegal procedure" proc))
+ ((not (correct-arity? proc arity))
+ (skribe-error id
+ (string-append "Illegal `" name "'procedure")
+ proc))))
+ (define (check-output name proc)
+ (and proc (or (string? proc) (check-procedure name proc 2))))
+ ;; check the engine
+ (if (not (engine? e))
+ (skribe-error id "Illegal engine" e))
+ ;; check the options
+ (if (not (or (eq? opt 'all) (list? opt)))
+ (skribe-error id "Illegal options" opt))
+ ;; check the correctness of the predicate and the validator
+ (check-procedure "predicate" pred 2)
+ (when va (check-procedure "validate" va 2))
+ ;; check the correctness of the three actions
+ (check-output "before" before)
+ (check-output "action" action)
+ (check-output "after" after)
+ ;; create a new writer...
+ (let ((n (instantiate::%writer
+ (ident (if (symbol? id) id 'all))
+ (class class)
+ (pred pred)
+ (upred upred)
+ (options opt)
+ (before before)
+ (action action)
+ (after after)
+ (validate va))))
+ ;; ...and bind it
+ (with-access::%engine e (writers)
+ (set! writers (cons n writers))
+ n)))
diff --git a/skribe/src/bigloo/eval.scm b/skribe/src/bigloo/eval.scm
new file mode 100644
index 0000000..b5c6548
--- /dev/null
+++ b/skribe/src/bigloo/eval.scm
@@ -0,0 +1,335 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/eval.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 12:48:11 2003 */
+;* Last change : Wed May 18 15:52:01 2005 (serrano) */
+;* Copyright : 2003-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe evaluator */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_eval
+
+ (option (set! dsssl-symbol->keyword
+ (lambda (s)
+ (string->keyword
+ (string-append ":" (symbol->string s))))))
+
+ (include "debug.sch")
+
+ (import skribe_param
+ skribe_types
+ skribe_resolve
+ skribe_verify
+ skribe_output
+ skribe_read
+ skribe_lib
+ skribe_engine)
+
+ (export (skribe-eval-location)
+ (skribe-error ::obj ::obj ::obj)
+ (skribe-type-error ::obj ::obj ::obj ::bstring)
+ (skribe-warning ::int . obj)
+ (skribe-warning/ast ::int ::%ast . obj)
+ (skribe-message ::bstring . obj)
+ (skribe-load ::bstring #!rest opt #!key engine path)
+ (skribe-load-options)
+ (skribe-include ::bstring . rest)
+ (skribe-open-bib-file ::bstring ::obj)
+ (skribe-eval-port ::input-port ::obj #!key env)
+ (skribe-eval ::obj ::%engine #!key env)
+ (skribe-path::pair-nil)
+ (skribe-path-set! ::obj)
+ (skribe-image-path::pair-nil)
+ (skribe-image-path-set! ::obj)
+ (skribe-bib-path::pair-nil)
+ (skribe-bib-path-set! ::obj)
+ (skribe-source-path::pair-nil)
+ (skribe-source-path-set! ::obj)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-eval-location ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-eval-location)
+ (evmeaning-location))
+
+;*---------------------------------------------------------------------*/
+;* skribe-error ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-error proc msg obj)
+ (if (ast? obj)
+ (skribe-ast-error proc msg obj)
+ (error/evloc proc msg obj)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-type-error ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-type-error proc msg obj etype)
+ (let ((ty (if (%markup? obj)
+ (format "~a#~a" (markup-markup obj) (markup-ident obj))
+ (find-runtime-type obj))))
+ (skribe-error proc
+ (bigloo-type-error-msg msg etype ty)
+ obj)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-ast-error ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-ast-error proc msg obj)
+ (let ((l (ast-loc obj))
+ (shape (if (%markup? obj)
+ (%markup-markup obj)
+ (find-runtime-type obj))))
+ (if (location? l)
+ (error/location proc msg shape (location-file l) (location-pos l))
+ (error/evloc proc msg shape))))
+
+;*---------------------------------------------------------------------*/
+;* error/evloc ... */
+;*---------------------------------------------------------------------*/
+(define (error/evloc proc msg obj)
+ (let ((l (evmeaning-location)))
+ (if (location? l)
+ (error/location proc msg obj (location-file l) (location-pos l))
+ ((begin error) proc msg obj))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-warning ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-warning level . obj)
+ (if (>= *skribe-warning* level)
+ (let ((l (evmeaning-location)))
+ (if (location? l)
+ (apply warning/location (location-file l) (location-pos l) obj)
+ (apply warning obj)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-warning/ast ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-warning/ast level ast . obj)
+ (if (>= *skribe-warning* level)
+ (let ((l (%ast-loc ast)))
+ (if (location? l)
+ (apply warning/location (location-file l) (location-pos l) obj)
+ (apply skribe-warning level obj)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-message ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-message fmt . obj)
+ (if (> *skribe-verbose* 0)
+ (apply fprintf (current-error-port) fmt obj)))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-loaded* ... */
+;* ------------------------------------------------------------- */
+;* This hash table stores the list of loaded files in order */
+;* to avoid one file to be loaded twice. */
+;*---------------------------------------------------------------------*/
+(define *skribe-loaded* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-load-options* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-load-options* '())
+
+;*---------------------------------------------------------------------*/
+;* skribe-load ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-load file #!rest opt #!key engine path)
+ (with-debug 4 'skribe-load
+ (debug-item " engine=" engine)
+ (debug-item " path=" path)
+ (debug-item " opt" opt)
+ (let* ((ei (cond
+ ((not engine)
+ *skribe-engine*)
+ ((engine? engine)
+ engine)
+ ((not (symbol? engine))
+ (skribe-error 'skribe-load "Illegal engine" engine))
+ (else
+ engine)))
+ (path (cond
+ ((not path)
+ (skribe-path))
+ ((string? path)
+ (list path))
+ ((not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-load "Illegal path" path))
+ (else
+ path)))
+ (filep (find-file/path file path)))
+ (set! *skribe-load-options* opt)
+ (if (and (string? filep) (file-exists? filep))
+ (if (not (hashtable-get *skribe-loaded* filep))
+ (begin
+ (hashtable-put! *skribe-loaded* filep #t)
+ (cond
+ ((>fx *skribe-verbose* 1)
+ (fprint (current-error-port)
+ " [loading file: " filep " " opt "]"))
+ ((>fx *skribe-verbose* 0)
+ (fprint (current-error-port)
+ " [loading file: " filep "]")))
+ (with-input-from-file filep
+ (lambda ()
+ (skribe-eval-port (current-input-port) ei)))))
+ (skribe-error 'skribe-load
+ (format "Can't find file `~a' in path" file)
+ path)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-load-options ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-load-options)
+ *skribe-load-options*)
+
+;*---------------------------------------------------------------------*/
+;* evaluate ... */
+;*---------------------------------------------------------------------*/
+(define (evaluate exp)
+ (try (eval exp)
+ (lambda (a p m o)
+ (evmeaning-notify-error p m o)
+ (flush-output-port (current-error-port)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-include ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-include file . rest)
+ (let* ((path (cond
+ ((or (null? rest) (null? (cdr rest)))
+ (skribe-path))
+ ((not (every? string? (cdr rest)))
+ (skribe-error 'skribe-include "Illegal path" (cdr rest)))
+ (else
+ (cdr rest))))
+ (filep (find-file/path file (if (null? path) (skribe-path) path))))
+ (if (and (string? filep) (file-exists? filep))
+ (begin
+ (if (>fx *skribe-verbose* 0)
+ (fprint (current-error-port)
+ " [including file: " filep "]"))
+ (with-input-from-file filep
+ (lambda ()
+ (let loop ((exp (skribe-read (current-input-port)))
+ (res '()))
+ (if (eof-object? exp)
+ (if (and (pair? res) (null? (cdr res)))
+ (car res)
+ (reverse! res))
+ (loop (skribe-read (current-input-port))
+ (cons (evaluate exp) res)))))))
+ (skribe-error 'skribe-include
+ (format "Can't find file `~a 'in path" file)
+ path))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-open-bib-file ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-open-bib-file file command)
+ (let ((filep (find-file/path file *skribe-bib-path*)))
+ (if (string? filep)
+ (begin
+ (if (>fx *skribe-verbose* 0)
+ (fprint (current-error-port) " [loading bib: " filep "]"))
+ (open-input-file (if (string? command)
+ (string-append "| "
+ (format command filep))
+ filep)))
+ (begin
+ (skribe-warning 1
+ 'bibliography
+ "Can't find bibliography -- " file)
+ #f))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-eval-port ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-eval-port port ei #!key (env '()))
+ (with-debug 2 'skribe-eval-port
+ (debug-item "ei=" ei)
+ (let ((e (if (symbol? ei) (find-engine ei) ei)))
+ (debug-item "e=" e)
+ (if (not (%engine? e))
+ (skribe-error 'find-engine "Can't find engine" ei)
+ (let loop ((exp (skribe-read port)))
+ (with-debug 10 'skribe-eval-port
+ (debug-item "exp=" exp))
+ (if (not (eof-object? exp))
+ (begin
+ (skribe-eval (evaluate exp) e :env env)
+ (loop (skribe-read port)))))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-eval ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-eval a e #!key (env '()))
+ (with-debug 2 'skribe-eval
+ (debug-item "a=" a " e=" (%engine-ident e))
+ (let ((a2 (resolve! a e env)))
+ (debug-item "resolved a=" a)
+ (let ((a3 (verify a2 e)))
+ (debug-item "verified a=" a3)
+ (output a3 e)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-path ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-path)
+ *skribe-path*)
+
+;*---------------------------------------------------------------------*/
+;* skribe-path-set! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-path-set! path)
+ (if (not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-path-set! "Illegal path" path)
+ (set! *skribe-path* path)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-image-path ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-image-path)
+ *skribe-image-path*)
+
+;*---------------------------------------------------------------------*/
+;* skribe-image-path-set! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-image-path-set! path)
+ (if (not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-image-path-set! "Illegal path" path)
+ (set! *skribe-image-path* path)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-bib-path ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-bib-path)
+ *skribe-bib-path*)
+
+;*---------------------------------------------------------------------*/
+;* skribe-bib-path-set! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-bib-path-set! path)
+ (if (not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-bib-path-set! "Illegal path" path)
+ (set! *skribe-bib-path* path)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-source-path ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-source-path)
+ *skribe-source-path*)
+
+;*---------------------------------------------------------------------*/
+;* skribe-source-path-set! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-source-path-set! path)
+ (if (not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-source-path-set! "Illegal path" path)
+ (set! *skribe-source-path* path)))
diff --git a/skribe/src/bigloo/evapi.scm b/skribe/src/bigloo/evapi.scm
new file mode 100644
index 0000000..6f0d49e
--- /dev/null
+++ b/skribe/src/bigloo/evapi.scm
@@ -0,0 +1,39 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/evapi.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 18:57:09 2003 */
+;* Last change : Sun Jul 11 11:32:23 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Bigloo eval declarations */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_evapi
+ (import skribe_types
+ skribe_lib
+ skribe_api
+ skribe_engine
+ skribe_writer
+ skribe_output
+ skribe_eval
+ skribe_read
+ skribe_resolve
+ skribe_param
+ skribe_source
+ skribe_index
+ skribe_configure
+ skribe_lisp
+ skribe_xml
+ skribe_c
+ skribe_asm
+ skribe_bib
+ skribe_color
+ skribe_sui
+ skribe_debug)
+ (eval (export-all)))
+
+
diff --git a/skribe/src/bigloo/index.bgl b/skribe/src/bigloo/index.bgl
new file mode 100644
index 0000000..9697981
--- /dev/null
+++ b/skribe/src/bigloo/index.bgl
@@ -0,0 +1,32 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/index.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Aug 24 08:01:45 2003 */
+;* Last change : Wed Feb 4 05:24:10 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe indexes Bigloo module declaration */
+;* ------------------------------------------------------------- */
+;* Implementation: @label index@ */
+;* bigloo: @path ../common/index.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_index
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api)
+
+ (export (index?::bool ::obj)
+ (default-index)
+ (make-index-table ::bstring)
+ (resolve-the-index ::obj ::obj ::obj ::pair-nil ::bool ::int ::int ::int)))
+
diff --git a/skribe/src/bigloo/lib.bgl b/skribe/src/bigloo/lib.bgl
new file mode 100644
index 0000000..6dd6d37
--- /dev/null
+++ b/skribe/src/bigloo/lib.bgl
@@ -0,0 +1,340 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/lib.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 12:48:11 2003 */
+;* Last change : Wed Dec 1 14:27:57 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe runtime (i.e., the style user functions). */
+;* ------------------------------------------------------------- */
+;* Implementation: @label lib@ */
+;* bigloo: @path ../common/lib.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_lib
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_eval
+ skribe_param
+ skribe_output
+ skribe_engine)
+
+ (export (markup-option ::%markup ::obj)
+ (markup-option-add! ::%markup ::obj ::obj)
+ (markup-class ::%markup)
+
+ (container-env-get ::%container ::symbol)
+ (container-search-down::pair-nil ::procedure ::%container)
+ (search-down::pair-nil ::procedure ::obj)
+
+ (find-markup-ident::pair-nil ::bstring)
+
+ (find-down::pair-nil ::procedure ::obj)
+ (find1-down::obj ::procedure ::obj)
+ (find-up::pair-nil ::procedure ::obj)
+ (find1-up::obj ::procedure ::obj)
+
+ (ast-document ::%ast)
+ (ast-chapter ::%ast)
+ (ast-section ::%ast)
+
+ (the-body ::pair-nil)
+ (the-options ::pair-nil . rest)
+
+ (list-split::pair-nil ::pair-nil ::int . ::obj)
+
+ (generic ast->string::bstring ::obj)
+
+ (strip-ref-base ::bstring)
+ (ast->file-location ::%ast)
+
+ (convert-image ::bstring ::pair-nil)
+
+ (make-string-replace ::pair-nil)
+ (string-canonicalize::bstring ::bstring)
+ (inline unspecified?::bool ::obj)))
+
+;*---------------------------------------------------------------------*/
+;* markup-option ... */
+;*---------------------------------------------------------------------*/
+(define (markup-option m opt)
+ (if (%markup? m)
+ (with-access::%markup m (options)
+ (let ((c (assq opt options)))
+ (and (pair? c) (pair? (cdr c)) (cadr c))))
+ (skribe-type-error 'markup-option "Illegal markup:" m "markup")))
+
+;*---------------------------------------------------------------------*/
+;* markup-option-add! ... */
+;*---------------------------------------------------------------------*/
+(define (markup-option-add! m opt val)
+ (if (%markup? m)
+ (with-access::%markup m (options)
+ (set! options (cons (list opt val) options)))
+ (skribe-type-error 'markup-option "Illegal markup:" m "markup")))
+
+;*---------------------------------------------------------------------*/
+;* markup-class ... */
+;*---------------------------------------------------------------------*/
+(define (markup-class m)
+ (%markup-class m))
+
+;*---------------------------------------------------------------------*/
+;* container-env-get ... */
+;*---------------------------------------------------------------------*/
+(define (container-env-get m key)
+ (with-access::%container m (env)
+ (let ((c (assq key env)))
+ (and (pair? c) (cadr c)))))
+
+;*---------------------------------------------------------------------*/
+;* strip-ref-base ... */
+;*---------------------------------------------------------------------*/
+(define (strip-ref-base file)
+ (if (not (string? *skribe-ref-base*))
+ file
+ (let ((l (string-length *skribe-ref-base*)))
+ (cond
+ ((not (>fx (string-length file) (+fx l 2)))
+ file)
+ ((not (substring=? file *skribe-ref-base* l))
+ file)
+ ((not (char=? (string-ref file l) (file-separator)))
+ file)
+ (else
+ (substring file (+fx l 1) (string-length file)))))))
+
+;*---------------------------------------------------------------------*/
+;* ast->file-location ... */
+;*---------------------------------------------------------------------*/
+(define (ast->file-location ast)
+ (let ((l (ast-loc ast)))
+ (if (location? l)
+ (format "~a:~a" (location-file l) (location-pos l))
+ "")))
+
+;*---------------------------------------------------------------------*/
+;* builtin-convert-image ... */
+;*---------------------------------------------------------------------*/
+(define (builtin-convert-image from fmt dir)
+ (let* ((s (suffix from))
+ (f (string-append (prefix (basename from)) "." fmt))
+ (to (make-file-name dir f)))
+ (cond
+ ((string=? s fmt)
+ to)
+ ((file-exists? to)
+ to)
+ (else
+ (let ((c (if (string=? s "fig")
+ (string-append "fig2dev -L " fmt " " from " > " to)
+ (string-append "convert " from " " to))))
+ (cond
+ ((>fx *skribe-verbose* 1)
+ (fprint (current-error-port)
+ " [converting image: " from " (" c ")]"))
+ ((>fx *skribe-verbose* 0)
+ (fprint (current-error-port)
+ " [converting image: " from "]")))
+ (if (=fx (system c) 0) to #f))))))
+
+;*---------------------------------------------------------------------*/
+;* convert-image ... */
+;*---------------------------------------------------------------------*/
+(define (convert-image file formats)
+ (let ((path (find-file/path file (skribe-image-path))))
+ (if (not (string? path))
+ (skribe-error 'image
+ (format "Can't find `~a' image file in path: " file)
+ (skribe-image-path))
+ (let ((suf (suffix file)))
+ (if (member suf formats)
+ (let* ((dir (if (string? *skribe-dest*)
+ (dirname *skribe-dest*)
+ #f)))
+ (if dir
+ (let ((dest (basename path)))
+ (copy-file path (make-file-name dir dest))
+ dest)
+ path))
+ (let loop ((fmts formats))
+ (if (null? fmts)
+ #f
+ (let* ((dir (if (string? *skribe-dest*)
+ (dirname *skribe-dest*)
+ "."))
+ (p (builtin-convert-image path (car fmts) dir)))
+ (if (string? p)
+ p
+ (loop (cdr fmts)))))))))))
+
+;*---------------------------------------------------------------------*/
+;* html-string ... */
+;*---------------------------------------------------------------------*/
+(define (html-string str)
+ (let ((len (string-length str)))
+ (let loop ((r 0)
+ (nlen len))
+ (if (=fx r len)
+ (if (=fx nlen len)
+ str
+ (let ((res (make-string nlen)))
+ (let loop ((r 0)
+ (w 0))
+ (if (=fx w nlen)
+ res
+ (let ((c (string-ref-ur str r)))
+ (case c
+ ((#\<)
+ (blit-string! "<" 0 res w 4)
+ (loop (+fx r 1) (+fx w 4)))
+ ((#\>)
+ (blit-string! ">" 0 res w 4)
+ (loop (+fx r 1) (+fx w 4)))
+ ((#\&)
+ (blit-string! "&" 0 res w 5)
+ (loop (+fx r 1) (+fx w 5)))
+ ((#\")
+ (blit-string! """ 0 res w 6)
+ (loop (+fx r 1) (+fx w 6)))
+ (else
+ (string-set! res w c)
+ (loop (+fx r 1) (+fx w 1)))))))))
+ (case (string-ref-ur str r)
+ ((#\< #\>)
+ (loop (+fx r 1) (+fx nlen 3)))
+ ((#\&)
+ (loop (+fx r 1) (+fx nlen 4)))
+ ((#\")
+ (loop (+fx r 1) (+fx nlen 5)))
+ (else
+ (loop (+fx r 1) nlen)))))))
+
+;*---------------------------------------------------------------------*/
+;* make-generic-string-replace ... */
+;*---------------------------------------------------------------------*/
+(define (make-generic-string-replace lst)
+ (lambda (str)
+ (let ((len (string-length str)))
+ (let loop ((r 0)
+ (nlen len))
+ (if (=fx r len)
+ (let ((res (make-string nlen)))
+ (let loop ((r 0)
+ (w 0))
+ (if (=fx w nlen)
+ res
+ (let* ((c (string-ref-ur str r))
+ (p (assq c lst)))
+ (if (pair? p)
+ (let ((pl (string-length (cadr p))))
+ (blit-string! (cadr p) 0 res w pl)
+ (loop (+fx r 1) (+fx w pl)))
+ (begin
+ (string-set! res w c)
+ (loop (+fx r 1) (+fx w 1))))))))
+ (let* ((c (string-ref-ur str r))
+ (p (assq c lst)))
+ (if (pair? p)
+ (loop (+fx r 1)
+ (+fx nlen (-fx (string-length (cadr p)) 1)))
+ (loop (+fx r 1)
+ nlen))))))))
+
+;*---------------------------------------------------------------------*/
+;* make-string-replace ... */
+;*---------------------------------------------------------------------*/
+(define (make-string-replace lst)
+ (let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2))))))
+ (cond
+ ((equal? l '((#\" """) (#\& "&") (#\< "<") (#\> ">")))
+ html-string)
+ (else
+ (make-generic-string-replace lst)))))
+
+;*---------------------------------------------------------------------*/
+;* ast->string ... */
+;*---------------------------------------------------------------------*/
+(define-generic (ast->string ast)
+ (cond
+ ((string? ast)
+ ast)
+ ((number? ast)
+ (number->string ast))
+ ((pair? ast)
+ (let* ((t (map ast->string ast))
+ (res (make-string
+ (apply + -1 (length t) (map string-length t))
+ #\space)))
+ (let loop ((t t)
+ (w 0))
+ (if (null? t)
+ res
+ (let ((l (string-length (car t))))
+ (blit-string! (car t) 0 res w l)
+ (loop (cdr t) (+ w l 1)))))))
+ (else
+ "")))
+
+;*---------------------------------------------------------------------*/
+;* ast->string ::%node ... */
+;*---------------------------------------------------------------------*/
+(define-method (ast->string ast::%node)
+ (ast->string (%node-body ast)))
+
+;*---------------------------------------------------------------------*/
+;* string-canonicalize ... */
+;*---------------------------------------------------------------------*/
+(define (string-canonicalize old)
+ (let* ((l (string-length old))
+ (new (make-string l)))
+ (let loop ((r 0)
+ (w 0)
+ (s #f))
+ (cond
+ ((=fx r l)
+ (cond
+ ((=fx w 0)
+ "")
+ ((char-whitespace? (string-ref new (-fx w 1)))
+ (substring new 0 (-fx w 1)))
+ ((=fx w r)
+ new)
+ (else
+ (substring new 0 w))))
+ ((char-whitespace? (string-ref old r))
+ (if s
+ (loop (+fx r 1) w #t)
+ (begin
+ (string-set! new w #\-)
+ (loop (+fx r 1) (+fx w 1) #t))))
+ ((or (char=? (string-ref old r) #\#)
+ (char=? (string-ref old r) #\,)
+ (>= (char->integer (string-ref old r)) #x7f))
+ (string-set! new w #\-)
+ (loop (+fx r 1) (+fx w 1) #t))
+ (else
+ (string-set! new w (string-ref old r))
+ (loop (+fx r 1) (+fx w 1) #f))))))
+
+;*---------------------------------------------------------------------*/
+;* unspecified? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (unspecified? obj)
+ (eq? obj #unspecified))
+
+;*---------------------------------------------------------------------*/
+;* base */
+;* ------------------------------------------------------------- */
+;* A base engine must pre-exist before anything is loaded. In */
+;* particular, this dummy base engine is used to load the */
+;* actual definition of base. */
+;*---------------------------------------------------------------------*/
+(make-engine 'base :version 'bootstrap)
+
diff --git a/skribe/src/bigloo/lisp.scm b/skribe/src/bigloo/lisp.scm
new file mode 100644
index 0000000..65a8227
--- /dev/null
+++ b/skribe/src/bigloo/lisp.scm
@@ -0,0 +1,530 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/lisp.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Aug 29 08:14:59 2003 */
+;* Last change : Mon Nov 8 14:32:22 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Handling of lispish source files. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_lisp
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api
+ skribe_param
+ skribe_source)
+
+ (export bigloo
+ scheme
+ lisp
+ skribe))
+
+;*---------------------------------------------------------------------*/
+;* keys ... */
+;*---------------------------------------------------------------------*/
+(define *the-key* #f)
+(define *bracket-highlight* #t)
+(define *bigloo-key* #f)
+(define *scheme-key* #f)
+(define *lisp-key* #f)
+(define *skribe-key* #f)
+
+;*---------------------------------------------------------------------*/
+;* init-bigloo-fontifier! ... */
+;*---------------------------------------------------------------------*/
+(define (init-bigloo-fontifier!)
+ (if (not *bigloo-key*)
+ (begin
+ (set! *bigloo-key* (gensym))
+ ;; language keywords
+ (for-each (lambda (symbol)
+ (putprop! symbol *bigloo-key* 'symbol))
+ '(set! if let cond case quote begin letrec let*
+ lambda export extern class generic inline
+ static import foreign type with-access instantiate
+ duplicate labels
+ match-case match-lambda
+ syntax-rules pragma widen! shrink!
+ wide-class profile profile/gc
+ regular-grammar lalr-grammar apply))
+ ;; define
+ (for-each (lambda (symbol)
+ (putprop! symbol *bigloo-key* 'define))
+ '(define define-inline define-struct define-macro
+ define-generic define-method define-syntax
+ define-expander))
+ ;; error
+ (for-each (lambda (symbol)
+ (putprop! symbol *bigloo-key* 'error))
+ '(bind-exit unwind-protect call/cc error warning))
+ ;; module
+ (for-each (lambda (symbol)
+ (putprop! symbol *bigloo-key* 'module))
+ '(module import export library))
+ ;; thread
+ (for-each (lambda (symbol)
+ (putprop! symbol *bigloo-key* 'thread))
+ '(make-thread thread-start! thread-yield!
+ thread-await! thread-await*!
+ thread-sleep! thread-join!
+ thread-terminate! thread-suspend!
+ thread-resume! thread-yield!
+ thread-specific thread-specific-set!
+ thread-name thread-name-set!
+ scheduler-react! scheduler-start!
+ broadcast! scheduler-broadcast!
+ current-thread thread?
+ current-scheduler scheduler? make-scheduler
+ make-input-signal make-output-signal
+ make-connect-signal make-process-signal
+ make-accept-signal make-timer-signal
+ thread-get-values! thread-get-values*!)))))
+
+;*---------------------------------------------------------------------*/
+;* init-lisp-fontifier! ... */
+;*---------------------------------------------------------------------*/
+(define (init-lisp-fontifier!)
+ (if (not *lisp-key*)
+ (begin
+ (set! *lisp-key* (gensym))
+ ;; language keywords
+ (for-each (lambda (symbol)
+ (putprop! symbol *lisp-key* 'symbol))
+ '(setq if let cond case else progn letrec let*
+ lambda labels try unwind-protect apply funcall))
+ ;; defun
+ (for-each (lambda (symbol)
+ (putprop! symbol *lisp-key* 'define))
+ '(define defun defvar defmacro)))))
+
+;*---------------------------------------------------------------------*/
+;* init-skribe-fontifier! ... */
+;*---------------------------------------------------------------------*/
+(define (init-skribe-fontifier!)
+ (if (not *skribe-key*)
+ (begin
+ (set! *skribe-key* (gensym))
+ ;; language keywords
+ (for-each (lambda (symbol)
+ (putprop! symbol *skribe-key* 'symbol))
+ '(set! bold it emph tt color ref index underline
+ figure center pre flush hrule linebreak
+ image kbd code var samp sc sf sup sub
+ itemize description enumerate item
+ table tr td th item prgm author
+ prgm hook font lambda))
+ ;; define
+ (for-each (lambda (symbol)
+ (putprop! symbol *skribe-key* 'define))
+ '(define define-markup))
+ ;; markup
+ (for-each (lambda (symbol)
+ (putprop! symbol *skribe-key* 'markup))
+ '(document chapter section subsection subsubsection
+ paragraph p handle resolve processor
+ abstract margin toc table-of-contents
+ current-document current-chapter current-section
+ document-sections* section-number
+ footnote print-index include skribe-load
+ slide)))))
+
+;*---------------------------------------------------------------------*/
+;* bigloo ... */
+;*---------------------------------------------------------------------*/
+(define bigloo
+ (new language
+ (name "bigloo")
+ (fontifier bigloo-fontifier)
+ (extractor bigloo-extractor)))
+
+;*---------------------------------------------------------------------*/
+;* scheme ... */
+;*---------------------------------------------------------------------*/
+(define scheme
+ (new language
+ (name "scheme")
+ (fontifier scheme-fontifier)
+ (extractor scheme-extractor)))
+
+;*---------------------------------------------------------------------*/
+;* lisp ... */
+;*---------------------------------------------------------------------*/
+(define lisp
+ (new language
+ (name "lisp")
+ (fontifier lisp-fontifier)
+ (extractor lisp-extractor)))
+
+;*---------------------------------------------------------------------*/
+;* bigloo-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (bigloo-fontifier s)
+ (init-bigloo-fontifier!)
+ (set! *the-key* *bigloo-key*)
+ (set! *bracket-highlight* #f)
+ (fontify-lisp (open-input-string s)))
+
+;*---------------------------------------------------------------------*/
+;* bigloo-extractor ... */
+;*---------------------------------------------------------------------*/
+(define (bigloo-extractor iport def tab)
+ (definition-search iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-inline define-generic
+ define-method define-macro define-expander)
+ (?fun . ?-) . ?-)
+ (eq? def fun))
+ (((or define define-struct define-library) (and (? symbol?) ?var) . ?-)
+ (eq? var def))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* skribe ... */
+;*---------------------------------------------------------------------*/
+(define skribe
+ (new language
+ (name "skribe")
+ (fontifier skribe-fontifier)
+ (extractor skribe-extractor)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-fontifier s)
+ (init-skribe-fontifier!)
+ (set! *the-key* *skribe-key*)
+ (set! *bracket-highlight* #t)
+ (fontify-lisp (open-input-string s)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-extractor ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-extractor iport def tab)
+ (definition-search iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-macro define-markup) (?fun . ?-) . ?-)
+ (eq? def fun))
+ ((define (and (? symbol?) ?var) . ?-)
+ (eq? var def))
+ ((markup-output (quote ?mk) . ?-)
+ (eq? mk def))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* scheme-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (scheme-fontifier s) s)
+
+;*---------------------------------------------------------------------*/
+;* scheme-extractor ... */
+;*---------------------------------------------------------------------*/
+(define (scheme-extractor iport def tab)
+ (definition-search iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-macro) (?fun . ?-) . ?-)
+ (eq? def fun))
+ ((define (and (? symbol?) ?var) . ?-)
+ (eq? var def))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* lisp-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (lisp-fontifier s)
+ (init-lisp-fontifier!)
+ (set! *the-key* *lisp-key*)
+ (set! *bracket-highlight* #f)
+ (fontify-lisp (open-input-string s)))
+
+;*---------------------------------------------------------------------*/
+;* lisp-extractor ... */
+;*---------------------------------------------------------------------*/
+(define (lisp-extractor iport def tab)
+ (definition-search iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or defun defmacro) ?fun ?- . ?-)
+ (eq? def fun))
+ ((defvar ?var . ?-)
+ (eq? var def))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* definition-search ... */
+;* ------------------------------------------------------------- */
+;* This function seeks a Bigloo definition. If it finds it, it */
+;* returns two values the starting char number of the definition */
+;* and the stop char. */
+;*---------------------------------------------------------------------*/
+(define (definition-search ip tab semipred)
+ (cond-expand
+ (bigloo2.6
+ (define (reader-current-line-number)
+ (let* ((port (open-input-string "(9)"))
+ (exp (read port #t)))
+ (close-input-port port)
+ (line-number exp)))
+ (define (line-number expr)
+ (and (epair? expr)
+ (match-case (cer expr)
+ ((at ?- ?pos ?line)
+ line))))
+ (reader-reset!)
+ (let loop ((exp (read ip #t)))
+ (if (not (eof-object? exp))
+ (let ((v (semipred exp)))
+ (if (not v)
+ (loop (read ip #t))
+ (let* ((b (line-number exp))
+ (e (reader-current-line-number)))
+ (source-read-lines (input-port-name ip) b e tab)))))))
+ (else
+ (define (char-number expr)
+ (and (epair? expr)
+ (match-case (cer expr)
+ ((at ?- ?pos)
+ pos))))
+ (let loop ((exp (read ip #t)))
+ (if (not (eof-object? exp))
+ (let ((v (semipred exp)))
+ (if (not v)
+ (loop (read ip #t))
+ (let* ((b (char-number exp))
+ (e (input-port-position ip)))
+ (source-read-chars (input-port-name ip)
+ b
+ e
+ tab)))))))))
+
+
+;*---------------------------------------------------------------------*/
+;* fontify-lisp ... */
+;*---------------------------------------------------------------------*/
+(define (fontify-lisp port::input-port)
+ (let ((g (regular-grammar ()
+ ((: ";;" (* all))
+ ;; italic comments
+ (let ((c (new markup
+ (markup '&source-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((: ";*" (* all))
+ ;; bold comments
+ (let ((c (new markup
+ (markup '&source-line-comment)
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((: ";" (out #\; #\*) (* all))
+ ;; plain comments
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ ((: #\\ (* (in #\space #\tab)) ";" (out #\; #\*) (* all))
+ ;; plain comments
+ (let ((str (the-substring 1 (the-length))))
+ (cons str (ignore))))
+ ((+ #\Space)
+ ;; separators
+ (let ((str (the-string)))
+ (cons (highlight str) (ignore))))
+ (#\(
+ ;; open parenthesis
+ (let ((str (highlight (the-string))))
+ (pupush-highlight)
+ (cons str (ignore))))
+ (#\)
+ ;; close parenthesis
+ (let ((str (highlight (the-string) -1)))
+ (cons str (ignore))))
+ ((+ (in "[]"))
+ ;; brackets
+ (let ((s (the-string)))
+ (if *bracket-highlight*
+ (let ((c (new markup
+ (markup '&source-bracket)
+ (body s))))
+ (cons c (ignore)))
+ (cons s (ignore)))))
+ ((+ #\Tab)
+ (let ((str (the-string)))
+ (cons (highlight str) (ignore))))
+ ((: #\( (+ (out "; \t()[]:\"\n")))
+ ;; keywords
+ (let* ((string (the-substring 1 (the-length)))
+ (symbol (string->symbol string))
+ (key (getprop symbol *the-key*)))
+ (cons
+ "("
+ (case key
+ ((symbol)
+ (let ((c (new markup
+ (markup '&source-keyword)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ ((define)
+ (let ((c (new markup
+ (markup '&source-define)
+ (body string))))
+ (push-highlight (lambda (e)
+ (new markup
+ (markup '&source-define)
+ (ident (symbol->string (gensym)))
+ (body e)))
+ 1)
+ (cons c (ignore))))
+ ((error)
+ (let ((c (new markup
+ (markup '&source-error)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ ((module)
+ (let ((c (new markup
+ (markup '&source-module)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (push-highlight (lambda (e)
+ (new markup
+ (markup '&source-module)
+ (ident (symbol->string (gensym)))
+ (body e)))
+ 1)
+ (cons c (ignore))))
+ ((markup)
+ (let ((c (new markup
+ (markup '&source-markup)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ ((thread)
+ (let ((c (new markup
+ (markup '&source-thread)
+ (ident (symbol->string (gensym)))
+ (body string))))
+ (cons c (ignore))))
+ (else
+ (cons (highlight string 1) (ignore)))))))
+ ((+ (out "; \t()[]:\"\n"))
+ (let ((string (the-string)))
+ (cons (highlight string 1) (ignore))))
+ ((+ #\Newline)
+ ;; newline
+ (let ((str (the-string)))
+ (cons (highlight str) (ignore))))
+ ((or (: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (: "#\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\""))
+ ;; strings
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-string)
+ (ident (symbol->string (gensym)))
+ (body s))))
+ str)
+ (ignore))))
+ ((: "::" (+ (out ";\n \t()[]:\"")))
+ ;; type annotations
+ (let ((c (new markup
+ (markup '&source-type)
+ (ident (symbol->string (gensym)))
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((: ":" (out ":()[] \n\t\"") (* (out ";\n \t()[]:\"")))
+ ;; keywords annotations
+ (let ((c (new markup
+ (markup '&source-key)
+ (ident (symbol->string (gensym)))
+ (body (the-string)))))
+ (cons c (ignore))))
+ ((+ (or #\: #\; #\"))
+ (let ((str (the-string)))
+ (cons (highlight str 1) (ignore))))
+ ((: #\# #\\ (+ (out " \n\t")))
+ ;; characters
+ (let ((str (the-string)))
+ (cons (highlight str 1) (ignore))))
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ '()
+ (error "source(lisp)" "Unexpected character" c)))))))
+ (reset-highlight!)
+ (read/rp g port)))
+
+;*---------------------------------------------------------------------*/
+;* *highlight* ... */
+;*---------------------------------------------------------------------*/
+(define *highlight* '())
+
+;*---------------------------------------------------------------------*/
+;* reset-highlight! ... */
+;*---------------------------------------------------------------------*/
+(define (reset-highlight!)
+ (set! *highlight* '()))
+
+;*---------------------------------------------------------------------*/
+;* push-highlight ... */
+;*---------------------------------------------------------------------*/
+(define (push-highlight col pv)
+ (set! *highlight* (cons (cons col pv) *highlight*)))
+
+;*---------------------------------------------------------------------*/
+;* pupush-highlight ... */
+;*---------------------------------------------------------------------*/
+(define (pupush-highlight)
+ (if (pair? *highlight*)
+ (let ((c (car *highlight*)))
+ (set-cdr! c 100000))))
+
+;*---------------------------------------------------------------------*/
+;* pop-highlight ... */
+;*---------------------------------------------------------------------*/
+(define (pop-highlight pv)
+ (case pv
+ ((-1)
+ (set! *highlight* (cdr *highlight*)))
+ ((0)
+ 'nop)
+ (else
+ (let ((c (car *highlight*)))
+ (if (>fx (cdr c) 1)
+ (set-cdr! c (-fx (cdr c) 1))
+ (set! *highlight* (cdr *highlight*)))))))
+
+;*---------------------------------------------------------------------*/
+;* highlight ... */
+;*---------------------------------------------------------------------*/
+(define (highlight exp . pop)
+ (if (pair? *highlight*)
+ (let* ((c (car *highlight*))
+ (r (if (>fx (cdr c) 0)
+ ((car c) exp)
+ exp)))
+ (if (pair? pop) (pop-highlight (car pop)))
+ r)
+ exp))
+
+
diff --git a/skribe/src/bigloo/main.scm b/skribe/src/bigloo/main.scm
new file mode 100644
index 0000000..5b9e5e5
--- /dev/null
+++ b/skribe/src/bigloo/main.scm
@@ -0,0 +1,96 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/main.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Jul 22 16:51:49 2003 */
+;* Last change : Wed May 18 15:45:27 2005 (serrano) */
+;* Copyright : 2003-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe main entry point */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_main
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_parse-args
+ skribe_param
+ skribe_lib
+ skribe_eval
+ skribe_read
+ skribe_engine
+ skribe_evapi)
+
+ (main main))
+
+;*---------------------------------------------------------------------*/
+;* main ... */
+;*---------------------------------------------------------------------*/
+(define (main args)
+ (with-debug 2 'main
+ (debug-item "parse env variables...")
+ (parse-env-variables)
+
+ (debug-item "load rc file...")
+ (load-rc)
+
+ (debug-item "parse command line...")
+ (parse-args args)
+
+ (debug-item "load base...")
+ (skribe-load "base.skr" :engine 'base)
+
+ (debug-item "preload... (" *skribe-engine* ")")
+ (for-each (lambda (f)
+ (skribe-load f :engine *skribe-engine*))
+ *skribe-preload*)
+
+ ;; Load the specified variants
+ (debug-item "variant... (" *skribe-variants* ")")
+ (for-each (lambda (x)
+ (skribe-load (format "~a.skr" x) :engine *skribe-engine*))
+ (reverse! *skribe-variants*))
+
+ (debug-item "body..." *skribe-engine*)
+ (if (string? *skribe-dest*)
+ (cond-expand
+ (bigloo2.6
+ (try (with-output-to-file *skribe-dest* doskribe)
+ (lambda (e a b c)
+ (delete-file *skribe-dest*)
+ (let ((s (with-output-to-string
+ (lambda () (write c)))))
+ (notify-error a b s))
+ (exit -1))))
+ (else
+ (with-exception-handler
+ (lambda (e)
+ (if (&warning? e)
+ (raise e)
+ (begin
+ (delete-file *skribe-dest*)
+ (if (&error? e)
+ (error-notify e)
+ (raise e))
+ (exit 1))))
+ (lambda ()
+ (with-output-to-file *skribe-dest* doskribe)))))
+ (doskribe))))
+
+;*---------------------------------------------------------------------*/
+;* doskribe ... */
+;*---------------------------------------------------------------------*/
+(define (doskribe)
+ (let ((e (find-engine *skribe-engine*)))
+ (if (and (engine? e) (pair? *skribe-precustom*))
+ (for-each (lambda (cv)
+ (engine-custom-set! e (car cv) (cdr cv)))
+ *skribe-precustom*))
+ (if (pair? *skribe-src*)
+ (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
+ *skribe-src*)
+ (skribe-eval-port (current-input-port) *skribe-engine*))))
diff --git a/skribe/src/bigloo/new.sch b/skribe/src/bigloo/new.sch
new file mode 100644
index 0000000..16bb7d5
--- /dev/null
+++ b/skribe/src/bigloo/new.sch
@@ -0,0 +1,17 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/new.sch */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Aug 17 11:58:30 2003 */
+;* Last change : Wed Sep 10 11:14:15 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The new facility */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* new ... */
+;*---------------------------------------------------------------------*/
+(define-macro (new id . inits)
+ `(,(symbol-append 'instantiate::% id) ,@inits))
+
diff --git a/skribe/src/bigloo/output.scm b/skribe/src/bigloo/output.scm
new file mode 100644
index 0000000..4bc6271
--- /dev/null
+++ b/skribe/src/bigloo/output.scm
@@ -0,0 +1,167 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/output.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 12:48:11 2003 */
+;* Last change : Wed Feb 4 10:33:19 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe engine */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_output
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_engine
+ skribe_writer
+ skribe_eval)
+
+ (export (output ::obj ::%engine . w)))
+
+;*---------------------------------------------------------------------*/
+;* output ... */
+;*---------------------------------------------------------------------*/
+(define (output node e . writer)
+ (with-debug 3 'output
+ (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
+ (debug-item "writer=" writer)
+ (if (pair? writer)
+ (cond
+ ((%writer? (car writer))
+ (out/writer node e (car writer)))
+ ((not (car writer))
+ (skribe-error 'output
+ (format "Illegal `~a' user writer" (%engine-ident e))
+ (if (markup? node) (%markup-markup node) node)))
+ (else
+ (skribe-error 'output "Illegal user writer" (car writer))))
+ (out node e))))
+
+;*---------------------------------------------------------------------*/
+;* out/writer ... */
+;*---------------------------------------------------------------------*/
+(define (out/writer n e w)
+ (with-debug 5 'out/writer
+ (debug-item "n=" (find-runtime-type n)
+ " " (if (markup? n) (markup-markup n) ""))
+ (debug-item "e=" (%engine-ident e))
+ (debug-item "w=" (%writer-ident w))
+ (if (%writer? w)
+ (with-access::%writer w (before action after)
+ (invoke before n e)
+ (invoke action n e)
+ (invoke after n e)))))
+
+;*---------------------------------------------------------------------*/
+;* out ... */
+;*---------------------------------------------------------------------*/
+(define-generic (out node e::%engine)
+ (cond
+ ((pair? node)
+ (out* node e))
+ ((string? node)
+ (let ((f (%engine-filter e)))
+ (if (procedure? f)
+ (display (f node))
+ (display node))))
+ ((number? node)
+ (display node))
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* out ::%processor ... */
+;*---------------------------------------------------------------------*/
+(define-method (out n::%processor e::%engine)
+ (with-access::%processor n (combinator engine body procedure)
+ (let ((newe (processor-get-engine combinator engine e)))
+ (out (procedure body newe) newe))))
+
+;*---------------------------------------------------------------------*/
+;* out ::%command ... */
+;*---------------------------------------------------------------------*/
+(define-method (out node::%command e::%engine)
+ (with-access::%command node (fmt body)
+ (let ((lb (length body))
+ (lf (string-length fmt)))
+ (define (loops i n)
+ (if (= i lf)
+ (begin
+ (if (> n 0)
+ (if (<= n lb)
+ (output (list-ref body (- n 1)) e)
+ (skribe-error '!
+ "Too few arguments provided"
+ node)))
+ lf)
+ (let ((c (string-ref fmt i)))
+ (cond
+ ((char=? c #\$)
+ (display "$")
+ (+ 1 i))
+ ((not (char-numeric? c))
+ (cond
+ ((= n 0)
+ i)
+ ((<= n lb)
+ (output (list-ref body (- n 1)) e)
+ i)
+ (else
+ (skribe-error '!
+ "Too few arguments provided"
+ node))))
+ (else
+ (loops (+ i 1)
+ (+ (- (char->integer c)
+ (char->integer #\0))
+ (* 10 n))))))))
+ (let loop ((i 0))
+ (cond
+ ((= i lf)
+ #f)
+ ((not (char=? (string-ref fmt i) #\$))
+ (display (string-ref fmt i))
+ (loop (+ i 1)))
+ (else
+ (loop (loops (+ i 1) 0))))))))
+
+;*---------------------------------------------------------------------*/
+;* out ::%handle ... */
+;*---------------------------------------------------------------------*/
+(define-method (out node::%handle e::%engine)
+ #unspecified)
+
+;*---------------------------------------------------------------------*/
+;* out ::%unresolved ... */
+;*---------------------------------------------------------------------*/
+(define-method (out node::%unresolved e::%engine)
+ (error 'output "Orphan unresolved" node))
+
+;*---------------------------------------------------------------------*/
+;* out ::%markup ... */
+;*---------------------------------------------------------------------*/
+(define-method (out node::%markup e::%engine)
+ (let ((w (lookup-markup-writer node e)))
+ (if (writer? w)
+ (out/writer node e w)
+ (output (%markup-body node) e))))
+
+;*---------------------------------------------------------------------*/
+;* out* ... */
+;*---------------------------------------------------------------------*/
+(define (out* n+ e)
+ (let loop ((n* n+))
+ (cond
+ ((pair? n*)
+ (out (car n*) e)
+ (loop (cdr n*)))
+ ((not (null? n*))
+ (error 'output "Illegal argument" n*)))))
+
+
diff --git a/skribe/src/bigloo/param.bgl b/skribe/src/bigloo/param.bgl
new file mode 100644
index 0000000..6ff6b42
--- /dev/null
+++ b/skribe/src/bigloo/param.bgl
@@ -0,0 +1,134 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/param.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sat Jul 26 14:03:15 2003 */
+;* Last change : Wed Mar 3 10:18:48 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe parameters */
+;* ------------------------------------------------------------- */
+;* Implementation: @label param@ */
+;* bigloo: @path ../common/param.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_param
+
+ (import skribe_configure)
+
+ (export *skribe-verbose*
+ *skribe-warning*
+ *skribe-path*
+ *skribe-bib-path*
+ *skribe-source-path*
+ *skribe-image-path*
+ *load-rc*
+
+ *skribe-src*
+ *skribe-dest*
+ *skribe-engine*
+ *skribe-variants*
+ *skribe-chapter-split*
+
+ *skribe-ref-base*
+
+ *skribe-rc-directory*
+ *skribe-rc-file*
+ *skribe-auto-mode-alist*
+ *skribe-auto-load-alist*
+ *skribe-preload*
+ *skribe-precustom*
+
+ *skribebib-auto-mode-alist*))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-verbose* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-verbose* 0)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-warning* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-warning* 5)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-path* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-path* (skribe-default-path))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-bib-path* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-bib-path* '("."))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-source-path* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-source-path* '("."))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-image-path* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-image-path* '("."))
+
+;*---------------------------------------------------------------------*/
+;* *load-rc* ... */
+;*---------------------------------------------------------------------*/
+(define *load-rc* #t)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-src* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-src* '())
+
+;*---------------------------------------------------------------------*/
+;* *skribe-dest* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-dest* #f)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-engine* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-engine* 'html)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-variants* */
+;*---------------------------------------------------------------------*/
+(define *skribe-variants* '())
+
+;*---------------------------------------------------------------------*/
+;* *skribe-chapter-split* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-chapter-split* '())
+
+;*---------------------------------------------------------------------*/
+;* *skribe-ref-base* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-ref-base* #f)
+
+;*---------------------------------------------------------------------*/
+;* *skribe-rc-directory* ... */
+;* ------------------------------------------------------------- */
+;* The "runtime command" file directory. */
+;*---------------------------------------------------------------------*/
+(define *skribe-rc-directory*
+ (let ((home (getenv "HOME"))
+ (host (hostname)))
+ (let loop ((host (if (not (string? host)) (getenv "HOST") host)))
+ (if (string? host)
+ (let ((home/host (string-append home "/.skribe" host)))
+ (if (and (file-exists? home/host) (directory? home/host))
+ home/host
+ (if (string=? (suffix host) "")
+ (let ((home/def (make-file-name home ".skribe")))
+ (cond
+ ((and (file-exists? home/def)
+ (directory? home/def))
+ home/def)
+ (else
+ home)))
+ (loop (prefix host)))))))))
+
diff --git a/skribe/src/bigloo/parseargs.scm b/skribe/src/bigloo/parseargs.scm
new file mode 100644
index 0000000..4ce58c4
--- /dev/null
+++ b/skribe/src/bigloo/parseargs.scm
@@ -0,0 +1,186 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/parseargs.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Jul 22 16:52:53 2003 */
+;* Last change : Wed Nov 10 10:57:40 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Argument parsing */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_parse-args
+
+ (include "debug.sch")
+
+ (import skribe_configure
+ skribe_param
+ skribe_read
+ skribe_types
+ skribe_eval)
+
+ (export (parse-env-variables)
+ (parse-args ::pair)
+ (load-rc)))
+
+;*---------------------------------------------------------------------*/
+;* parse-env-variables ... */
+;*---------------------------------------------------------------------*/
+(define (parse-env-variables)
+ (let ((e (getenv "SKRIBEPATH")))
+ (if (string? e)
+ (skribe-path-set! (append (unix-path->list e) (skribe-path))))))
+
+;*---------------------------------------------------------------------*/
+;* parse-args ... */
+;*---------------------------------------------------------------------*/
+(define (parse-args args)
+ (define (usage args-parse-usage)
+ (print "usage: skribe [options] [input]")
+ (newline)
+ (args-parse-usage #f)
+ (newline)
+ (print "Rc file:")
+ (newline)
+ (print " *skribe-rc* (searched in \".\" then $HOME)")
+ (newline)
+ (print "Target formats:")
+ (for-each (lambda (f) (print " - " (car f))) *skribe-auto-mode-alist*)
+ (newline)
+ (print "Shell Variables:")
+ (newline)
+ (for-each (lambda (var)
+ (print " - " (car var) " " (cdr var)))
+ '(("SKRIBEPATH" . "Skribe input path (all files)"))))
+ (define (version)
+ (print "skribe v" (skribe-release)))
+ (define (query)
+ (version)
+ (newline)
+ (for-each (lambda (x)
+ (let ((s (keyword->string (car x))))
+ (printf " ~a: ~a\n"
+ (substring s 1 (string-length s))
+ (cadr x))))
+ (skribe-configure)))
+ (let ((np '())
+ (engine #f))
+ (args-parse (cdr args)
+ ((("-h" "--help") (help "This message"))
+ (usage args-parse-usage)
+ (exit 0))
+ (("--options" (help "Display the skribe options and exit"))
+ (args-parse-usage #t)
+ (exit 0))
+ (("--version" (help "The version of Skribe"))
+ (version)
+ (exit 0))
+ ((("-q" "--query") (help "Display informations about the Skribe configuration"))
+ (query)
+ (exit 0))
+ ((("-c" "--custom") ?key=val (synopsis "Preset custom value"))
+ (let ((l (string-length key=val)))
+ (let loop ((i 0))
+ (cond
+ ((= i l)
+ (skribe-error 'skribe "Illegal option" key=val))
+ ((char=? (string-ref key=val i) #\=)
+ (let ((key (substring key=val 0 i))
+ (val (substring key=val (+ i 1) l)))
+ (set! *skribe-precustom*
+ (cons (cons (string->symbol key) val)
+ *skribe-precustom*))))
+ (else
+ (loop (+ i 1)))))))
+ (("-v?level" (help "Increase or set verbosity level (-v0 for crystal silence)"))
+ (if (string=? level "")
+ (set! *skribe-verbose* (+fx 1 *skribe-verbose*))
+ (set! *skribe-verbose* (string->integer level))))
+ (("-w?level" (help "Increase or set warning level (-w0 for crystal silence)"))
+ (if (string=? level "")
+ (set! *skribe-warning* (+fx 1 *skribe-warning*))
+ (set! *skribe-warning* (string->integer level))))
+ (("-g?level" (help "Increase or set debug level"))
+ (if (string=? level "")
+ (set! *skribe-debug* (+fx 1 *skribe-debug*))
+ (let ((l (string->integer level)))
+ (if (= l 0)
+ (begin
+ (set! *skribe-debug* 1)
+ (set! *skribe-debug-symbols*
+ (cons (string->symbol level)
+ *skribe-debug-symbols*)))
+ (set! *skribe-debug* l)))))
+ (("--no-color" (help "Disable coloring for debug"))
+ (set! *skribe-debug-color* #f))
+ ((("-t" "--target") ?e (help "The output target format"))
+ (set! engine (string->symbol e)))
+ (("-I" ?path (help "Add <path> to skribe path"))
+ (set! np (cons path np)))
+ (("-B" ?path (help "Add <path> to skribe bibliography path"))
+ (skribe-bib-path-set! (cons path (skribe-bib-path))))
+ (("-S" ?path (help "Add <path> to skribe source path"))
+ (skribe-source-path-set! (cons path (skribe-source-path))))
+ (("-P" ?path (help "Add <path> to skribe image path"))
+ (skribe-image-path-set! (cons path (skribe-image-path))))
+ ((("-C" "--split-chapter") ?chapter (help "Emit chapter's sections in separate files"))
+ (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
+ (("--eval" ?expr (help "Evaluate expression"))
+ (with-input-from-string expr
+ (lambda ()
+ (eval (skribe-read)))))
+ (("--no-init-file" (help "Dont load rc Skribe file"))
+ (set! *load-rc* #f))
+ ((("-p" "--preload") ?file (help "Preload file"))
+ (set! *skribe-preload* (cons file *skribe-preload*)))
+ ((("-u" "--use-variant") ?variant (help "use <variant> output format"))
+ (set! *skribe-variants* (cons variant *skribe-variants*)))
+ ((("-o" "--output") ?o (help "The output target name"))
+ (set! *skribe-dest* o)
+ (let* ((s (suffix o))
+ (c (assoc s *skribe-auto-mode-alist*)))
+ (if (and (pair? c) (symbol? (cdr c)))
+ (set! *skribe-engine* (cdr c)))))
+ ((("-b" "--base") ?base (help "The base prefix to be removed from hyperlinks"))
+ (set! *skribe-ref-base* base))
+ ;; skribe rc directory
+ ((("-d" "--rc-dir") ?dir (synopsis "Set the skribe RC directory"))
+ (set! *skribe-rc-directory* dir))
+ (else
+ (set! *skribe-src* (cons else *skribe-src*))))
+ ;; we have to configure according to the environment variables
+ (if engine (set! *skribe-engine* engine))
+ (set! *skribe-src* (reverse! *skribe-src*))
+ (skribe-path-set! (append (build-path-from-shell-variable "SKRIBEPATH")
+ (reverse! np)
+ (skribe-path)))))
+
+;*---------------------------------------------------------------------*/
+;* build-path-from-shell-variable ... */
+;*---------------------------------------------------------------------*/
+(define (build-path-from-shell-variable var)
+ (let ((val (getenv var)))
+ (if (string? val)
+ (string-case val
+ ((+ (out #\:))
+ (let* ((str (the-string))
+ (res (ignore)))
+ (cons str res)))
+ (#\:
+ (ignore))
+ (else
+ '()))
+ '())))
+
+;*---------------------------------------------------------------------*/
+;* load-rc ... */
+;*---------------------------------------------------------------------*/
+(define (load-rc)
+ (if *load-rc*
+ (let ((file (make-file-name *skribe-rc-directory* *skribe-rc-file*)))
+ (if (and (string? file) (file-exists? file))
+ (loadq file)))))
+
diff --git a/skribe/src/bigloo/prog.scm b/skribe/src/bigloo/prog.scm
new file mode 100644
index 0000000..baad0f0
--- /dev/null
+++ b/skribe/src/bigloo/prog.scm
@@ -0,0 +1,196 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/prog.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Aug 27 09:14:28 2003 */
+;* Last change : Tue Oct 7 15:07:48 2003 (serrano) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe prog bigloo implementation */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_prog
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api)
+
+ (export (make-prog-body ::obj ::obj ::obj ::obj)
+ (resolve-line ::bstring)))
+
+;*---------------------------------------------------------------------*/
+;* *lines* ... */
+;*---------------------------------------------------------------------*/
+(define *lines* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* make-line-mark ... */
+;*---------------------------------------------------------------------*/
+(define (make-line-mark m lnum b)
+ (let* ((ls (integer->string lnum))
+ (n (list (mark ls) b)))
+ (hashtable-put! *lines* m n)
+ n))
+
+;*---------------------------------------------------------------------*/
+;* resolve-line ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-line id)
+ (hashtable-get *lines* id))
+
+;*---------------------------------------------------------------------*/
+;* extract-string-mark ... */
+;*---------------------------------------------------------------------*/
+(define (extract-string-mark line mark regexp)
+ (let ((m (pregexp-match regexp line)))
+ (if (pair? m)
+ (values (substring (car m)
+ (string-length mark)
+ (string-length (car m)))
+ (pregexp-replace regexp line ""))
+ (values #f line))))
+
+;*---------------------------------------------------------------------*/
+;* extract-mark ... */
+;* ------------------------------------------------------------- */
+;* Extract the prog mark from a line. */
+;*---------------------------------------------------------------------*/
+(define (extract-mark line mark regexp)
+ (cond
+ ((not regexp)
+ (values #f line))
+ ((string? line)
+ (extract-string-mark line mark regexp))
+ ((pair? line)
+ (let loop ((ls line)
+ (res '()))
+ (if (null? ls)
+ (values #f line)
+ (multiple-value-bind (m l)
+ (extract-mark (car ls) mark regexp)
+ (if (not m)
+ (loop (cdr ls) (cons l res))
+ (values m (append (reverse! res) (cons l (cdr ls)))))))))
+ ((%node? line)
+ (multiple-value-bind (m l)
+ (extract-mark (%node-body line) mark regexp)
+ (if (not m)
+ (values #f line)
+ (begin
+ (%node-body-set! line l)
+ (values m line)))))
+ (else
+ (values #f line))))
+
+;*---------------------------------------------------------------------*/
+;* split-line ... */
+;*---------------------------------------------------------------------*/
+(define (split-line line)
+ (cond
+ ((string? line)
+ (let ((l (string-length line)))
+ (let loop ((r1 0)
+ (r2 0)
+ (res '()))
+ (cond
+ ((=fx r2 l)
+ (if (=fx r1 r2)
+ (reverse! res)
+ (reverse! (cons (substring line r1 r2) res))))
+ ((char=? (string-ref line r2) #\Newline)
+ (loop (+fx r2 1)
+ (+fx r2 1)
+ (if (=fx r1 r2)
+ (cons 'eol res)
+ (cons* 'eol (substring line r1 r2) res))))
+ (else
+ (loop r1
+ (+fx r2 1)
+ res))))))
+ ((pair? line)
+ (let loop ((ls line)
+ (res '()))
+ (if (null? ls)
+ res
+ (loop (cdr ls) (append res (split-line (car ls)))))))
+ (else
+ (list line))))
+
+;*---------------------------------------------------------------------*/
+;* flat-lines ... */
+;*---------------------------------------------------------------------*/
+(define (flat-lines lines)
+ (apply append (map split-line lines)))
+
+;*---------------------------------------------------------------------*/
+;* collect-lines ... */
+;*---------------------------------------------------------------------*/
+(define (collect-lines lines)
+ (let loop ((lines (flat-lines lines))
+ (res '())
+ (tmp '()))
+ (cond
+ ((null? lines)
+ (reverse! (cons (reverse! tmp) res)))
+ ((eq? (car lines) 'eol)
+ (cond
+ ((null? (cdr lines))
+ (reverse! (cons (reverse! tmp) res)))
+ ((and (null? res) (null? tmp))
+ (loop (cdr lines)
+ res
+ '()))
+ (else
+ (loop (cdr lines)
+ (cons (reverse! tmp) res)
+ '()))))
+ (else
+ (loop (cdr lines)
+ res
+ (cons (car lines) tmp))))))
+
+;*---------------------------------------------------------------------*/
+;* make-prog-body ... */
+;*---------------------------------------------------------------------*/
+(define (make-prog-body src lnum-init ldigit mark)
+ (define (int->str i rl)
+ (let* ((s (integer->string i))
+ (l (string-length s)))
+ (if (= l rl)
+ s
+ (string-append (make-string (- rl l) #\space) s))))
+ (let* ((regexp (and mark
+ (format "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
+ (pregexp-quote mark))))
+ (src (cond
+ ((not (pair? src)) (list src))
+ ((and (pair? (car src)) (null? (cdr src))) (car src))
+ (else src)))
+ (lines (collect-lines src))
+ (lnum (if (integer? lnum-init) lnum-init 1))
+ (s (integer->string (+fx (if (integer? ldigit)
+ (max lnum (expt 10 (-fx ldigit 1)))
+ lnum)
+ (length lines))))
+ (cs (string-length s)))
+ (let loop ((lines lines)
+ (lnum lnum)
+ (res '()))
+ (if (null? lines)
+ (reverse! res)
+ (multiple-value-bind (m l)
+ (extract-mark (car lines) mark regexp)
+ (let ((n (new markup
+ (markup '&prog-line)
+ (ident (and lnum-init (int->str lnum cs)))
+ (body (if m (make-line-mark m lnum l) l)))))
+ (loop (cdr lines)
+ (+ lnum 1)
+ (cons n res))))))))
diff --git a/skribe/src/bigloo/read.scm b/skribe/src/bigloo/read.scm
new file mode 100644
index 0000000..91cd345
--- /dev/null
+++ b/skribe/src/bigloo/read.scm
@@ -0,0 +1,482 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/read.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Dec 27 11:16:00 1994 */
+;* Last change : Mon Nov 8 13:30:32 2004 (serrano) */
+;* ------------------------------------------------------------- */
+;* Skribe's reader */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* Le module */
+;*---------------------------------------------------------------------*/
+(module skribe_read
+ (export (skribe-read . port)))
+
+;*---------------------------------------------------------------------*/
+;* Global counteurs ... */
+;*---------------------------------------------------------------------*/
+(define *par-open* 0)
+
+;*---------------------------------------------------------------------*/
+;* Parenthesis mismatch (or unclosing) errors. */
+;*---------------------------------------------------------------------*/
+(define *list-error-level* 20)
+(define *list-errors* (make-vector *list-error-level* #unspecified))
+(define *vector-errors* (make-vector *list-error-level* #unspecified))
+
+;*---------------------------------------------------------------------*/
+;* Control variables. */
+;*---------------------------------------------------------------------*/
+(define *end-of-list* (cons 0 0))
+(define *dotted-mark* (cons 1 1))
+
+;*---------------------------------------------------------------------*/
+;* skribe-reader-reset! ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-reader-reset!)
+ (set! *par-open* 0))
+
+;*---------------------------------------------------------------------*/
+;* read-error ... */
+;*---------------------------------------------------------------------*/
+(define (read-error msg obj port)
+ (let* ((obj-loc (if (epair? obj)
+ (match-case (cer obj)
+ ((at ?fname ?pos ?-)
+ pos)
+ (else
+ #f))
+ #f))
+ (loc (if (number? obj-loc)
+ obj-loc
+ (cond
+ ((>fx *par-open* 0)
+ (let ((open-key (-fx *par-open* 1)))
+ (if (<fx open-key (vector-length *list-errors*))
+ (vector-ref *list-errors* open-key)
+ #f)))
+ (else
+ #f)))))
+ (if (fixnum? loc)
+ (error/location "skribe-read" msg obj (input-port-name port) loc)
+ (error "skribe-read" msg obj))))
+
+;*---------------------------------------------------------------------*/
+;* make-list! ... */
+;*---------------------------------------------------------------------*/
+(define (make-list! l port)
+ (define (reverse-proper-list! l)
+ (let nr ((l l)
+ (r '()))
+ (cond
+ ((eq? (car l) *dotted-mark*)
+ (read-error "Illegal pair" r port))
+ ((null? (cdr l))
+ (set-cdr! l r)
+ l)
+ (else
+ (let ((cdrl (cdr l)))
+ (nr cdrl
+ (begin (set-cdr! l r)
+ l)))))))
+ (define (reverse-improper-list! l)
+ (let nr ((l (cddr l))
+ (r (car l)))
+ (cond
+ ((eq? (car l) *dotted-mark*)
+ (read-error "Illegal pair" r port))
+ ((null? (cdr l))
+ (set-cdr! l r)
+ l)
+ (else
+ (let ((cdrl (cdr l)))
+ (nr cdrl
+ (begin (set-cdr! l r)
+ l)))))))
+ (cond
+ ((null? l)
+ l)
+ ((and (pair? l) (pair? (cdr l)) (eq? (cadr l) *dotted-mark*))
+ (if (null? (cddr l))
+ (car l)
+ (reverse-improper-list! l)))
+ (else
+ (reverse-proper-list! l))))
+
+;*---------------------------------------------------------------------*/
+;* make-at ... */
+;*---------------------------------------------------------------------*/
+(define (make-at name pos)
+ (cond-expand
+ ((or bigloo2.4 bigloo2.5 bigloo2.6)
+ `(at ,name ,pos _))
+ (else
+ `(at ,name ,pos))))
+
+;*---------------------------------------------------------------------*/
+;* collect-up-to ... */
+;* ------------------------------------------------------------- */
+;* The first pair of the list is special because of source file */
+;* location. We want the location to be associated to the first */
+;* open parenthesis, not the last character of the car of the list. */
+;*---------------------------------------------------------------------*/
+(define-inline (collect-up-to ignore kind port)
+ (let ((name (input-port-name port)))
+ (let* ((pos (input-port-position port))
+ (item (ignore)))
+ (if (eq? item *end-of-list*)
+ '()
+ (let loop ((acc (econs item '() (make-at name pos))))
+ (let ((item (ignore)))
+ (if (eq? item *end-of-list*)
+ acc
+ (loop (let ((new-pos (input-port-position port)))
+ (econs item
+ acc
+ (make-at name new-pos)))))))))))
+
+;*---------------------------------------------------------------------*/
+;* read-quote ... */
+;*---------------------------------------------------------------------*/
+(define (read-quote kwote port ignore)
+ (let* ((pos (input-port-position port))
+ (obj (ignore)))
+ (if (or (eof-object? obj) (eq? obj *end-of-list*))
+ (error/location "read"
+ "Illegal quotation"
+ kwote
+ (input-port-name port)
+ pos))
+ (econs kwote
+ (cons obj '())
+ (make-at (input-port-name port) pos))))
+
+;*---------------------------------------------------------------------*/
+;* *sexp-grammar* ... */
+;*---------------------------------------------------------------------*/
+(define *sexp-grammar*
+ (regular-grammar ((float (or (: (* digit) "." (+ digit))
+ (: (+ digit) "." (* digit))))
+ (letter (in ("azAZ") (#a128 #a255)))
+ (special (in "!@~$%^&*></-_+\\=?.:{}"))
+ (kspecial (in "!@~$%^&*></-_+\\=?."))
+ (quote (in "\",'`"))
+ (paren (in "()"))
+ (id (: (* digit)
+ (or letter special)
+ (* (or letter special digit (in ",'`")))))
+ (kid (: (* digit)
+ (or letter kspecial)
+ (* (or letter kspecial digit (in ",'`")))))
+ (blank (in #\Space #\Tab #a012 #a013)))
+
+ ;; newlines
+ ((+ #\Newline)
+ (ignore))
+
+ ;; blank lines
+ ((+ blank)
+ (ignore))
+
+ ;; comments
+ ((: ";" (* all))
+ (ignore))
+
+ ;; the interpreter header or the dsssl named constants
+ ((: "#!" (+ (in letter)))
+ (let* ((str (the-string)))
+ (cond
+ ((string=? str "#!optional")
+ boptional)
+ ((string=? str "#!rest")
+ brest)
+ ((string=? str "#!key")
+ bkey)
+ (else
+ (ignore)))))
+
+ ;; characters
+ ((: (uncase "#a") (= 3 digit))
+ (let ((string (the-string)))
+ (if (not (=fx (the-length) 5))
+ (error/location "skribe-read"
+ "Illegal ascii character"
+ string
+ (input-port-name (the-port))
+ (input-port-position (the-port)))
+ (integer->char (string->integer (the-substring 2 5))))))
+ ((: "#\\" (or letter digit special (in "|#; []" quote paren)))
+ (string-ref (the-string) 2))
+ ((: "#\\" (>= 2 letter))
+ (let ((char-name (string->symbol
+ (string-upcase!
+ (the-substring 2 (the-length))))))
+ (case char-name
+ ((NEWLINE)
+ #\Newline)
+ ((TAB)
+ #\tab)
+ ((SPACE)
+ #\space)
+ ((RETURN)
+ (integer->char 13))
+ (else
+ (error/location "skribe-read"
+ "Illegal character"
+ (the-string)
+ (input-port-name (the-port))
+ (input-port-position (the-port)))))))
+
+ ;; ucs-2 characters
+ ((: "#u" (= 4 xdigit))
+ (integer->ucs2 (string->integer (the-substring 2 6) 16)))
+
+ ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (let ((str (the-substring 1 (-fx (the-length) 1))))
+ (let ((str (the-substring 0 (-fx (the-length) 1))))
+ (escape-C-string str))))
+ ;; ucs2 strings
+ ((: "#u\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (let ((str (the-substring 3 (-fx (the-length) 1))))
+ (utf8-string->ucs2-string str)))
+
+ ;; fixnums
+ ((: (? (in "-+")) (+ digit))
+ (the-fixnum))
+ ((: "#o" (? (in "-+")) (+ (in ("07"))))
+ (string->integer (the-substring 2 (the-length)) 8))
+ ((: "#d" (? (in "-+")) (+ (in ("09"))))
+ (string->integer (the-substring 2 (the-length)) 10))
+ ((: "#x" (? (in "-+")) (+ (in (uncase (in ("09af"))))))
+ (string->integer (the-substring 2 (the-length)) 16))
+ ((: "#e" (? (in "-+")) (+ digit))
+ (string->elong (the-substring 2 (the-length)) 10))
+ ((: "#l" (? (in "-+")) (+ digit))
+ (string->llong (the-substring 2 (the-length)) 10))
+
+ ;; flonum
+ ((: (? (in "-+"))
+ (or float
+ (: (or float (+ digit)) (in "eE") (? (in "+-")) (+ digit))))
+ (the-flonum))
+
+ ;; doted pairs
+ ("."
+ (if (<=fx *par-open* 0)
+ (error/location "read"
+ "Illegal token"
+ #\.
+ (input-port-name (the-port))
+ (input-port-position (the-port)))
+ *dotted-mark*))
+
+ ;; unspecified and eof-object
+ ((: "#" (in "ue") (+ (in "nspecified-objt")))
+ (let ((symbol (string->symbol
+ (string-upcase!
+ (the-substring 1 (the-length))))))
+ (case symbol
+ ((UNSPECIFIED)
+ unspec)
+ ((EOF-OBJECT)
+ beof)
+ (else
+ (error/location "read"
+ "Illegal identifier"
+ symbol
+ (input-port-name (the-port))
+ (input-port-position (the-port)))))))
+
+ ;; booleans
+ ((: "#" (uncase #\t))
+ #t)
+ ((: "#" (uncase #\f))
+ #f)
+
+ ;; keywords
+ ((or (: ":" kid) (: kid ":"))
+ ;; since the keyword expression is also matched by the id
+ ;; rule, keyword rule has to be placed before the id rule.
+ (the-keyword))
+
+ ;; identifiers
+ (id
+ ;; this rule has to be placed after the rule matching the `.' char
+ (the-symbol))
+ ((: "|" (+ (or (out #a000 #\\ #\|) (: #\\ all))) "|")
+ (if (=fx (the-length) 2)
+ (the-symbol)
+ (let ((str (the-substring 0 (-fx (the-length) 1))))
+ (string->symbol (escape-C-string str)))))
+
+ ;; quotations
+ ("'"
+ (read-quote 'quote (the-port) ignore))
+ ("`"
+ (read-quote 'quasiquote (the-port) ignore))
+ (","
+ (read-quote 'unquote (the-port) ignore))
+ (",@"
+ (read-quote 'unquote-splicing (the-port) ignore))
+
+ ;; lists
+ (#\(
+ ;; if possible, we store the opening parenthesis.
+ (if (and (vector? *list-errors*)
+ (<fx *par-open* (vector-length *list-errors*)))
+ (vector-set! *list-errors*
+ *par-open*
+ (input-port-position (the-port))))
+ ;; we increment the number of open parenthesis
+ (set! *par-open* (+fx 1 *par-open*))
+ ;; and then, we compute the result list...
+ (make-list! (collect-up-to ignore "list" (the-port)) (the-port)))
+ (#\)
+ ;; we decrement the number of open parenthesis
+ (set! *par-open* (-fx *par-open* 1))
+ (if (<fx *par-open* 0)
+ (begin
+ (warning/location (input-port-name (the-port))
+ (input-port-position (the-port))
+ "read"
+ "Superfluous closing parenthesis `"
+ (the-string)
+ "'")
+ (set! *par-open* 0)
+ (ignore))
+ *end-of-list*))
+
+ ;; list of strings
+ (#\[
+ (let ((exp (read/rp *text-grammar* (the-port))))
+ (list 'quasiquote exp)))
+
+ ;; vectors
+ ("#("
+ ;; if possible, we store the opening parenthesis.
+ (if (and (vector? *vector-errors*)
+ (<fx *par-open* (vector-length *vector-errors*)))
+ (let ((pos (input-port-position (the-port))))
+ (vector-set! *vector-errors* *par-open* pos)))
+ ;; we increment the number of open parenthesis
+ (set! *par-open* (+fx 1 *par-open*))
+ (list->vector (reverse! (collect-up-to ignore "vector" (the-port)))))
+
+ ;; error or eof
+ (else
+ (let ((port (the-port))
+ (char (the-failure)))
+ (if (eof-object? char)
+ (cond
+ ((>fx *par-open* 0)
+ (let ((open-key (-fx *par-open* 1)))
+ (skribe-reader-reset!)
+ (if (and (<fx open-key (vector-length *list-errors*))
+ (fixnum? (vector-ref *list-errors* open-key)))
+ (error/location "skribe-read"
+ "Unclosed list"
+ char
+ (input-port-name port)
+ (vector-ref *list-errors* open-key))
+ (error "skribe-read"
+ "Unexpected end-of-file"
+ "Unclosed list"))))
+ (else
+ (reset-eof port)
+ char))
+ (error/location "skribe-read"
+ "Illegal char"
+ (illegal-char-rep char)
+ (input-port-name port)
+ (input-port-position port)))))))
+
+;*---------------------------------------------------------------------*/
+;* *text-grammar* ... */
+;* ------------------------------------------------------------- */
+;* The grammar that parses texts (the [...] forms). */
+;*---------------------------------------------------------------------*/
+(define *text-grammar*
+ (regular-grammar ()
+ ((: (* (out ",[]\\")) #\])
+ (let* ((port (the-port))
+ (name (input-port-name port))
+ (pos (input-port-position port))
+ (loc (make-at name pos))
+ (item (the-substring 0 (-fx (the-length) 1))))
+ (econs item '() loc)))
+ ((: (* (out ",[\\")) ",]")
+ (let* ((port (the-port))
+ (name (input-port-name port))
+ (pos (input-port-position port))
+ (loc (make-at name pos))
+ (item (the-substring 0 (-fx (the-length) 1))))
+ (econs item '() loc)))
+ ((: (* (out ",[]\\")) #\,)
+ (let* ((port (the-port))
+ (name (input-port-name port))
+ (pos (input-port-position port))
+ (loc (make-at name pos))
+ (item (the-substring 0 (-fx (the-length) 1)))
+ (sexp (read/rp *sexp-grammar* (the-port)))
+ (rest (ignore)))
+ (if (string=? item "")
+ (cons (list 'unquote sexp) rest)
+ (econs item (cons (list 'unquote sexp) rest) loc))))
+ ((or (+ (out ",[]\\"))
+ (+ #\Newline)
+ (: (* (out ",[]\\")) #\, (out "([]\\")))
+ (let* ((port (the-port))
+ (name (input-port-name port))
+ (pos (input-port-position port))
+ (loc (make-at name pos))
+ (item (the-string))
+ (rest (ignore)))
+ (econs item rest loc)))
+ ("\\\\"
+ (cons "\\" (ignore)))
+ ("\\n"
+ (cons "\n" (ignore)))
+ ("\\t"
+ (cons "\t" (ignore)))
+ ("\\]"
+ (cons "]" (ignore)))
+ ("\\["
+ (cons "[" (ignore)))
+ ("\\,"
+ (cons "," (ignore)))
+ (#\\
+ (cons "\\" (ignore)))
+ (else
+ (let ((c (the-failure))
+ (port (the-port)))
+ (define (err msg)
+ (error/location "skribe-read-text"
+ msg
+ (the-failure)
+ (input-port-name port)
+ (input-port-position port)))
+ (cond
+ ((eof-object? c)
+ (err "Illegal `end of file'"))
+ ((char=? c #\[)
+ (err "Illegal nested `[...]' form"))
+ (else
+ (err "Illegal string character")))))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-read ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-read . input-port)
+ (cond
+ ((null? input-port)
+ (read/rp *sexp-grammar* (current-input-port)))
+ ((not (input-port? (car input-port)))
+ (error "read" "type `input-port' expected" (car input-port)))
+ (else
+ (let ((port (car input-port)))
+ (if (closed-input-port? port)
+ (error "read" "Illegal closed input port" port)
+ (read/rp *sexp-grammar* port))))))
+
diff --git a/skribe/src/bigloo/resolve.scm b/skribe/src/bigloo/resolve.scm
new file mode 100644
index 0000000..7507560
--- /dev/null
+++ b/skribe/src/bigloo/resolve.scm
@@ -0,0 +1,281 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/resolve.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Jul 25 09:31:18 2003 */
+;* Last change : Sun Jul 11 09:17:52 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe resolve stage */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_resolve
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_bib
+ skribe_eval)
+
+ (import skribe_index)
+
+ (export (resolve! ::obj ::%engine ::pair-nil)
+ (resolve-children ::obj)
+ (resolve-children* ::obj)
+ (resolve-parent ::%ast ::pair-nil)
+ (resolve-search-parent ::%ast ::pair-nil ::procedure)
+ (resolve-counter ::%ast ::pair-nil ::symbol ::obj . o)
+ (resolve-ident ::bstring ::obj ::%ast ::obj)))
+
+;*---------------------------------------------------------------------*/
+;* *unresolved* ... */
+;*---------------------------------------------------------------------*/
+(define *unresolved* #f)
+
+;*---------------------------------------------------------------------*/
+;* resolve! ... */
+;* ------------------------------------------------------------- */
+;* This function iterates over an ast until all unresolved */
+;* references are resolved. */
+;*---------------------------------------------------------------------*/
+(define (resolve! ast engine env)
+ (with-debug 3 'resolve
+ (debug-item "ast=" ast)
+ (let ((old *unresolved*))
+ (let loop ((ast ast))
+ (set! *unresolved* #f)
+ (let ((ast (do-resolve! ast engine env)))
+ (if *unresolved*
+ (loop ast)
+ (begin
+ (set! *unresolved* old)
+ ast)))))))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ... */
+;*---------------------------------------------------------------------*/
+(define-generic (do-resolve! ast engine env)
+ (if (pair? ast)
+ (do-resolve*! ast engine env)
+ ast))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ::%node ... */
+;*---------------------------------------------------------------------*/
+(define-method (do-resolve! node::%node engine env)
+ (with-access::%node node (body options parent)
+ (with-debug 5 'do-resolve::body
+ (debug-item "node=" (if (markup? node)
+ (markup-markup node)
+ (find-runtime-type node)))
+ (debug-item "body=" (find-runtime-type body))
+ (if (not (eq? parent #unspecified))
+ node
+ (let ((p (assq 'parent env)))
+ (set! parent (and (pair? p) (pair? (cdr p)) (cadr p)))
+ (if (pair? options)
+ (begin
+ (debug-item "unresolved options=" options)
+ (for-each (lambda (o)
+ (set-car! (cdr o)
+ (do-resolve! (cadr o) engine env)))
+ options)
+ (debug-item "resolved options=" options)))))
+ (set! body (do-resolve! body engine env))
+ node)))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ::%container ... */
+;*---------------------------------------------------------------------*/
+(define-method (do-resolve! node::%container engine env0)
+ (with-access::%container node (body options env parent)
+ (with-debug 5 'do-resolve::%container
+ (debug-item "markup=" (markup-markup node))
+ (debug-item "body=" (find-runtime-type body))
+ (debug-item "env0=" env0)
+ (debug-item "env=" env)
+ (if (not (eq? parent #unspecified))
+ node
+ (let ((p (assq 'parent env0)))
+ (set! parent (and (pair? p) (pair? (cdr p)) (cadr p)))
+ (if (pair? options)
+ (let ((e (append `((parent ,node)) env0)))
+ (debug-item "unresolved options=" options)
+ (for-each (lambda (o)
+ (set-car! (cdr o)
+ (do-resolve! (cadr o) engine e)))
+ options)
+ (debug-item "resolved options=" options)))
+ (let ((e `((parent ,node) ,@env ,@env0)))
+ (set! body (do-resolve! body engine e))
+ node))))
+ ;; return the container
+ node))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ::%document ... */
+;*---------------------------------------------------------------------*/
+(define-method (do-resolve! node::%document engine env0)
+ (with-access::%document node (env)
+ (call-next-method)
+ ;; resolve the engine custom
+ (let ((env (append `((parent ,node)) env0)))
+ (for-each (lambda (c)
+ (let ((i (car c))
+ (a (cadr c)))
+ (debug-item "custom=" i " " a)
+ (set-car! (cdr c) (do-resolve! a engine env))))
+ (%engine-customs engine)))
+ ;; return the container
+ node))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ::%unresolved ... */
+;*---------------------------------------------------------------------*/
+(define-method (do-resolve! node::%unresolved engine env)
+ (with-debug 5 'do-resolve::%unresolved
+ (debug-item "node=" node)
+ (with-access::%unresolved node (proc parent loc)
+ (let ((p (assq 'parent env)))
+ (set! parent (and (pair? p) (pair? (cdr p)) (cadr p))))
+ (let ((res (resolve! (proc node engine env) engine env)))
+ (if (ast? res) (%ast-loc-set! res loc))
+ (debug-item "res=" res)
+ (set! *unresolved* #t)
+ res))))
+
+;*---------------------------------------------------------------------*/
+;* do-resolve! ::handle ... */
+;*---------------------------------------------------------------------*/
+(define-method (do-resolve! node::%handle engine env)
+ node)
+
+;*---------------------------------------------------------------------*/
+;* do-resolve*! ... */
+;*---------------------------------------------------------------------*/
+(define (do-resolve*! n+ engine env)
+ (let loop ((n* n+))
+ (cond
+ ((pair? n*)
+ (set-car! n* (do-resolve! (car n*) engine env))
+ (loop (cdr n*)))
+ ((not (null? n*))
+ (skribe-error 'do-resolve "Illegal argument" n*))
+ (else
+ n+))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-children ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-children n)
+ (if (pair? n)
+ n
+ (list n)))
+
+;*---------------------------------------------------------------------*/
+;* resolve-children* ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-children* n)
+ (cond
+ ((pair? n)
+ (map resolve-children* n))
+ ((%container? n)
+ (cons n (resolve-children* (%container-body n))))
+ (else
+ (list n))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-parent ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-parent n e)
+ (with-debug 5 'resolve-parent
+ (debug-item "n=" n)
+ (cond
+ ((not (%ast? n))
+ (let ((c (assq 'parent e)))
+ (if (pair? c)
+ (cadr c)
+ n)))
+ ((eq? (%ast-parent n) #unspecified)
+ (skribe-error 'resolve-parent "Orphan node" n))
+ (else
+ (%ast-parent n)))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-search-parent ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-search-parent n e pred)
+ (with-debug 5 'resolve-search-parent
+ (debug-item "node=" (find-runtime-type n))
+ (debug-item "searching=" pred)
+ (let ((p (resolve-parent n e)))
+ (debug-item "parent=" (find-runtime-type p) " "
+ (if (markup? p) (markup-markup p) "???"))
+ (cond
+ ((pred p)
+ p)
+ ((%unresolved? p)
+ p)
+ ((not p)
+ #f)
+ (else
+ (resolve-search-parent p e pred))))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-counter ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-counter n e cnt val . opt)
+ (let ((c (assq (symbol-append cnt '-counter) e)))
+ (if (not (pair? c))
+ (if (or (null? opt) (not (car opt)) (null? e))
+ (skribe-error cnt "Orphan node" n)
+ (begin
+ (set-cdr! (last-pair e)
+ (list (list (symbol-append cnt '-counter) 0)
+ (list (symbol-append cnt '-env) '())))
+ (resolve-counter n e cnt val)))
+ (let* ((num (cadr c))
+ (nval (if (integer? val)
+ val
+ (+ 1 num))))
+ (let ((c2 (assq (symbol-append cnt '-env) e)))
+ (set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2))))
+ (cond
+ ((integer? val)
+ (set-car! (cdr c) val)
+ (car val))
+ ((not val)
+ val)
+ (else
+ (set-car! (cdr c) (+ 1 num))
+ (+ 1 num)))))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-ident ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-ident ident markup n e)
+ (with-debug 4 'resolve-ident
+ (debug-item "ident=" ident)
+ (debug-item "markup=" markup)
+ (debug-item "n=" (if (markup? n) (markup-markup n) n))
+ (if (not (string? ident))
+ (skribe-type-error 'resolve-ident
+ "Illegal ident"
+ ident
+ "string")
+ (let ((mks (find-markups ident)))
+ (and mks
+ (if (not markup)
+ (car mks)
+ (let loop ((mks mks))
+ (cond
+ ((null? mks)
+ #f)
+ ((is-markup? (car mks) markup)
+ (car mks))
+ (else
+ (loop (cdr mks)))))))))))
diff --git a/skribe/src/bigloo/source.scm b/skribe/src/bigloo/source.scm
new file mode 100644
index 0000000..babadff
--- /dev/null
+++ b/skribe/src/bigloo/source.scm
@@ -0,0 +1,238 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/source.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Aug 29 07:27:25 2003 */
+;* Last change : Tue Nov 2 14:25:50 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Bigloo handling of Skribe programs. */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_source
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api
+ skribe_param)
+
+ (export (source-read-chars::bstring ::bstring ::int ::int ::obj)
+ (source-read-lines::bstring ::bstring ::obj ::obj ::obj)
+ (source-read-definition::bstring ::bstring ::obj ::obj ::obj)
+ (source-fontify ::obj ::obj)
+ (split-string-newline::pair-nil ::bstring)))
+
+;*---------------------------------------------------------------------*/
+;* source-read-lines ... */
+;*---------------------------------------------------------------------*/
+(define (source-read-chars file start stop tab)
+ (define (readl p)
+ (read/rp (regular-grammar ()
+ ((: (* (out #\Newline)) (? #\Newline))
+ (the-string))
+ (else
+ (the-failure)))
+ p))
+ (let ((p (find-file/path file (skribe-source-path))))
+ (if (or (not (string? p)) (not (file-exists? p)))
+ (skribe-error 'source
+ (format "Can't find `~a' source file in path" file)
+ (skribe-source-path))
+ (with-input-from-file p
+ (lambda ()
+ (if (>fx *skribe-verbose* 0)
+ (fprint (current-error-port) " [source file: " p "]"))
+ (let loop ((c -1)
+ (s (readl (current-input-port)))
+ (r '()))
+ (let ((p (input-port-position (current-input-port))))
+ (cond
+ ((eof-object? s)
+ (apply string-append (reverse! r)))
+ ((>=fx p stop)
+ (let* ((len (-fx (-fx stop start) c))
+ (line (untabify (substring s 0 len) tab)))
+ (apply string-append
+ (reverse! (cons line r)))))
+ ((>=fx c 0)
+ (loop (+fx (string-length s) c)
+ (readl (current-input-port))
+ (cons (untabify s tab) r)))
+ ((>=fx p start)
+ (let* ((len (string-length s))
+ (nc (-fx p start)))
+ (if (>fx p stop)
+ (untabify
+ (substring s
+ (-fx len (-fx p start))
+ (-fx (-fx p stop) 1))
+ tab)
+ (loop nc
+ (readl (current-input-port))
+ (list
+ (untabify
+ (substring s
+ (-fx len (-fx p start))
+ len)
+ tab))))))
+ (else
+ (loop c (readl (current-input-port)) r))))))))))
+
+;*---------------------------------------------------------------------*/
+;* source-read-lines ... */
+;*---------------------------------------------------------------------*/
+(define (source-read-lines file start stop tab)
+ (let ((p (find-file/path file (skribe-source-path))))
+ (if (or (not (string? p)) (not (file-exists? p)))
+ (skribe-error 'source
+ (format "Can't find `~a' source file in path" file)
+ (skribe-source-path))
+ (with-input-from-file p
+ (lambda ()
+ (if (>fx *skribe-verbose* 0)
+ (fprint (current-error-port) " [source file: " p "]"))
+ (let ((startl (if (string? start) (string-length start) -1))
+ (stopl (if (string? stop) (string-length stop) -1)))
+ (let loop ((l 1)
+ (armedp (not (or (integer? start)
+ (string? start))))
+ (s (read-line))
+ (r '()))
+ (cond
+ ((or (eof-object? s)
+ (and (integer? stop) (> l stop))
+ (and (string? stop) (substring=? stop s stopl)))
+ (apply string-append (reverse! r)))
+ (armedp
+ (loop (+fx l 1)
+ #t
+ (read-line)
+ (cons* "\n" (untabify s tab) r)))
+ ((and (integer? start) (>= l start))
+ (loop (+fx l 1)
+ #t
+ (read-line)
+ (cons* "\n" (untabify s tab) r)))
+ ((and (string? start) (substring=? start s startl))
+ (loop (+fx l 1) #t (read-line) r))
+ (else
+ (loop (+fx l 1) #f (read-line) r))))))))))
+
+;*---------------------------------------------------------------------*/
+;* untabify ... */
+;*---------------------------------------------------------------------*/
+(define (untabify obj tab)
+ (if (not tab)
+ obj
+ (let ((len (string-length obj))
+ (tabl tab))
+ (let loop ((i 0)
+ (col 1))
+ (cond
+ ((=fx i len)
+ (let ((nlen (-fx col 1)))
+ (if (=fx len nlen)
+ obj
+ (let ((new (make-string col #\space)))
+ (let liip ((i 0)
+ (j 0)
+ (col 1))
+ (cond
+ ((=fx i len)
+ new)
+ ((char=? (string-ref obj i) #\tab)
+ (let ((next-tab (*fx (/fx (+fx col tabl)
+ tabl)
+ tabl)))
+ (liip (+fx i 1)
+ next-tab
+ next-tab)))
+ (else
+ (string-set! new j (string-ref obj i))
+ (liip (+fx i 1) (+fx j 1) (+fx col 1)))))))))
+ ((char=? (string-ref obj i) #\tab)
+ (loop (+fx i 1)
+ (*fx (/fx (+fx col tabl) tabl) tabl)))
+ (else
+ (loop (+fx i 1) (+fx col 1))))))))
+
+;*---------------------------------------------------------------------*/
+;* source-read-definition ... */
+;*---------------------------------------------------------------------*/
+(define (source-read-definition file definition tab lang)
+ (let ((p (find-file/path file (skribe-source-path))))
+ (cond
+ ((not (%language-extractor lang))
+ (skribe-error 'source
+ "The specified language has not defined extractor"
+ lang))
+ ((or (not p) (not (file-exists? p)))
+ (skribe-error 'source
+ (format "Can't find `~a' program file in path" file)
+ (skribe-source-path)))
+ (else
+ (let ((ip (open-input-file p)))
+ (if (>fx *skribe-verbose* 0)
+ (fprint (current-error-port) " [source file: " p "]"))
+ (if (not (input-port? ip))
+ (skribe-error 'source "Can't open file for input" p)
+ (unwind-protect
+ (let ((s ((%language-extractor lang) ip definition tab)))
+ (if (not (string? s))
+ (skribe-error 'source
+ "Can't find definition"
+ definition)
+ s))
+ (close-input-port ip))))))))
+
+;*---------------------------------------------------------------------*/
+;* source-fontify ... */
+;*---------------------------------------------------------------------*/
+(define (source-fontify o language)
+ (define (fontify f o)
+ (cond
+ ((string? o) (f o))
+ ((pair? o) (map (lambda (s) (if (string? s) (f s) (fontify f s))) o))
+ (else o)))
+ (let ((f (%language-fontifier language)))
+ (if (procedure? f)
+ (fontify f o)
+ o)))
+
+;*---------------------------------------------------------------------*/
+;* split-string-newline ... */
+;*---------------------------------------------------------------------*/
+(define (split-string-newline str)
+ (let ((l (string-length str)))
+ (let loop ((i 0)
+ (j 0)
+ (r '()))
+ (cond
+ ((=fx i l)
+ (if (=fx i j)
+ (reverse! r)
+ (reverse! (cons (substring str j i) r))))
+ ((char=? (string-ref str i) #\Newline)
+ (loop (+fx i 1)
+ (+fx i 1)
+ (if (=fx i j)
+ (cons 'eol r)
+ (cons* 'eol (substring str j i) r))))
+ ((and (char=? (string-ref str i) #a013)
+ (<fx (+fx i 1) l)
+ (char=? (string-ref str (+fx i 1)) #\Newline))
+ (loop (+fx i 2)
+ (+fx i 2)
+ (if (=fx i j)
+ (cons 'eol r)
+ (cons* 'eol (substring str j i) r))))
+ (else
+ (loop (+fx i 1) j r))))))
+
diff --git a/skribe/src/bigloo/sui.bgl b/skribe/src/bigloo/sui.bgl
new file mode 100644
index 0000000..63c5477
--- /dev/null
+++ b/skribe/src/bigloo/sui.bgl
@@ -0,0 +1,34 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/sui.bgl */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 23 12:48:11 2003 */
+;* Last change : Thu Jan 1 16:16:03 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe runtime (i.e., the style user functions). */
+;* ------------------------------------------------------------- */
+;* Implementation: @label sui@ */
+;* bigloo: @path ../common/sui.scm@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_sui
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_eval
+ skribe_param
+ skribe_output
+ skribe_engine)
+
+ (export (load-sui ::bstring)
+ (sui-ref->url ::bstring ::obj ::obj ::pair-nil)
+ (sui-title::bstring ::pair-nil)
+ (sui-file::obj ::pair-nil)
+ (sui-key::obj ::pair-nil ::obj)
+ (sui-filter::pair-nil ::obj ::procedure ::procedure)))
+
diff --git a/skribe/src/bigloo/types.scm b/skribe/src/bigloo/types.scm
new file mode 100644
index 0000000..b8babd4
--- /dev/null
+++ b/skribe/src/bigloo/types.scm
@@ -0,0 +1,685 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/types.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Jul 22 16:40:42 2003 */
+;* Last change : Thu Oct 21 13:23:17 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The definition of the Skribe classes */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_types
+
+ (export (abstract-class %ast
+ (parent (default #unspecified))
+ (loc (default (evmeaning-location))))
+
+ (class %command::%ast
+ (fmt::bstring read-only)
+ (body (default #f)))
+
+ (class %unresolved::%ast
+ (proc::procedure read-only))
+
+ (class %handle::%ast
+ (ast (default #f)))
+
+ (abstract-class %node::%ast
+ (required-options::pair-nil read-only (default '()))
+ (options::pair-nil (default '()))
+ (body (default #f)))
+
+ (class %processor::%node
+ (combinator (default (lambda (e1 e2) e1)))
+ (procedure::procedure (default (lambda (n e) n)))
+ engine)
+
+ (class %markup::%node
+ (markup-init)
+ (ident (default #f))
+ (class (default #f))
+ (markup::symbol read-only))
+
+ (class %container::%markup
+ (env::pair-nil (default '())))
+
+ (class %document::%container)
+
+ (class %engine
+ (ident::symbol read-only)
+ (format::bstring (default "raw"))
+ (info::pair-nil (default '()))
+ (version::obj read-only (default #unspecified))
+ (delegate read-only (default #f))
+ (writers::pair-nil (default '()))
+ (filter::obj (default #f))
+ (customs::pair-nil (default '()))
+ (symbol-table::pair-nil (default '())))
+
+ (class %writer
+ (ident::symbol read-only)
+ (class read-only)
+ (pred::procedure read-only)
+ (upred read-only)
+ (options::obj read-only)
+ (verified?::bool (default #f))
+ (validate (default #f))
+ (before read-only)
+ (action read-only)
+ (after read-only))
+
+ (class %language
+ (name::bstring read-only)
+ (fontifier read-only (default #f))
+ (extractor read-only (default #f)))
+
+ (markup-init ::%markup)
+ (find-markups ::bstring)
+
+ (inline ast?::bool ::obj)
+ (inline ast-parent::obj ::%ast)
+ (inline ast-loc::obj ::%ast)
+ (inline ast-loc-set!::obj ::%ast ::obj)
+ (ast-location::bstring ::%ast)
+
+ (new-command . inits)
+ (inline command?::bool ::obj)
+ (inline command-fmt::bstring ::%command)
+ (inline command-body::obj ::%command)
+
+ (new-unresolved . inits)
+ (inline unresolved?::bool ::obj)
+ (inline unresolved-proc::procedure ::%unresolved)
+
+ (new-handle . inits)
+ (inline handle?::bool ::obj)
+ (inline handle-ast::obj ::%handle)
+
+ (inline node?::bool ::obj)
+ (inline node-body::obj ::%node)
+ (inline node-options::pair-nil ::%node)
+ (inline node-loc::obj ::%node)
+
+ (new-processor . inits)
+ (inline processor?::bool ::obj)
+ (inline processor-combinator::obj ::%processor)
+ (inline processor-engine::obj ::%processor)
+
+ (new-markup . inits)
+ (inline markup?::bool ::obj)
+ (inline is-markup?::bool ::obj ::symbol)
+ (inline markup-markup::obj ::%markup)
+ (inline markup-ident::obj ::%markup)
+ (inline markup-body::obj ::%markup)
+ (inline markup-options::pair-nil ::%markup)
+
+ (new-container . inits)
+ (inline container?::bool ::obj)
+ (inline container-ident::obj ::%container)
+ (inline container-body::obj ::%container)
+ (inline container-options::pair-nil ::%container)
+
+ (new-document . inits)
+ (inline document?::bool ::obj)
+ (inline document-ident::bool ::%document)
+ (inline document-body::bool ::%document)
+ (inline document-options::pair-nil ::%document)
+ (inline document-env::pair-nil ::%document)
+
+ (inline engine?::bool ::obj)
+ (inline engine-ident::obj ::obj)
+ (inline engine-format::obj ::obj)
+ (inline engine-customs::pair-nil ::obj)
+ (inline engine-filter::obj ::obj)
+ (inline engine-symbol-table::pair-nil ::%engine)
+
+ (inline writer?::bool ::obj)
+ (inline writer-before::obj ::%writer)
+ (inline writer-action::obj ::%writer)
+ (inline writer-after::obj ::%writer)
+ (inline writer-options::obj ::%writer)
+
+ (inline language?::bool ::obj)
+ (inline language-name::obj ::obj)
+ (inline language-fontifier::obj ::obj)
+ (inline language-extractor::obj ::obj)
+
+ (new-language . inits)
+
+ (location?::bool ::obj)
+ (location-file::bstring ::pair)
+ (location-pos::int ::pair)))
+
+;*---------------------------------------------------------------------*/
+;* skribe-instantiate ... */
+;*---------------------------------------------------------------------*/
+(define-macro (skribe-instantiate type values . slots)
+ `(begin
+ (skribe-instantiate-check-values ',type ,values ',slots)
+ (,(symbol-append 'instantiate::% type)
+ ,@(map (lambda (slot)
+ (let ((id (if (pair? slot) (car slot) slot))
+ (def (if (pair? slot) (cadr slot) #f)))
+ `(,id (new-get-value ',id ,values ,def))))
+ slots))))
+
+;*---------------------------------------------------------------------*/
+;* skribe-instantiate-check-values ... */
+;*---------------------------------------------------------------------*/
+(define (skribe-instantiate-check-values id values slots)
+ (let ((bs (every (lambda (v) (not (memq (car v) slots))) values)))
+ (when (pair? bs)
+ (for-each (lambda (b)
+ (error (symbol-append '|new | id)
+ "Illegal field"
+ b))
+ bs))))
+
+;*---------------------------------------------------------------------*/
+;* object-print ... */
+;*---------------------------------------------------------------------*/
+(define-method (object-print obj::%ast port print-slot::procedure)
+ (let* ((class (object-class obj))
+ (class-name (class-name class)))
+ (display "#|" port)
+ (display class-name port)
+ (display #\| port)))
+
+;*---------------------------------------------------------------------*/
+;* object-display ::%ast ... */
+;*---------------------------------------------------------------------*/
+(define-method (object-display n::%ast . port)
+ (fprintf (if (pair? port) (car port) (current-output-port))
+ "<#~a>"
+ (find-runtime-type n)))
+
+;*---------------------------------------------------------------------*/
+;* object-display ::%markup ... */
+;*---------------------------------------------------------------------*/
+(define-method (object-display n::%markup . port)
+ (fprintf (if (pair? port) (car port) (current-output-port))
+ "<#~a:~a>"
+ (find-runtime-type n)
+ (markup-markup n)))
+
+;*---------------------------------------------------------------------*/
+;* object-write ::%markup ... */
+;*---------------------------------------------------------------------*/
+(define-method (object-write n::%markup . port)
+ (fprintf (if (pair? port) (car port) (current-output-port))
+ "<#~a:~a:~a>"
+ (find-runtime-type n)
+ (markup-markup n)
+ (find-runtime-type (markup-body n))))
+
+;*---------------------------------------------------------------------*/
+;* *node-table* */
+;* ------------------------------------------------------------- */
+;* A private hashtable that stores all the nodes of an ast. It */
+;* is used for retreiving a node from its identifier. */
+;*---------------------------------------------------------------------*/
+(define *node-table* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* ast? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (ast? obj)
+ (%ast? obj))
+
+;*---------------------------------------------------------------------*/
+;* ast-parent ... */
+;*---------------------------------------------------------------------*/
+(define-inline (ast-parent obj)
+ (%ast-parent obj))
+
+;*---------------------------------------------------------------------*/
+;* ast-loc ... */
+;*---------------------------------------------------------------------*/
+(define-inline (ast-loc obj)
+ (%ast-loc obj))
+
+;*---------------------------------------------------------------------*/
+;* ast-loc-set! ... */
+;*---------------------------------------------------------------------*/
+(define-inline (ast-loc-set! obj loc)
+ (%ast-loc-set! obj loc))
+
+;*---------------------------------------------------------------------*/
+;* ast-location ... */
+;*---------------------------------------------------------------------*/
+(define (ast-location obj)
+ (with-access::%ast obj (loc)
+ (if (location? loc)
+ (let* ((fname (location-file loc))
+ (char (location-pos loc))
+ (pwd (pwd))
+ (len (string-length pwd))
+ (lenf (string-length fname))
+ (file (if (and (substring=? pwd fname len)
+ (and (>fx lenf len)))
+ (substring fname len (+fx 1 (string-length fname)))
+ fname)))
+ (format "~a, char ~a" file char))
+ "no source location")))
+
+;*---------------------------------------------------------------------*/
+;* new-command ... */
+;*---------------------------------------------------------------------*/
+(define (new-command . init)
+ (skribe-instantiate command init
+ (parent #unspecified)
+ (loc #f)
+ fmt
+ (body #f)))
+
+;*---------------------------------------------------------------------*/
+;* command? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (command? obj)
+ (%command? obj))
+
+;*---------------------------------------------------------------------*/
+;* command-fmt ... */
+;*---------------------------------------------------------------------*/
+(define-inline (command-fmt cmd)
+ (%command-fmt cmd))
+
+;*---------------------------------------------------------------------*/
+;* command-body ... */
+;*---------------------------------------------------------------------*/
+(define-inline (command-body cmd)
+ (%command-body cmd))
+
+;*---------------------------------------------------------------------*/
+;* new-unresolved ... */
+;*---------------------------------------------------------------------*/
+(define (new-unresolved . init)
+ (skribe-instantiate unresolved init
+ (parent #unspecified)
+ loc
+ proc))
+
+;*---------------------------------------------------------------------*/
+;* unresolved? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (unresolved? obj)
+ (%unresolved? obj))
+
+;*---------------------------------------------------------------------*/
+;* unresolved-proc ... */
+;*---------------------------------------------------------------------*/
+(define-inline (unresolved-proc unr)
+ (%unresolved-proc unr))
+
+;*---------------------------------------------------------------------*/
+;* new-handle ... */
+;*---------------------------------------------------------------------*/
+(define (new-handle . init)
+ (skribe-instantiate handle init
+ (parent #unspecified)
+ loc
+ (ast #f)))
+
+;*---------------------------------------------------------------------*/
+;* handle? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (handle? obj)
+ (%handle? obj))
+
+;*---------------------------------------------------------------------*/
+;* handle-ast ... */
+;*---------------------------------------------------------------------*/
+(define-inline (handle-ast obj)
+ (%handle-ast obj))
+
+;*---------------------------------------------------------------------*/
+;* node? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (node? obj)
+ (%node? obj))
+
+;*---------------------------------------------------------------------*/
+;* node-body ... */
+;*---------------------------------------------------------------------*/
+(define-inline (node-body obj)
+ (%node-body obj))
+
+;*---------------------------------------------------------------------*/
+;* node-options ... */
+;*---------------------------------------------------------------------*/
+(define-inline (node-options obj)
+ (%node-options obj))
+
+;*---------------------------------------------------------------------*/
+;* node-loc ... */
+;*---------------------------------------------------------------------*/
+(define-inline (node-loc obj)
+ (%node-loc obj))
+
+;*---------------------------------------------------------------------*/
+;* new-processor ... */
+;*---------------------------------------------------------------------*/
+(define (new-processor . init)
+ (skribe-instantiate processor init
+ (parent #unspecified)
+ loc
+ (combinator (lambda (e1 e2) e1))
+ engine
+ (body #f)))
+
+;*---------------------------------------------------------------------*/
+;* processor? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (processor? obj)
+ (%processor? obj))
+
+;*---------------------------------------------------------------------*/
+;* processor-combinator ... */
+;*---------------------------------------------------------------------*/
+(define-inline (processor-combinator proc)
+ (%processor-combinator proc))
+
+;*---------------------------------------------------------------------*/
+;* processor-engine ... */
+;*---------------------------------------------------------------------*/
+(define-inline (processor-engine proc)
+ (%processor-engine proc))
+
+;*---------------------------------------------------------------------*/
+;* new-markup ... */
+;*---------------------------------------------------------------------*/
+(define (new-markup . init)
+ (skribe-instantiate markup init
+ (parent #unspecified)
+ (loc #f)
+ markup
+ ident
+ (class #f)
+ (body #f)
+ (options '())
+ (required-options '())))
+
+;*---------------------------------------------------------------------*/
+;* markup? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (markup? obj)
+ (%markup? obj))
+
+;*---------------------------------------------------------------------*/
+;* is-markup? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (is-markup? obj markup)
+ (and (markup? obj) (eq? (markup-markup obj) markup)))
+
+;*---------------------------------------------------------------------*/
+;* markup-init ... */
+;* ------------------------------------------------------------- */
+;* The markup constructor simply stores in the markup table the */
+;* news markups. */
+;*---------------------------------------------------------------------*/
+(define (markup-init markup)
+ (bind-markup! markup))
+
+;*---------------------------------------------------------------------*/
+;* bind-markup! ... */
+;*---------------------------------------------------------------------*/
+(define (bind-markup! node)
+ (hashtable-update! *node-table*
+ (markup-ident node)
+ (lambda (cur) (cons node cur))
+ (list node)))
+
+;*---------------------------------------------------------------------*/
+;* find-markups ... */
+;*---------------------------------------------------------------------*/
+(define (find-markups ident)
+ (hashtable-get *node-table* ident))
+
+;*---------------------------------------------------------------------*/
+;* markup-markup ... */
+;*---------------------------------------------------------------------*/
+(define-inline (markup-markup obj)
+ (%markup-markup obj))
+
+;*---------------------------------------------------------------------*/
+;* markup-ident ... */
+;*---------------------------------------------------------------------*/
+(define-inline (markup-ident obj)
+ (%markup-ident obj))
+
+;*---------------------------------------------------------------------*/
+;* markup-body ... */
+;*---------------------------------------------------------------------*/
+(define-inline (markup-body obj)
+ (%markup-body obj))
+
+;*---------------------------------------------------------------------*/
+;* markup-options ... */
+;*---------------------------------------------------------------------*/
+(define-inline (markup-options obj)
+ (%markup-options obj))
+
+;*---------------------------------------------------------------------*/
+;* new-container ... */
+;*---------------------------------------------------------------------*/
+(define (new-container . init)
+ (skribe-instantiate container init
+ (parent #unspecified)
+ loc
+ markup
+ ident
+ (class #f)
+ (body #f)
+ (options '())
+ (required-options '())
+ (env '())))
+
+;*---------------------------------------------------------------------*/
+;* container? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (container? obj)
+ (%container? obj))
+
+;*---------------------------------------------------------------------*/
+;* container-ident ... */
+;*---------------------------------------------------------------------*/
+(define-inline (container-ident obj)
+ (%container-ident obj))
+
+;*---------------------------------------------------------------------*/
+;* container-body ... */
+;*---------------------------------------------------------------------*/
+(define-inline (container-body obj)
+ (%container-body obj))
+
+;*---------------------------------------------------------------------*/
+;* container-options ... */
+;*---------------------------------------------------------------------*/
+(define-inline (container-options obj)
+ (%container-options obj))
+
+;*---------------------------------------------------------------------*/
+;* new-document ... */
+;*---------------------------------------------------------------------*/
+(define (new-document . init)
+ (skribe-instantiate document init
+ (parent #unspecified)
+ loc
+ markup
+ ident
+ (class #f)
+ (body #f)
+ (options '())
+ (required-options '())
+ (env '())))
+
+;*---------------------------------------------------------------------*/
+;* document? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (document? obj)
+ (%document? obj))
+
+;*---------------------------------------------------------------------*/
+;* document-options ... */
+;*---------------------------------------------------------------------*/
+(define-inline (document-options doc)
+ (%document-options doc))
+
+;*---------------------------------------------------------------------*/
+;* document-env ... */
+;*---------------------------------------------------------------------*/
+(define-inline (document-env doc)
+ (%document-env doc))
+
+;*---------------------------------------------------------------------*/
+;* document-ident ... */
+;*---------------------------------------------------------------------*/
+(define-inline (document-ident doc)
+ (%document-ident doc))
+
+;*---------------------------------------------------------------------*/
+;* document-body ... */
+;*---------------------------------------------------------------------*/
+(define-inline (document-body doc)
+ (%document-body doc))
+
+;*---------------------------------------------------------------------*/
+;* engine? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine? obj)
+ (%engine? obj))
+
+;*---------------------------------------------------------------------*/
+;* engine-ident ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine-ident obj)
+ (%engine-ident obj))
+
+;*---------------------------------------------------------------------*/
+;* engine-format ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine-format obj)
+ (%engine-format obj))
+
+;*---------------------------------------------------------------------*/
+;* engine-customs ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine-customs obj)
+ (%engine-customs obj))
+
+;*---------------------------------------------------------------------*/
+;* engine-filter ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine-filter obj)
+ (%engine-filter obj))
+
+;*---------------------------------------------------------------------*/
+;* engine-symbol-table ... */
+;*---------------------------------------------------------------------*/
+(define-inline (engine-symbol-table obj)
+ (%engine-symbol-table obj))
+
+;*---------------------------------------------------------------------*/
+;* writer? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (writer? obj)
+ (%writer? obj))
+
+;*---------------------------------------------------------------------*/
+;* writer-before ... */
+;*---------------------------------------------------------------------*/
+(define-inline (writer-before obj)
+ (%writer-before obj))
+
+;*---------------------------------------------------------------------*/
+;* writer-action ... */
+;*---------------------------------------------------------------------*/
+(define-inline (writer-action obj)
+ (%writer-action obj))
+
+;*---------------------------------------------------------------------*/
+;* writer-after ... */
+;*---------------------------------------------------------------------*/
+(define-inline (writer-after obj)
+ (%writer-after obj))
+
+;*---------------------------------------------------------------------*/
+;* writer-options ... */
+;*---------------------------------------------------------------------*/
+(define-inline (writer-options obj)
+ (%writer-options obj))
+
+;*---------------------------------------------------------------------*/
+;* language? ... */
+;*---------------------------------------------------------------------*/
+(define-inline (language? obj)
+ (%language? obj))
+
+;*---------------------------------------------------------------------*/
+;* language-name ... */
+;*---------------------------------------------------------------------*/
+(define-inline (language-name lg)
+ (%language-name lg))
+
+;*---------------------------------------------------------------------*/
+;* language-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define-inline (language-fontifier lg)
+ (%language-fontifier lg))
+
+;*---------------------------------------------------------------------*/
+;* language-extractor ... */
+;*---------------------------------------------------------------------*/
+(define-inline (language-extractor lg)
+ (%language-extractor lg))
+
+;*---------------------------------------------------------------------*/
+;* new-get-value ... */
+;*---------------------------------------------------------------------*/
+(define (new-get-value key init def)
+ (let ((c (assq key init)))
+ (match-case c
+ ((?- ?v)
+ v)
+ (else
+ def))))
+
+;*---------------------------------------------------------------------*/
+;* new-language ... */
+;*---------------------------------------------------------------------*/
+(define (new-language . init)
+ (skribe-instantiate language init name fontifier extractor))
+
+;*---------------------------------------------------------------------*/
+;* location? ... */
+;*---------------------------------------------------------------------*/
+(define (location? o)
+ (match-case o
+ ((at ?- ?-)
+ #t)
+ (else
+ #f)))
+
+;*---------------------------------------------------------------------*/
+;* location-file ... */
+;*---------------------------------------------------------------------*/
+(define (location-file o)
+ (match-case o
+ ((at ?fname ?-)
+ fname)
+ (else
+ (error 'location-file "Illegal location" o))))
+
+;*---------------------------------------------------------------------*/
+;* location-pos ... */
+;*---------------------------------------------------------------------*/
+(define (location-pos o)
+ (match-case o
+ ((at ?- ?loc)
+ loc)
+ (else
+ (error 'location-pos "Illegal location" o))))
diff --git a/skribe/src/bigloo/verify.scm b/skribe/src/bigloo/verify.scm
new file mode 100644
index 0000000..602a951
--- /dev/null
+++ b/skribe/src/bigloo/verify.scm
@@ -0,0 +1,143 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/verify.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Jul 25 09:54:55 2003 */
+;* Last change : Thu Sep 23 19:58:01 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Skribe verification stage */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_verify
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_engine
+ skribe_writer
+ skribe_eval)
+
+ (export (generic verify ::obj ::%engine)))
+
+;*---------------------------------------------------------------------*/
+;* check-required-options ... */
+;*---------------------------------------------------------------------*/
+(define (check-required-options n::%markup w::%writer e::%engine)
+ (with-access::%markup n (required-options)
+ (with-access::%writer w (ident options verified?)
+ (or verified?
+ (eq? options 'all)
+ (begin
+ (for-each (lambda (o)
+ (if (not (memq o options))
+ (skribe-error (%engine-ident e)
+ (format "Option unsupported: ~a, supported options: ~a" o options)
+ n)))
+ required-options)
+ (set! verified? #t))))))
+
+;*---------------------------------------------------------------------*/
+;* check-options ... */
+;* ------------------------------------------------------------- */
+;* Only keywords are checked, symbols are voluntary left unchecked. */
+;*---------------------------------------------------------------------*/
+(define (check-options eo*::pair-nil m::%markup e::%engine)
+ (with-debug 6 'check-options
+ (debug-item "markup=" (%markup-markup m))
+ (debug-item "options=" (%markup-options m))
+ (debug-item "eo*=" eo*)
+ (for-each (lambda (o2)
+ (for-each (lambda (o)
+ (if (and (keyword? o)
+ (not (eq? o :&skribe-eval-location))
+ (not (memq o eo*)))
+ (skribe-warning/ast
+ 3
+ m
+ 'verify
+ (format "Engine `~a' does not support markup `~a' option `~a' -- ~a"
+ (%engine-ident e)
+ (%markup-markup m)
+ o
+ (markup-option m o)))))
+ o2))
+ (%markup-options m))))
+
+;*---------------------------------------------------------------------*/
+;* verify :: ... */
+;*---------------------------------------------------------------------*/
+(define-generic (verify node e)
+ (if (pair? node)
+ (for-each (lambda (n) (verify n e)) node))
+ node)
+
+;*---------------------------------------------------------------------*/
+;* verify ::%processor ... */
+;*---------------------------------------------------------------------*/
+(define-method (verify n::%processor e)
+ (with-access::%processor n (combinator engine body)
+ (verify body (processor-get-engine combinator engine e))
+ n))
+
+;*---------------------------------------------------------------------*/
+;* verify ::%node ... */
+;*---------------------------------------------------------------------*/
+(define-method (verify node::%node e)
+ (with-access::%node node (body options)
+ (verify body e)
+ (for-each (lambda (o) (verify (cadr o) e)) options)
+ node))
+
+;*---------------------------------------------------------------------*/
+;* verify ::%markup ... */
+;*---------------------------------------------------------------------*/
+(define-method (verify node::%markup e)
+ (with-debug 5 'verify::%markup
+ (debug-item "node=" (%markup-markup node))
+ (debug-item "options=" (%markup-options node))
+ (debug-item "e=" (%engine-ident e))
+ (call-next-method)
+ (let ((w (lookup-markup-writer node e)))
+ (if (%writer? w)
+ (begin
+ (check-required-options node w e)
+ (if (pair? (%writer-options w))
+ (check-options (%writer-options w) node e))
+ (let ((validate (%writer-validate w)))
+ (when (procedure? validate)
+ (unless (validate node e)
+ (skribe-warning
+ 1
+ node
+ (format "Node `~a' forbidden here by ~a engine"
+ (markup-markup node)
+ (engine-ident e))
+ node)))))))
+ ;; return the node
+ node))
+
+;*---------------------------------------------------------------------*/
+;* verify ::%document ... */
+;*---------------------------------------------------------------------*/
+(define-method (verify node::%document e)
+ (call-next-method)
+ ;; verify the engine custom
+ (for-each (lambda (c)
+ (let ((i (car c))
+ (a (cadr c)))
+ (set-car! (cdr c) (verify a e))))
+ (%engine-customs e))
+ ;; return the node
+ node)
+
+;*---------------------------------------------------------------------*/
+;* verify ::%handle ... */
+;*---------------------------------------------------------------------*/
+(define-method (verify node::%handle e)
+ node)
+
diff --git a/skribe/src/bigloo/writer.scm b/skribe/src/bigloo/writer.scm
new file mode 100644
index 0000000..ce515bf
--- /dev/null
+++ b/skribe/src/bigloo/writer.scm
@@ -0,0 +1,232 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/writer.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Tue Sep 9 06:19:57 2003 */
+;* Last change : Tue Nov 2 14:33:59 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe writer management */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_writer
+
+ (option (set! dsssl-symbol->keyword
+ (lambda (s)
+ (string->keyword
+ (string-append ":" (symbol->string s))))))
+
+ (include "debug.sch")
+
+ (import skribe_types
+ skribe_eval
+ skribe_param
+ skribe_engine
+ skribe_output
+ skribe_lib)
+
+ (export (invoke proc node e)
+
+ (lookup-markup-writer ::%markup ::%engine)
+
+ (markup-writer ::obj #!optional e #!key p class opt va bef aft act)
+ (copy-markup-writer ::obj ::obj #!optional e #!key p c o v b ac a)
+ (markup-writer-get ::obj #!optional e #!key class pred)
+ (markup-writer-get*::pair-nil ::obj #!optional e #!key class)))
+
+;*---------------------------------------------------------------------*/
+;* invoke ... */
+;*---------------------------------------------------------------------*/
+(define (invoke proc node e)
+ (let ((id (if (markup? node)
+ (string->symbol
+ (format "~a#~a"
+ (%engine-ident e)
+ (%markup-markup node)))
+ (%engine-ident e))))
+ (with-push-trace id
+ (with-debug 5 'invoke
+ (debug-item "e=" (%engine-ident e))
+ (debug-item "node=" (find-runtime-type node)
+ " " (if (markup? node) (%markup-markup node) ""))
+ (if (string? proc)
+ (display proc)
+ (if (procedure? proc)
+ (proc node e)))))))
+
+;*---------------------------------------------------------------------*/
+;* lookup-markup-writer ... */
+;*---------------------------------------------------------------------*/
+(define (lookup-markup-writer node e)
+ (with-access::%engine e (writers delegate)
+ (let loop ((w* writers))
+ (cond
+ ((pair? w*)
+ (with-access::%writer (car w*) (pred)
+ (if (pred node e)
+ (car w*)
+ (loop (cdr w*)))))
+ ((engine? delegate)
+ (lookup-markup-writer node delegate))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* make-writer-predicate ... */
+;*---------------------------------------------------------------------*/
+(define (make-writer-predicate markup predicate class)
+ (let* ((t1 (if (symbol? markup)
+ (lambda (n e) (is-markup? n markup))
+ (lambda (n e) #t)))
+ (t2 (if class
+ (lambda (n e)
+ (and (t1 n e) (equal? (%markup-class n) class)))
+ t1)))
+ (if predicate
+ (cond
+ ((not (procedure? predicate))
+ (skribe-error 'markup-writer
+ "Illegal predicate (procedure expected)"
+ predicate))
+ ((not (correct-arity? predicate 2))
+ (skribe-error 'markup-writer
+ "Illegal predicate arity (2 arguments expected)"
+ predicate))
+ (else
+ (lambda (n e)
+ (and (t2 n e) (predicate n e)))))
+ t2)))
+
+;*---------------------------------------------------------------------*/
+;* markup-writer ... */
+;*---------------------------------------------------------------------*/
+(define (markup-writer markup
+ #!optional
+ engine
+ #!key
+ (predicate #f)
+ (class #f)
+ (options '())
+ (validate #f)
+ (before #f)
+ (action #unspecified)
+ (after #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((and (not (symbol? markup)) (not (eq? markup #t)))
+ (skribe-error 'markup-writer "Illegal markup" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer "Illegal engine" e))
+ ((and (not predicate)
+ (not class)
+ (null? options)
+ (not before)
+ (eq? action #unspecified)
+ (not after))
+ (skribe-error 'markup-writer "Illegal writer" markup))
+ (else
+ (let ((m (make-writer-predicate markup predicate class))
+ (ac (if (eq? action #unspecified)
+ (lambda (n e)
+ (output (markup-body n) e))
+ action)))
+ (engine-add-writer! e markup m predicate
+ options before ac after class validate))))))
+
+;*---------------------------------------------------------------------*/
+;* copy-markup-writer ... */
+;*---------------------------------------------------------------------*/
+(define (copy-markup-writer markup old-engine
+ #!optional new-engine
+ #!key
+ (predicate #unspecified)
+ (class #unspecified)
+ (options #unspecified)
+ (validate #unspecified)
+ (before #unspecified)
+ (action #unspecified)
+ (after #unspecified))
+ (let ((old (markup-writer-get markup old-engine))
+ (new-engine (or new-engine old-engine)))
+ (markup-writer markup new-engine
+ :pred (if (unspecified? predicate)
+ (%writer-pred old)
+ predicate)
+ :class (if (unspecified? class)
+ (%writer-class old)
+ class)
+ :options (if (unspecified? options)
+ (%writer-options old)
+ options)
+ :validate (if (unspecified? validate)
+ (%writer-validate old)
+ validate)
+ :before (if (unspecified? before)
+ (%writer-before old)
+ before)
+ :action (if (unspecified? action)
+ (%writer-action old)
+ action)
+ :after (if (unspecified? after)
+ (%writer-after old) after))))
+
+;*---------------------------------------------------------------------*/
+;* markup-writer-get ... */
+;* ------------------------------------------------------------- */
+;* Finds the writer that matches MARKUP with optional CLASS */
+;* attribute. */
+;*---------------------------------------------------------------------*/
+(define (markup-writer-get markup #!optional engine #!key (class #f) (pred #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((not (symbol? markup))
+ (skribe-error 'markup-writer "Illegal symbol" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer "Illegal engine" e))
+ (else
+ (let liip ((e e))
+ (let loop ((w* (%engine-writers e)))
+ (cond
+ ((pair? w*)
+ (if (and (eq? (%writer-ident (car w*)) markup)
+ (equal? (%writer-class (car w*)) class)
+ (or (eq? pred #unspecified)
+ (eq? (%writer-upred (car w*)) pred)))
+ (car w*)
+ (loop (cdr w*))))
+ ((engine? (%engine-delegate e))
+ (liip (%engine-delegate e)))
+ (else
+ #f))))))))
+
+;*---------------------------------------------------------------------*/
+;* markup-writer-get* ... */
+;* ------------------------------------------------------------- */
+;* Finds alll writers that matches MARKUP with optional CLASS */
+;* attribute. */
+;*---------------------------------------------------------------------*/
+(define (markup-writer-get* markup #!optional engine #!key (class #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((not (symbol? markup))
+ (skribe-error 'markup-writer "Illegal symbol" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer "Illegal engine" e))
+ (else
+ (let liip ((e e)
+ (res '()))
+ (let loop ((w* (%engine-writers e))
+ (res res))
+ (cond
+ ((pair? w*)
+ (if (and (eq? (%writer-ident (car w*)) markup)
+ (equal? (%writer-class (car w*)) class))
+ (loop (cdr w*) (cons (car w*) res))
+ (loop (cdr w*) res)))
+ ((engine? (%engine-delegate e))
+ (liip (%engine-delegate e) res))
+ (else
+ (reverse! res)))))))))
diff --git a/skribe/src/bigloo/xml.scm b/skribe/src/bigloo/xml.scm
new file mode 100644
index 0000000..d4c662e
--- /dev/null
+++ b/skribe/src/bigloo/xml.scm
@@ -0,0 +1,92 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/bigloo/xml.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Sep 1 12:08:39 2003 */
+;* Last change : Mon May 17 10:14:24 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* XML fontification */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribe_xml
+
+ (include "new.sch")
+
+ (import skribe_types
+ skribe_lib
+ skribe_resolve
+ skribe_eval
+ skribe_api
+ skribe_param
+ skribe_source)
+
+ (export xml))
+
+;*---------------------------------------------------------------------*/
+;* xml ... */
+;*---------------------------------------------------------------------*/
+(define xml
+ (new language
+ (name "xml")
+ (fontifier xml-fontifier)
+ (extractor #f)))
+
+;*---------------------------------------------------------------------*/
+;* xml-fontifier ... */
+;*---------------------------------------------------------------------*/
+(define (xml-fontifier s)
+ (let ((g (regular-grammar ()
+ ((: #\; (in "<!--") (* (or all #\Newline)) "-->")
+ ;; italic comments
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-line-comment)
+ (body s))))
+ str)
+ (ignore))))
+ ((+ (or #\Newline #\Space))
+ ;; separators
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ ((or (: #\< (+ (out #\> #\space #\tab #\Newline))) #\>)
+ ;; markup
+ (let ((str (the-string)))
+ (let ((c (new markup
+ (markup '&source-module)
+ (body (the-string)))))
+ (cons c (ignore)))))
+ ((+ (out #\< #\> #\Space #\Tab #\= #\"))
+ ;; regular text
+ (let ((string (the-string)))
+ (cons string (ignore))))
+ ((or (: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (: "\'" (* (or (out #a000 #\\ #\') (: #\\ all))) "\'"))
+ ;; strings
+ (let ((str (split-string-newline (the-string))))
+ (append (map (lambda (s)
+ (if (eq? s 'eol)
+ "\n"
+ (new markup
+ (markup '&source-string)
+ (body s))))
+ str)
+ (ignore))))
+ ((in "\"=")
+ (let ((str (the-string)))
+ (cons str (ignore))))
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ '()
+ (error "source(xml)" "Unexpected character" c)))))))
+ (with-input-from-string s
+ (lambda ()
+ (read/rp g (current-input-port))))))
+
diff --git a/skribe/src/common/api.scm b/skribe/src/common/api.scm
new file mode 100644
index 0000000..397ba09
--- /dev/null
+++ b/skribe/src/common/api.scm
@@ -0,0 +1,1243 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/api.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Mon Jul 21 18:11:56 2003 */
+;* Last change : Mon Dec 20 10:38:23 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Scribe API */
+;* ------------------------------------------------------------- */
+;* Implementation: @label api@ */
+;* bigloo: @path ../bigloo/api.bgl@ */
+;* Documentation: */
+;* @path ../../doc/user/markup.skb@ */
+;* @path ../../doc/user/document.skb@ */
+;* @path ../../doc/user/sectioning.skb@ */
+;* @path ../../doc/user/toc.skb@ */
+;* @path ../../doc/user/ornament.skb@ */
+;* @path ../../doc/user/line.skb@ */
+;* @path ../../doc/user/font.skb@ */
+;* @path ../../doc/user/justify.skb@ */
+;* @path ../../doc/user/enumeration.skb@ */
+;* @path ../../doc/user/colframe.skb@ */
+;* @path ../../doc/user/figure.skb@ */
+;* @path ../../doc/user/image.skb@ */
+;* @path ../../doc/user/table.skb@ */
+;* @path ../../doc/user/footnote.skb@ */
+;* @path ../../doc/user/char.skb@ */
+;* @path ../../doc/user/links.skb@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* include ... */
+;*---------------------------------------------------------------------*/
+(define-markup (include file)
+ (if (not (string? file))
+ (skribe-error 'include "Illegal file (string expected)" file)
+ (skribe-include file)))
+
+;*---------------------------------------------------------------------*/
+;* document ... */
+;*---------------------------------------------------------------------*/
+(define-markup (document #!rest
+ opts
+ #!key
+ (ident #f) (class "document")
+ (title #f) (html-title #f) (author #f)
+ (ending #f) (env '()))
+ (new document
+ (markup 'document)
+ (ident (or ident
+ (ast->string title)
+ (symbol->string (gensym 'document))))
+ (class class)
+ (required-options '(:title :author :ending))
+ (options (the-options opts :ident :class :env))
+ (body (the-body opts))
+ (env (append env
+ (list (list 'chapter-counter 0) (list 'chapter-env '())
+ (list 'section-counter 0) (list 'section-env '())
+ (list 'footnote-counter 0) (list 'footnote-env '())
+ (list 'figure-counter 0) (list 'figure-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;* author ... */
+;*---------------------------------------------------------------------*/
+(define-markup (author #!rest
+ opts
+ #!key
+ (ident #f) (class "author")
+ name
+ (title #f)
+ (affiliation #f)
+ (email #f)
+ (url #f)
+ (address #f)
+ (phone #f)
+ (photo #f)
+ (align 'center))
+ (if (not (memq align '(center left right)))
+ (skribe-error 'author "Illegal align value" align)
+ (new container
+ (markup 'author)
+ (ident (or ident (symbol->string (gensym 'author))))
+ (class class)
+ (required-options '(:name :title :affiliation :email :url :address :phone :photo :align))
+ (options `((:name ,name)
+ (:align ,align)
+ ,@(the-options opts :ident :class)))
+ (body #f))))
+
+;*---------------------------------------------------------------------*/
+;* toc ... */
+;*---------------------------------------------------------------------*/
+(define-markup (toc #!rest
+ opts
+ #!key
+ (ident #f) (class "toc")
+ (chapter #t) (section #t) (subsection #f))
+ (let ((body (the-body opts)))
+ (new container
+ (markup 'toc)
+ (ident (or ident (symbol->string (gensym 'toc))))
+ (class class)
+ (required-options '())
+ (options `((:chapter ,chapter)
+ (:section ,section)
+ (:subsection ,subsection)
+ ,@(the-options opts :ident :class)))
+ (body (cond
+ ((null? body)
+ (new unresolved
+ (proc (lambda (n e env)
+ (handle
+ (resolve-search-parent n env document?))))))
+ ((null? (cdr body))
+ (if (handle? (car body))
+ (car body)
+ (skribe-error 'toc
+ "Illegal argument (handle expected)"
+ (if (markup? (car body))
+ (markup-markup (car body))
+ "???"))))
+ (else
+ (skribe-error 'toc "Illegal argument" body)))))))
+
+;*---------------------------------------------------------------------*/
+;* chapter ... ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/sectioning.skb:chapter@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:chapter@ */
+;*---------------------------------------------------------------------*/
+(define-markup (chapter #!rest
+ opts
+ #!key
+ (ident #f) (class "chapter")
+ title (html-title #f) (file #f) (toc #t) (number #t))
+ (new container
+ (markup 'chapter)
+ (ident (or ident (ast->string title)))
+ (class class)
+ (required-options '(:title :file :toc :number))
+ (options `((:toc ,toc)
+ (:number ,(and number
+ (new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n
+ env
+ 'chapter
+ number))))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))
+ (env (list (list 'section-counter 0) (list 'section-env '())
+ (list 'footnote-counter 0) (list 'footnote-env '())))))
+
+;*---------------------------------------------------------------------*/
+;* section-number ... */
+;*---------------------------------------------------------------------*/
+(define (section-number number markup)
+ (and number
+ (new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env markup number))))))
+
+;*---------------------------------------------------------------------*/
+;* section ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/sectioning.skb:section@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:sectionr@ */
+;*---------------------------------------------------------------------*/
+(define-markup (section #!rest
+ opts
+ #!key
+ (ident #f) (class "section")
+ title (file #f) (toc #t) (number #t))
+ (new container
+ (markup 'section)
+ (ident (or ident (ast->string title)))
+ (class class)
+ (required-options '(:title :toc :file :toc :number))
+ (options `((:number ,(section-number number 'section))
+ (:toc ,toc)
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))
+ (env (if file
+ (list (list 'subsection-counter 0) (list 'subsection-env '())
+ (list 'footnote-counter 0) (list 'footnote-env '()))
+ (list (list 'subsection-counter 0) (list 'subsection-env '()))))))
+
+;*---------------------------------------------------------------------*/
+;* subsection ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/sectioning.skb:subsection@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:subsectionr@ */
+;*---------------------------------------------------------------------*/
+(define-markup (subsection #!rest
+ opts
+ #!key
+ (ident #f) (class "subsection")
+ title (file #f) (toc #t) (number #t))
+ (new container
+ (markup 'subsection)
+ (ident (or ident (ast->string title)))
+ (class class)
+ (required-options '(:title :toc :file :number))
+ (options `((:number ,(section-number number 'subsection))
+ (:toc ,toc)
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))
+ (env (list (list 'subsubsection-counter 0) (list 'subsubsection-env '())))))
+
+;*---------------------------------------------------------------------*/
+;* subsubsection ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/sectioning.skb:subsubsection@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:subsubsectionr@ */
+;*---------------------------------------------------------------------*/
+(define-markup (subsubsection #!rest
+ opts
+ #!key
+ (ident #f) (class "subsubsection")
+ title (file #f) (toc #f) (number #t))
+ (new container
+ (markup 'subsubsection)
+ (ident (or ident (ast->string title)))
+ (class class)
+ (required-options '(:title :toc :number :file))
+ (options `((:number ,(section-number number 'subsubsection))
+ (:toc ,toc)
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* paragraph ... */
+;*---------------------------------------------------------------------*/
+(define-simple-markup paragraph)
+
+;*---------------------------------------------------------------------*/
+;* footnote ... */
+;*---------------------------------------------------------------------*/
+(define-markup (footnote #!rest opts
+ #!key (ident #f) (class "footnote") (number #f))
+ (new container
+ (markup 'footnote)
+ (ident (symbol->string (gensym 'footnote)))
+ (class class)
+ (required-options '())
+ (options `((:number
+ ,(new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env 'footnote #t)))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* linebreak ... */
+;*---------------------------------------------------------------------*/
+(define-markup (linebreak #!rest opts #!key (ident #f) (class #f))
+ (let ((ln (new markup
+ (ident (or ident (symbol->string (gensym 'linebreak))))
+ (class class)
+ (markup 'linebreak)))
+ (num (the-body opts)))
+ (cond
+ ((null? num)
+ ln)
+ ((not (null? (cdr num)))
+ (skribe-error 'linebreak "Illegal arguments" num))
+ ((not (and (integer? (car num)) (positive? (car num))))
+ (skribe-error 'linebreak "Illegal argument" (car num)))
+ (else
+ (vector->list (make-vector (car num) ln))))))
+
+;*---------------------------------------------------------------------*/
+;* hrule ... */
+;*---------------------------------------------------------------------*/
+(define-markup (hrule #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (width 100.) (height 1))
+ (new markup
+ (markup 'hrule)
+ (ident (or ident (symbol->string (gensym 'hrule))))
+ (class class)
+ (required-options '())
+ (options `((:width ,width)
+ (:height ,height)
+ ,@(the-options opts :ident :class)))
+ (body #f)))
+
+;*---------------------------------------------------------------------*/
+;* color ... */
+;*---------------------------------------------------------------------*/
+(define-markup (color #!rest
+ opts
+ #!key
+ (ident #f) (class "color")
+ (bg #f) (fg #f) (width #f) (margin #f))
+ (new container
+ (markup 'color)
+ (ident (or ident (symbol->string (gensym 'color))))
+ (class class)
+ (required-options '(:bg :fg :width))
+ (options `((:bg ,(if bg (skribe-use-color! bg) bg))
+ (:fg ,(if fg (skribe-use-color! fg) fg))
+ ,@(the-options opts :ident :class :bg :fg)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* frame ... */
+;*---------------------------------------------------------------------*/
+(define-markup (frame #!rest
+ opts
+ #!key
+ (ident #f) (class "frame")
+ (width #f) (margin 2) (border 1))
+ (new container
+ (markup 'frame)
+ (ident (or ident (symbol->string (gensym 'frame))))
+ (class class)
+ (required-options '(:width :border :margin))
+ (options `((:margin ,margin)
+ (:border ,(cond
+ ((integer? border) border)
+ (border 1)
+ (else #f)))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* font ... */
+;*---------------------------------------------------------------------*/
+(define-markup (font #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (size #f) (face #f))
+ (new container
+ (markup 'font)
+ (ident (or ident (symbol->string (gensym 'font))))
+ (class class)
+ (required-options '(:size))
+ (options (the-options opts :ident :class))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* flush ... */
+;*---------------------------------------------------------------------*/
+(define-markup (flush #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ side)
+ (case side
+ ((center left right)
+ (new container
+ (markup 'flush)
+ (ident (or ident (symbol->string (gensym 'flush))))
+ (class class)
+ (required-options '(:side))
+ (options (the-options opts :ident :class))
+ (body (the-body opts))))
+ (else
+ (skribe-error 'flush "Illegal side" side))))
+
+;*---------------------------------------------------------------------*/
+;* center ... */
+;*---------------------------------------------------------------------*/
+(define-simple-container center)
+
+;*---------------------------------------------------------------------*/
+;* pre ... */
+;*---------------------------------------------------------------------*/
+(define-simple-container pre)
+
+;*---------------------------------------------------------------------*/
+;* prog ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/prgm.skb:prog@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:prog@ */
+;*---------------------------------------------------------------------*/
+(define-markup (prog #!rest
+ opts
+ #!key
+ (ident #f) (class "prog")
+ (line 1) (linedigit #f) (mark ";!"))
+ (if (not (or (string? mark) (eq? mark #f)))
+ (skribe-error 'prog "Illegal mark" mark)
+ (new container
+ (markup 'prog)
+ (ident (or ident (symbol->string (gensym 'prog))))
+ (class class)
+ (required-options '(:line :mark))
+ (options (the-options opts :ident :class :linedigit))
+ (body (make-prog-body (the-body opts) line linedigit mark)))))
+
+;*---------------------------------------------------------------------*/
+;* source ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/prgm.skb:source@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:source@ */
+;*---------------------------------------------------------------------*/
+(define-markup (source #!rest
+ opts
+ #!key
+ language
+ (file #f) (start #f) (stop #f)
+ (definition #f) (tab 8))
+ (let ((body (the-body opts)))
+ (cond
+ ((and (not (null? body)) (or file start stop definition))
+ (skribe-error 'source
+ "file, start/stop, and definition are exclusive with body"
+ body))
+ ((and start stop definition)
+ (skribe-error 'source
+ "start/stop are exclusive with a definition"
+ body))
+ ((and (or start stop definition) (not file))
+ (skribe-error 'source
+ "start/stop and definition require a file specification"
+ file))
+ ((and definition (not language))
+ (skribe-error 'source
+ "definition requires a language specification"
+ definition))
+ ((and file (not (string? file)))
+ (skribe-error 'source "Illegal file" file))
+ ((and start (not (or (integer? start) (string? start))))
+ (skribe-error 'source "Illegal start" start))
+ ((and stop (not (or (integer? stop) (string? stop))))
+ (skribe-error 'source "Illegal start" stop))
+ ((and (integer? start) (integer? stop) (> start stop))
+ (skribe-error 'source
+ "start line > stop line"
+ (format "~a/~a" start stop)))
+ ((and language (not (language? language)))
+ (skribe-error 'source "Illegal language" language))
+ ((and tab (not (integer? tab)))
+ (skribe-error 'source "Illegal tab" tab))
+ (file
+ (let ((s (if (not definition)
+ (source-read-lines file start stop tab)
+ (source-read-definition file definition tab language))))
+ (if language
+ (source-fontify s language)
+ s)))
+ (language
+ (source-fontify body language))
+ (else
+ body))))
+
+;*---------------------------------------------------------------------*/
+;* language ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/prgm.skb:language@ */
+;*---------------------------------------------------------------------*/
+(define-markup (language #!key name (fontifier #f) (extractor #f))
+ (if (not (string? name))
+ (skribe-type-error 'language "Illegal name, " name "string")
+ (new language
+ (name name)
+ (fontifier fontifier)
+ (extractor extractor))))
+
+;*---------------------------------------------------------------------*/
+;* figure ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/figure.skb:figure@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:figure@ */
+;*---------------------------------------------------------------------*/
+(define-markup (figure #!rest
+ opts
+ #!key
+ (ident #f) (class "figure")
+ (legend #f) (number #t) (multicolumns #f))
+ (new container
+ (markup 'figure)
+ (ident (or ident
+ (let ((s (ast->string legend)))
+ (if (not (string=? s ""))
+ s
+ (symbol->string (gensym 'figure))))))
+ (class class)
+ (required-options '(:legend :number :multicolumns))
+ (options `((:number
+ ,(new unresolved
+ (proc (lambda (n e env)
+ (resolve-counter n env 'figure number)))))
+ ,@(the-options opts :ident :class)))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* parse-list-of ... */
+;* ------------------------------------------------------------- */
+;* The function table accepts two different prototypes. It */
+;* may receive its N elements in a list of N elements or in */
+;* a list of one element which is a list of N elements. This */
+;* gets rid of APPLY when calling container markup such as ITEMIZE */
+;* or TABLE. */
+;*---------------------------------------------------------------------*/
+(define (parse-list-of for markup lst)
+ (cond
+ ((null? lst)
+ '())
+ ((and (pair? lst)
+ (or (pair? (car lst)) (null? (car lst)))
+ (null? (cdr lst)))
+ (parse-list-of for markup (car lst)))
+ (else
+ (let loop ((lst lst))
+ (cond
+ ((null? lst)
+ '())
+ ((pair? (car lst))
+ (loop (car lst)))
+ (else
+ (let ((r (car lst)))
+ (if (not (is-markup? r markup))
+ (skribe-warning 2
+ for
+ (format "Illegal `~a' element, `~a' expected"
+ (if (markup? r)
+ (markup-markup r)
+ (find-runtime-type r))
+ markup)))
+ (cons r (loop (cdr lst))))))))))
+
+;*---------------------------------------------------------------------*/
+;* itemize ... */
+;*---------------------------------------------------------------------*/
+(define-markup (itemize #!rest opts #!key (ident #f) (class "itemize") symbol)
+ (new container
+ (markup 'itemize)
+ (ident (or ident (symbol->string (gensym 'itemize))))
+ (class class)
+ (required-options '(:symbol))
+ (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+ (body (parse-list-of 'itemize 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* enumerate ... */
+;*---------------------------------------------------------------------*/
+(define-markup (enumerate #!rest opts #!key (ident #f) (class "enumerate") symbol)
+ (new container
+ (markup 'enumerate)
+ (ident (or ident (symbol->string (gensym 'enumerate))))
+ (class class)
+ (required-options '(:symbol))
+ (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+ (body (parse-list-of 'enumerate 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* description ... */
+;*---------------------------------------------------------------------*/
+(define-markup (description #!rest opts #!key (ident #f) (class "description") symbol)
+ (new container
+ (markup 'description)
+ (ident (or ident (symbol->string (gensym 'description))))
+ (class class)
+ (required-options '(:symbol))
+ (options `((:symbol ,symbol) ,@(the-options opts :ident :class)))
+ (body (parse-list-of 'description 'item (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* item ... */
+;*---------------------------------------------------------------------*/
+(define-markup (item #!rest opts #!key (ident #f) (class #f) key)
+ (if (and key (not (or (string? key)
+ (number? key)
+ (markup? key)
+ (pair? key))))
+ (skribe-type-error 'item "Illegal key:" key "node")
+ (new container
+ (markup 'item)
+ (ident (or ident (symbol->string (gensym 'item))))
+ (class class)
+ (required-options '(:key))
+ (options `((:key ,key) ,@(the-options opts :ident :class :key)))
+ (body (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* table */
+;*---------------------------------------------------------------------*/
+(define-markup (table #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (border #f) (width #f)
+ (frame 'none) (rules 'none)
+ (cellstyle 'collapse) (cellpadding #f) (cellspacing #f))
+ (let ((frame (cond
+ ((string? frame)
+ (string->symbol frame))
+ ((not frame)
+ #f)
+ (else
+ frame)))
+ (rules (cond
+ ((string? rules)
+ (string->symbol rules))
+ ((not rules)
+ #f)
+ (else
+ rules)))
+ (frame-vals '(none above below hsides vsides lhs rhs box border))
+ (rules-vals '(none rows cols all header))
+ (cells-vals '(collapse separate)))
+ (cond
+ ((and frame (not (memq frame frame-vals)))
+ (skribe-error 'table
+ (format "frame should be one of \"~a\"" frame-vals)
+ frame))
+ ((and rules (not (memq rules rules-vals)))
+ (skribe-error 'table
+ (format "rules should be one of \"~a\"" rules-vals)
+ rules))
+ ((not (or (memq cellstyle cells-vals)
+ (string? cellstyle)
+ (number? cellstyle)))
+ (skribe-error 'table
+ (format "cellstyle should be one of \"~a\", or a number, or a string" cells-vals)
+ cellstyle))
+ (else
+ (new container
+ (markup 'table)
+ (ident (or ident (symbol->string (gensym 'table))))
+ (class class)
+ (required-options '(:width :frame :rules))
+ (options `((:frame ,frame)
+ (:rules ,rules)
+ (:cellstyle ,cellstyle)
+ ,@(the-options opts :ident :class)))
+ (body (parse-list-of 'table 'tr (the-body opts))))))))
+
+;*---------------------------------------------------------------------*/
+;* tr ... */
+;*---------------------------------------------------------------------*/
+(define-markup (tr #!rest opts #!key (ident #f) (class #f) (bg #f))
+ (new container
+ (markup 'tr)
+ (ident (or ident (symbol->string (gensym 'tr))))
+ (class class)
+ (required-options '())
+ (options `(,@(if bg `((:bg ,(if bg (skribe-use-color! bg) bg))) '())
+ ,@(the-options opts :ident :class :bg)))
+ (body (parse-list-of 'tr 'tc (the-body opts)))))
+
+;*---------------------------------------------------------------------*/
+;* tc... */
+;*---------------------------------------------------------------------*/
+(define-markup (tc m
+ #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (width #f) (align 'center) (valign #f)
+ (colspan 1) (bg #f))
+ (let ((align (if (string? align)
+ (string->symbol align)
+ align))
+ (valign (if (string? valign)
+ (string->symbol valign)
+ valign)))
+ (cond
+ ((not (integer? colspan))
+ (skribe-type-error 'tc "Illegal colspan, " colspan "integer"))
+ ((not (symbol? align))
+ (skribe-type-error 'tc "Illegal align, " align "align"))
+ ((not (memq align '(#f center left right)))
+ (skribe-error
+ 'tc
+ "align should be one of 'left', `center', or `right'"
+ align))
+ ((not (memq valign '(#f top middle center bottom)))
+ (skribe-error
+ 'tc
+ "valign should be one of 'top', `middle', `center', or `bottom'"
+ valign))
+ (else
+ (new container
+ (markup 'tc)
+ (ident (or ident (symbol->string (gensym 'tc))))
+ (class class)
+ (required-options '(:width :align :valign :colspan))
+ (options `((markup ,m)
+ (:align ,align)
+ (:valign ,valign)
+ (:colspan ,colspan)
+ ,@(if bg
+ `((:bg ,(if bg (skribe-use-color! bg) bg)))
+ '())
+ ,@(the-options opts :ident :class :bg :align :valign)))
+ (body (the-body opts)))))))
+
+;*---------------------------------------------------------------------*/
+;* th ... */
+;*---------------------------------------------------------------------*/
+(define-markup (th #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (width #f) (align 'center) (valign #f)
+ (colspan 1) (bg #f))
+ (apply tc 'th opts))
+
+;*---------------------------------------------------------------------*/
+;* td ... */
+;*---------------------------------------------------------------------*/
+(define-markup (td #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ (width #f) (align 'center) (valign #f)
+ (colspan 1) (bg #f))
+ (apply tc 'td opts))
+
+;*---------------------------------------------------------------------*/
+;* image ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/image.skb:image@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:image@ */
+;* latex: @ref ../../skr/latex.skr:image@ */
+;*---------------------------------------------------------------------*/
+(define-markup (image #!rest
+ opts
+ #!key
+ (ident #f) (class #f)
+ file (url #f) (width #f) (height #f) (zoom #f))
+ (cond
+ ((not (or (string? file) (string? url)))
+ (skribe-error 'image "No file or url provided" file))
+ ((and (string? file) (string? url))
+ (skribe-error 'image "Both file and url provided" (list file url)))
+ (else
+ (new markup
+ (markup 'image)
+ (ident (or ident (symbol->string (gensym 'image))))
+ (class class)
+ (required-options '(:file :url :width :height))
+ (options (the-options opts :ident :class))
+ (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;* blockquote */
+;*---------------------------------------------------------------------*/
+(define-simple-markup blockquote)
+
+;*---------------------------------------------------------------------*/
+;* Ornaments ... */
+;*---------------------------------------------------------------------*/
+(define-simple-markup roman)
+(define-simple-markup bold)
+(define-simple-markup underline)
+(define-simple-markup strike)
+(define-simple-markup emph)
+(define-simple-markup kbd)
+(define-simple-markup it)
+(define-simple-markup tt)
+(define-simple-markup code)
+(define-simple-markup var)
+(define-simple-markup samp)
+(define-simple-markup sf)
+(define-simple-markup sc)
+(define-simple-markup sub)
+(define-simple-markup sup)
+
+;*---------------------------------------------------------------------*/
+;* char ... */
+;*---------------------------------------------------------------------*/
+(define-markup (char char)
+ (cond
+ ((char? char)
+ (string char))
+ ((integer? char)
+ (string (integer->char char)))
+ ((and (string? char) (= (string-length char) 1))
+ char)
+ (else
+ (skribe-error 'char "Illegal char" char))))
+
+;*---------------------------------------------------------------------*/
+;* symbol ... */
+;*---------------------------------------------------------------------*/
+(define-markup (symbol symbol)
+ (let ((v (cond
+ ((symbol? symbol)
+ (symbol->string symbol))
+ ((string? symbol)
+ symbol)
+ (else
+ (skribe-error 'symbol
+ "Illegal argument (symbol expected)"
+ symbol)))))
+ (new markup
+ (markup 'symbol)
+ (body v))))
+
+;*---------------------------------------------------------------------*/
+;* ! ... */
+;*---------------------------------------------------------------------*/
+(define-markup (! format #!rest node)
+ (if (not (string? format))
+ (skribe-type-error '! "Illegal format:" format "string")
+ (new command
+ (fmt format)
+ (body node))))
+
+;*---------------------------------------------------------------------*/
+;* processor ... */
+;*---------------------------------------------------------------------*/
+(define-markup (processor #!rest opts
+ #!key (combinator #f) (engine #f) (procedure #f))
+ (cond
+ ((and combinator (not (procedure? combinator)))
+ (skribe-error 'processor "Combinator not a procedure" combinator))
+ ((and engine (not (engine? engine)))
+ (skribe-error 'processor "Illegal engine" engine))
+ ((and procedure
+ (or (not (procedure? procedure))
+ (not (correct-arity? procedure 2))))
+ (skribe-error 'processor "Illegal procedure" procedure))
+ (else
+ (new processor
+ (combinator combinator)
+ (engine engine)
+ (procedure (or procedure (lambda (n e) n)))
+ (body (the-body opts))))))
+
+;*---------------------------------------------------------------------*/
+;* Processors ... */
+;*---------------------------------------------------------------------*/
+(define-processor-markup html-processor)
+(define-processor-markup tex-processor)
+
+;*---------------------------------------------------------------------*/
+;* handle ... */
+;*---------------------------------------------------------------------*/
+(define-markup (handle #!rest opts
+ #!key (ident #f) (class "handle") value section)
+ (let ((body (the-body opts)))
+ (cond
+ (section
+ (error 'handle "Illegal handle `section' option" section)
+ (new unresolved
+ (proc (lambda (n e env)
+ (let ((s (resolve-ident section 'section n env)))
+ (new handle
+ (ast s)))))))
+ ((and (pair? body)
+ (null? (cdr body))
+ (markup? (car body)))
+ (new handle
+ (ast (car body))))
+ (else
+ (skribe-error 'handle "Illegal handle" opts)))))
+
+;*---------------------------------------------------------------------*/
+;* mailto ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/links.skb:mailto@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:mailto@ */
+;*---------------------------------------------------------------------*/
+(define-markup (mailto #!rest opts #!key (ident #f) (class "mailto") text)
+ (new markup
+ (markup 'mailto)
+ (ident (or ident (symbol->string (gensym 'ident))))
+ (class class)
+ (required-options '(:text))
+ (options (the-options opts :ident :class))
+ (body (the-body opts))))
+
+;*---------------------------------------------------------------------*/
+;* *mark-table* ... */
+;*---------------------------------------------------------------------*/
+(define *mark-table* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* mark ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/links.skb:mark@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:mark@ */
+;*---------------------------------------------------------------------*/
+(define-markup (mark #!rest opts #!key (ident #f) (class "mark") (text #f))
+ (let ((bd (the-body opts)))
+ (cond
+ ((and (pair? bd) (not (null? (cdr bd))))
+ (skribe-error 'mark "Too many argument provided" bd))
+ ((null? bd)
+ (skribe-error 'mark "Missing argument" '()))
+ ((not (string? (car bd)))
+ (skribe-type-error 'mark "Illegal ident:" (car bd) "string"))
+ (ident
+ (skribe-error 'mark "Illegal `ident:' option" ident))
+ (else
+ (let* ((bs (ast->string bd))
+ (n (new markup
+ (markup 'mark)
+ (ident bs)
+ (class class)
+ (options (the-options opts :ident :class :text))
+ (body text))))
+ (hashtable-put! *mark-table* bs n)
+ n)))))
+
+;*---------------------------------------------------------------------*/
+;* ref ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/links.skb:ref@ */
+;* writer: */
+;* html: @ref ../../skr/html.skr:ref@ */
+;* latex: @ref ../../skr/latex.skr:ref@ */
+;*---------------------------------------------------------------------*/
+(define-markup (ref #!rest
+ opts
+ #!key
+ (class #f)
+ (ident #f)
+ (text #f)
+ (chapter #f)
+ (section #f)
+ (subsection #f)
+ (subsubsection #f)
+ (bib #f)
+ (bib-table (default-bib-table))
+ (url #f)
+ (figure #f)
+ (mark #f)
+ (handle #f)
+ (line #f)
+ (skribe #f)
+ (page #f))
+ (define (unref ast text kind)
+ (let ((msg (format "Can't find `~a': " kind)))
+ (if (ast? ast)
+ (begin
+ (skribe-warning/ast 1 ast 'ref msg text)
+ (new markup
+ (markup 'unref)
+ (ident (symbol->string 'unref))
+ (class class)
+ (required-options '(:text))
+ (options `((kind ,kind) ,@(the-options opts :ident :class)))
+ (body (list text ": " (ast->file-location ast)))))
+ (begin
+ (skribe-warning 1 'ref msg text)
+ (new markup
+ (markup 'unref)
+ (ident (symbol->string 'unref))
+ (class class)
+ (required-options '(:text))
+ (options `((kind ,kind) ,@(the-options opts :ident :class)))
+ (body text))))))
+ (define (skribe-ref skribe)
+ (let ((path (find-file/path skribe (skribe-path))))
+ (if (not path)
+ (unref #f skribe 'sui-file)
+ (let* ((sui (load-sui path))
+ (os (the-options opts :skribe :class :text))
+ (u (sui-ref->url (dirname path) sui ident os)))
+ (if (not u)
+ (unref #f os 'sui-ref)
+ (ref :url u :text text :ident ident :class class))))))
+ (define (handle-ref text)
+ (new markup
+ (markup 'ref)
+ (ident (symbol->string 'ref))
+ (class class)
+ (required-options '(:text))
+ (options `((kind handle) ,@(the-options opts :ident :class)))
+ (body text)))
+ (define (doref text kind)
+ (if (not (string? text))
+ (skribe-type-error 'ref "Illegal reference" text "string")
+ (new unresolved
+ (proc (lambda (n e env)
+ (let ((s (resolve-ident text kind n env)))
+ (if s
+ (new markup
+ (markup 'ref)
+ (ident (symbol->string 'ref))
+ (class class)
+ (required-options '(:text))
+ (options `((kind ,kind)
+ (mark ,text)
+ ,@(the-options opts :ident :class)))
+ (body (new handle
+ (ast s))))
+ (unref n text (or kind 'ident)))))))))
+ (define (mark-ref mark)
+ (if (not (string? mark))
+ (skribe-type-error 'mark "Illegal mark, " mark "string")
+ (new unresolved
+ (proc (lambda (n e env)
+ (let ((s (hashtable-get *mark-table* mark)))
+ (if s
+ (new markup
+ (markup 'ref)
+ (ident (symbol->string 'ref))
+ (class class)
+ (required-options '(:text))
+ (options `((kind mark)
+ (mark ,mark)
+ ,@(the-options opts :ident :class)))
+ (body (new handle
+ (ast s))))
+ (unref n mark 'mark))))))))
+ (define (make-bib-ref v)
+ (let ((s (resolve-bib bib-table v)))
+ (if s
+ (let* ((n (new markup
+ (markup 'bib-ref)
+ (ident (symbol->string 'bib-ref))
+ (class class)
+ (required-options '(:text))
+ (options (the-options opts :ident :class))
+ (body (new handle
+ (ast s)))))
+ (h (new handle (ast n)))
+ (o (markup-option s 'used)))
+ (markup-option-add! s 'used (if (pair? o) (cons h o) (list h)))
+ n)
+ (unref #f v 'bib))))
+ (define (bib-ref text)
+ (if (pair? text)
+ (new markup
+ (markup 'bib-ref+)
+ (ident (symbol->string 'bib-ref+))
+ (class class)
+ (options (the-options opts :ident :class))
+ (body (map make-bib-ref text)))
+ (make-bib-ref text)))
+ (define (url-ref)
+ (new markup
+ (markup 'url-ref)
+ (ident (symbol->string 'url-ref))
+ (class class)
+ (required-options '(:url :text))
+ (options (the-options opts :ident :class))))
+ (define (line-ref line)
+ (new unresolved
+ (proc (lambda (n e env)
+ (let ((l (resolve-line line)))
+ (if (pair? l)
+ (new markup
+ (markup 'line-ref)
+ (ident (symbol->string 'line-ref))
+ (class class)
+ (options `((:text ,(markup-ident (car l)))
+ ,@(the-options opts :ident :class)))
+ (body (new handle
+ (ast (car l)))))
+ (unref n line 'line)))))))
+ (let ((b (the-body opts)))
+ (if (not (null? b))
+ (skribe-warning 1 'ref "Arguments ignored " b))
+ (cond
+ (skribe (skribe-ref skribe))
+ (handle (handle-ref handle))
+ (ident (doref ident #f))
+ (chapter (doref chapter 'chapter))
+ (section (doref section 'section))
+ (subsection (doref subsection 'subsection))
+ (subsubsection (doref subsubsection 'subsubsection))
+ (figure (doref figure 'figure))
+ (mark (mark-ref mark))
+ (bib (bib-ref bib))
+ (url (url-ref))
+ (line (line-ref line))
+ (else (skribe-error 'ref "Illegal reference" opts)))))
+
+;*---------------------------------------------------------------------*/
+;* resolve ... */
+;*---------------------------------------------------------------------*/
+(define-markup (resolve fun)
+ (new unresolved
+ (proc fun)))
+
+;*---------------------------------------------------------------------*/
+;* bibliography ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/bib.skb:bibliography@ */
+;*---------------------------------------------------------------------*/
+(define-markup (bibliography #!rest files
+ #!key
+ (command #f) (bib-table (default-bib-table)))
+ (for-each (lambda (f)
+ (cond
+ ((string? f)
+ (bib-load! bib-table f command))
+ ((pair? f)
+ (bib-add! bib-table f))
+ (else
+ (skribe-error "bibliography" "Illegal entry" f))))
+ (the-body files)))
+
+;*---------------------------------------------------------------------*/
+;* the-bibliography ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/bib.skb:the-bibliography@ */
+;* writer: */
+;* base: @ref ../../skr/base.skr:the-bibliography@ */
+;*---------------------------------------------------------------------*/
+(define-markup (the-bibliography #!rest opts
+ #!key
+ pred
+ (bib-table (default-bib-table))
+ (sort bib-sort/authors)
+ (count 'partial))
+ (if (not (memq count '(partial full)))
+ (skribe-error 'the-bibliography
+ "Cound must be either `partial' or `full'"
+ count)
+ (new unresolved
+ (proc (lambda (n e env)
+ (resolve-the-bib bib-table
+ (new handle (ast n))
+ sort
+ pred
+ count
+ (the-options opts)))))))
+
+;*---------------------------------------------------------------------*/
+;* make-index ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/index.skb:make-index@ */
+;*---------------------------------------------------------------------*/
+(define-markup (make-index ident)
+ (make-index-table ident))
+
+;*---------------------------------------------------------------------*/
+;* index ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/index.skb:index@ */
+;*---------------------------------------------------------------------*/
+(define-markup (index #!rest
+ opts
+ #!key
+ (ident #f) (class "index")
+ (note #f) (index #f) (shape #f)
+ (url #f))
+ (let* ((entry-name (the-body opts))
+ (ename (cond
+ ((string? entry-name)
+ entry-name)
+ ((and (pair? entry-name) (every string? entry-name))
+ (apply string-append entry-name))
+ (else
+ (skribe-error
+ 'index
+ "entry-name must be either a string or a list of strings"
+ entry-name))))
+ (table (cond
+ ((not index) (default-index))
+ ((index? index) index)
+ (else (skribe-type-error 'index
+ "Illegal index table, "
+ index
+ "index"))))
+ (m (mark (symbol->string (gensym))))
+ (h (new handle (ast m)))
+ (new (new markup
+ (markup '&index-entry)
+ (ident (or ident (symbol->string (gensym 'index))))
+ (class class)
+ (options `((name ,ename) ,@(the-options opts :ident :class)))
+ (body (if url
+ (ref :url url :text (or shape ename))
+ (ref :handle h :text (or shape ename)))))))
+ ;; New is bound to a dummy option of the mark in order
+ ;; to make new options verified.
+ (markup-option-add! m 'to-verify new)
+ (hashtable-update! table
+ ename
+ (lambda (cur) (cons new cur))
+ (list new))
+ m))
+
+;*---------------------------------------------------------------------*/
+;* the-index ... */
+;* ------------------------------------------------------------- */
+;* doc: */
+;* @ref ../../doc/user/index.skb:the-index@ */
+;* writer: */
+;* base: @ref ../../skr/base.skr:the-index@ */
+;* html: @ref ../../skr/html.skr:the-index-header@ */
+;*---------------------------------------------------------------------*/
+(define-markup (the-index #!rest
+ opts
+ #!key
+ (ident #f)
+ (class "the-index")
+ (split #f)
+ (char-offset 0)
+ (header-limit 50)
+ (column 1))
+ (let ((bd (the-body opts)))
+ (cond
+ ((not (and (integer? char-offset) (>= char-offset 0)))
+ (skribe-error 'the-index "Illegal char offset" char-offset))
+ ((not (integer? column))
+ (skribe-error 'the-index "Illegal column number" column))
+ ((not (every? index? bd))
+ (skribe-error 'the-index
+ "Illegal indexes"
+ (filter (lambda (o) (not (index? o))) bd)))
+ (else
+ (new unresolved
+ (proc (lambda (n e env)
+ (resolve-the-index (ast-loc n)
+ ident class
+ bd
+ split
+ char-offset
+ header-limit
+ column))))))))
diff --git a/skribe/src/common/bib.scm b/skribe/src/common/bib.scm
new file mode 100644
index 0000000..b73c5f0
--- /dev/null
+++ b/skribe/src/common/bib.scm
@@ -0,0 +1,192 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/bib.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Dec 7 06:12:29 2001 */
+;* Last change : Wed Jan 14 08:02:45 2004 (serrano) */
+;* Copyright : 2001-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe Bibliography */
+;* ------------------------------------------------------------- */
+;* Implementation: @label bib@ */
+;* bigloo: @path ../bigloo/bib.bgl@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* bib-load! ... */
+;*---------------------------------------------------------------------*/
+(define (bib-load! table filename command)
+ (if (not (bib-table? table))
+ (skribe-error 'bib-load "Illegal bibliography table" table)
+ ;; read the file
+ (let ((p (skribe-open-bib-file filename command)))
+ (if (not (input-port? p))
+ (skribe-error 'bib-load "Can't open data base" filename)
+ (unwind-protect
+ (parse-bib table p)
+ (close-input-port p))))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-bib ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-bib table ident)
+ (if (not (bib-table? table))
+ (skribe-error 'resolve-bib "Illegal bibliography table" table)
+ (let* ((i (cond
+ ((string? ident) ident)
+ ((symbol? ident) (symbol->string ident))
+ (else (skribe-error 'resolve-bib "Illegal ident" ident))))
+ (en (hashtable-get table i)))
+ (if (is-markup? en '&bib-entry)
+ en
+ #f))))
+
+;*---------------------------------------------------------------------*/
+;* make-bib-entry ... */
+;*---------------------------------------------------------------------*/
+(define (make-bib-entry kind ident fields from)
+ (let* ((m (new markup
+ (markup '&bib-entry)
+ (ident ident)
+ (options `((kind ,kind) (from ,from)))))
+ (h (new handle
+ (ast m))))
+ (for-each (lambda (f)
+ (if (and (pair? f)
+ (pair? (cdr f))
+ (null? (cddr f))
+ (symbol? (car f)))
+ (markup-option-add! m
+ (car f)
+ (new markup
+ (markup (symbol-append
+ '&bib-entry-
+ (car f)))
+ (parent h)
+ (body (cadr f))))
+ (bib-parse-error f)))
+ fields)
+ m))
+
+;*---------------------------------------------------------------------*/
+;* bib-sort/authors ... */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/authors l)
+ (define (cmp i1 i2 def)
+ (cond
+ ((and (markup? i1) (markup? i2))
+ (cmp (markup-body i1) (markup-body i2) def))
+ ((markup? i1)
+ (cmp (markup-body i1) i2 def))
+ ((markup? i2)
+ (cmp i1 (markup-body i2) def))
+ ((and (string? i1) (string? i2))
+ (if (string=? i1 i2)
+ (def)
+ (string<? i1 i2)))
+ ((string? i1)
+ #f)
+ ((string? i2)
+ #t)
+ (else
+ (def))))
+ (sort l (lambda (e1 e2)
+ (cmp (markup-option e1 'author)
+ (markup-option e2 'author)
+ (lambda ()
+ (cmp (markup-option e1 'year)
+ (markup-option e2 'year)
+ (lambda ()
+ (cmp (markup-option e1 'title)
+ (markup-option e2 'title)
+ (lambda ()
+ (cmp (markup-ident e1)
+ (markup-ident e2)
+ (lambda ()
+ #t)))))))))))
+
+;*---------------------------------------------------------------------*/
+;* bib-sort/idents ... */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/idents l)
+ (sort l (lambda (e f) (string<? (markup-ident e) (markup-ident f)))))
+
+;*---------------------------------------------------------------------*/
+;* bib-sort/dates ... */
+;*---------------------------------------------------------------------*/
+(define (bib-sort/dates l)
+ (sort l (lambda (p1 p2)
+ (define (month-num m)
+ (let ((body (markup-body m)))
+ (if (not (string? body))
+ 13
+ (let* ((s (if (> (string-length body) 3)
+ (substring body 0 3)
+ body))
+ (sy (string->symbol (string-downcase body)))
+ (c (assq sy '((jan . 1)
+ (feb . 2)
+ (mar . 3)
+ (apr . 4)
+ (may . 5)
+ (jun . 6)
+ (jul . 7)
+ (aug . 8)
+ (sep . 9)
+ (oct . 10)
+ (nov . 11)
+ (dec . 12)))))
+ (if (pair? c) (cdr c) 13)))))
+ (let ((d1 (markup-option p1 'year))
+ (d2 (markup-option p2 'year)))
+ (cond
+ ((not (markup? d1)) #f)
+ ((not (markup? d2)) #t)
+ (else
+ (let ((y1 (markup-body d1))
+ (y2 (markup-body d2)))
+ (cond
+ ((string>? y1 y2) #t)
+ ((string<? y1 y2) #f)
+ (else
+ (let ((d1 (markup-option p1 'month))
+ (d2 (markup-option p2 'month)))
+ (cond
+ ((not (markup? d1)) #f)
+ ((not (markup? d2)) #t)
+ (else
+ (let ((m1 (month-num d1))
+ (m2 (month-num d2)))
+ (> m1 m2))))))))))))))
+
+;*---------------------------------------------------------------------*/
+;* resolve-the-bib ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-bib table n sort pred count opts)
+ (define (count! entries)
+ (let loop ((es entries)
+ (i 1))
+ (if (pair? es)
+ (begin
+ (markup-option-add! (car es)
+ :title
+ (new markup
+ (markup '&bib-entry-ident)
+ (parent (car es))
+ (options `((number ,i)))
+ (body (new handle
+ (ast (car es))))))
+ (loop (cdr es) (+ i 1))))))
+ (if (not (bib-table? table))
+ (skribe-error 'resolve-the-bib "Illegal bibliography table" table)
+ (let* ((es (sort (hashtable->list table)))
+ (fes (filter (if (procedure? pred)
+ (lambda (m) (pred m n))
+ (lambda (m) (pair? (markup-option m 'used))))
+ es)))
+ (count! (if (eq? count 'full) es fes))
+ (new markup
+ (markup '&the-bibliography)
+ (options opts)
+ (body fes)))))
+
diff --git a/skribe/src/common/configure.scm.in b/skribe/src/common/configure.scm.in
new file mode 100644
index 0000000..830ec4d
--- /dev/null
+++ b/skribe/src/common/configure.scm.in
@@ -0,0 +1,6 @@
+(define (skribe-release) "@SKRIBE_RELEASE@")
+(define (skribe-url) "@SKRIBE_URL@")
+(define (skribe-doc-dir) "@SKRIBE_DOC_DIR@")
+(define (skribe-ext-dir) "@SKRIBE_EXT_DIR@")
+(define (skribe-default-path) @SKRIBE_SKR_PATH@)
+(define (skribe-scheme) "@SKRIBE_SCHEME@")
diff --git a/skribe/src/common/index.scm b/skribe/src/common/index.scm
new file mode 100644
index 0000000..65c271f
--- /dev/null
+++ b/skribe/src/common/index.scm
@@ -0,0 +1,126 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/index.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Sun Aug 24 08:01:45 2003 */
+;* Last change : Wed Feb 4 14:58:05 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe indexes */
+;* ------------------------------------------------------------- */
+;* Implementation: @label index@ */
+;* bigloo: @path ../bigloo/index.bgl@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* index? ... */
+;*---------------------------------------------------------------------*/
+(define (index? obj)
+ (hashtable? obj))
+
+;*---------------------------------------------------------------------*/
+;* *index-table* ... */
+;*---------------------------------------------------------------------*/
+(define *index-table* #f)
+
+;*---------------------------------------------------------------------*/
+;* make-index-table ... */
+;*---------------------------------------------------------------------*/
+(define (make-index-table ident)
+ (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* default-index ... */
+;*---------------------------------------------------------------------*/
+(define (default-index)
+ (if (not *index-table*)
+ (set! *index-table* (make-index-table "default-index")))
+ *index-table*)
+
+;*---------------------------------------------------------------------*/
+;* resolve-the-index ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-the-index loc i c indexes split char-offset header-limit col)
+ ;; fetch the descriminating index name letter
+ (define (index-ref n)
+ (let ((name (markup-option n 'name)))
+ (if (>= char-offset (string-length name))
+ (skribe-error 'the-index "char-offset out of bound" char-offset)
+ (string-ref name char-offset))))
+ ;; sort a bucket of entries (the entries in a bucket share there name)
+ (define (sort-entries-bucket ie)
+ (sort ie
+ (lambda (i1 i2)
+ (or (not (markup-option i1 :note))
+ (markup-option i2 :note)))))
+ ;; accumulate all the entries starting with the same letter
+ (define (letter-references refs)
+ (let ((letter (index-ref (car (car refs)))))
+ (let loop ((refs refs)
+ (acc '()))
+ (if (or (null? refs)
+ (not (char-ci=? letter (index-ref (car (car refs))))))
+ (values (char-upcase letter) acc refs)
+ (loop (cdr refs) (cons (car refs) acc))))))
+ ;; merge the buckets that comes from different index tables
+ (define (merge-buckets buckets)
+ (if (null? buckets)
+ '()
+ (let loop ((buckets buckets)
+ (res '()))
+ (cond
+ ((null? (cdr buckets))
+ (reverse! (cons (car buckets) res)))
+ ((string=? (markup-option (car (car buckets)) 'name)
+ (markup-option (car (cadr buckets)) 'name))
+ ;; we merge
+ (loop (cons (append (car buckets) (cadr buckets))
+ (cddr buckets))
+ res))
+ (else
+ (loop (cdr buckets)
+ (cons (car buckets) res)))))))
+ (let* ((entries (apply append (map hashtable->list indexes)))
+ (sorted (map sort-entries-bucket
+ (merge-buckets
+ (sort entries
+ (lambda (e1 e2)
+ (string-ci<?
+ (markup-option (car e1) 'name)
+ (markup-option (car e2) 'name))))))))
+ (if (and (not split) (< (apply + (map length sorted)) header-limit))
+ (new markup
+ (markup '&the-index)
+ (loc loc)
+ (ident i)
+ (class c)
+ (options `((:column ,col)))
+ (body sorted))
+ (let loop ((refs sorted)
+ (lrefs '())
+ (body '()))
+ (if (null? refs)
+ (new markup
+ (markup '&the-index)
+ (loc loc)
+ (ident i)
+ (class c)
+ (options `((:column ,col)
+ (header ,(new markup
+ (markup '&the-index-header)
+ (loc loc)
+ (body (reverse! lrefs))))))
+ (body (reverse! body)))
+ (call-with-values
+ (lambda () (letter-references refs))
+ (lambda (l lr next-refs)
+ (let* ((s (string l))
+ (m (mark (symbol->string (gensym s)) :text s))
+ (h (new handle (loc loc) (ast m)))
+ (r (ref :handle h :text s)))
+ (ast-loc-set! m loc)
+ (ast-loc-set! r loc)
+ (loop next-refs
+ (cons r lrefs)
+ (append lr (cons m body)))))))))))
+
diff --git a/skribe/src/common/lib.scm b/skribe/src/common/lib.scm
new file mode 100644
index 0000000..b0fa2d0
--- /dev/null
+++ b/skribe/src/common/lib.scm
@@ -0,0 +1,238 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/lib.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Sep 10 11:57:54 2003 */
+;* Last change : Wed Oct 27 12:16:40 2004 (eg) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The Scheme independent lib part. */
+;* ------------------------------------------------------------- */
+;* Implementation: @label lib@ */
+;* bigloo: @path ../bigloo/lib.bgl@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* engine-custom-add! ... */
+;*---------------------------------------------------------------------*/
+(define (engine-custom-add! e id val)
+ (let ((old (engine-custom e id)))
+ (if (unspecified? old)
+ (engine-custom-set! e id (list val))
+ (engine-custom-set! e id (cons val old)))))
+
+;*---------------------------------------------------------------------*/
+;* find-markup-ident ... */
+;*---------------------------------------------------------------------*/
+(define (find-markup-ident ident)
+ (let ((r (find-markups ident)))
+ (if (or (pair? r) (null? r))
+ r
+ '())))
+
+;*---------------------------------------------------------------------*/
+;* container-search-down ... */
+;*---------------------------------------------------------------------*/
+(define (container-search-down pred obj)
+ (with-debug 4 'container-search-down
+ (debug-item "obj=" (find-runtime-type obj))
+ (let loop ((obj (markup-body obj)))
+ (cond
+ ((pair? obj)
+ (apply append (map (lambda (o) (loop o)) obj)))
+ ((container? obj)
+ (let ((rest (loop (markup-body obj))))
+ (if (pred obj)
+ (cons obj rest)
+ rest)))
+ ((pred obj)
+ (list obj))
+ (else
+ '())))))
+
+;*---------------------------------------------------------------------*/
+;* search-down ... */
+;*---------------------------------------------------------------------*/
+(define (search-down pred obj)
+ (with-debug 4 'search-down
+ (debug-item "obj=" (find-runtime-type obj))
+ (let loop ((obj (markup-body obj)))
+ (cond
+ ((pair? obj)
+ (apply append (map (lambda (o) (loop o)) obj)))
+ ((markup? obj)
+ (let ((rest (loop (markup-body obj))))
+ (if (pred obj)
+ (cons obj rest)
+ rest)))
+ ((pred obj)
+ (list obj))
+ (else
+ '())))))
+
+;*---------------------------------------------------------------------*/
+;* find-down ... */
+;*---------------------------------------------------------------------*/
+(define (find-down pred obj)
+ (with-debug 4 'find-down
+ (debug-item "obj=" (find-runtime-type obj))
+ (let loop ((obj obj))
+ (cond
+ ((pair? obj)
+ (apply append (map (lambda (o) (loop o)) obj)))
+ ((markup? obj)
+ (debug-item "loop=" (find-runtime-type obj)
+ " " (markup-ident obj))
+ (if (pred obj)
+ (list (cons obj (loop (markup-body obj))))
+ '()))
+ (else
+ (if (pred obj)
+ (list obj)
+ '()))))))
+
+;*---------------------------------------------------------------------*/
+;* find1-down ... */
+;*---------------------------------------------------------------------*/
+(define (find1-down pred obj)
+ (with-debug 4 'find1-down
+ (let loop ((obj obj)
+ (stack '()))
+ (debug-item "obj=" (find-runtime-type obj)
+ " " (if (markup? obj) (markup-markup obj) "???")
+ " " (if (markup? obj) (markup-ident obj) ""))
+ (cond
+ ((memq obj stack)
+ (skribe-error 'find1-down "Illegal cyclic object" obj))
+ ((pair? obj)
+ (let liip ((obj obj))
+ (cond
+ ((null? obj)
+ #f)
+ (else
+ (or (loop (car obj) (cons obj stack))
+ (liip (cdr obj)))))))
+ ((pred obj)
+ obj)
+ ((markup? obj)
+ (loop (markup-body obj) (cons obj stack)))
+ (else
+ #f)))))
+
+;*---------------------------------------------------------------------*/
+;* find-up ... */
+;*---------------------------------------------------------------------*/
+(define (find-up pred obj)
+ (let loop ((obj obj)
+ (res '()))
+ (cond
+ ((not (ast? obj))
+ res)
+ ((pred obj)
+ (loop (ast-parent obj) (cons obj res)))
+ (else
+ (loop (ast-parent obj) (cons obj res))))))
+
+;*---------------------------------------------------------------------*/
+;* find1-up ... */
+;*---------------------------------------------------------------------*/
+(define (find1-up pred obj)
+ (let loop ((obj obj))
+ (cond
+ ((not (ast? obj))
+ #f)
+ ((pred obj)
+ obj)
+ (else
+ (loop (ast-parent obj))))))
+
+;*---------------------------------------------------------------------*/
+;* ast-document ... */
+;*---------------------------------------------------------------------*/
+(define (ast-document m)
+ (find1-up document? m))
+
+;*---------------------------------------------------------------------*/
+;* ast-chapter ... */
+;*---------------------------------------------------------------------*/
+(define (ast-chapter m)
+ (find1-up (lambda (n) (is-markup? n 'chapter)) m))
+
+;*---------------------------------------------------------------------*/
+;* ast-section ... */
+;*---------------------------------------------------------------------*/
+(define (ast-section m)
+ (find1-up (lambda (n) (is-markup? n 'section)) m))
+
+;*---------------------------------------------------------------------*/
+;* the-body ... */
+;* ------------------------------------------------------------- */
+;* Filter out the options */
+;*---------------------------------------------------------------------*/
+(define (the-body opt+)
+ (let loop ((opt* opt+)
+ (res '()))
+ (cond
+ ((null? opt*)
+ (reverse! res))
+ ((not (pair? opt*))
+ (skribe-error 'the-body "Illegal body" opt*))
+ ((keyword? (car opt*))
+ (if (null? (cdr opt*))
+ (skribe-error 'the-body "Illegal option" (car opt*))
+ (loop (cddr opt*) res)))
+ (else
+ (loop (cdr opt*) (cons (car opt*) res))))))
+
+;*---------------------------------------------------------------------*/
+;* the-options ... */
+;* ------------------------------------------------------------- */
+;* Returns an list made of options. The OUT argument contains */
+;* keywords that are filtered out. */
+;*---------------------------------------------------------------------*/
+(define (the-options opt+ . out)
+ (let loop ((opt* opt+)
+ (res '()))
+ (cond
+ ((null? opt*)
+ (reverse! res))
+ ((not (pair? opt*))
+ (skribe-error 'the-options "Illegal options" opt*))
+ ((keyword? (car opt*))
+ (cond
+ ((null? (cdr opt*))
+ (skribe-error 'the-options "Illegal option" (car opt*)))
+ ((memq (car opt*) out)
+ (loop (cdr opt*) res))
+ (else
+ (loop (cdr opt*)
+ (cons (list (car opt*) (cadr opt*)) res)))))
+ (else
+ (loop (cdr opt*) res)))))
+
+;*---------------------------------------------------------------------*/
+;* list-split ... */
+;*---------------------------------------------------------------------*/
+(define (list-split l num . fill)
+ (let loop ((l l)
+ (i 0)
+ (acc '())
+ (res '()))
+ (cond
+ ((null? l)
+ (reverse! (cons (if (or (null? fill) (= i num))
+ (reverse! acc)
+ (append! (reverse! acc)
+ (make-list (- num i) (car fill))))
+ res)))
+ ((= i num)
+ (loop l
+ 0
+ '()
+ (cons (reverse! acc) res)))
+ (else
+ (loop (cdr l)
+ (+ i 1)
+ (cons (car l) acc)
+ res)))))
+
diff --git a/skribe/src/common/param.scm b/skribe/src/common/param.scm
new file mode 100644
index 0000000..ba8d489
--- /dev/null
+++ b/skribe/src/common/param.scm
@@ -0,0 +1,69 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/param.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Jul 30 09:06:53 2003 */
+;* Last change : Thu Oct 28 21:51:49 2004 (eg) */
+;* Copyright : 2003 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Common Skribe parameters */
+;* Implementation: @label param@ */
+;* bigloo: @path ../bigloo/param.bgl@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* *skribe-rc-file* ... */
+;* ------------------------------------------------------------- */
+;* The "runtime command" file. */
+;*---------------------------------------------------------------------*/
+(define *skribe-rc-file* "skriberc")
+
+;*---------------------------------------------------------------------*/
+;* *skribe-auto-mode-alist* ... */
+;*---------------------------------------------------------------------*/
+(define *skribe-auto-mode-alist*
+ '(("html" . html)
+ ("sui" . sui)
+ ("tex" . latex)
+ ("ctex" . context)
+ ("xml" . xml)
+ ("info" . info)
+ ("txt" . ascii)
+ ("mgp" . mgp)
+ ("man" . man)))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-auto-load-alist* ... */
+;* ------------------------------------------------------------- */
+;* Autoload engines. */
+;*---------------------------------------------------------------------*/
+(define *skribe-auto-load-alist*
+ '((base . "base.skr")
+ (html . "html.skr")
+ (sui . "html.skr")
+ (latex . "latex.skr")
+ (context . "context.skr")
+ (xml . "xml.skr")))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-preload* ... */
+;* ------------------------------------------------------------- */
+;* The list of skribe files (e.g. styles) to be loaded at boot-time */
+;*---------------------------------------------------------------------*/
+(define *skribe-preload*
+ '("skribe.skr"))
+
+;*---------------------------------------------------------------------*/
+;* *skribe-precustom* ... */
+;* ------------------------------------------------------------- */
+;* The list of pair <custom x value> to be assigned to the default */
+;* engine. */
+;*---------------------------------------------------------------------*/
+(define *skribe-precustom*
+ '())
+
+;*---------------------------------------------------------------------*/
+;* *skribebib-auto-mode-alist* ... */
+;*---------------------------------------------------------------------*/
+(define *skribebib-auto-mode-alist*
+ '(("bib" . "skribebibtex")))
diff --git a/skribe/src/common/sui.scm b/skribe/src/common/sui.scm
new file mode 100644
index 0000000..eb6134b
--- /dev/null
+++ b/skribe/src/common/sui.scm
@@ -0,0 +1,166 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/src/common/sui.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Wed Dec 31 11:44:33 2003 */
+;* Last change : Tue Feb 17 11:35:32 2004 (serrano) */
+;* Copyright : 2003-04 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* Skribe Url Indexes */
+;* ------------------------------------------------------------- */
+;* Implementation: @label lib@ */
+;* bigloo: @path ../bigloo/sui.bgl@ */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* *sui-table* ... */
+;*---------------------------------------------------------------------*/
+(define *sui-table* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* load-sui ... */
+;* ------------------------------------------------------------- */
+;* Returns a SUI sexp if already loaded. Load it otherwise. */
+;* Raise an error if the file cannot be open. */
+;*---------------------------------------------------------------------*/
+(define (load-sui path)
+ (let ((sexp (hashtable-get *sui-table* path)))
+ (or sexp
+ (begin
+ (when (> *skribe-verbose* 0)
+ (fprintf (current-error-port) " [loading sui: ~a]\n" path))
+ (let ((p (open-input-file path)))
+ (if (not (input-port? p))
+ (skribe-error 'load-sui
+ "Can't find `Skribe Url Index' file"
+ path)
+ (unwind-protect
+ (let ((sexp (read p)))
+ (match-case sexp
+ ((sui (? string?) . ?-)
+ (hashtable-put! *sui-table* path sexp))
+ (else
+ (skribe-error 'load-sui
+ "Illegal `Skribe Url Index' file"
+ path)))
+ sexp)
+ (close-input-port p))))))))
+
+;*---------------------------------------------------------------------*/
+;* sui-ref->url ... */
+;*---------------------------------------------------------------------*/
+(define (sui-ref->url dir sui ident opts)
+ (let ((refs (sui-find-ref sui ident opts)))
+ (and (pair? refs)
+ (let ((base (sui-file sui))
+ (file (car (car refs)))
+ (mark (cdr (car refs))))
+ (format "~a/~a#~a" dir (or file base) mark)))))
+
+;*---------------------------------------------------------------------*/
+;* sui-title ... */
+;*---------------------------------------------------------------------*/
+(define (sui-title sexp)
+ (match-case sexp
+ ((sui (and ?title (? string?)) . ?-)
+ title)
+ (else
+ (skribe-error 'sui-title "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;* sui-file ... */
+;*---------------------------------------------------------------------*/
+(define (sui-file sexp)
+ (sui-key sexp :file))
+
+;*---------------------------------------------------------------------*/
+;* sui-key ... */
+;*---------------------------------------------------------------------*/
+(define (sui-key sexp key)
+ (match-case sexp
+ ((sui ?- . ?rest)
+ (let loop ((rest rest))
+ (and (pair? rest)
+ (if (eq? (car rest) key)
+ (and (pair? (cdr rest))
+ (cadr rest))
+ (loop (cdr rest))))))
+ (else
+ (skribe-error 'sui-key "Illegal `sui' format" sexp))))
+
+;*---------------------------------------------------------------------*/
+;* sui-find-ref ... */
+;*---------------------------------------------------------------------*/
+(define (sui-find-ref sui ident opts)
+ (let ((ident (assq :ident opts))
+ (mark (assq :mark opts))
+ (class (let ((c (assq :class opts)))
+ (and (pair? c) (cadr c))))
+ (chapter (assq :chapter opts))
+ (section (assq :section opts))
+ (subsection (assq :subsection opts))
+ (subsubsection (assq :subsubsection opts)))
+ (match-case sui
+ ((sui (? string?) . ?refs)
+ (cond
+ (mark (sui-search-ref 'marks refs (cadr mark) class))
+ (chapter (sui-search-ref 'chapters refs (cadr chapter) class))
+ (section (sui-search-ref 'sections refs (cadr section) class))
+ (subsection (sui-search-ref 'subsections refs (cadr subsection) class))
+ (subsubsection (sui-search-ref 'subsubsections refs (cadr subsubsection) class))
+ (ident (sui-search-all-refs sui ident class))
+ (else '())))
+ (else
+ (skribe-error 'sui-find-ref "Illegal `sui' format" sui)))))
+
+;*---------------------------------------------------------------------*/
+;* sui-search-all-refs ... */
+;*---------------------------------------------------------------------*/
+(define (sui-search-all-refs sui id refs)
+ '())
+
+;*---------------------------------------------------------------------*/
+;* sui-search-ref ... */
+;*---------------------------------------------------------------------*/
+(define (sui-search-ref kind refs val class)
+ (define (find-ref refs val class)
+ (map (lambda (r)
+ (let ((f (memq :file r))
+ (c (memq :mark r)))
+ (cons (and (pair? f) (cadr f)) (and (pair? c) (cadr c)))))
+ (filter (if class
+ (lambda (m)
+ (and (pair? m)
+ (string? (car m))
+ (string=? (car m) val)
+ (let ((c (memq :class m)))
+ (and (pair? c)
+ (eq? (cadr c) class)))))
+ (lambda (m)
+ (and (pair? m)
+ (string? (car m))
+ (string=? (car m) val))))
+ refs)))
+ (let loop ((refs refs))
+ (if (pair? refs)
+ (if (and (pair? (car refs)) (eq? (caar refs) kind))
+ (find-ref (cdar refs) val class)
+ (loop (cdr refs)))
+ '())))
+
+;*---------------------------------------------------------------------*/
+;* sui-filter ... */
+;*---------------------------------------------------------------------*/
+(define (sui-filter sui pred1 pred2)
+ (match-case sui
+ ((sui (? string?) . ?refs)
+ (let loop ((refs refs)
+ (res '()))
+ (if (pair? refs)
+ (if (and (pred1 (car refs)))
+ (loop (cdr refs)
+ (cons (filter pred2 (cdar refs)) res))
+ (loop (cdr refs) res))
+ (reverse! res))))
+ (else
+ (skribe-error 'sui-filter "Illegal `sui' format" sui))))
diff --git a/skribe/src/stklos/Makefile.in b/skribe/src/stklos/Makefile.in
new file mode 100644
index 0000000..80a26de
--- /dev/null
+++ b/skribe/src/stklos/Makefile.in
@@ -0,0 +1,110 @@
+#
+# Makefile.in -- Skribe Src Makefile
+#
+# Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+#
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+# USA.
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 10-Aug-2003 20:26 (eg)
+# Last file update: 6-Mar-2004 16:00 (eg)
+#
+include ../../etc/stklos/Makefile.skb
+
+prefix=@PREFIX@
+
+SKR = $(wildcard ../../skr/*.skr)
+
+DEPS= ../common/configure.scm ../common/param.scm ../common/api.scm \
+ ../common/index.scm ../common/bib.scm ../common/lib.scm
+
+SRCS= biblio.stk c.stk color.stk configure.stk debug.stk engine.stk \
+ eval.stk lib.stk lisp.stk main.stk output.stk prog.stk reader.stk \
+ resolve.stk runtime.stk source.stk types.stk vars.stk \
+ verify.stk writer.stk xml.stk
+
+LEXFILES = c-lex.l lisp-lex.l xml-lex.l
+
+LEXSRCS = c-lex.stk lisp-lex.stk xml-lex.stk
+
+BINDIR=../../bin
+
+EXE= $(BINDIR)/skribe.stklos
+
+PRCS_FILES = Makefile.in $(SRCS) $(LEXFILES)
+
+SFLAGS=
+
+all: $(EXE)
+
+Makefile: Makefile.in
+ (cd ../../etc/stklos; autoconf; configure)
+
+$(EXE): $(DEPS) $(BINDIR) $(LEXSRCS) $(SRCS)
+ stklos-compile $(SFLAGS) -o $(EXE) main.stk && \
+ chmod $(BMASK) $(EXE)
+
+#
+# Lex files
+#
+lisp-lex.stk: lisp-lex.l
+ stklos-genlex lisp-lex.l lisp-lex.stk lisp-lex
+
+xml-lex.stk: xml-lex.l
+ stklos-genlex xml-lex.l xml-lex.stk xml-lex
+
+c-lex.stk: c-lex.l
+ stklos-genlex c-lex.l c-lex.stk c-lex
+
+
+install: $(INSTALL_BINDIR)
+ cp $(EXE) $(INSTALL_BINDIR)/skribe.stklos \
+ && chmod $(BMASK) $(INSTALL_BINDIR)/skribe.stklos
+ rm -f $(INSTALL_BINDIR)/skribe
+ ln -s skribe.stklos $(INSTALL_BINDIR)/skribe
+
+uninstall:
+ rm $(INSTALL_BINDIR)/skribe
+ rm $(INSTALL_BINDIR)/skribe.stklos
+
+$(BINDIR):
+ mkdir -p $(BINDIR) && chmod a+rx $(BINDIR)
+
+$(INSTALL_BINDIR):
+ mkdir -p $(INSTALL_BINDIR) && chmod a+rx $(INSTALL_BINDIR)
+
+##
+## Services
+##
+tags: TAGS
+
+TAGS: $(SRCS)
+ etags -l scheme $(SRCS)
+
+pop:
+ @echo $(PRCS_FILES:%=src/stklos/%)
+
+links:
+ ln -s $(DEPS) .
+ ln -s $(SKR) .
+
+clean:
+ /bin/rm -f skribe $(EXE) *~ TAGS *.scm *.skr
+
+distclean: clean
+ /bin/rm -f Makefile
+ /bin/rm -f ../common/configure.scm
diff --git a/skribe/src/stklos/biblio.stk b/skribe/src/stklos/biblio.stk
new file mode 100644
index 0000000..5691588
--- /dev/null
+++ b/skribe/src/stklos/biblio.stk
@@ -0,0 +1,161 @@
+;;;;
+;;;; biblio.stk -- Bibliography functions
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.main.st
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 31-Aug-2003 22:07 (eg)
+;;;; Last file update: 28-Oct-2004 21:19 (eg)
+;;;;
+
+
+
+(define-module SKRIBE-BIBLIO-MODULE
+ (import SKRIBE-RUNTIME-MODULE)
+ (export bib-tables? make-bib-table default-bib-table
+ bib-load! resolve-bib resolve-the-bib
+ bib-sort/authors bib-sort/idents bib-sort/dates)
+
+(define *bib-table* #f)
+
+;; Forward declarations
+(define skribe-open-bib-file #f)
+(define parse-bib #f)
+
+(include "../common/bib.scm")
+
+;;;; ======================================================================
+;;;;
+;;;; Utilities
+;;;;
+;;;; ======================================================================
+
+(define (make-bib-table ident)
+ (make-hashtable))
+
+(define (bib-table? obj)
+ (hashtable? obj))
+
+(define (default-bib-table)
+ (unless *bib-table*
+ (set! *bib-table* (make-bib-table "default-bib-table")))
+ *bib-table*)
+
+;;
+;; Utilities
+;;
+(define (%bib-error who entry)
+ (let ((msg "bibliography syntax error on entry"))
+ (if (%epair? entry)
+ (skribe-line-error (%epair-file entry) (%epair-line entry) who msg entry)
+ (skribe-error who msg entry))))
+
+;;;; ======================================================================
+;;;;
+;;;; BIB-DUPLICATE
+;;;;
+;;;; ======================================================================
+(define (bib-duplicate ident from old)
+ (let ((ofrom (markup-option old 'from)))
+ (skribe-warning 2
+ 'bib
+ (format "Duplicated bibliographic entry ~a'.\n" ident)
+ (if ofrom
+ (format " Using version of `~a'.\n" ofrom)
+ "")
+ (if from
+ (format " Ignoring version of `~a'." from)
+ " Ignoring redefinition."))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; PARSE-BIB
+;;;;
+;;;; ======================================================================
+(define (parse-bib table port)
+ (if (not (bib-table? table))
+ (skribe-error 'parse-bib "Illegal bibliography table" table)
+ (let ((from (port-file-name port)))
+ (let Loop ((entry (read port)))
+ (unless (eof-object? entry)
+ (cond
+ ((and (list? entry) (> (length entry) 2))
+ (let* ((kind (car entry))
+ (key (format "~A" (cadr entry)))
+ (fields (cddr entry))
+ (old (hashtable-get table key)))
+ (if old
+ (bib-duplicate ident from old)
+ (hash-table-put! table
+ key
+ (make-bib-entry kind key fields from)))
+ (Loop (read port))))
+ (else
+ (%bib-error 'bib-parse entry))))))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; BIB-ADD!
+;;;;
+;;;; ======================================================================
+(define (bib-add! table . entries)
+ (if (not (bib-table? table))
+ (skribe-error 'bib-add! "Illegal bibliography table" table)
+ (for-each (lambda (entry)
+ (cond
+ ((and (list? entry) (> (length entry) 2))
+ (let* ((kind (car entry))
+ (key (format "~A" (cadr entry)))
+ (fields (cddr entry))
+ (old (hashtable-get table ident)))
+ (if old
+ (bib-duplicate key #f old)
+ (hash-table-put! table
+ key
+ (make-bib-entry kind key fields #f)))))
+ (else
+ (%bib-error 'bib-add! entry))))
+ entries)))
+
+
+;;;; ======================================================================
+;;;;
+;;;; SKRIBE-OPEN-BIB-FILE
+;;;;
+;;;; ======================================================================
+;; FIXME: Factoriser
+(define (skribe-open-bib-file file command)
+ (let ((path (find-path file *skribe-bib-path*)))
+ (if (string? path)
+ (begin
+ (when (> *skribe-verbose* 0)
+ (format (current-error-port) " [loading bibliography: ~S]\n" path))
+ (open-input-file (if (string? command)
+ (string-append "| "
+ (format command path))
+ path)))
+ (begin
+ (skribe-warning 1
+ 'bibliography
+ "Can't find bibliography -- " file)
+ #f))))
+
+)
diff --git a/skribe/src/stklos/c-lex.l b/skribe/src/stklos/c-lex.l
new file mode 100644
index 0000000..a5b337e
--- /dev/null
+++ b/skribe/src/stklos/c-lex.l
@@ -0,0 +1,67 @@
+;;;;
+;;;; c-lex.l -- C fontifier for Skribe
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 6-Mar-2004 15:35 (eg)
+;;;; Last file update: 7-Mar-2004 00:10 (eg)
+;;;;
+
+space [ \n\9]
+letter [_a-zA-Z]
+alphanum [_a-zA-Z0-9]
+
+%%
+
+;; Strings
+\"[^\"]*\" (new markup
+ (markup '&source-string)
+ (body yytext))
+;;Comments
+/\*.*\*/ (new markup
+ (markup '&source-line-comment)
+ (body yytext))
+//.* (new markup
+ (markup '&source-line-comment)
+ (body yytext))
+
+;; Identifiers (only letters since we are interested in keywords only)
+[_a-zA-Z]+ (let* ((ident (string->symbol yytext))
+ (tmp (memq ident *the-keys*)))
+ (if tmp
+ (new markup
+ (markup '&source-module)
+ (body yytext))
+ yytext))
+
+;; Regular text
+[^\"a-zA-Z]+ (begin yytext)
+
+
+
+<<EOF>> 'eof
+<<ERROR>> (skribe-error 'lisp-fontifier "Parse error" yytext)
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/skribe/src/stklos/c.stk b/skribe/src/stklos/c.stk
new file mode 100644
index 0000000..265c421
--- /dev/null
+++ b/skribe/src/stklos/c.stk
@@ -0,0 +1,95 @@
+;;;;
+;;;; c.stk -- C fontifier for Skribe
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 6-Mar-2004 15:35 (eg)
+;;;; Last file update: 7-Mar-2004 00:12 (eg)
+;;;;
+
+(require "lex-rt") ;; to avoid module problems
+
+(define-module SKRIBE-C-MODULE
+ (export c java)
+ (import SKRIBE-SOURCE-MODULE)
+
+(include "c-lex.stk") ;; SILex generated
+
+
+(define *the-keys* #f)
+
+(define *c-keys* #f)
+(define *java-keys* #f)
+
+
+(define (fontifier s)
+ (let ((lex (c-lex (open-input-string s))))
+ (let Loop ((token (lexer-next-token lex))
+ (res '()))
+ (if (eq? token 'eof)
+ (reverse! res)
+ (Loop (lexer-next-token lex)
+ (cons token res))))))
+
+;;;; ======================================================================
+;;;;
+;;;; C
+;;;;
+;;;; ======================================================================
+(define (init-c-keys)
+ (unless *c-keys*
+ (set! *c-keys* '(for while return break continue void
+ do if else typedef struct union goto switch case
+ static extern default)))
+ *c-keys*)
+
+(define (c-fontifier s)
+ (fluid-let ((*the-keys* (init-c-keys)))
+ (fontifier s)))
+
+(define c
+ (new language
+ (name "C")
+ (fontifier c-fontifier)
+ (extractor #f)))
+
+;;;; ======================================================================
+;;;;
+;;;; JAVA
+;;;;
+;;;; ======================================================================
+(define (init-java-keys)
+ (unless *java-keys*
+ (set! *java-keys* (append (init-c-keys)
+ '(public final class throw catch))))
+ *java-keys*)
+
+(define (java-fontifier s)
+ (fluid-let ((*the-keys* (init-java-keys)))
+ (fontifier s)))
+
+(define java
+ (new language
+ (name "java")
+ (fontifier java-fontifier)
+ (extractor #f)))
+
+)
+
diff --git a/skribe/src/stklos/color.stk b/skribe/src/stklos/color.stk
new file mode 100644
index 0000000..0cb829f
--- /dev/null
+++ b/skribe/src/stklos/color.stk
@@ -0,0 +1,622 @@
+;;;;
+;;;; color.stk -- Skribe Color Management
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 25-Oct-2003 00:10 (eg)
+;;;; Last file update: 12-Feb-2004 18:24 (eg)
+;;;;
+
+(define-module SKRIBE-COLOR-MODULE
+ (export skribe-color->rgb skribe-get-used-colors skribe-use-color!)
+
+(define *used-colors* '())
+
+(define *skribe-rgb-alist* '(
+ ("snow" . "255 250 250")
+ ("ghostwhite" . "248 248 255")
+ ("whitesmoke" . "245 245 245")
+ ("gainsboro" . "220 220 220")
+ ("floralwhite" . "255 250 240")
+ ("oldlace" . "253 245 230")
+ ("linen" . "250 240 230")
+ ("antiquewhite" . "250 235 215")
+ ("papayawhip" . "255 239 213")
+ ("blanchedalmond" . "255 235 205")
+ ("bisque" . "255 228 196")
+ ("peachpuff" . "255 218 185")
+ ("navajowhite" . "255 222 173")
+ ("moccasin" . "255 228 181")
+ ("cornsilk" . "255 248 220")
+ ("ivory" . "255 255 240")
+ ("lemonchiffon" . "255 250 205")
+ ("seashell" . "255 245 238")
+ ("honeydew" . "240 255 240")
+ ("mintcream" . "245 255 250")
+ ("azure" . "240 255 255")
+ ("aliceblue" . "240 248 255")
+ ("lavender" . "230 230 250")
+ ("lavenderblush" . "255 240 245")
+ ("mistyrose" . "255 228 225")
+ ("white" . "255 255 255")
+ ("black" . "0 0 0")
+ ("darkslategrey" . "47 79 79")
+ ("dimgrey" . "105 105 105")
+ ("slategrey" . "112 128 144")
+ ("lightslategrey" . "119 136 153")
+ ("grey" . "190 190 190")
+ ("lightgrey" . "211 211 211")
+ ("midnightblue" . "25 25 112")
+ ("navy" . "0 0 128")
+ ("navyblue" . "0 0 128")
+ ("cornflowerblue" . "100 149 237")
+ ("darkslateblue" . "72 61 139")
+ ("slateblue" . "106 90 205")
+ ("mediumslateblue" . "123 104 238")
+ ("lightslateblue" . "132 112 255")
+ ("mediumblue" . "0 0 205")
+ ("royalblue" . "65 105 225")
+ ("blue" . "0 0 255")
+ ("dodgerblue" . "30 144 255")
+ ("deepskyblue" . "0 191 255")
+ ("skyblue" . "135 206 235")
+ ("lightskyblue" . "135 206 250")
+ ("steelblue" . "70 130 180")
+ ("lightsteelblue" . "176 196 222")
+ ("lightblue" . "173 216 230")
+ ("powderblue" . "176 224 230")
+ ("paleturquoise" . "175 238 238")
+ ("darkturquoise" . "0 206 209")
+ ("mediumturquoise" . "72 209 204")
+ ("turquoise" . "64 224 208")
+ ("cyan" . "0 255 255")
+ ("lightcyan" . "224 255 255")
+ ("cadetblue" . "95 158 160")
+ ("mediumaquamarine" . "102 205 170")
+ ("aquamarine" . "127 255 212")
+ ("darkgreen" . "0 100 0")
+ ("darkolivegreen" . "85 107 47")
+ ("darkseagreen" . "143 188 143")
+ ("seagreen" . "46 139 87")
+ ("mediumseagreen" . "60 179 113")
+ ("lightseagreen" . "32 178 170")
+ ("palegreen" . "152 251 152")
+ ("springgreen" . "0 255 127")
+ ("lawngreen" . "124 252 0")
+ ("green" . "0 255 0")
+ ("chartreuse" . "127 255 0")
+ ("mediumspringgreen" . "0 250 154")
+ ("greenyellow" . "173 255 47")
+ ("limegreen" . "50 205 50")
+ ("yellowgreen" . "154 205 50")
+ ("forestgreen" . "34 139 34")
+ ("olivedrab" . "107 142 35")
+ ("darkkhaki" . "189 183 107")
+ ("khaki" . "240 230 140")
+ ("palegoldenrod" . "238 232 170")
+ ("lightgoldenrodyellow" . "250 250 210")
+ ("lightyellow" . "255 255 224")
+ ("yellow" . "255 255 0")
+ ("gold" . "255 215 0")
+ ("lightgoldenrod" . "238 221 130")
+ ("goldenrod" . "218 165 32")
+ ("darkgoldenrod" . "184 134 11")
+ ("rosybrown" . "188 143 143")
+ ("indianred" . "205 92 92")
+ ("saddlebrown" . "139 69 19")
+ ("sienna" . "160 82 45")
+ ("peru" . "205 133 63")
+ ("burlywood" . "222 184 135")
+ ("beige" . "245 245 220")
+ ("wheat" . "245 222 179")
+ ("sandybrown" . "244 164 96")
+ ("tan" . "210 180 140")
+ ("chocolate" . "210 105 30")
+ ("firebrick" . "178 34 34")
+ ("brown" . "165 42 42")
+ ("darksalmon" . "233 150 122")
+ ("salmon" . "250 128 114")
+ ("lightsalmon" . "255 160 122")
+ ("orange" . "255 165 0")
+ ("darkorange" . "255 140 0")
+ ("coral" . "255 127 80")
+ ("lightcoral" . "240 128 128")
+ ("tomato" . "255 99 71")
+ ("orangered" . "255 69 0")
+ ("red" . "255 0 0")
+ ("hotpink" . "255 105 180")
+ ("deeppink" . "255 20 147")
+ ("pink" . "255 192 203")
+ ("lightpink" . "255 182 193")
+ ("palevioletred" . "219 112 147")
+ ("maroon" . "176 48 96")
+ ("mediumvioletred" . "199 21 133")
+ ("violetred" . "208 32 144")
+ ("magenta" . "255 0 255")
+ ("violet" . "238 130 238")
+ ("plum" . "221 160 221")
+ ("orchid" . "218 112 214")
+ ("mediumorchid" . "186 85 211")
+ ("darkorchid" . "153 50 204")
+ ("darkviolet" . "148 0 211")
+ ("blueviolet" . "138 43 226")
+ ("purple" . "160 32 240")
+ ("mediumpurple" . "147 112 219")
+ ("thistle" . "216 191 216")
+ ("snow1" . "255 250 250")
+ ("snow2" . "238 233 233")
+ ("snow3" . "205 201 201")
+ ("snow4" . "139 137 137")
+ ("seashell1" . "255 245 238")
+ ("seashell2" . "238 229 222")
+ ("seashell3" . "205 197 191")
+ ("seashell4" . "139 134 130")
+ ("antiquewhite1" . "255 239 219")
+ ("antiquewhite2" . "238 223 204")
+ ("antiquewhite3" . "205 192 176")
+ ("antiquewhite4" . "139 131 120")
+ ("bisque1" . "255 228 196")
+ ("bisque2" . "238 213 183")
+ ("bisque3" . "205 183 158")
+ ("bisque4" . "139 125 107")
+ ("peachpuff1" . "255 218 185")
+ ("peachpuff2" . "238 203 173")
+ ("peachpuff3" . "205 175 149")
+ ("peachpuff4" . "139 119 101")
+ ("navajowhite1" . "255 222 173")
+ ("navajowhite2" . "238 207 161")
+ ("navajowhite3" . "205 179 139")
+ ("navajowhite4" . "139 121 94")
+ ("lemonchiffon1" . "255 250 205")
+ ("lemonchiffon2" . "238 233 191")
+ ("lemonchiffon3" . "205 201 165")
+ ("lemonchiffon4" . "139 137 112")
+ ("cornsilk1" . "255 248 220")
+ ("cornsilk2" . "238 232 205")
+ ("cornsilk3" . "205 200 177")
+ ("cornsilk4" . "139 136 120")
+ ("ivory1" . "255 255 240")
+ ("ivory2" . "238 238 224")
+ ("ivory3" . "205 205 193")
+ ("ivory4" . "139 139 131")
+ ("honeydew1" . "240 255 240")
+ ("honeydew2" . "224 238 224")
+ ("honeydew3" . "193 205 193")
+ ("honeydew4" . "131 139 131")
+ ("lavenderblush1" . "255 240 245")
+ ("lavenderblush2" . "238 224 229")
+ ("lavenderblush3" . "205 193 197")
+ ("lavenderblush4" . "139 131 134")
+ ("mistyrose1" . "255 228 225")
+ ("mistyrose2" . "238 213 210")
+ ("mistyrose3" . "205 183 181")
+ ("mistyrose4" . "139 125 123")
+ ("azure1" . "240 255 255")
+ ("azure2" . "224 238 238")
+ ("azure3" . "193 205 205")
+ ("azure4" . "131 139 139")
+ ("slateblue1" . "131 111 255")
+ ("slateblue2" . "122 103 238")
+ ("slateblue3" . "105 89 205")
+ ("slateblue4" . "71 60 139")
+ ("royalblue1" . "72 118 255")
+ ("royalblue2" . "67 110 238")
+ ("royalblue3" . "58 95 205")
+ ("royalblue4" . "39 64 139")
+ ("blue1" . "0 0 255")
+ ("blue2" . "0 0 238")
+ ("blue3" . "0 0 205")
+ ("blue4" . "0 0 139")
+ ("dodgerblue1" . "30 144 255")
+ ("dodgerblue2" . "28 134 238")
+ ("dodgerblue3" . "24 116 205")
+ ("dodgerblue4" . "16 78 139")
+ ("steelblue1" . "99 184 255")
+ ("steelblue2" . "92 172 238")
+ ("steelblue3" . "79 148 205")
+ ("steelblue4" . "54 100 139")
+ ("deepskyblue1" . "0 191 255")
+ ("deepskyblue2" . "0 178 238")
+ ("deepskyblue3" . "0 154 205")
+ ("deepskyblue4" . "0 104 139")
+ ("skyblue1" . "135 206 255")
+ ("skyblue2" . "126 192 238")
+ ("skyblue3" . "108 166 205")
+ ("skyblue4" . "74 112 139")
+ ("lightskyblue1" . "176 226 255")
+ ("lightskyblue2" . "164 211 238")
+ ("lightskyblue3" . "141 182 205")
+ ("lightskyblue4" . "96 123 139")
+ ("lightsteelblue1" . "202 225 255")
+ ("lightsteelblue2" . "188 210 238")
+ ("lightsteelblue3" . "162 181 205")
+ ("lightsteelblue4" . "110 123 139")
+ ("lightblue1" . "191 239 255")
+ ("lightblue2" . "178 223 238")
+ ("lightblue3" . "154 192 205")
+ ("lightblue4" . "104 131 139")
+ ("lightcyan1" . "224 255 255")
+ ("lightcyan2" . "209 238 238")
+ ("lightcyan3" . "180 205 205")
+ ("lightcyan4" . "122 139 139")
+ ("paleturquoise1" . "187 255 255")
+ ("paleturquoise2" . "174 238 238")
+ ("paleturquoise3" . "150 205 205")
+ ("paleturquoise4" . "102 139 139")
+ ("cadetblue1" . "152 245 255")
+ ("cadetblue2" . "142 229 238")
+ ("cadetblue3" . "122 197 205")
+ ("cadetblue4" . "83 134 139")
+ ("turquoise1" . "0 245 255")
+ ("turquoise2" . "0 229 238")
+ ("turquoise3" . "0 197 205")
+ ("turquoise4" . "0 134 139")
+ ("cyan1" . "0 255 255")
+ ("cyan2" . "0 238 238")
+ ("cyan3" . "0 205 205")
+ ("cyan4" . "0 139 139")
+ ("aquamarine1" . "127 255 212")
+ ("aquamarine2" . "118 238 198")
+ ("aquamarine3" . "102 205 170")
+ ("aquamarine4" . "69 139 116")
+ ("darkseagreen1" . "193 255 193")
+ ("darkseagreen2" . "180 238 180")
+ ("darkseagreen3" . "155 205 155")
+ ("darkseagreen4" . "105 139 105")
+ ("seagreen1" . "84 255 159")
+ ("seagreen2" . "78 238 148")
+ ("seagreen3" . "67 205 128")
+ ("seagreen4" . "46 139 87")
+ ("palegreen1" . "154 255 154")
+ ("palegreen2" . "144 238 144")
+ ("palegreen3" . "124 205 124")
+ ("palegreen4" . "84 139 84")
+ ("springgreen1" . "0 255 127")
+ ("springgreen2" . "0 238 118")
+ ("springgreen3" . "0 205 102")
+ ("springgreen4" . "0 139 69")
+ ("green1" . "0 255 0")
+ ("green2" . "0 238 0")
+ ("green3" . "0 205 0")
+ ("green4" . "0 139 0")
+ ("chartreuse1" . "127 255 0")
+ ("chartreuse2" . "118 238 0")
+ ("chartreuse3" . "102 205 0")
+ ("chartreuse4" . "69 139 0")
+ ("olivedrab1" . "192 255 62")
+ ("olivedrab2" . "179 238 58")
+ ("olivedrab3" . "154 205 50")
+ ("olivedrab4" . "105 139 34")
+ ("darkolivegreen1" . "202 255 112")
+ ("darkolivegreen2" . "188 238 104")
+ ("darkolivegreen3" . "162 205 90")
+ ("darkolivegreen4" . "110 139 61")
+ ("khaki1" . "255 246 143")
+ ("khaki2" . "238 230 133")
+ ("khaki3" . "205 198 115")
+ ("khaki4" . "139 134 78")
+ ("lightgoldenrod1" . "255 236 139")
+ ("lightgoldenrod2" . "238 220 130")
+ ("lightgoldenrod3" . "205 190 112")
+ ("lightgoldenrod4" . "139 129 76")
+ ("lightyellow1" . "255 255 224")
+ ("lightyellow2" . "238 238 209")
+ ("lightyellow3" . "205 205 180")
+ ("lightyellow4" . "139 139 122")
+ ("yellow1" . "255 255 0")
+ ("yellow2" . "238 238 0")
+ ("yellow3" . "205 205 0")
+ ("yellow4" . "139 139 0")
+ ("gold1" . "255 215 0")
+ ("gold2" . "238 201 0")
+ ("gold3" . "205 173 0")
+ ("gold4" . "139 117 0")
+ ("goldenrod1" . "255 193 37")
+ ("goldenrod2" . "238 180 34")
+ ("goldenrod3" . "205 155 29")
+ ("goldenrod4" . "139 105 20")
+ ("darkgoldenrod1" . "255 185 15")
+ ("darkgoldenrod2" . "238 173 14")
+ ("darkgoldenrod3" . "205 149 12")
+ ("darkgoldenrod4" . "139 101 8")
+ ("rosybrown1" . "255 193 193")
+ ("rosybrown2" . "238 180 180")
+ ("rosybrown3" . "205 155 155")
+ ("rosybrown4" . "139 105 105")
+ ("indianred1" . "255 106 106")
+ ("indianred2" . "238 99 99")
+ ("indianred3" . "205 85 85")
+ ("indianred4" . "139 58 58")
+ ("sienna1" . "255 130 71")
+ ("sienna2" . "238 121 66")
+ ("sienna3" . "205 104 57")
+ ("sienna4" . "139 71 38")
+ ("burlywood1" . "255 211 155")
+ ("burlywood2" . "238 197 145")
+ ("burlywood3" . "205 170 125")
+ ("burlywood4" . "139 115 85")
+ ("wheat1" . "255 231 186")
+ ("wheat2" . "238 216 174")
+ ("wheat3" . "205 186 150")
+ ("wheat4" . "139 126 102")
+ ("tan1" . "255 165 79")
+ ("tan2" . "238 154 73")
+ ("tan3" . "205 133 63")
+ ("tan4" . "139 90 43")
+ ("chocolate1" . "255 127 36")
+ ("chocolate2" . "238 118 33")
+ ("chocolate3" . "205 102 29")
+ ("chocolate4" . "139 69 19")
+ ("firebrick1" . "255 48 48")
+ ("firebrick2" . "238 44 44")
+ ("firebrick3" . "205 38 38")
+ ("firebrick4" . "139 26 26")
+ ("brown1" . "255 64 64")
+ ("brown2" . "238 59 59")
+ ("brown3" . "205 51 51")
+ ("brown4" . "139 35 35")
+ ("salmon1" . "255 140 105")
+ ("salmon2" . "238 130 98")
+ ("salmon3" . "205 112 84")
+ ("salmon4" . "139 76 57")
+ ("lightsalmon1" . "255 160 122")
+ ("lightsalmon2" . "238 149 114")
+ ("lightsalmon3" . "205 129 98")
+ ("lightsalmon4" . "139 87 66")
+ ("orange1" . "255 165 0")
+ ("orange2" . "238 154 0")
+ ("orange3" . "205 133 0")
+ ("orange4" . "139 90 0")
+ ("darkorange1" . "255 127 0")
+ ("darkorange2" . "238 118 0")
+ ("darkorange3" . "205 102 0")
+ ("darkorange4" . "139 69 0")
+ ("coral1" . "255 114 86")
+ ("coral2" . "238 106 80")
+ ("coral3" . "205 91 69")
+ ("coral4" . "139 62 47")
+ ("tomato1" . "255 99 71")
+ ("tomato2" . "238 92 66")
+ ("tomato3" . "205 79 57")
+ ("tomato4" . "139 54 38")
+ ("orangered1" . "255 69 0")
+ ("orangered2" . "238 64 0")
+ ("orangered3" . "205 55 0")
+ ("orangered4" . "139 37 0")
+ ("red1" . "255 0 0")
+ ("red2" . "238 0 0")
+ ("red3" . "205 0 0")
+ ("red4" . "139 0 0")
+ ("deeppink1" . "255 20 147")
+ ("deeppink2" . "238 18 137")
+ ("deeppink3" . "205 16 118")
+ ("deeppink4" . "139 10 80")
+ ("hotpink1" . "255 110 180")
+ ("hotpink2" . "238 106 167")
+ ("hotpink3" . "205 96 144")
+ ("hotpink4" . "139 58 98")
+ ("pink1" . "255 181 197")
+ ("pink2" . "238 169 184")
+ ("pink3" . "205 145 158")
+ ("pink4" . "139 99 108")
+ ("lightpink1" . "255 174 185")
+ ("lightpink2" . "238 162 173")
+ ("lightpink3" . "205 140 149")
+ ("lightpink4" . "139 95 101")
+ ("palevioletred1" . "255 130 171")
+ ("palevioletred2" . "238 121 159")
+ ("palevioletred3" . "205 104 137")
+ ("palevioletred4" . "139 71 93")
+ ("maroon1" . "255 52 179")
+ ("maroon2" . "238 48 167")
+ ("maroon3" . "205 41 144")
+ ("maroon4" . "139 28 98")
+ ("violetred1" . "255 62 150")
+ ("violetred2" . "238 58 140")
+ ("violetred3" . "205 50 120")
+ ("violetred4" . "139 34 82")
+ ("magenta1" . "255 0 255")
+ ("magenta2" . "238 0 238")
+ ("magenta3" . "205 0 205")
+ ("magenta4" . "139 0 139")
+ ("orchid1" . "255 131 250")
+ ("orchid2" . "238 122 233")
+ ("orchid3" . "205 105 201")
+ ("orchid4" . "139 71 137")
+ ("plum1" . "255 187 255")
+ ("plum2" . "238 174 238")
+ ("plum3" . "205 150 205")
+ ("plum4" . "139 102 139")
+ ("mediumorchid1" . "224 102 255")
+ ("mediumorchid2" . "209 95 238")
+ ("mediumorchid3" . "180 82 205")
+ ("mediumorchid4" . "122 55 139")
+ ("darkorchid1" . "191 62 255")
+ ("darkorchid2" . "178 58 238")
+ ("darkorchid3" . "154 50 205")
+ ("darkorchid4" . "104 34 139")
+ ("purple1" . "155 48 255")
+ ("purple2" . "145 44 238")
+ ("purple3" . "125 38 205")
+ ("purple4" . "85 26 139")
+ ("mediumpurple1" . "171 130 255")
+ ("mediumpurple2" . "159 121 238")
+ ("mediumpurple3" . "137 104 205")
+ ("mediumpurple4" . "93 71 139")
+ ("thistle1" . "255 225 255")
+ ("thistle2" . "238 210 238")
+ ("thistle3" . "205 181 205")
+ ("thistle4" . "139 123 139")
+ ("grey0" . "0 0 0")
+ ("grey1" . "3 3 3")
+ ("grey2" . "5 5 5")
+ ("grey3" . "8 8 8")
+ ("grey4" . "10 10 10")
+ ("grey5" . "13 13 13")
+ ("grey6" . "15 15 15")
+ ("grey7" . "18 18 18")
+ ("grey8" . "20 20 20")
+ ("grey9" . "23 23 23")
+ ("grey10" . "26 26 26")
+ ("grey11" . "28 28 28")
+ ("grey12" . "31 31 31")
+ ("grey13" . "33 33 33")
+ ("grey14" . "36 36 36")
+ ("grey15" . "38 38 38")
+ ("grey16" . "41 41 41")
+ ("grey17" . "43 43 43")
+ ("grey18" . "46 46 46")
+ ("grey19" . "48 48 48")
+ ("grey20" . "51 51 51")
+ ("grey21" . "54 54 54")
+ ("grey22" . "56 56 56")
+ ("grey23" . "59 59 59")
+ ("grey24" . "61 61 61")
+ ("grey25" . "64 64 64")
+ ("grey26" . "66 66 66")
+ ("grey27" . "69 69 69")
+ ("grey28" . "71 71 71")
+ ("grey29" . "74 74 74")
+ ("grey30" . "77 77 77")
+ ("grey31" . "79 79 79")
+ ("grey32" . "82 82 82")
+ ("grey33" . "84 84 84")
+ ("grey34" . "87 87 87")
+ ("grey35" . "89 89 89")
+ ("grey36" . "92 92 92")
+ ("grey37" . "94 94 94")
+ ("grey38" . "97 97 97")
+ ("grey39" . "99 99 99")
+ ("grey40" . "102 102 102")
+ ("grey41" . "105 105 105")
+ ("grey42" . "107 107 107")
+ ("grey43" . "110 110 110")
+ ("grey44" . "112 112 112")
+ ("grey45" . "115 115 115")
+ ("grey46" . "117 117 117")
+ ("grey47" . "120 120 120")
+ ("grey48" . "122 122 122")
+ ("grey49" . "125 125 125")
+ ("grey50" . "127 127 127")
+ ("grey51" . "130 130 130")
+ ("grey52" . "133 133 133")
+ ("grey53" . "135 135 135")
+ ("grey54" . "138 138 138")
+ ("grey55" . "140 140 140")
+ ("grey56" . "143 143 143")
+ ("grey57" . "145 145 145")
+ ("grey58" . "148 148 148")
+ ("grey59" . "150 150 150")
+ ("grey60" . "153 153 153")
+ ("grey61" . "156 156 156")
+ ("grey62" . "158 158 158")
+ ("grey63" . "161 161 161")
+ ("grey64" . "163 163 163")
+ ("grey65" . "166 166 166")
+ ("grey66" . "168 168 168")
+ ("grey67" . "171 171 171")
+ ("grey68" . "173 173 173")
+ ("grey69" . "176 176 176")
+ ("grey70" . "179 179 179")
+ ("grey71" . "181 181 181")
+ ("grey72" . "184 184 184")
+ ("grey73" . "186 186 186")
+ ("grey74" . "189 189 189")
+ ("grey75" . "191 191 191")
+ ("grey76" . "194 194 194")
+ ("grey77" . "196 196 196")
+ ("grey78" . "199 199 199")
+ ("grey79" . "201 201 201")
+ ("grey80" . "204 204 204")
+ ("grey81" . "207 207 207")
+ ("grey82" . "209 209 209")
+ ("grey83" . "212 212 212")
+ ("grey84" . "214 214 214")
+ ("grey85" . "217 217 217")
+ ("grey86" . "219 219 219")
+ ("grey87" . "222 222 222")
+ ("grey88" . "224 224 224")
+ ("grey89" . "227 227 227")
+ ("grey90" . "229 229 229")
+ ("grey91" . "232 232 232")
+ ("grey92" . "235 235 235")
+ ("grey93" . "237 237 237")
+ ("grey94" . "240 240 240")
+ ("grey95" . "242 242 242")
+ ("grey96" . "245 245 245")
+ ("grey97" . "247 247 247")
+ ("grey98" . "250 250 250")
+ ("grey99" . "252 252 252")
+ ("grey100" . "255 255 255")
+ ("darkgrey" . "169 169 169")
+ ("darkblue" . "0 0 139")
+ ("darkcyan" . "0 139 139")
+ ("darkmagenta" . "139 0 139")
+ ("darkred" . "139 0 0")
+ ("lightgreen" . "144 238 144")))
+
+
+(define (%convert-color str)
+ (let ((col (assoc str *skribe-rgb-alist*)))
+ (cond
+ (col
+ (let* ((p (open-input-string (cdr col)))
+ (r (read p))
+ (g (read p))
+ (b (read p)))
+ (values r g b)))
+ ((and (string? str) (eq? (string-ref str 0) #\#) (= (string-length str) 7))
+ (values (string->number (substring str 1 3) 16)
+ (string->number (substring str 3 5) 16)
+ (string->number (substring str 5 7) 16)))
+ ((and (string? str) (eq? (string-ref str 0) #\#) (= (string-length str) 13))
+ (values (string->number (substring str 1 5) 16)
+ (string->number (substring str 5 9) 16)
+ (string->number (substring str 9 13) 16)))
+ (else
+ (values 0 0 0)))))
+
+;;;
+;;; SKRIBE-COLOR->RGB
+;;;
+(define (skribe-color->rgb spec)
+ (cond
+ ((string? spec) (%convert-color spec))
+ ((integer? spec)
+ (values (bit-and #xff (bit-shift spec -16))
+ (bit-and #xff (bit-shift spec -8))
+ (bit-and #xff spec)))
+ (else
+ (values 0 0 0))))
+
+;;;
+;;; SKRIBE-GET-USED-COLORS
+;;;
+(define (skribe-get-used-colors)
+ *used-colors*)
+
+;;;
+;;; SKRIBE-USE-COLOR!
+;;;
+(define (skribe-use-color! color)
+ (set! *used-colors* (cons color *used-colors*))
+ color)
+
+)
\ No newline at end of file
diff --git a/skribe/src/stklos/configure.stk b/skribe/src/stklos/configure.stk
new file mode 100644
index 0000000..ece7abc
--- /dev/null
+++ b/skribe/src/stklos/configure.stk
@@ -0,0 +1,90 @@
+;;;;
+;;;; configure.stk -- Skribe configuration options
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 10-Feb-2004 11:47 (eg)
+;;;; Last file update: 17-Feb-2004 09:43 (eg)
+;;;;
+
+(define-module SKRIBE-CONFIGURE-MODULE
+ (export skribe-configure skribe-enforce-configure)
+
+
+(define %skribe-conf
+ `((:release ,(skribe-release))
+ (:scheme ,(skribe-scheme))
+ (:url ,(skribe-url))
+ (:doc-dir ,(skribe-doc-dir))
+ (:ext-dir ,(skribe-ext-dir))
+ (:default-path ,(skribe-default-path))))
+
+;;;
+;;; SKRIBE-CONFIGURE
+;;;
+(define (skribe-configure . opt)
+ (let ((conf %skribe-conf))
+ (cond
+ ((null? opt)
+ conf)
+ ((null? (cdr opt))
+ (let ((cell (assq (car opt) conf)))
+ (if (pair? cell)
+ (cadr cell)
+ 'void)))
+ (else
+ (let loop ((opt opt))
+ (cond
+ ((null? opt)
+ #t)
+ ((not (keyword? (car opt)))
+ #f)
+ ((or (null? (cdr opt)) (keyword? (cadr opt)))
+ #f)
+ (else
+ (let ((cell (assq (car opt) conf)))
+ (if (and (pair? cell)
+ (if (procedure? (cadr opt))
+ ((cadr opt) (cadr cell))
+ (equal? (cadr opt) (cadr cell))))
+ (loop (cddr opt))
+ #f)))))))))
+;;;
+;;; SKRIBE-ENFORCE-CONFIGURE ...
+;;;
+(define (skribe-enforce-configure . opt)
+ (let loop ((o opt))
+ (when (pair? o)
+ (cond
+ ((or (not (keyword? (car o)))
+ (null? (cdr o)))
+ (skribe-error 'skribe-enforce-configure "Illegal enforcement" opt))
+ ((skribe-configure (car o) (cadr o))
+ (loop (cddr o)))
+ (else
+ (skribe-error 'skribe-enforce-configure
+ (format "Configuration mismatch: ~a" (car o))
+ (if (procedure? (cadr o))
+ (format "provided `~a'"
+ (skribe-configure (car o)))
+ (format "provided `~a', required `~a'"
+ (skribe-configure (car o))
+ (cadr o)))))))))
+)
\ No newline at end of file
diff --git a/skribe/src/stklos/debug.stk b/skribe/src/stklos/debug.stk
new file mode 100644
index 0000000..a9fefde
--- /dev/null
+++ b/skribe/src/stklos/debug.stk
@@ -0,0 +1,161 @@
+;;;;
+;;;; debug.stk -- Debug Facilities (stolen to Manuel Serrano)
+;;;;
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 10-Aug-2003 20:45 (eg)
+;;;; Last file update: 28-Oct-2004 13:16 (eg)
+;;;;
+
+
+(define-module SKRIBE-DEBUG-MODULE
+ (export debug-item skribe-debug set-skribe-debug! add-skribe-debug-symbol
+ no-debug-color)
+
+(define *skribe-debug* 0)
+(define *skribe-debug-symbols* '())
+(define *skribe-debug-color* #t)
+(define *skribe-debug-item* #f)
+(define *debug-port* (current-error-port))
+(define *debug-depth* 0)
+(define *debug-margin* "")
+(define *skribe-margin-debug-level* 0)
+
+
+(define (set-skribe-debug! val)
+ (set! *skribe-debug* val))
+
+(define (add-skribe-debug-symbol s)
+ (set! *skribe-debug-symbols* (cons s *skribe-debug-symbols*)))
+
+
+(define (no-debug-color)
+ (set! *skribe-debug-color* #f))
+
+(define (skribe-debug)
+ *skribe-debug*)
+
+;;
+;; debug-port
+;;
+; (define (debug-port . o)
+; (cond
+; ((null? o)
+; *debug-port*)
+; ((output-port? (car o))
+; (set! *debug-port* o)
+; o)
+; (else
+; (error 'debug-port "Illegal debug port" (car o)))))
+;
+
+;;;
+;;; debug-color
+;;;
+(define (debug-color col . o)
+ (with-output-to-string
+ (if (and *skribe-debug-color*
+ (equal? (getenv "TERM") "xterm")
+ (interactive-port? *debug-port*))
+ (lambda ()
+ (format #t "[0m[1;~Am" (+ 31 col))
+ (for-each display o)
+ (display "[0m"))
+ (lambda ()
+ (for-each display o)))))
+
+;;;
+;;; debug-bold
+;;;
+(define (debug-bold . o)
+ (apply debug-color -30 o))
+
+;;;
+;;; debug-item
+;;;
+(define (debug-item . args)
+ (when (or (>= *skribe-debug* *skribe-margin-debug-level*)
+ *skribe-debug-item*)
+ (display *debug-margin* *debug-port*)
+ (display (debug-color (- *debug-depth* 1) "- ") *debug-port*)
+ (for-each (lambda (a) (display a *debug-port*)) args)
+ (newline *debug-port*)))
+
+;;(define-macro (debug-item . args)
+;; `())
+
+;;;
+;;; %with-debug-margin
+;;;
+(define (%with-debug-margin margin thunk)
+ (let ((om *debug-margin*))
+ (set! *debug-depth* (+ *debug-depth* 1))
+ (set! *debug-margin* (string-append om margin))
+ (let ((res (thunk)))
+ (set! *debug-depth* (- *debug-depth* 1))
+ (set! *debug-margin* om)
+ res)))
+
+;;;
+;;; %with-debug
+;;
+(define (%with-debug lvl lbl thunk)
+ (let ((ol *skribe-margin-debug-level*)
+ (oi *skribe-debug-item*))
+ (set! *skribe-margin-debug-level* lvl)
+ (let ((r (if (or (and (number? lvl) (>= *skribe-debug* lvl))
+ (and (symbol? lbl)
+ (memq lbl *skribe-debug-symbols*)
+ (set! *skribe-debug-item* #t)))
+ (begin
+ (display *debug-margin* *debug-port*)
+ (display (if (= *debug-depth* 0)
+ (debug-color *debug-depth* "+ " lbl)
+ (debug-color *debug-depth* "--+ " lbl))
+ *debug-port*)
+ (newline *debug-port*)
+ (%with-debug-margin (debug-color *debug-depth* " |")
+ thunk))
+ (thunk))))
+ (set! *skribe-debug-item* oi)
+ (set! *skribe-margin-debug-level* ol)
+ r)))
+
+(define-macro (with-debug level label . body)
+ `((in-module SKRIBE-DEBUG-MODULE %with-debug) ,level ,label (lambda () ,@body)))
+
+;;(define-macro (with-debug level label . body)
+;; `(begin ,@body))
+
+)
+
+#|
+Example:
+
+(with-debug 0 'foo1.1
+ (debug-item 'foo2.1)
+ (debug-item 'foo2.2)
+ (with-debug 0 'foo2.3
+ (debug-item 'foo3.1)
+ (with-debug 0 'foo3.2
+ (debug-item 'foo4.1)
+ (debug-item 'foo4.2))
+ (debug-item 'foo3.3))
+ (debug-item 'foo2.4))
+|#
diff --git a/skribe/src/stklos/engine.stk b/skribe/src/stklos/engine.stk
new file mode 100644
index 0000000..a13ed0f
--- /dev/null
+++ b/skribe/src/stklos/engine.stk
@@ -0,0 +1,242 @@
+;;;;
+;;;; engines.stk -- Skribe Engines Stuff
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 24-Jul-2003 20:33 (eg)
+;;;; Last file update: 28-Oct-2004 21:21 (eg)
+;;;;
+
+(define-module SKRIBE-ENGINE-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-EVAL-MODULE)
+
+ (export default-engine default-engine-set!
+ make-engine copy-engine find-engine
+ engine-custom engine-custom-set!
+ engine-format? engine-add-writer!
+ processor-get-engine
+ push-default-engine pop-default-engine)
+)
+
+;;; Module definition is split here because this file is read by the documentation
+;;; Should be changed.
+(select-module SKRIBE-ENGINE-MODULE)
+
+(define *engines* '())
+(define *default-engine* #f)
+(define *default-engines* '())
+
+
+(define (default-engine)
+ *default-engine*)
+
+
+(define (default-engine-set! e)
+ (unless (engine? e)
+ (skribe-error 'default-engine-set! "bad engine ~S" e))
+ (set! *default-engine* e)
+ (set! *default-engines* (cons e *default-engines*))
+ e)
+
+
+(define (push-default-engine e)
+ (set! *default-engines* (cons e *default-engines*))
+ (default-engine-set! e))
+
+(define (pop-default-engine)
+ (if (null? *default-engines*)
+ (skribe-error 'pop-default-engine "Empty engine stack" '())
+ (begin
+ (set! *default-engines* (cdr *default-engines*))
+ (if (pair? *default-engines*)
+ (default-engine-set! (car *default-engines*))
+ (set! *default-engine* #f)))))
+
+
+(define (processor-get-engine combinator newe olde)
+ (cond
+ ((procedure? combinator)
+ (combinator newe olde))
+ ((engine? newe)
+ newe)
+ (else
+ olde)))
+
+
+(define (engine-format? fmt . e)
+ (let ((e (cond
+ ((pair? e) (car e))
+ ((engine? *skribe-engine*) *skribe-engine*)
+ (else (find-engine *skribe-engine*)))))
+ (if (not (engine? e))
+ (skribe-error 'engine-format? "No engine" e)
+ (string=? fmt (engine-format e)))))
+
+;;;
+;;; MAKE-ENGINE
+;;;
+(define (make-engine ident :key (version 'unspecified)
+ (format "raw")
+ (filter #f)
+ (delegate #f)
+ (symbol-table '())
+ (custom '())
+ (info '()))
+ (let ((e (make <engine> :ident ident :version version :format format
+ :filter filter :delegate delegate
+ :symbol-table symbol-table
+ :custom custom :info info)))
+ ;; store the engine in the global table
+ (set! *engines* (cons e *engines*))
+ ;; return it
+ e))
+
+
+;;;
+;;; COPY-ENGINE
+;;;
+(define (copy-engine ident e :key (version 'unspecified)
+ (filter #f)
+ (delegate #f)
+ (symbol-table #f)
+ (custom #f))
+ (let ((new (shallow-clone e)))
+ (slot-set! new 'ident ident)
+ (slot-set! new 'version version)
+ (slot-set! new 'filter (or filter (slot-ref e 'filter)))
+ (slot-set! new 'delegate (or delegate (slot-ref e 'delegate)))
+ (slot-set! new 'symbol-table (or symbol-table (slot-ref e 'symbol-table)))
+ (slot-set! new 'customs (or custom (slot-ref e 'customs)))
+
+ (set! *engines* (cons new *engines*))
+ new))
+
+
+;;;
+;;; FIND-ENGINE
+;;;
+(define (%find-loaded-engine id version)
+ (let Loop ((es *engines*))
+ (cond
+ ((null? es) #f)
+ ((eq? (slot-ref (car es) 'ident) id)
+ (cond
+ ((eq? version 'unspecified) (car es))
+ ((eq? version (slot-ref (car es) 'version)) (car es))
+ (else (Loop (cdr es)))))
+ (else (loop (cdr es))))))
+
+
+(define (find-engine id :key (version 'unspecified))
+ (with-debug 5 'find-engine
+ (debug-item "id=" id " version=" version)
+
+ (or (%find-loaded-engine id version)
+ (let ((c (assq id *skribe-auto-load-alist*)))
+ (debug-item "c=" c)
+ (if (and c (string? (cdr c)))
+ (begin
+ (skribe-load (cdr c) :engine 'base)
+ (%find-loaded-engine id version))
+ #f)))))
+
+;;;
+;;; ENGINE-CUSTOM
+;;;
+(define (engine-custom e id)
+ (let* ((customs (slot-ref e 'customs))
+ (c (assq id customs)))
+ (if (pair? c)
+ (cadr c)
+ 'unspecified)))
+
+
+;;;
+;;; ENGINE-CUSTOM-SET!
+;;;
+(define (engine-custom-set! e id val)
+ (let* ((customs (slot-ref e 'customs))
+ (c (assq id customs)))
+ (if (pair? c)
+ (set-car! (cdr c) val)
+ (slot-set! e 'customs (cons (list id val) customs)))))
+
+
+;;;
+;;; ENGINE-ADD-WRITER!
+;;;
+(define (engine-add-writer! e ident pred upred opt before action after class valid)
+ (define (check-procedure name proc arity)
+ (cond
+ ((not (procedure? proc))
+ (skribe-error ident "Illegal procedure" proc))
+ ((not (equal? (%procedure-arity proc) arity))
+ (skribe-error ident
+ (format #f "Illegal ~S procedure" name)
+ proc))))
+
+ (define (check-output name proc)
+ (and proc (or (string? proc) (check-procedure name proc 2))))
+
+ ;;
+ ;; Engine-add-writer! starts here
+ ;;
+ (unless (is-a? e <engine>)
+ (skribe-error ident "Illegal engine" e))
+
+ ;; check the options
+ (unless (or (eq? opt 'all) (list? opt))
+ (skribe-error ident "Illegal options" opt))
+
+ ;; check the correctness of the predicate
+ (check-procedure "predicate" pred 2)
+
+ ;; check the correctness of the validation proc
+ (when valid
+ (check-procedure "validate" valid 2))
+
+ ;; check the correctness of the three actions
+ (check-output "before" before)
+ (check-output "action" action)
+ (check-output "after" after)
+
+ ;; create a new writer and bind it
+ (let ((n (make <writer>
+ :ident (if (symbol? ident) ident 'all)
+ :class class :pred pred :upred upred :options opt
+ :before before :action action :after after
+ :validate valid)))
+ (slot-set! e 'writers (cons n (slot-ref e 'writers)))
+ n))
+
+;;;; ======================================================================
+;;;;
+;;;; I N I T S
+;;;;
+;;;; ======================================================================
+
+;; A base engine must pre-exist before anything is loaded. In
+;; particular, this dummy base engine is used to load the actual
+;; definition of base.
+
+(make-engine 'base :version 'bootstrap)
+
+
+(select-module STklos)
diff --git a/skribe/src/stklos/eval.stk b/skribe/src/stklos/eval.stk
new file mode 100644
index 0000000..3acace9
--- /dev/null
+++ b/skribe/src/stklos/eval.stk
@@ -0,0 +1,149 @@
+;;;;
+;;;; eval.stk -- Skribe Evaluator
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 27-Jul-2003 09:15 (eg)
+;;;; Last file update: 28-Oct-2004 15:05 (eg)
+;;;;
+
+
+;; FIXME; On peut impl�menter maintenant skribe-warning/node
+
+
+(define-module SKRIBE-EVAL-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-ENGINE-MODULE SKRIBE-VERIFY-MODULE
+ SKRIBE-RESOLVE-MODULE SKRIBE-OUTPUT-MODULE)
+ (export skribe-eval skribe-eval-port skribe-load skribe-load-options
+ skribe-include)
+
+
+(define *skribe-loaded* '()) ;; List of already loaded files
+(define *skribe-load-options* '())
+
+(define (%evaluate expr)
+ (with-handler
+ (lambda (c)
+ (flush-output-port (current-error-port))
+ (raise c))
+ (eval expr (find-module 'STklos))))
+
+;;;
+;;; SKRIBE-EVAL
+;;;
+(define (skribe-eval a e :key (env '()))
+ (with-debug 2 'skribe-eval
+ (debug-item "a=" a " e=" (engine-ident e))
+ (let ((a2 (resolve! a e env)))
+ (debug-item "resolved a=" a)
+ (let ((a3 (verify a2 e)))
+ (debug-item "verified a=" a3)
+ (output a3 e)))))
+
+;;;
+;;; SKRIBE-EVAL-PORT
+;;;
+(define (skribe-eval-port port engine :key (env '()))
+ (with-debug 2 'skribe-eval-port
+ (debug-item "engine=" engine)
+ (let ((e (if (symbol? engine) (find-engine engine) engine)))
+ (debug-item "e=" e)
+ (if (not (is-a? e <engine>))
+ (skribe-error 'skribe-eval-port "Cannot find engine" engine)
+ (let loop ((exp (read port)))
+ (with-debug 10 'skribe-eval-port
+ (debug-item "exp=" exp))
+ (unless (eof-object? exp)
+ (skribe-eval (%evaluate exp) e :env env)
+ (loop (read port))))))))
+
+;;;
+;;; SKRIBE-LOAD
+;;;
+(define *skribe-load-options* '())
+
+(define (skribe-load-options)
+ *skribe-load-options*)
+
+(define (skribe-load file :rest opt :key engine path)
+ (with-debug 4 'skribe-load
+ (debug-item " engine=" engine)
+ (debug-item " path=" path)
+ (debug-item " opt" opt)
+
+ (let* ((ei (cond
+ ((not engine) *skribe-engine*)
+ ((engine? engine) engine)
+ ((not (symbol? engine)) (skribe-error 'skribe-load
+ "Illegal engine" engine))
+ (else engine)))
+ (path (cond
+ ((not path) (skribe-path))
+ ((string? path) (list path))
+ ((not (and (list? path) (every? string? path)))
+ (skribe-error 'skribe-load "Illegal path" path))
+ (else path)))
+ (filep (find-path file path)))
+
+ (set! *skribe-load-options* opt)
+
+ (unless (and (string? filep) (file-exists? filep))
+ (skribe-error 'skribe-load
+ (format "Cannot find ~S in path" file)
+ *skribe-path*))
+
+ ;; Load this file if not already done
+ (unless (member filep *skribe-loaded*)
+ (cond
+ ((> *skribe-verbose* 1)
+ (format (current-error-port) " [loading file: ~S ~S]\n" filep opt))
+ ((> *skribe-verbose* 0)
+ (format (current-error-port) " [loading file: ~S]\n" filep)))
+ ;; Load it
+ (with-input-from-file filep
+ (lambda ()
+ (skribe-eval-port (current-input-port) ei)))
+ (set! *skribe-loaded* (cons filep *skribe-loaded*))))))
+
+;;;
+;;; SKRIBE-INCLUDE
+;;;
+(define (skribe-include file :optional (path (skribe-path)))
+ (unless (every string? path)
+ (skribe-error 'skribe-include "Illegal path" path))
+
+ (let ((path (find-path file path)))
+ (unless (and (string? path) (file-exists? path))
+ (skribe-error 'skribe-load
+ (format "Cannot find ~S in path" file)
+ path))
+ (when (> *skribe-verbose* 0)
+ (format (current-error-port) " [including file: ~S]\n" path))
+ (with-input-from-file path
+ (lambda ()
+ (let Loop ((exp (read (current-input-port)))
+ (res '()))
+ (if (eof-object? exp)
+ (if (and (pair? res) (null? (cdr res)))
+ (car res)
+ (reverse! res))
+ (Loop (read (current-input-port))
+ (cons (%evaluate exp) res))))))))
+)
\ No newline at end of file
diff --git a/skribe/src/stklos/lib.stk b/skribe/src/stklos/lib.stk
new file mode 100644
index 0000000..3c3b9f0
--- /dev/null
+++ b/skribe/src/stklos/lib.stk
@@ -0,0 +1,317 @@
+;;;;
+;;;; lib.stk -- Utilities
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 11-Aug-2003 20:29 (eg)
+;;;; Last file update: 27-Oct-2004 12:41 (eg)
+;;;;
+
+;;;
+;;; NEW
+;;;
+(define (maybe-copy obj)
+ (if (pair-mutable? obj)
+ obj
+ (copy-tree obj)))
+
+(define-macro (new class . parameters)
+ `(make ,(string->symbol (format "<~a>" class))
+ ,@(apply append (map (lambda (x)
+ `(,(make-keyword (car x)) (maybe-copy ,(cadr x))))
+ parameters))))
+
+;;;
+;;; DEFINE-MARKUP
+;;;
+(define-macro (define-markup bindings . body)
+ ;; This is just a STklos extended lambda. Nothing to do
+ `(define ,bindings ,@body))
+
+
+;;;
+;;; DEFINE-SIMPLE-MARKUP
+;;;
+(define-macro (define-simple-markup markup)
+ `(define-markup (,markup :rest opts :key ident class loc)
+ (new markup
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+
+;;;
+;;; DEFINE-SIMPLE-CONTAINER
+;;;
+(define-macro (define-simple-container markup)
+ `(define-markup (,markup :rest opts :key ident class loc)
+ (new container
+ (markup ',markup)
+ (ident (or ident (symbol->string (gensym ',markup))))
+ (loc loc)
+ (class class)
+ (required-options '())
+ (options (the-options opts :ident :class :loc))
+ (body (the-body opts)))))
+
+
+;;;
+;;; DEFINE-PROCESSOR-MARKUP
+;;;
+(define-macro (define-processor-markup proc)
+ `(define-markup (,proc #!rest opts)
+ (new processor
+ (engine (find-engine ',proc))
+ (body (the-body opts))
+ (options (the-options opts)))))
+
+
+;;;
+;;; SKRIBE-EVAL-LOCATION ...
+;;;
+(define (skribe-eval-location)
+ (format (current-error-port)
+ "FIXME: ...... SKRIBE-EVAL-LOCATION (should not appear)\n")
+ #f)
+
+;;;
+;;; SKRIBE-ERROR
+;;;
+(define (skribe-ast-error proc msg obj)
+ (let ((l (ast-loc obj))
+ (shape (if (markup? obj) (markup-markup obj) obj)))
+ (if (location? l)
+ (error "~a:~a: ~a: ~a ~s" (location-file l) (location-pos l) proc msg shape)
+ (error "~a: ~a ~s " proc msg shape))))
+
+(define (skribe-error proc msg obj)
+ (if (ast? obj)
+ (skribe-ast-error proc msg obj)
+ (error proc msg obj)))
+
+
+;;;
+;;; SKRIBE-TYPE-ERROR
+;;;
+(define (skribe-type-error proc msg obj etype)
+ (skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f))
+
+
+
+;;; FIXME: Peut-�tre vir�e maintenant
+(define (skribe-line-error file line proc msg obj)
+ (error (format "%a:%a: ~a:~a ~S" file line proc msg obj)))
+
+
+;;;
+;;; SKRIBE-WARNING & SKRIBE-WARNING/AST
+;;;
+(define (%skribe-warn level file line lst)
+ (let ((port (current-error-port)))
+ (format port "**** WARNING:\n")
+ (when (and file line) (format port "~a: ~a: " file line))
+ (for-each (lambda (x) (format port "~a " x)) lst)
+ (newline port)))
+
+
+(define (skribe-warning level . obj)
+ (if (>= *skribe-warning* level)
+ (%skribe-warn level #f #f obj)))
+
+
+(define (skribe-warning/ast level ast . obj)
+ (if (>= *skribe-warning* level)
+ (let ((l (ast-loc ast)))
+ (if (location? l)
+ (%skribe-warn level (location-file l) (location-pos l) obj)
+ (%skribe-warn level #f #f obj)))))
+
+;;;
+;;; SKRIBE-MESSAGE
+;;;
+(define (skribe-message fmt . obj)
+ (when (> *skribe-verbose* 0)
+ (apply format (current-error-port) fmt obj)))
+
+;;;
+;;; FILE-PREFIX / FILE-SUFFIX
+;;;
+(define (file-prefix fn)
+ (if fn
+ (let ((match (regexp-match "(.*)\\.([^/]*$)" fn)))
+ (if match
+ (cadr match)
+ fn))
+ "./SKRIBE-OUTPUT"))
+
+(define (file-suffix s)
+ ;; Not completely correct, but sufficient here
+ (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2"))
+ (split (string-split basename ".")))
+ (if (> (length split) 1)
+ (car (reverse! split))
+ "")))
+
+
+;;;
+;;; KEY-GET
+;;;
+;;; We need to redefine the standard key-get to be more permissive. In
+;;; STklos key-get accepts a list which is formed only of keywords. In
+;;; Skribe, parameter lists are of the form
+;;; (:title "..." :option "...." body1 body2 body3)
+;;; So is we find an element which is not a keyword, we skip it (unless it
+;;; follows a keyword of course). Since the compiler of extended lambda
+;;; uses the function key-get, it will now accept Skribe markups
+(define (key-get lst key :optional (default #f default?))
+ (define (not-found)
+ (if default?
+ default
+ (error 'key-get "value ~S not found in list ~S" key lst)))
+ (let Loop ((l lst))
+ (cond
+ ((null? l)
+ (not-found))
+ ((not (pair? l))
+ (error 'key-get "bad list ~S" lst))
+ ((keyword? (car l))
+ (if (null? (cdr l))
+ (error 'key-get "bad keyword list ~S" lst)
+ (if (eq? (car l) key)
+ (cadr l)
+ (Loop (cddr l)))))
+ (else
+ (Loop (cdr l))))))
+
+
+;;;
+;;; UNSPECIFIED?
+;;;
+(define (unspecified? obj)
+ (eq? obj 'unspecified))
+
+;;;; ======================================================================
+;;;;
+;;;; A C C E S S O R S
+;;;;
+;;;; ======================================================================
+
+;; SKRIBE-PATH
+(define (skribe-path) *skribe-path*)
+
+(define (skribe-path-set! path)
+ (if (not (and (list? path) (every string? path)))
+ (skribe-error 'skribe-path-set! "Illegal path" path)
+ (set! *skribe-path* path)))
+
+;; SKRIBE-IMAGE-PATH
+(define (skribe-image-path) *skribe-image-path*)
+
+(define (skribe-image-path-set! path)
+ (if (not (and (list? path) (every string? path)))
+ (skribe-error 'skribe-image-path-set! "Illegal path" path)
+ (set! *skribe-image-path* path)))
+
+;; SKRIBE-BIB-PATH
+(define (skribe-bib-path) *skribe-bib-path*)
+
+(define (skribe-bib-path-set! path)
+ (if (not (and (list? path) (every string? path)))
+ (skribe-error 'skribe-bib-path-set! "Illegal path" path)
+ (set! *skribe-bib-path* path)))
+
+;; SKRBE-SOURCE-PATH
+(define (skribe-source-path) *skribe-source-path*)
+
+(define (skribe-source-path-set! path)
+ (if (not (and (list? path) (every string? path)))
+ (skribe-error 'skribe-source-path-set! "Illegal path" path)
+ (set! *skribe-source-path* path)))
+
+;;;; ======================================================================
+;;;;
+;;;; Compatibility with Bigloo
+;;;;
+;;;; ======================================================================
+
+(define (substring=? s1 s2 len)
+ (let ((l1 (string-length s1))
+ (l2 (string-length s2)))
+ (let Loop ((i 0))
+ (cond
+ ((= i len) #t)
+ ((= i l1) #f)
+ ((= i l2) #f)
+ ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1)))
+ (else #f)))))
+
+(define (directory->list str)
+ (map basename (glob (string-append str "/*") (string-append "/.*"))))
+
+(define-macro (printf . args) `(format #t ,@args))
+(define fprintf format)
+
+(define (symbol-append . l)
+ (string->symbol (apply string-append (map symbol->string l))))
+
+
+(define (make-list n . fill)
+ (let ((fill (if (null? fill) (void) (car fill))))
+ (let Loop ((i n) (res '()))
+ (if (zero? i)
+ res
+ (Loop (- i 1) (cons fill res))))))
+
+
+(define string-capitalize string-titlecase)
+(define prefix file-prefix)
+(define suffix file-suffix)
+(define system->string exec)
+(define any? any)
+(define every? every)
+(define cons* list*)
+(define find-file/path find-path)
+(define process-input-port process-input)
+(define process-output-port process-output)
+(define process-error-port process-error)
+
+;;;
+;;; h a s h t a b l e s
+;;;
+(define make-hashtable (lambda () (make-hash-table equal?)))
+(define hashtable? hash-table?)
+(define hashtable-get (lambda (h k) (hash-table-get h k #f)))
+(define hashtable-put! hash-table-put!)
+(define hashtable-update! hash-table-update!)
+(define hashtable->list (lambda (h)
+ (map cdr (hash-table->list h))))
+
+(define find-runtime-type (lambda (obj) obj))
+
+(define-macro (unwind-protect expr1 expr2)
+ ;; This is no completely correct.
+ `(dynamic-wind
+ (lambda () #f)
+ (lambda () ,expr1)
+ (lambda () ,expr2)))
diff --git a/skribe/src/stklos/lisp-lex.l b/skribe/src/stklos/lisp-lex.l
new file mode 100644
index 0000000..efad24b
--- /dev/null
+++ b/skribe/src/stklos/lisp-lex.l
@@ -0,0 +1,91 @@
+;;;; -*- Scheme -*-
+;;;;
+;;;; lisp-lex.l -- SILex input for the Lisp Languages
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 21-Dec-2003 17:19 (eg)
+;;;; Last file update: 5-Jan-2004 18:24 (eg)
+;;;;
+
+space [ \n\9]
+letter [#?!_:a-zA-Z\-]
+digit [0-9]
+
+
+%%
+;; Strings
+\"[^\"]*\" (new markup
+ (markup '&source-string)
+ (body yytext))
+
+;;Comment
+\;.* (new markup
+ (markup '&source-line-comment)
+ (body yytext))
+
+;; Skribe text (i.e. [....])
+\[|\] (if *bracket-highlight*
+ (new markup
+ (markup '&source-bracket)
+ (body yytext))
+ yytext)
+;; Spaces & parenthesis
+[ \n\9\(\)]+ (begin
+ yytext)
+
+;; Identifier (real syntax is slightly more complicated but we are
+;; interested here in the identifiers that we will fontify)
+[^\;\"\[\] \n\9\(\)]+ (let ((c (string-ref yytext 0)))
+ (cond
+ ((or (char=? c #\:)
+ (char=? (string-ref yytext
+ (- (string-length yytext) 1))
+ #\:))
+ ;; Scheme keyword
+ (new markup
+ (markup '&source-type)
+ (body yytext)))
+ ((char=? c #\<)
+ ;; STklos class
+ (let* ((len (string-length yytext))
+ (c (string-ref yytext (- len 1))))
+ (if (char=? c #\>)
+ (if *class-highlight*
+ (new markup
+ (markup '&source-module)
+ (body yytext))
+ yytext) ; no
+ yytext))) ; no
+ (else
+ (let ((tmp (assoc (string->symbol yytext)
+ *the-keys*)))
+ (if tmp
+ (new markup
+ (markup (cdr tmp))
+ (body yytext))
+ yytext)))))
+
+
+<<EOF>> 'eof
+<<ERROR>> (skribe-error 'lisp-fontifier "Parse error" yytext)
+
+
+; LocalWords: fontify
diff --git a/skribe/src/stklos/lisp.stk b/skribe/src/stklos/lisp.stk
new file mode 100644
index 0000000..9bfe75a
--- /dev/null
+++ b/skribe/src/stklos/lisp.stk
@@ -0,0 +1,294 @@
+;;;;
+;;;; lisp.stk -- Lisp Family Fontification
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 16-Oct-2003 22:17 (eg)
+;;;; Last file update: 28-Oct-2004 21:14 (eg)
+;;;;
+
+(require "lex-rt") ;; to avoid module problems
+
+(define-module SKRIBE-LISP-MODULE
+ (export skribe scheme stklos bigloo lisp)
+ (import SKRIBE-SOURCE-MODULE)
+
+(include "lisp-lex.stk") ;; SILex generated
+
+(define *bracket-highlight* #f)
+(define *class-highlight* #f)
+(define *the-keys* #f)
+
+(define *lisp-keys* #f)
+(define *scheme-keys* #f)
+(define *skribe-keys* #f)
+(define *stklos-keys* #f)
+(define *lisp-keys* #f)
+
+
+;;;
+;;; DEFINITION-SEARCH
+;;;
+(define (definition-search inp tab test)
+ (let Loop ((exp (%read inp)))
+ (unless (eof-object? exp)
+ (if (test exp)
+ (let ((start (and (%epair? exp) (%epair-line exp)))
+ (stop (port-current-line inp)))
+ (source-read-lines (port-file-name inp) start stop tab))
+ (Loop (%read inp))))))
+
+
+(define (lisp-family-fontifier s)
+ (let ((lex (lisp-lex (open-input-string s))))
+ (let Loop ((token (lexer-next-token lex))
+ (res '()))
+ (if (eq? token 'eof)
+ (reverse! res)
+ (Loop (lexer-next-token lex)
+ (cons token res))))))
+
+;;;; ======================================================================
+;;;;
+;;;; LISP
+;;;;
+;;;; ======================================================================
+(define (lisp-extractor iport def tab)
+ (definition-search
+ iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or defun defmacro) ?fun ?- . ?-)
+ (and (eq? def fun) exp))
+ ((defvar ?var . ?-)
+ (and (eq? var def) exp))
+ (else
+ #f)))))
+
+(define (init-lisp-keys)
+ (unless *lisp-keys*
+ (set! *lisp-keys*
+ (append ;; key
+ (map (lambda (x) (cons x '&source-keyword))
+ '(setq if let let* letrec cond case else progn lambda))
+ ;; define
+ (map (lambda (x) (cons x '&source-define))
+ '(defun defclass defmacro)))))
+ *lisp-keys*)
+
+(define (lisp-fontifier s)
+ (fluid-let ((*the-keys* (init-lisp-keys))
+ (*bracket-highlight* #f)
+ (*class-highlight* #f))
+ (lisp-family-fontifier s)))
+
+
+(define lisp
+ (new language
+ (name "lisp")
+ (fontifier lisp-fontifier)
+ (extractor lisp-extractor)))
+
+;;;; ======================================================================
+;;;;
+;;;; SCHEME
+;;;;
+;;;; ======================================================================
+(define (scheme-extractor iport def tab)
+ (definition-search
+ iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-macro) (?fun . ?-) . ?-)
+ (and (eq? def fun) exp))
+ ((define (and (? symbol?) ?var) . ?-)
+ (and (eq? var def) exp))
+ (else
+ #f)))))
+
+
+(define (init-scheme-keys)
+ (unless *scheme-keys*
+ (set! *scheme-keys*
+ (append ;; key
+ (map (lambda (x) (cons x '&source-keyword))
+ '(set! if let let* letrec quote cond case else begin do lambda))
+ ;; define
+ (map (lambda (x) (cons x '&source-define))
+ '(define define-syntax)))))
+ *scheme-keys*)
+
+
+(define (scheme-fontifier s)
+ (fluid-let ((*the-keys* (init-scheme-keys))
+ (*bracket-highlight* #f)
+ (*class-highlight* #f))
+ (lisp-family-fontifier s)))
+
+
+(define scheme
+ (new language
+ (name "scheme")
+ (fontifier scheme-fontifier)
+ (extractor scheme-extractor)))
+
+;;;; ======================================================================
+;;;;
+;;;; STKLOS
+;;;;
+;;;; ======================================================================
+(define (stklos-extractor iport def tab)
+ (definition-search
+ iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-generic define-method define-macro)
+ (?fun . ?-) . ?-)
+ (and (eq? def fun) exp))
+ (((or define define-module) (and (? symbol?) ?var) . ?-)
+ (and (eq? var def) exp))
+ (else
+ #f)))))
+
+
+(define (init-stklos-keys)
+ (unless *stklos-keys*
+ (init-scheme-keys)
+ (set! *stklos-keys* (append *scheme-keys*
+ ;; Markups
+ (map (lambda (x) (cons x '&source-key))
+ '(select-module import export))
+ ;; Key
+ (map (lambda (x) (cons x '&source-keyword))
+ '(case-lambda dotimes match-case match-lambda))
+ ;; Define
+ (map (lambda (x) (cons x '&source-define))
+ '(define-generic define-class
+ define-macro define-method define-module))
+ ;; error
+ (map (lambda (x) (cons x '&source-error))
+ '(error call/cc)))))
+ *stklos-keys*)
+
+
+(define (stklos-fontifier s)
+ (fluid-let ((*the-keys* (init-stklos-keys))
+ (*bracket-highlight* #t)
+ (*class-highlight* #t))
+ (lisp-family-fontifier s)))
+
+
+(define stklos
+ (new language
+ (name "stklos")
+ (fontifier stklos-fontifier)
+ (extractor stklos-extractor)))
+
+;;;; ======================================================================
+;;;;
+;;;; SKRIBE
+;;;;
+;;;; ======================================================================
+(define (skribe-extractor iport def tab)
+ (definition-search
+ iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-macro define-markup) (?fun . ?-) . ?-)
+ (and (eq? def fun) exp))
+ ((define (and (? symbol?) ?var) . ?-)
+ (and (eq? var def) exp))
+ ((markup-output (quote ?mk) . ?-)
+ (and (eq? mk def) exp))
+ (else
+ #f)))))
+
+
+(define (init-skribe-keys)
+ (unless *skribe-keys*
+ (init-stklos-keys)
+ (set! *skribe-keys* (append *stklos-keys*
+ ;; Markups
+ (map (lambda (x) (cons x '&source-markup))
+ '(bold it emph tt color ref index underline
+ roman figure center pre flush hrule
+ linebreak image kbd code var samp
+ sc sf sup sub
+ itemize description enumerate item
+ table tr td th item prgm author
+ prgm hook font
+ document chapter section subsection
+ subsubsection paragraph p handle resolve
+ processor abstract margin toc
+ table-of-contents current-document
+ current-chapter current-section
+ document-sections* section-number
+ footnote print-index include skribe-load
+ slide))
+ ;; Define
+ (map (lambda (x) (cons x '&source-define))
+ '(define-markup)))))
+ *skribe-keys*)
+
+
+(define (skribe-fontifier s)
+ (fluid-let ((*the-keys* (init-skribe-keys))
+ (*bracket-highlight* #t)
+ (*class-highlight* #t))
+ (lisp-family-fontifier s)))
+
+
+(define skribe
+ (new language
+ (name "skribe")
+ (fontifier skribe-fontifier)
+ (extractor skribe-extractor)))
+
+;;;; ======================================================================
+;;;;
+;;;; BIGLOO
+;;;;
+;;;; ======================================================================
+(define (bigloo-extractor iport def tab)
+ (definition-search
+ iport
+ tab
+ (lambda (exp)
+ (match-case exp
+ (((or define define-inline define-generic
+ define-method define-macro define-expander)
+ (?fun . ?-) . ?-)
+ (and (eq? def fun) exp))
+ (((or define define-struct define-library) (and (? symbol?) ?var) . ?-)
+ (and (eq? var def) exp))
+ (else
+ #f)))))
+
+(define bigloo
+ (new language
+ (name "bigloo")
+ (fontifier scheme-fontifier)
+ (extractor bigloo-extractor)))
+
+)
diff --git a/skribe/src/stklos/main.stk b/skribe/src/stklos/main.stk
new file mode 100644
index 0000000..4905423
--- /dev/null
+++ b/skribe/src/stklos/main.stk
@@ -0,0 +1,264 @@
+;;;;
+;;;; skribe.stk -- Skribe Main
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 24-Jul-2003 20:33 (eg)
+;;;; Last file update: 6-Mar-2004 16:13 (eg)
+;;;;
+
+;; FIXME: These are horrible hacks
+;(DESCRIBE 1 (current-error-port)) ; to make compiler happy
+(set! *compiler-options* '()) ;HORREUR pour �viter les warnings du compilo
+
+
+(include "../common/configure.scm")
+(include "../common/param.scm")
+
+(include "vars.stk")
+(include "reader.stk")
+(include "configure.stk")
+(include "types.stk")
+(include "debug.stk")
+(include "lib.stk")
+(include "../common/lib.scm")
+(include "resolve.stk")
+(include "writer.stk")
+(include "verify.stk")
+(include "output.stk")
+(include "prog.stk")
+(include "eval.stk")
+(include "runtime.stk")
+(include "engine.stk")
+(include "biblio.stk")
+(include "source.stk")
+(include "lisp.stk")
+(include "xml.stk")
+(include "c.stk")
+(include "color.stk")
+(include "../common/sui.scm")
+
+(import SKRIBE-EVAL-MODULE
+ SKRIBE-CONFIGURE-MODULE
+ SKRIBE-RUNTIME-MODULE
+ SKRIBE-ENGINE-MODULE
+ SKRIBE-EVAL-MODULE
+ SKRIBE-WRITER-MODULE
+ SKRIBE-VERIFY-MODULE
+ SKRIBE-OUTPUT-MODULE
+ SKRIBE-BIBLIO-MODULE
+ SKRIBE-PROG-MODULE
+ SKRIBE-RESOLVE-MODULE
+ SKRIBE-SOURCE-MODULE
+ SKRIBE-LISP-MODULE
+ SKRIBE-XML-MODULE
+ SKRIBE-C-MODULE
+ SKRIBE-DEBUG-MODULE
+ SKRIBE-COLOR-MODULE)
+
+(include "../common/index.scm")
+(include "../common/api.scm")
+
+
+;;; KLUDGE for allowing redefinition of Skribe INCLUDE
+(remove-expander! 'include)
+
+
+;;;; ======================================================================
+;;;;
+;;;; P A R S E - A R G S
+;;;;
+;;;; ======================================================================
+(define (parse-args args)
+
+ (define (version)
+ (format #t "skribe v~A\n" (skribe-release)))
+
+ (define (query)
+ (version)
+ (for-each (lambda (x)
+ (let ((s (keyword->string (car x))))
+ (printf " ~a: ~a\n" s (cadr x))))
+ (skribe-configure)))
+
+ ;;
+ ;; parse-args starts here
+ ;;
+ (let ((paths '())
+ (engine #f))
+ (parse-arguments args
+ "Usage: skribe [options] [input]"
+ "General options:"
+ (("target" :alternate "t" :arg target
+ :help "sets the output format to <target>")
+ (set! engine (string->symbol target)))
+ (("I" :arg path :help "adds <path> to Skribe path")
+ (set! paths (cons path paths)))
+ (("B" :arg path :help "adds <path> to bibliography path")
+ (skribe-bib-path-set! (cons path (skribe-bib-path))))
+ (("S" :arg path :help "adds <path> to source path")
+ (skribe-source-path-set! (cons path (skribe-source-path))))
+ (("P" :arg path :help "adds <path> to image path")
+ (skribe-image-path-set! (cons path (skribe-image-path))))
+ (("split-chapters" :alternate "C" :arg chapter
+ :help "emit chapter's sections in separate files")
+ (set! *skribe-chapter-split* (cons chapter *skribe-chapter-split*)))
+ (("preload" :arg file :help "preload <file>")
+ (set! *skribe-preload* (cons file *skribe-preload*)))
+ (("use-variant" :alternate "u" :arg variant
+ :help "use <variant> output format")
+ (set! *skribe-variants* (cons variant *skribe-variants*)))
+ (("base" :alternate "b" :arg base
+ :help "base prefix to remove from hyperlinks")
+ (set! *skribe-ref-base* base))
+ (("rc-dir" :arg dir :alternate "d" :help "set the RC directory to <dir>")
+ (set! *skribe-rc-directory* dir))
+
+ "File options:"
+ (("no-init-file" :help "Dont load rc Skribe file")
+ (set! *load-rc* #f))
+ (("output" :alternate "o" :arg file :help "set the output to <file>")
+ (set! *skribe-dest* file)
+ (let* ((s (file-suffix file))
+ (c (assoc s *skribe-auto-mode-alist*)))
+ (when (and (pair? c) (symbol? (cdr c)))
+ (set! *skribe-engine* (cdr c)))))
+
+ "Misc:"
+ (("help" :alternate "h" :help "provides help for the command")
+ (arg-usage (current-error-port))
+ (exit 0))
+ (("options" :help "display the skribe options and exit")
+ (arg-usage (current-output-port) #t)
+ (exit 0))
+ (("version" :alternate "V" :help "displays the version of Skribe")
+ (version)
+ (exit 0))
+ (("query" :alternate "q"
+ :help "displays informations about Skribe conf.")
+ (query)
+ (exit 0))
+ (("verbose" :alternate "v" :arg level
+ :help "sets the verbosity to <level>. Use -v0 for crystal silence")
+ (let ((val (string->number level)))
+ (when (integer? val)
+ (set! *skribe-verbose* val))))
+ (("warning" :alternate "w" :arg level
+ :help "sets the verbosity to <level>. Use -w0 for crystal silence")
+ (let ((val (string->number level)))
+ (when (integer? val)
+ (set! *skribe-warning* val))))
+ (("debug" :alternate "g" :arg level :help "sets the debug <level>")
+ (let ((val (string->number level)))
+ (if (integer? val)
+ (set-skribe-debug! val)
+ (begin
+ ;; Use the symbol for debug
+ (set-skribe-debug! 1)
+ (add-skribe-debug-symbol (string->symbol level))))))
+ (("no-color" :help "disable coloring for output")
+ (no-debug-color))
+ (("custom" :alternate "c" :arg key=val :help "Preset custom value")
+ (let ((args (string-split key=val "=")))
+ (if (and (list args) (= (length args) 2))
+ (let ((key (car args))
+ (val (cadr args)))
+ (set! *skribe-precustom* (cons (cons (string->symbol key) val)
+ *skribe-precustom*)))
+ (error 'parse-arguments "Bad custom ~S" key=val))))
+ (("eval" :alternate "e" :arg expr :help "evaluate expression <expr>")
+ (with-input-from-string expr
+ (lambda () (eval (read)))))
+ (else
+ (set! *skribe-src* other-arguments)))
+
+ ;; we have to configure Skribe path according to the environment variable
+ (skribe-path-set! (append (let ((path (getenv "SKRIBEPATH")))
+ (if path
+ (string-split path ":")
+ '()))
+ (reverse! paths)
+ (skribe-default-path)))
+ ;; Final initializations
+ (when engine
+ (set! *skribe-engine* engine))))
+
+;;;; ======================================================================
+;;;;
+;;;; L O A D - R C
+;;;;
+;;;; ======================================================================
+(define (load-rc)
+ (when *load-rc*
+ (let ((file (make-path *skribe-rc-directory* *skribe-rc-file*)))
+ (when (and file (file-exists? file))
+ (load file)))))
+
+
+
+;;;; ======================================================================
+;;;;
+;;;; S K R I B E
+;;;;
+;;;; ======================================================================
+(define (doskribe)
+ (let ((e (find-engine *skribe-engine*)))
+ (if (and (engine? e) (pair? *skribe-precustom*))
+ (for-each (lambda (cv)
+ (engine-custom-set! e (car cv) (cdr cv)))
+ *skribe-precustom*))
+ (if (pair? *skribe-src*)
+ (for-each (lambda (f) (skribe-load f :engine *skribe-engine*))
+ *skribe-src*)
+ (skribe-eval-port (current-input-port) *skribe-engine*))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; M A I N
+;;;;
+;;;; ======================================================================
+(define (main args)
+ ;; Load the user rc file
+ (load-rc)
+
+ ;; Parse command line
+ (parse-args args)
+
+ ;; Load the base file to bootstrap the system as well as the files
+ ;; that are in the *skribe-preload* variable
+ (skribe-load "base.skr" :engine 'base)
+ (for-each (lambda (f) (skribe-load f :engine *skribe-engine*)) *skribe-preload*)
+
+ ;; Load the specified variants
+ (for-each (lambda (x) (skribe-load (format "~a.skr" x) :engine *skribe-engine*))
+ (reverse! *skribe-variants*))
+
+;; (if (string? *skribe-dest*)
+;; (with-handler (lambda (kind loc msg)
+;; (remove-file *skribe-dest*)
+;; (error loc msg))
+;; (with-output-to-file *skribe-dest* doskribe))
+;; (doskribe))
+(if (string? *skribe-dest*)
+ (with-output-to-file *skribe-dest* doskribe)
+ (doskribe))
+
+ 0)
diff --git a/skribe/src/stklos/output.stk b/skribe/src/stklos/output.stk
new file mode 100644
index 0000000..3c00323
--- /dev/null
+++ b/skribe/src/stklos/output.stk
@@ -0,0 +1,158 @@
+;;;;
+;;;; output.stk -- Skribe Output Stage
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 13-Aug-2003 18:42 (eg)
+;;;; Last file update: 5-Mar-2004 10:32 (eg)
+;;;;
+
+(define-module SKRIBE-OUTPUT-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-ENGINE-MODULE SKRIBE-WRITER-MODULE)
+ (export output)
+
+
+(define-generic out)
+
+(define (%out/writer n e w)
+ (with-debug 5 'out/writer
+ (debug-item "n=" n " " (if (markup? n) (markup-markup n) ""))
+ (debug-item "e=" (engine-ident e))
+ (debug-item "w=" (writer-ident w))
+
+ (when (writer? w)
+ (invoke (slot-ref w 'before) n e)
+ (invoke (slot-ref w 'action) n e)
+ (invoke (slot-ref w 'after) n e))))
+
+
+
+(define (output node e . writer)
+ (with-debug 3 'output
+ (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
+ (debug-item "writer=" writer)
+ (if (null? writer)
+ (out node e)
+ (cond
+ ((is-a? (car writer) <writer>)
+ (%out/writer node e (car writer)))
+ ((not (car writer))
+ (skribe-error 'output
+ (format "Illegal ~A user writer" (engine-ident e))
+ (if (markup? node) (markup-markup node) node)))
+ (else
+ (skribe-error 'output "Illegal user writer" (car writer)))))))
+
+
+;;;
+;;; OUT implementations
+;;;
+(define-method out (node e)
+ #f)
+
+
+(define-method out ((node <pair>) e)
+ (let Loop ((n* node))
+ (cond
+ ((pair? n*)
+ (out (car n*) e)
+ (loop (cdr n*)))
+ ((not (null? n*))
+ (skribe-error 'out "Illegal argument" n*)))))
+
+
+(define-method out ((node <string>) e)
+ (let ((f (slot-ref e 'filter)))
+ (if (procedure? f)
+ (display (f node))
+ (display node))))
+
+
+(define-method out ((node <number>) e)
+ (out (number->string node) e))
+
+
+(define-method out ((n <processor>) e)
+ (let ((combinator (slot-ref n 'combinator))
+ (engine (slot-ref n 'engine))
+ (body (slot-ref n 'body))
+ (procedure (slot-ref n 'procedure)))
+ (let ((newe (processor-get-engine combinator engine e)))
+ (out (procedure body newe) newe))))
+
+
+(define-method out ((n <command>) e)
+ (let* ((fmt (slot-ref n 'fmt))
+ (body (slot-ref n 'body))
+ (lb (length body))
+ (lf (string-length fmt)))
+ (define (loops i n)
+ (if (= i lf)
+ (begin
+ (if (> n 0)
+ (if (<= n lb)
+ (output (list-ref body (- n 1)) e)
+ (skribe-error '! "Too few arguments provided" n)))
+ lf)
+ (let ((c (string-ref fmt i)))
+ (cond
+ ((char=? c #\$)
+ (display "$")
+ (+ 1 i))
+ ((not (char-numeric? c))
+ (cond
+ ((= n 0)
+ i)
+ ((<= n lb)
+ (output (list-ref body (- n 1)) e)
+ i)
+ (else
+ (skribe-error '! "Too few arguments provided" n))))
+ (else
+ (loops (+ i 1)
+ (+ (- (char->integer c)
+ (char->integer #\0))
+ (* 10 n))))))))
+
+ (let loop ((i 0))
+ (cond
+ ((= i lf)
+ #f)
+ ((not (char=? (string-ref fmt i) #\$))
+ (display (string-ref fmt i))
+ (loop (+ i 1)))
+ (else
+ (loop (loops (+ i 1) 0)))))))
+
+
+(define-method out ((n <handle>) e)
+ 'unspecified)
+
+
+(define-method out ((n <unresolved>) e)
+ (skribe-error 'output "Orphan unresolved" n))
+
+
+(define-method out ((node <markup>) e)
+ (let ((w (lookup-markup-writer node e)))
+ (if (writer? w)
+ (%out/writer node e w)
+ (output (slot-ref node 'body) e))))
+)
diff --git a/skribe/src/stklos/prog.stk b/skribe/src/stklos/prog.stk
new file mode 100644
index 0000000..6301ece
--- /dev/null
+++ b/skribe/src/stklos/prog.stk
@@ -0,0 +1,219 @@
+;;;;
+;;;; prog.stk -- All the stuff for the prog markup
+;;;;
+;;;; Copyright � 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 31-Aug-2003 23:42 (eg)
+;;;; Last file update: 22-Oct-2003 19:35 (eg)
+;;;;
+
+(define-module SKRIBE-PROG-MODULE
+ (export make-prog-body resolve-line)
+
+;;; ======================================================================
+;;;
+;;; COMPATIBILITY
+;;;
+;;; ======================================================================
+(define pregexp-match regexp-match)
+(define pregexp-replace regexp-replace)
+(define pregexp-quote regexp-quote)
+
+
+(define (node-body-set! b v)
+ (slot-set! b 'body v))
+
+;;;
+;;; FIXME: Tout le module peut se factoriser
+;;; d�finir en bigloo node-body-set
+
+
+;*---------------------------------------------------------------------*/
+;* *lines* ... */
+;*---------------------------------------------------------------------*/
+(define *lines* (make-hashtable))
+
+;*---------------------------------------------------------------------*/
+;* make-line-mark ... */
+;*---------------------------------------------------------------------*/
+(define (make-line-mark m lnum b)
+ (let* ((ls (number->string lnum))
+ (n (list (mark ls) b)))
+ (hashtable-put! *lines* m n)
+ n))
+
+;*---------------------------------------------------------------------*/
+;* resolve-line ... */
+;*---------------------------------------------------------------------*/
+(define (resolve-line id)
+ (hashtable-get *lines* id))
+
+;*---------------------------------------------------------------------*/
+;* extract-string-mark ... */
+;*---------------------------------------------------------------------*/
+(define (extract-string-mark line mark regexp)
+ (let ((m (pregexp-match regexp line)))
+ (if (pair? m)
+ (values (substring (car m)
+ (string-length mark)
+ (string-length (car m)))
+ (pregexp-replace regexp line ""))
+ (values #f line))))
+
+;*---------------------------------------------------------------------*/
+;* extract-mark ... */
+;* ------------------------------------------------------------- */
+;* Extract the prog mark from a line. */
+;*---------------------------------------------------------------------*/
+(define (extract-mark line mark regexp)
+ (cond
+ ((not regexp)
+ (values #f line))
+ ((string? line)
+ (extract-string-mark line mark regexp))
+ ((pair? line)
+ (let loop ((ls line)
+ (res '()))
+ (if (null? ls)
+ (values #f line)
+ (receive (m l)
+ (extract-mark (car ls) mark regexp)
+ (if (not m)
+ (loop (cdr ls) (cons l res))
+ (values m (append (reverse! res) (cons l (cdr ls)))))))))
+ ((node? line)
+ (receive (m l)
+ (extract-mark (node-body line) mark regexp)
+ (if (not m)
+ (values #f line)
+ (begin
+ (node-body-set! line l)
+ (values m line)))))
+ (else
+ (values #f line))))
+
+;*---------------------------------------------------------------------*/
+;* split-line ... */
+;*---------------------------------------------------------------------*/
+(define (split-line line)
+ (cond
+ ((string? line)
+ (let ((l (string-length line)))
+ (let loop ((r1 0)
+ (r2 0)
+ (res '()))
+ (cond
+ ((= r2 l)
+ (if (= r1 r2)
+ (reverse! res)
+ (reverse! (cons (substring line r1 r2) res))))
+ ((char=? (string-ref line r2) #\Newline)
+ (loop (+ r2 1)
+ (+ r2 1)
+ (if (= r1 r2)
+ (cons 'eol res)
+ (cons* 'eol (substring line r1 r2) res))))
+ (else
+ (loop r1
+ (+ r2 1)
+ res))))))
+ ((pair? line)
+ (let loop ((ls line)
+ (res '()))
+ (if (null? ls)
+ res
+ (loop (cdr ls) (append res (split-line (car ls)))))))
+ (else
+ (list line))))
+
+;*---------------------------------------------------------------------*/
+;* flat-lines ... */
+;*---------------------------------------------------------------------*/
+(define (flat-lines lines)
+ (apply append (map split-line lines)))
+
+;*---------------------------------------------------------------------*/
+;* collect-lines ... */
+;*---------------------------------------------------------------------*/
+(define (collect-lines lines)
+ (let loop ((lines (flat-lines lines))
+ (res '())
+ (tmp '()))
+ (cond
+ ((null? lines)
+ (reverse! (cons (reverse! tmp) res)))
+ ((eq? (car lines) 'eol)
+ (cond
+ ((null? (cdr lines))
+ (reverse! (cons (reverse! tmp) res)))
+ ((and (null? res) (null? tmp))
+ (loop (cdr lines)
+ res
+ '()))
+ (else
+ (loop (cdr lines)
+ (cons (reverse! tmp) res)
+ '()))))
+ (else
+ (loop (cdr lines)
+ res
+ (cons (car lines) tmp))))))
+
+;*---------------------------------------------------------------------*/
+;* make-prog-body ... */
+;*---------------------------------------------------------------------*/
+(define (make-prog-body src lnum-init ldigit mark)
+ (define (int->str i rl)
+ (let* ((s (number->string i))
+ (l (string-length s)))
+ (if (= l rl)
+ s
+ (string-append (make-string (- rl l) #\space) s))))
+
+ (let* ((regexp (and mark
+ (format "~a[-a-zA-Z_][-0-9a-zA-Z_]+"
+ (pregexp-quote mark))))
+ (src (cond
+ ((not (pair? src)) (list src))
+ ((and (pair? (car src)) (null? (cdr src))) (car src))
+ (else src)))
+ (lines (collect-lines src))
+ (lnum (if (integer? lnum-init) lnum-init 1))
+ (s (number->string (+ (if (integer? ldigit)
+ (max lnum (expt 10 (- ldigit 1)))
+ lnum)
+ (length lines))))
+ (cs (string-length s)))
+ (let loop ((lines lines)
+ (lnum lnum)
+ (res '()))
+ (if (null? lines)
+ (reverse! res)
+ (receive (m l)
+ (extract-mark (car lines) mark regexp)
+ (let ((n (new markup
+ (markup '&prog-line)
+ (ident (and lnum-init (int->str lnum cs)))
+ (body (if m (make-line-mark m lnum l) l)))))
+ (loop (cdr lines)
+ (+ lnum 1)
+ (cons n res))))))))
+
+)
\ No newline at end of file
diff --git a/skribe/src/stklos/reader.stk b/skribe/src/stklos/reader.stk
new file mode 100644
index 0000000..bd38562
--- /dev/null
+++ b/skribe/src/stklos/reader.stk
@@ -0,0 +1,136 @@
+;;;;
+;;;; reader.stk -- Reader hook for the open bracket
+;;;;
+;;;; Copyright (C) 2001-2003 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@unice.fr]
+;;;; Creation date: 6-Dec-2001 22:59 (eg)
+;;;; Last file update: 28-Feb-2004 10:22 (eg)
+;;;;
+
+;; Examples of ISO-2022-JP (here for cut'n paste tests, since my japanese
+;; is *very* limited ;-).
+;;
+;; "Japan" $BF|K\(B
+;; "China and Chinese music" $BCf9q$HCf9q$N2;3Z(B
+
+
+;;
+;; This function is a hook for the standard reader. After defining,
+;; %read-bracket, the reader calls it when it encounters an open
+;; bracket
+
+
+(define (%read-bracket in)
+
+ (define (read-japanese in)
+ ;; This function reads an ISO-2022-JP sequence. Susch s sequence is coded
+ ;; as "^[$B......^[(B" . When entering in this function the current
+ ;; character is 'B' (the opening sequence one). Function reads until the
+ ;; end of the sequence and return it as a string
+ (read-char in) ;; to skip the starting #\B
+ (let ((res (open-output-string)))
+ (let Loop ((c (peek-char in)))
+ (cond
+ ((eof-object? c) ;; EOF
+ (error '%read-bracket "EOF encountered"))
+ ((char=? c #\escape)
+ (read-char in)
+ (let ((next1 (peek-char in)))
+ (if (char=? next1 #\()
+ (begin
+ (read-char in)
+ (let ((next2 (peek-char in)))
+ (if (char=? next2 #\B)
+ (begin
+ (read-char in)
+ (format "\033$B~A\033(B" (get-output-string res)))
+ (begin
+ (format res "\033~A" next1)
+ (Loop next2)))))
+ (begin
+ (display #\escape res)
+ (Loop next1)))))
+ (else (display (read-char in) res)
+ (Loop (peek-char in)))))))
+ ;;
+ ;; Body of %read-bracket starts here
+ ;;
+ (let ((out (open-output-string))
+ (res '())
+ (in-string? #f))
+
+ (read-char in) ; skip open bracket
+
+ (let Loop ((c (peek-char in)))
+ (cond
+ ((eof-object? c) ;; EOF
+ (error '%read-bracket "EOF encountered"))
+
+ ((char=? c #\escape) ;; ISO-2022-JP string?
+ (read-char in)
+ (let ((next1 (peek-char in)))
+ (if (char=? next1 #\$)
+ (begin
+ (read-char in)
+ (let ((next2 (peek-char in)))
+ (if (char=? next2 #\B)
+ (begin
+ (set! res
+ (append! res
+ (list (get-output-string out)
+ (list 'unquote
+ (list 'jp
+ (read-japanese in))))))
+ (set! out (open-output-string)))
+ (format out "\033~A" next1))))
+ (display #\escape out)))
+ (Loop (peek-char in)))
+
+ ((char=? c #\\) ;; Quote char
+ (read-char in)
+ (display (read-char in) out)
+ (Loop (peek-char in)))
+
+ ((and (not in-string?) (char=? c #\,)) ;; Comma
+ (read-char in)
+ (let ((next (peek-char in)))
+ (if (char=? next #\()
+ (begin
+ (set! res (append! res (list (get-output-string out)
+ (list 'unquote
+ (read in)))))
+ (set! out (open-output-string)))
+ (display #\, out))
+ (Loop (peek-char in))))
+
+ ((and (not in-string?) (char=? c #\[)) ;; Open bracket
+ (display (%read-bracket in) out)
+ (Loop (peek-char in)))
+
+ ((and (not in-string?) (char=? c #\])) ;; Close bracket
+ (read-char in)
+ (let ((str (get-output-string out)))
+ (list 'quasiquote
+ (append! res (if (string=? str "") '() (list str))))))
+
+ (else (when (char=? c #\") (set! in-string? (not in-string?)))
+ (display (read-char in) out)
+ (Loop (peek-char in)))))))
+
diff --git a/skribe/src/stklos/resolve.stk b/skribe/src/stklos/resolve.stk
new file mode 100644
index 0000000..91dc965
--- /dev/null
+++ b/skribe/src/stklos/resolve.stk
@@ -0,0 +1,255 @@
+;;;;
+;;;; resolve.stk -- Skribe Resolve Stage
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 13-Aug-2003 18:39 (eg)
+;;;; Last file update: 17-Feb-2004 14:43 (eg)
+;;;;
+
+(define-module SKRIBE-RESOLVE-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-RUNTIME-MODULE)
+ (export resolve! resolve-search-parent resolve-children resolve-children*
+ find1 resolve-counter resolve-parent resolve-ident)
+
+(define *unresolved* #f)
+(define-generic do-resolve!)
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE!
+;;;;
+;;;; This function iterates over an ast until all unresolved references
+;;;; are resolved.
+;;;;
+;;;; ======================================================================
+(define (resolve! ast engine env)
+ (with-debug 3 'resolve
+ (debug-item "ast=" ast)
+ (fluid-let ((*unresolved* #f))
+ (let Loop ((ast ast))
+ (set! *unresolved* #f)
+ (let ((ast (do-resolve! ast engine env)))
+ (if *unresolved*
+ (Loop ast)
+ ast))))))
+
+;;;; ======================================================================
+;;;;
+;;;; D O - R E S O L V E !
+;;;;
+;;;; ======================================================================
+
+(define-method do-resolve! (ast engine env)
+ ast)
+
+
+(define-method do-resolve! ((ast <pair>) engine env)
+ (let Loop ((n* ast))
+ (cond
+ ((pair? n*)
+ (set-car! n* (do-resolve! (car n*) engine env))
+ (Loop (cdr n*)))
+ ((not (null? n*))
+ (error 'do-resolve "Illegal argument" n*))
+ (else
+ ast))))
+
+
+(define-method do-resolve! ((node <node>) engine env)
+ (let ((body (slot-ref node 'body))
+ (options (slot-ref node 'options))
+ (parent (slot-ref node 'parent)))
+ (with-debug 5 'do-resolve<body>
+ (debug-item "body=" body)
+ (when (eq? parent 'unspecified)
+ (let ((p (assq 'parent env)))
+ (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
+ (when (pair? options)
+ (debug-item "unresolved options=" options)
+ (for-each (lambda (o)
+ (set-car! (cdr o)
+ (do-resolve! (cadr o) engine env)))
+ options)
+ (debug-item "resolved options=" options))))
+ (slot-set! node 'body (do-resolve! body engine env))
+ node)))
+
+
+
+(define-method do-resolve! ((node <container>) engine env0)
+ (let ((body (slot-ref node 'body))
+ (options (slot-ref node 'options))
+ (env (slot-ref node 'env))
+ (parent (slot-ref node 'parent)))
+ (with-debug 5 'do-resolve<container>
+ (debug-item "markup=" (markup-markup node))
+ (debug-item "body=" body)
+ (debug-item "env0=" env0)
+ (debug-item "env=" env)
+ (when (eq? parent 'unspecified)
+ (let ((p (assq 'parent env0)))
+ (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p)))
+ (when (pair? options)
+ (let ((e (append `((parent ,node)) env0)))
+ (debug-item "unresolved options=" options)
+ (for-each (lambda (o)
+ (set-car! (cdr o)
+ (do-resolve! (cadr o) engine e)))
+ options)
+ (debug-item "resolved options=" options)))
+ (let ((e `((parent ,node) ,@env ,@env0)))
+ (slot-set! node 'body (do-resolve! body engine e)))))
+ node)))
+
+
+(define-method do-resolve! ((node <document>) engine env0)
+ (next-method)
+ ;; resolve the engine custom
+ (let ((env (append `((parent ,node)) env0)))
+ (for-each (lambda (c)
+ (let ((i (car c))
+ (a (cadr c)))
+ (debug-item "custom=" i " " a)
+ (set-car! (cdr c) (do-resolve! a engine env))))
+ (slot-ref engine 'customs)))
+ node)
+
+
+(define-method do-resolve! ((node <unresolved>) engine env)
+ (with-debug 5 'do-resolve<unresolved>
+ (debug-item "node=" node)
+ (let ((p (assq 'parent env)))
+ (slot-set! node 'parent (and (pair? p) (pair? (cdr p)) (cadr p))))
+
+ (let* ((proc (slot-ref node 'proc))
+ (res (resolve! (proc node engine env) engine env))
+ (loc (ast-loc node)))
+ (when (ast? res)
+ (ast-loc-set! res loc))
+ (debug-item "res=" res)
+ (set! *unresolved* #t)
+ res)))
+
+
+(define-method do-resolve! ((node <handle>) engine env)
+ node)
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-PARENT
+;;;;
+;;;; ======================================================================
+(define (resolve-parent n e)
+ (with-debug 5 'resolve-parent
+ (debug-item "n=" n)
+ (cond
+ ((not (is-a? n <ast>))
+ (let ((c (assq 'parent e)))
+ (if (pair? c)
+ (cadr c)
+ n)))
+ ((eq? (slot-ref n 'parent) 'unspecified)
+ (skribe-error 'resolve-parent "Orphan node" n))
+ (else
+ (slot-ref n 'parent)))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-SEARCH-PARENT
+;;;;
+;;;; ======================================================================
+(define (resolve-search-parent n e pred)
+ (with-debug 5 'resolve-search-parent
+ (debug-item "node=" n)
+ (debug-item "searching=" pred)
+ (let ((p (resolve-parent n e)))
+ (debug-item "parent=" p " "
+ (if (is-a? p 'markup) (slot-ref p 'markup) "???"))
+ (cond
+ ((pred p) p)
+ ((is-a? p <unresolved>) p)
+ ((not p) #f)
+ (else (resolve-search-parent p e pred))))))
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-COUNTER
+;;;;
+;;;; ======================================================================
+;;FIXME: factoriser
+(define (resolve-counter n e cnt val . opt)
+ (let ((c (assq (symbol-append cnt '-counter) e)))
+ (if (not (pair? c))
+ (if (or (null? opt) (not (car opt)) (null? e))
+ (skribe-error cnt "Orphan node" n)
+ (begin
+ (set-cdr! (last-pair e)
+ (list (list (symbol-append cnt '-counter) 0)
+ (list (symbol-append cnt '-env) '())))
+ (resolve-counter n e cnt val)))
+ (let* ((num (cadr c))
+ (nval (if (integer? val)
+ val
+ (+ 1 num))))
+ (let ((c2 (assq (symbol-append cnt '-env) e)))
+ (set-car! (cdr c2) (cons (resolve-parent n e) (cadr c2))))
+ (cond
+ ((integer? val)
+ (set-car! (cdr c) val)
+ (car val))
+ ((not val)
+ val)
+ (else
+ (set-car! (cdr c) (+ 1 num))
+ (+ 1 num)))))))
+
+;;;; ======================================================================
+;;;;
+;;;; RESOLVE-IDENT
+;;;;
+;;;; ======================================================================
+(define (resolve-ident ident markup n e)
+ (with-debug 4 'resolve-ident
+ (debug-item "ident=" ident)
+ (debug-item "markup=" markup)
+ (debug-item "n=" (if (markup? n) (markup-markup n) n))
+ (if (not (string? ident))
+ (skribe-type-error 'resolve-ident
+ "Illegal ident"
+ ident
+ "string")
+ (let ((mks (find-markups ident)))
+ (and mks
+ (if (not markup)
+ (car mks)
+ (let loop ((mks mks))
+ (cond
+ ((null? mks)
+ #f)
+ ((is-markup? (car mks) markup)
+ (car mks))
+ (else
+ (loop (cdr mks)))))))))))
+
+)
diff --git a/skribe/src/stklos/runtime.stk b/skribe/src/stklos/runtime.stk
new file mode 100644
index 0000000..58d0d45
--- /dev/null
+++ b/skribe/src/stklos/runtime.stk
@@ -0,0 +1,456 @@
+;;;;
+;;;; runtime.stk -- Skribe runtime system
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 13-Aug-2003 18:47 (eg)
+;;;; Last file update: 15-Nov-2004 14:03 (eg)
+;;;;
+
+(define-module SKRIBE-RUNTIME-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-VERIFY-MODULE SKRIBE-RESOLVE-MODULE
+ SKRIBE-OUTPUT-MODULE SKRIBE-EVAL-MODULE)
+
+ (export ;; Utilities
+ strip-ref-base ast->file-location string-canonicalize
+
+ ;; Markup functions
+ markup-option markup-option-add! markup-output
+
+ ;; Container functions
+ container-env-get
+
+ ;; Images
+ convert-image
+
+ ;; String writing
+ make-string-replace
+
+ ;; AST
+ ast->string
+ )
+
+;;;; ======================================================================
+;;;;
+;;;; U T I L I T I E S
+;;;;
+;;;; ======================================================================
+(define skribe-load 'function-defined-below)
+
+
+;;FIXME: Remonter cette fonction
+(define (strip-ref-base file)
+ (if (not (string? *skribe-ref-base*))
+ file
+ (let ((l (string-length *skribe-ref-base*)))
+ (cond
+ ((not (> (string-length file) (+ l 2)))
+ file)
+ ((not (substring=? file *skribe-ref-base* l))
+ file)
+ ((not (char=? (string-ref file l) (file-separator)))
+ file)
+ (else
+ (substring file (+ l 1) (string-length file)))))))
+
+
+(define (ast->file-location ast)
+ (let ((l (ast-loc ast)))
+ (if (location? l)
+ (format "~a:~a:" (location-file l) (location-line l))
+ "")))
+
+;; FIXME: Remonter cette fonction
+(define (string-canonicalize old)
+ (let* ((l (string-length old))
+ (new (make-string l)))
+ (let loop ((r 0)
+ (w 0)
+ (s #f))
+ (cond
+ ((= r l)
+ (cond
+ ((= w 0)
+ "")
+ ((char-whitespace? (string-ref new (- w 1)))
+ (substring new 0 (- w 1)))
+ ((= w r)
+ new)
+ (else
+ (substring new 0 w))))
+ ((char-whitespace? (string-ref old r))
+ (if s
+ (loop (+ r 1) w #t)
+ (begin
+ (string-set! new w #\-)
+ (loop (+ r 1) (+ w 1) #t))))
+ ((or (char=? (string-ref old r) #\#)
+ (>= (char->integer (string-ref old r)) #x7f))
+ (string-set! new w #\-)
+ (loop (+ r 1) (+ w 1) #t))
+ (else
+ (string-set! new w (string-ref old r))
+ (loop (+ r 1) (+ w 1) #f))))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; M A R K U P S F U N C T I O N S
+;;;;
+;;;; ======================================================================
+;;; (define (markup-output markup
+;; :optional (engine #f)
+;; :key (predicate #f)
+;; (options '())
+;; (before #f)
+;; (action #f)
+;; (after #f))
+;; (let ((e (or engine (use-engine))))
+;; (cond
+;; ((not (is-a? e <engine>))
+;; (skribe-error 'markup-writer "illegal engine" e))
+;; ((and (not before)
+;; (not action)
+;; (not after))
+;; (%find-markup-output e markup))
+;; (else
+;; (let ((mp (if (procedure? predicate)
+;; (lambda (n e) (and (is-markup? n markup) (predicate n e)))
+;; (lambda (n e) (is-markup? n markup)))))
+;; (engine-output e markup mp options
+;; (or before (slot-ref e 'default-before))
+;; (or action (slot-ref e 'default-action))
+;; (or after (slot-ref e 'default-after))))))))
+
+(define (markup-option m opt)
+ (if (markup? m)
+ (let ((c (assq opt (slot-ref m 'options))))
+ (and (pair? c) (pair? (cdr c))
+ (cadr c)))
+ (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
+
+
+(define (markup-option-add! m opt val)
+ (if (markup? m)
+ (slot-set! m 'options (cons (list opt val)
+ (slot-ref m 'options)))
+ (skribe-type-error 'markup-option "Illegal markup: " m "markup")))
+
+;;;; ======================================================================
+;;;;
+;;;; C O N T A I N E R S
+;;;;
+;;;; ======================================================================
+(define (container-env-get m key)
+ (let ((c (assq key (slot-ref m 'env))))
+ (and (pair? c) (cadr c))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; I M A G E S
+;;;;
+;;;; ======================================================================
+(define (builtin-convert-image from fmt dir)
+ (let* ((s (suffix from))
+ (f (string-append (prefix (basename from)) "." fmt))
+ (to (string-append dir "/" f))) ;; FIXME:
+ (cond
+ ((string=? s fmt)
+ to)
+ ((file-exists? to)
+ to)
+ (else
+ (let ((c (if (string=? s "fig")
+ (string-append "fig2dev -L " fmt " " from " > " to)
+ (string-append "convert " from " " to))))
+ (cond
+ ((> *skribe-verbose* 1)
+ (format (current-error-port) " [converting image: ~S (~S)]" from c))
+ ((> *skribe-verbose* 0)
+ (format (current-error-port) " [converting image: ~S]" from)))
+ (and (zero? (system c))
+ to))))))
+
+(define (convert-image file formats)
+ (let ((path (find-path file (skribe-image-path))))
+ (if (not path)
+ (skribe-error 'convert-image
+ (format "Can't find `~a' image file in path: " file)
+ (skribe-image-path))
+ (let ((suf (suffix file)))
+ (if (member suf formats)
+ (let* ((dir (if (string? *skribe-dest*)
+ (dirname *skribe-dest*)
+ #f)))
+ (if dir
+ (let ((dest (basename path)))
+ (copy-file path (make-path dir dest))
+ dest)
+ path))
+ (let loop ((fmts formats))
+ (if (null? fmts)
+ #f
+ (let* ((dir (if (string? *skribe-dest*)
+ (dirname *skribe-dest*)
+ "."))
+ (p (builtin-convert-image path (car fmts) dir)))
+ (if (string? p)
+ p
+ (loop (cdr fmts)))))))))))
+
+;;;; ======================================================================
+;;;;
+;;;; S T R I N G - W R I T I N G
+;;;;
+;;;; ======================================================================
+
+;;
+;; (define (%make-html-replace)
+;; ;; Ad-hoc version for HTML, a little bit faster than the
+;; ;; make-general-string-replace define later (particularily if there
+;; ;; is nothing to replace since, it does not allocate a new string
+;; (let ((specials (string->regexp "&|\"|<|>")))
+;; (lambda (str)
+;; (if (regexp-match specials str)
+;; (begin
+;; (let ((out (open-output-string)))
+;; (dotimes (i (string-length str))
+;; (let ((ch (string-ref str i)))
+;; (case ch
+;; ((#\") (display """ out))
+;; ((#\&) (display "&" out))
+;; ((#\<) (display "<" out))
+;; ((#\>) (display ">" out))
+;; (else (write-char ch out)))))
+;; (get-output-string out)))
+;; str))))
+
+
+(define (%make-general-string-replace lst)
+ ;; The general version
+ (lambda (str)
+ (let ((out (open-output-string)))
+ (dotimes (i (string-length str))
+ (let* ((ch (string-ref str i))
+ (res (assq ch lst)))
+ (display (if res (cadr res) ch) out)))
+ (get-output-string out))))
+
+
+(define (make-string-replace lst)
+ (let ((l (sort lst (lambda (r1 r2) (char<? (car r1) (car r2))))))
+ (cond
+ ((equal? l '((#\" """) (#\& "&") (#\< "<") (#\> ">")))
+ string->html)
+ (else
+ (%make-general-string-replace lst)))))
+
+
+
+
+;;;; ======================================================================
+;;;;
+;;;; O P T I O N S
+;;;;
+;;;; ======================================================================
+
+;;NEW ;;
+;;NEW ;; GET-OPTION
+;;NEW ;;
+;;NEW (define (get-option obj key)
+;;NEW ;; This function either searches inside an a-list or a markup.
+;;NEW (cond
+;;NEW ((pair? obj) (let ((c (assq key obj)))
+;;NEW (and (pair? c) (pair? (cdr c)) (cadr c))))
+;;NEW ((markup? obj) (get-option (slot-ref obj 'option*) key))
+;;NEW (else #f)))
+;;NEW
+;;NEW ;;
+;;NEW ;; BIND-OPTION!
+;;NEW ;;
+;;NEW (define (bind-option! obj key value)
+;;NEW (slot-set! obj 'option* (cons (list key value)
+;;NEW (slot-ref obj 'option*))))
+;;NEW
+;;NEW
+;;NEW ;;
+;;NEW ;; GET-ENV
+;;NEW ;;
+;;NEW (define (get-env obj key)
+;;NEW ;; This function either searches inside an a-list or a container
+;;NEW (cond
+;;NEW ((pair? obj) (let ((c (assq key obj)))
+;;NEW (and (pair? c) (cadr c))))
+;;NEW ((container? obj) (get-env (slot-ref obj 'env) key))
+;;NEW (else #f)))
+;;NEW
+
+
+
+
+;;;; ======================================================================
+;;;;
+;;;; A S T
+;;;;
+;;;; ======================================================================
+
+(define-generic ast->string)
+
+
+(define-method ast->string ((ast <top>)) "")
+(define-method ast->string ((ast <string>)) ast)
+(define-method ast->string ((ast <number>)) (number->string ast))
+
+(define-method ast->string ((ast <pair>))
+ (let ((out (open-output-string)))
+ (let Loop ((lst ast))
+ (cond
+ ((null? lst)
+ (get-output-string out))
+ (else
+ (display (ast->string (car lst)) out)
+ (unless (null? (cdr lst))
+ (display #\space out))
+ (Loop (cdr lst)))))))
+
+(define-method ast->string ((ast <node>))
+ (ast->string (slot-ref ast 'body)))
+
+
+;;NEW ;;
+;;NEW ;; AST-PARENT
+;;NEW ;;
+;;NEW (define (ast-parent n)
+;;NEW (slot-ref n 'parent))
+;;NEW
+;;NEW ;;
+;;NEW ;; MARKUP-PARENT
+;;NEW ;;
+;;NEW (define (markup-parent m)
+;;NEW (let ((p (slot-ref m 'parent)))
+;;NEW (if (eq? p 'unspecified)
+;;NEW (skribe-error 'markup-parent "Unresolved parent reference" m)
+;;NEW p)))
+;;NEW
+;;NEW
+;;NEW ;;
+;;NEW ;; MARKUP-DOCUMENT
+;;NEW ;;
+;;NEW (define (markup-document m)
+;;NEW (let Loop ((p m)
+;;NEW (l #f))
+;;NEW (cond
+;;NEW ((is-markup? p 'document) p)
+;;NEW ((or (eq? p 'unspecified) (not p)) l)
+;;NEW (else (Loop (slot-ref p 'parent) p)))))
+;;NEW
+;;NEW ;;
+;;NEW ;; MARKUP-CHAPTER
+;;NEW ;;
+;;NEW (define (markup-chapter m)
+;;NEW (let loop ((p m)
+;;NEW (l #f))
+;;NEW (cond
+;;NEW ((is-markup? p 'chapter) p)
+;;NEW ((or (eq? p 'unspecified) (not p)) l)
+;;NEW (else (loop (slot-ref p 'parent) p)))))
+;;NEW
+;;NEW
+;;NEW ;;;; ======================================================================
+;;NEW ;;;;
+;;NEW ;;;; H A N D L E S
+;;NEW ;;;;
+;;NEW ;;;; ======================================================================
+;;NEW (define (handle-body h)
+;;NEW (slot-ref h 'body))
+;;NEW
+;;NEW
+;;NEW ;;;; ======================================================================
+;;NEW ;;;;
+;;NEW ;;;; F I N D
+;;NEW ;;;;
+;;NEW ;;;; ======================================================================
+;;NEW (define (find pred obj)
+;;NEW (with-debug 4 'find
+;;NEW (debug-item "obj=" obj)
+;;NEW (let loop ((obj (if (is-a? obj <container>) (container-body obj) obj)))
+;;NEW (cond
+;;NEW ((pair? obj)
+;;NEW (apply append (map (lambda (o) (loop o)) obj)))
+;;NEW ((is-a? obj <container>)
+;;NEW (debug-item "loop=" obj " " (slot-ref obj 'ident))
+;;NEW (if (pred obj)
+;;NEW (list (cons obj (loop (container-body obj))))
+;;NEW '()))
+;;NEW (else
+;;NEW (if (pred obj)
+;;NEW (list obj)
+;;NEW '()))))))
+;;NEW
+
+;;NEW ;;;; ======================================================================
+;;NEW ;;;;
+;;NEW ;;;; M A R K U P A R G U M E N T P A R S I N G
+;;NEW ;;;
+;;NEW ;;;; ======================================================================
+;;NEW (define (the-body opt)
+;;NEW ;; Filter out the options
+;;NEW (let loop ((opt* opt)
+;;NEW (res '()))
+;;NEW (cond
+;;NEW ((null? opt*)
+;;NEW (reverse! res))
+;;NEW ((not (pair? opt*))
+;;NEW (skribe-error 'the-body "Illegal body" opt))
+;;NEW ((keyword? (car opt*))
+;;NEW (if (null? (cdr opt*))
+;;NEW (skribe-error 'the-body "Illegal option" (car opt*))
+;;NEW (loop (cddr opt*) res)))
+;;NEW (else
+;;NEW (loop (cdr opt*) (cons (car opt*) res))))))
+;;NEW
+;;NEW
+;;NEW
+;;NEW (define (the-options opt+ . out)
+;;NEW ;; Returns an list made of options.The OUT argument contains
+;;NEW ;; keywords that are filtered out.
+;;NEW (let loop ((opt* opt+)
+;;NEW (res '()))
+;;NEW (cond
+;;NEW ((null? opt*)
+;;NEW (reverse! res))
+;;NEW ((not (pair? opt*))
+;;NEW (skribe-error 'the-options "Illegal options" opt*))
+;;NEW ((keyword? (car opt*))
+;;NEW (cond
+;;NEW ((null? (cdr opt*))
+;;NEW (skribe-error 'the-options "Illegal option" (car opt*)))
+;;NEW ((memq (car opt*) out)
+;;NEW (loop (cdr opt*) res))
+;;NEW (else
+;;NEW (loop (cdr opt*)
+;;NEW (cons (list (car opt*) (cadr opt*)) res)))))
+;;NEW (else
+;;NEW (loop (cdr opt*) res)))))
+;;NEW
+
+
+)
diff --git a/skribe/src/stklos/source.stk b/skribe/src/stklos/source.stk
new file mode 100644
index 0000000..a3102c1
--- /dev/null
+++ b/skribe/src/stklos/source.stk
@@ -0,0 +1,191 @@
+;;;;
+;;;; source.stk -- Skibe SOURCE implementation stuff
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 3-Sep-2003 12:22 (eg)
+;;;; Last file update: 27-Oct-2004 20:09 (eg)
+;;;;
+
+
+
+(define-module SKRIBE-SOURCE-MODULE
+ (export source-read-lines source-read-definition source-fontify)
+
+
+;; Temporary solution
+(define (language-extractor lang)
+ (slot-ref lang 'extractor))
+
+(define (language-fontifier lang)
+ (slot-ref lang 'fontifier))
+
+
+;*---------------------------------------------------------------------*/
+;* source-read-lines ... */
+;*---------------------------------------------------------------------*/
+(define (source-read-lines file start stop tab)
+ (let ((p (find-path file (skribe-source-path))))
+ (if (or (not (string? p)) (not (file-exists? p)))
+ (skribe-error 'source
+ (format "Can't find `~a' source file in path" file)
+ (skribe-source-path))
+ (with-input-from-file p
+ (lambda ()
+ (if (> *skribe-verbose* 0)
+ (format (current-error-port) " [source file: ~S]\n" p))
+ (let ((startl (if (string? start) (string-length start) -1))
+ (stopl (if (string? stop) (string-length stop) -1)))
+ (let loop ((l 1)
+ (armedp (not (or (integer? start) (string? start))))
+ (s (read-line))
+ (r '()))
+ (cond
+ ((or (eof-object? s)
+ (and (integer? stop) (> l stop))
+ (and (string? stop) (substring=? stop s stopl)))
+ (apply string-append (reverse! r)))
+ (armedp
+ (loop (+ l 1)
+ #t
+ (read-line)
+ (cons* "\n" (untabify s tab) r)))
+ ((and (integer? start) (>= l start))
+ (loop (+ l 1)
+ #t
+ (read-line)
+ (cons* "\n" (untabify s tab) r)))
+ ((and (string? start) (substring=? start s startl))
+ (loop (+ l 1) #t (read-line) r))
+ (else
+ (loop (+ l 1) #f (read-line) r))))))))))
+
+;*---------------------------------------------------------------------*/
+;* untabify ... */
+;*---------------------------------------------------------------------*/
+(define (untabify obj tab)
+ (if (not tab)
+ obj
+ (let ((len (string-length obj))
+ (tabl tab))
+ (let loop ((i 0)
+ (col 1))
+ (cond
+ ((= i len)
+ (let ((nlen (- col 1)))
+ (if (= len nlen)
+ obj
+ (let ((new (make-string col #\space)))
+ (let liip ((i 0)
+ (j 0)
+ (col 1))
+ (cond
+ ((= i len)
+ new)
+ ((char=? (string-ref obj i) #\tab)
+ (let ((next-tab (* (/ (+ col tabl)
+ tabl)
+ tabl)))
+ (liip (+ i 1)
+ next-tab
+ next-tab)))
+ (else
+ (string-set! new j (string-ref obj i))
+ (liip (+ i 1) (+ j 1) (+ col 1)))))))))
+ ((char=? (string-ref obj i) #\tab)
+ (loop (+ i 1)
+ (* (/ (+ col tabl) tabl) tabl)))
+ (else
+ (loop (+ i 1) (+ col 1))))))))
+
+;*---------------------------------------------------------------------*/
+;* source-read-definition ... */
+;*---------------------------------------------------------------------*/
+(define (source-read-definition file definition tab lang)
+ (let ((p (find-path file (skribe-source-path))))
+ (cond
+ ((not (language-extractor lang))
+ (skribe-error 'source
+ "The specified language has not defined extractor"
+ (slot-ref lang 'name)))
+ ((or (not p) (not (file-exists? p)))
+ (skribe-error 'source
+ (format "Can't find `~a' program file in path" file)
+ (skribe-source-path)))
+ (else
+ (let ((ip (open-input-file p)))
+ (if (> *skribe-verbose* 0)
+ (format (current-error-port) " [source file: ~S]\n" p))
+ (if (not (input-port? ip))
+ (skribe-error 'source "Can't open file for input" p)
+ (unwind-protect
+ (let ((s ((language-extractor lang) ip definition tab)))
+ (if (not (string? s))
+ (skribe-error 'source
+ "Can't find definition"
+ definition)
+ s))
+ (close-input-port ip))))))))
+
+;*---------------------------------------------------------------------*/
+;* source-fontify ... */
+;*---------------------------------------------------------------------*/
+(define (source-fontify o language)
+ (define (fontify f o)
+ (cond
+ ((string? o) (f o))
+ ((pair? o) (map (lambda (s) (if (string? s) (f s) (fontify f s))) o))
+ (else o)))
+ (let ((f (language-fontifier language)))
+ (if (procedure? f)
+ (fontify f o)
+ o)))
+
+;*---------------------------------------------------------------------*/
+;* split-string-newline ... */
+;*---------------------------------------------------------------------*/
+(define (split-string-newline str)
+ (let ((l (string-length str)))
+ (let loop ((i 0)
+ (j 0)
+ (r '()))
+ (cond
+ ((= i l)
+ (if (= i j)
+ (reverse! r)
+ (reverse! (cons (substring str j i) r))))
+ ((char=? (string-ref str i) #\Newline)
+ (loop (+ i 1)
+ (+ i 1)
+ (if (= i j)
+ (cons 'eol r)
+ (cons* 'eol (substring str j i) r))))
+ ((and (char=? (string-ref str i) #\cr)
+ (< (+ i 1) l)
+ (char=? (string-ref str (+ i 1)) #\Newline))
+ (loop (+ i 2)
+ (+ i 2)
+ (if (= i j)
+ (cons 'eol r)
+ (cons* 'eol (substring str j i) r))))
+ (else
+ (loop (+ i 1) j r))))))
+
+)
diff --git a/skribe/src/stklos/types.stk b/skribe/src/stklos/types.stk
new file mode 100644
index 0000000..fb16230
--- /dev/null
+++ b/skribe/src/stklos/types.stk
@@ -0,0 +1,294 @@
+;;;;
+;;;; types.stk -- Definition of Skribe classes
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 12-Aug-2003 22:18 (eg)
+;;;; Last file update: 28-Oct-2004 16:18 (eg)
+;;;;
+
+
+(define *node-table* (make-hash-table equal?))
+ ; Used to stores the nodes of an AST.
+ ; It permits to retrieve a node from its
+ ; identifier.
+
+
+;;;; ======================================================================
+;;;;
+;;;; <AST>
+;;;;
+;;;; ======================================================================
+;;FIXME: set! location in <ast>
+(define-class <ast> ()
+ ((parent :accessor ast-parent :init-keyword :parent :init-form 'unspecified)
+ (loc :init-form #f)))
+
+(define (ast? obj) (is-a? obj <ast>))
+(define (ast-loc obj) (slot-ref obj 'loc))
+(define (ast-loc-set! obj v) (slot-set! obj 'loc v))
+
+;;;; ======================================================================
+;;;;
+;;;; <COMMAND>
+;;;;
+;;;; ======================================================================
+(define-class <command> (<ast>)
+ ((fmt :init-keyword :fmt)
+ (body :init-keyword :body)))
+
+(define (command? obj) (is-a? obj <command>))
+(define (command-fmt obj) (slot-ref obj 'fmt))
+(define (command-body obj) (slot-ref obj 'body))
+
+;;;; ======================================================================
+;;;;
+;;;; <UNRESOLVED>
+;;;;
+;;;; ======================================================================
+(define-class <unresolved> (<ast>)
+ ((proc :init-keyword :proc)))
+
+(define (unresolved? obj) (is-a? obj <unresolved>))
+(define (unresolved-proc obj) (slot-ref obj 'proc))
+
+;;;; ======================================================================
+;;;;
+;;;; <HANDLE>
+;;;;
+;;;; ======================================================================
+(define-class <handle> (<ast>)
+ ((ast :init-keyword :ast :init-form #f :getter handle-ast)))
+
+(define (handle? obj) (is-a? obj <handle>))
+(define (handle-ast obj) (slot-ref obj 'ast))
+
+
+;;;; ======================================================================
+;;;;
+;;;; <NODE>
+;;;;
+;;;; ======================================================================
+(define-class <node> (<ast>)
+ ((required-options :init-keyword :required-options :init-form '())
+ (options :init-keyword :options :init-form '())
+ (body :init-keyword :body :init-form #f
+ :getter node-body)))
+
+(define (node? obj) (is-a? obj <node>))
+(define (node-options obj) (slot-ref obj 'options))
+(define node-loc ast-loc)
+
+
+;;;; ======================================================================
+;;;;
+;;;; <PROCESSOR>
+;;;;
+;;;; ======================================================================
+(define-class <processor> (<node>)
+ ((combinator :init-keyword :combinator :init-form (lambda (e1 e2) e1))
+ (engine :init-keyword :engine :init-form 'unspecified)
+ (procedure :init-keyword :procedure :init-form (lambda (n e) n))))
+
+(define (processor? obj) (is-a? obj <processor>))
+(define (processor-combinator obj) (slot-ref obj 'combinator))
+(define (processor-engine obj) (slot-ref obj 'engine))
+
+;;;; ======================================================================
+;;;;
+;;;; <MARKUP>
+;;;;
+;;;; ======================================================================
+(define-class <markup> (<node>)
+ ((ident :init-keyword :ident :getter markup-ident :init-form #f)
+ (class :init-keyword :class :getter markup-class :init-form #f)
+ (markup :init-keyword :markup :getter markup-markup)))
+
+
+(define (bind-markup! node)
+ (hash-table-update! *node-table*
+ (markup-ident node)
+ (lambda (cur) (cons node cur))
+ (list node)))
+
+
+(define-method initialize ((self <markup>) initargs)
+ (next-method)
+ (bind-markup! self))
+
+
+(define (markup? obj) (is-a? obj <markup>))
+(define (markup-options obj) (slot-ref obj 'options))
+(define markup-body node-body)
+
+
+(define (is-markup? obj markup)
+ (and (is-a? obj <markup>)
+ (eq? (slot-ref obj 'markup) markup)))
+
+
+
+(define (find-markups ident)
+ (hash-table-get *node-table* ident #f))
+
+
+(define-method write-object ((obj <markup>) port)
+ (format port "#[~A (~A/~A) ~A]"
+ (class-name (class-of obj))
+ (slot-ref obj 'markup)
+ (slot-ref obj 'ident)
+ (address-of obj)))
+
+;;;; ======================================================================
+;;;;
+;;;; <CONTAINER>
+;;;;
+;;;; ======================================================================
+(define-class <container> (<markup>)
+ ((env :init-keyword :env :init-form '())))
+
+(define (container? obj) (is-a? obj <container>))
+(define (container-env obj) (slot-ref obj 'env))
+(define container-options markup-options)
+(define container-ident markup-ident)
+(define container-body node-body)
+
+
+
+;;;; ======================================================================
+;;;;
+;;;; <DOCUMENT>
+;;;;
+;;;; ======================================================================
+(define-class <document> (<container>)
+ ())
+
+(define (document? obj) (is-a? obj <document>))
+(define (document-ident obj) (slot-ref obj 'ident))
+(define (document-body obj) (slot-ref obj 'body))
+(define document-options markup-options)
+(define document-env container-env)
+
+
+;;;; ======================================================================
+;;;;
+;;;; <ENGINE>
+;;;;
+;;;; ======================================================================
+(define-class <engine> ()
+ ((ident :init-keyword :ident :init-form '???)
+ (format :init-keyword :format :init-form "raw")
+ (info :init-keyword :info :init-form '())
+ (version :init-keyword :version :init-form 'unspecified)
+ (delegate :init-keyword :delegate :init-form #f)
+ (writers :init-keyword :writers :init-form '())
+ (filter :init-keyword :filter :init-form #f)
+ (customs :init-keyword :custom :init-form '())
+ (symbol-table :init-keyword :symbol-table :init-form '())))
+
+
+
+(define (engine? obj)
+ (is-a? obj <engine>))
+
+(define (engine-ident obj) ;; Define it here since the doc searches it
+ (slot-ref obj 'ident))
+
+(define (engine-format obj) ;; Define it here since the doc searches it
+ (slot-ref obj 'format))
+
+(define (engine-customs obj) ;; Define it here since the doc searches it
+ (slot-ref obj 'customs))
+
+(define (engine-filter obj) ;; Define it here since the doc searches it
+ (slot-ref obj 'filter))
+
+(define (engine-symbol-table obj) ;; Define it here since the doc searches it
+ (slot-ref obj 'symbol-table))
+
+
+;;;; ======================================================================
+;;;;
+;;;; <WRITER>
+;;;;
+;;;; ======================================================================
+(define-class <writer> ()
+ ((ident :init-keyword :ident :init-form '??? :getter writer-ident)
+ (class :init-keyword :class :initform 'unspecified
+ :getter writer-class)
+ (pred :init-keyword :pred :init-form 'unspecified)
+ (upred :init-keyword :upred :init-form 'unspecified)
+ (options :init-keyword :options :init-form '() :getter writer-options)
+ (verified? :init-keyword :verified? :init-form #f)
+ (validate :init-keyword :validate :init-form #f)
+ (before :init-keyword :before :init-form #f :getter writer-before)
+ (action :init-keyword :action :init-form #f :getter writer-action)
+ (after :init-keyword :after :init-form #f :getter writer-after)))
+
+(define (writer? obj)
+ (is-a? obj <writer>))
+
+(define-method write-object ((obj <writer>) port)
+ (format port "#[~A (~A) ~A]"
+ (class-name (class-of obj))
+ (slot-ref obj 'ident)
+ (address-of obj)))
+
+;;;; ======================================================================
+;;;;
+;;;; <LANGUAGE>
+;;;;
+;;;; ======================================================================
+(define-class <language> ()
+ ((name :init-keyword :name :init-form #f :getter langage-name)
+ (fontifier :init-keyword :fontifier :init-form #f :getter langage-fontifier)
+ (extractor :init-keyword :extractor :init-form #f :getter langage-extractor)))
+
+(define (language? obj)
+ (is-a? obj <language>))
+
+
+;;;; ======================================================================
+;;;;
+;;;; <LOCATION>
+;;;;
+;;;; ======================================================================
+(define-class <location> ()
+ ((file :init-keyword :file :getter location-file)
+ (pos :init-keyword :pos :getter location-pos)
+ (line :init-keyword :line :getter location-line)))
+
+(define (location? obj)
+ (is-a? obj <location>))
+
+(define (ast-location obj)
+ (let ((loc (slot-ref obj 'loc)))
+ (if (location? loc)
+ (let* ((fname (location-file loc))
+ (line (location-line loc))
+ (pwd (getcwd))
+ (len (string-length pwd))
+ (lenf (string-length fname))
+ (file (if (and (substring=? pwd fname len)
+ (> lenf len))
+ (substring fname len (+ 1 (string-length fname)))
+ fname)))
+ (format "~a, line ~a" file line))
+ "no source location")))
diff --git a/skribe/src/stklos/vars.stk b/skribe/src/stklos/vars.stk
new file mode 100644
index 0000000..1c875f8
--- /dev/null
+++ b/skribe/src/stklos/vars.stk
@@ -0,0 +1,82 @@
+;;;;
+;;;; vars.stk -- Skribe Globals
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 11-Aug-2003 16:18 (eg)
+;;;; Last file update: 26-Feb-2004 20:36 (eg)
+;;;;
+
+
+;;;
+;;; Switches
+;;;
+(define *skribe-verbose* 0)
+(define *skribe-warning* 5)
+(define *load-rc* #t)
+
+;;;
+;;; PATH variables
+;;;
+(define *skribe-path* #f)
+(define *skribe-bib-path* '("."))
+(define *skribe-source-path* '("."))
+(define *skribe-image-path* '("."))
+
+
+(define *skribe-rc-directory*
+ (make-path (getenv "HOME") ".skribe"))
+
+
+;;;
+;;; In and out ports
+;;;
+(define *skribe-src* '())
+(define *skribe-dest* #f)
+
+;;;
+;;; Engine
+;;;
+(define *skribe-engine* 'html) ;; Use HTML by default
+
+;;;
+;;; Misc
+;;;
+(define *skribe-chapter-split* '())
+(define *skribe-ref-base* #f)
+(define *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter
+(define *skribe-variants* '())
+
+
+
+
+;;; Forward definitions (to avoid warnings when compiling Skribe)
+;;; This is a KLUDGE.
+(define mark #f)
+(define ref #f)
+;;(define invoke 3)
+(define lookup-markup-writer #f)
+
+(define-module SKRIBE-ENGINE-MODULE
+ (define find-engine #f))
+
+(define-module SKRIBE-OUTPUT-MODULE)
+
+(define-module SKRIBE-RUNTIME-MODULE)
diff --git a/skribe/src/stklos/verify.stk b/skribe/src/stklos/verify.stk
new file mode 100644
index 0000000..da9b132
--- /dev/null
+++ b/skribe/src/stklos/verify.stk
@@ -0,0 +1,157 @@
+;;;;
+;;;; verify.stk -- Skribe Verification Stage
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 13-Aug-2003 11:57 (eg)
+;;;; Last file update: 27-Oct-2004 16:35 (eg)
+;;;;
+
+(define-module SKRIBE-VERIFY-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-ENGINE-MODULE SKRIBE-WRITER-MODULE
+ SKRIBE-RUNTIME-MODULE)
+ (export verify)
+
+
+(define-generic verify)
+
+;;;
+;;; CHECK-REQUIRED-OPTIONS
+;;;
+(define (check-required-options markup writer engine)
+ (let ((required-options (slot-ref markup 'required-options))
+ (ident (slot-ref writer 'ident))
+ (options (slot-ref writer 'options))
+ (verified? (slot-ref writer 'verified?)))
+ (or verified?
+ (eq? options 'all)
+ (begin
+ (for-each (lambda (o)
+ (if (not (memq o options))
+ (skribe-error (engine-ident engine)
+ (format "Option unsupported: ~a, supported options: ~a" o options)
+ markup)))
+ required-options)
+ (slot-set! writer 'verified? #t)))))
+
+;;;
+;;; CHECK-OPTIONS
+;;;
+(define (check-options lopts markup engine)
+
+ ;; Only keywords are checked, symbols are voluntary left unchecked. */
+ (with-debug 6 'check-options
+ (debug-item "markup=" (markup-markup markup))
+ (debug-item "options=" (slot-ref markup 'options))
+ (debug-item "lopts=" lopts)
+ (for-each
+ (lambda (o2)
+ (for-each
+ (lambda (o)
+ (if (and (keyword? o)
+ (not (eq? o :&skribe-eval-location))
+ (not (memq o lopts)))
+ (skribe-warning/ast
+ 3
+ markup
+ 'verify
+ (format "Engine ~a does not support markup ~a option `~a' -- ~a"
+ (engine-ident engine)
+ (markup-markup markup)
+ o
+ (markup-option markup o)))))
+ o2))
+ (slot-ref markup 'options))))
+
+
+;;; ======================================================================
+;;;
+;;; V E R I F Y
+;;;
+;;; ======================================================================
+
+;;; TOP
+(define-method verify ((obj <top>) e)
+ obj)
+
+;;; PAIR
+(define-method verify ((obj <pair>) e)
+ (for-each (lambda (x) (verify x e)) obj)
+ obj)
+
+;;; PROCESSOR
+(define-method verify ((obj <processor>) e)
+ (let ((combinator (slot-ref obj 'combinator))
+ (engine (slot-ref obj 'engine))
+ (body (slot-ref obj 'body)))
+ (verify body (processor-get-engine combinator engine e))
+ obj))
+
+;;; NODE
+(define-method verify ((node <node>) e)
+ ;; Verify body
+ (verify (slot-ref node 'body) e)
+ ;; Verify options
+ (for-each (lambda (o) (verify (cadr o) e))
+ (slot-ref node 'options))
+ node)
+
+;;; MARKUP
+(define-method verify ((node <markup>) e)
+ (with-debug 5 'verify::<markup>
+ (debug-item "node=" (markup-markup node))
+ (debug-item "options=" (slot-ref node 'options))
+ (debug-item "e=" (engine-ident e))
+
+ (next-method)
+
+ (let ((w (lookup-markup-writer node e)))
+ (when (writer? w)
+ (check-required-options node w e)
+ (when (pair? (writer-options w))
+ (check-options (slot-ref w 'options) node e))
+ (let ((validate (slot-ref w 'validate)))
+ (when (procedure? validate)
+ (unless (validate node e)
+ (skribe-warning
+ 1
+ node
+ (format "Node `~a' forbidden here by ~a engine"
+ (markup-markup node)
+ (engine-ident e))))))))
+ node))
+
+
+;;; DOCUMENT
+(define-method verify ((node <document>) e)
+ (next-method)
+
+ ;; verify the engine customs
+ (for-each (lambda (c)
+ (let ((i (car c))
+ (a (cadr c)))
+ (set-car! (cdr c) (verify a e))))
+ (slot-ref e 'customs))
+
+ node)
+
+
+)
+
diff --git a/skribe/src/stklos/writer.stk b/skribe/src/stklos/writer.stk
new file mode 100644
index 0000000..2b0f91c
--- /dev/null
+++ b/skribe/src/stklos/writer.stk
@@ -0,0 +1,211 @@
+;;;;
+;;;; writer.stk -- Skribe Writer Stuff
+;;;;
+;;;; Copyright � 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 15-Sep-2003 22:21 (eg)
+;;;; Last file update: 4-Mar-2004 10:48 (eg)
+;;;;
+
+
+(define-module SKRIBE-WRITER-MODULE
+ (import SKRIBE-DEBUG-MODULE SKRIBE-ENGINE-MODULE SKRIBE-OUTPUT-MODULE)
+ (export invoke markup-writer markup-writer-get markup-writer-get*
+ lookup-markup-writer copy-markup-writer)
+
+;;;; ======================================================================
+;;;;
+;;;; INVOKE
+;;;;
+;;;; ======================================================================
+(define (invoke proc node e)
+ (with-debug 5 'invoke
+ (debug-item "e=" (engine-ident e))
+ (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
+
+ (if (string? proc)
+ (display proc)
+ (if (procedure? proc)
+ (proc node e)))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; LOOKUP-MARKUP-WRITER
+;;;;
+;;;; ======================================================================
+(define (lookup-markup-writer node e)
+ (let ((writers (slot-ref e 'writers))
+ (delegate (slot-ref e 'delegate)))
+ (let Loop ((w* writers))
+ (cond
+ ((pair? w*)
+ (let ((pred (slot-ref (car w*) 'pred)))
+ (if (pred node e)
+ (car w*)
+ (loop (cdr w*)))))
+ ((engine? delegate)
+ (lookup-markup-writer node delegate))
+ (else
+ #f)))))
+
+;;;; ======================================================================
+;;;;
+;;;; MAKE-WRITER-PREDICATE
+;;;;
+;;;; ======================================================================
+(define (make-writer-predicate markup predicate class)
+ (let* ((t1 (if (symbol? markup)
+ (lambda (n e) (is-markup? n markup))
+ (lambda (n e) #t)))
+ (t2 (if class
+ (lambda (n e)
+ (and (t1 n e) (equal? (markup-class n) class)))
+ t1)))
+ (if predicate
+ (cond
+ ((not (procedure? predicate))
+ (skribe-error 'markup-writer
+ "Illegal predicate (procedure expected)"
+ predicate))
+ ((not (eq? (%procedure-arity predicate) 2))
+ (skribe-error 'markup-writer
+ "Illegal predicate arity (2 arguments expected)"
+ predicate))
+ (else
+ (lambda (n e)
+ (and (t2 n e) (predicate n e)))))
+ t2)))
+
+;;;; ======================================================================
+;;;;
+;;;; MARKUP-WRITER
+;;;;
+;;;; ======================================================================
+(define (markup-writer markup :optional engine
+ :key (predicate #f) (class #f) (options '())
+ (validate #f)
+ (before #f) (action 'unspecified) (after #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((and (not (symbol? markup)) (not (eq? markup #t)))
+ (skribe-error 'markup-writer "Illegal markup" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer "Illegal engine" e))
+ ((and (not predicate)
+ (not class)
+ (null? options)
+ (not before)
+ (eq? action 'unspecified)
+ (not after))
+ (skribe-error 'markup-writer "Illegal writer" markup))
+ (else
+ (let ((m (make-writer-predicate markup predicate class))
+ (ac (if (eq? action 'unspecified)
+ (lambda (n e) (output (markup-body n) e))
+ action)))
+ (engine-add-writer! e markup m predicate
+ options before ac after class validate))))))
+
+
+;;;; ======================================================================
+;;;;
+;;;; MARKUP-WRITER-GET
+;;;;
+;;;; ======================================================================
+(define (markup-writer-get markup :optional engine :key (class #f) (pred #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((not (symbol? markup))
+ (skribe-error 'markup-writer-get "Illegal symbol" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer-get "Illegal engine" e))
+ (else
+ (let liip ((e e))
+ (let loop ((w* (slot-ref e 'writers)))
+ (cond
+ ((pair? w*)
+ (if (and (eq? (writer-ident (car w*)) markup)
+ (equal? (writer-class (car w*)) class)
+ (or (unspecified? pred)
+ (eq? (slot-ref (car w*) 'upred) pred)))
+ (car w*)
+ (loop (cdr w*))))
+ ((engine? (slot-ref e 'delegate))
+ (liip (slot-ref e 'delegate)))
+ (else
+ #f))))))))
+
+;;;; ======================================================================
+;;;;
+;;;; MARKUP-WRITER-GET*
+;;;;
+;;;; ======================================================================
+
+;; Finds all writers that matches MARKUP with optional CLASS attribute.
+
+(define (markup-writer-get* markup #!optional engine #!key (class #f))
+ (let ((e (or engine (default-engine))))
+ (cond
+ ((not (symbol? markup))
+ (skribe-error 'markup-writer "Illegal symbol" markup))
+ ((not (engine? e))
+ (skribe-error 'markup-writer "Illegal engine" e))
+ (else
+ (let liip ((e e)
+ (res '()))
+ (let loop ((w* (slot-ref e 'writers))
+ (res res))
+ (cond
+ ((pair? w*)
+ (if (and (eq? (slot-ref (car w*) 'ident) markup)
+ (equal? (slot-ref (car w*) 'class) class))
+ (loop (cdr w*) (cons (car w*) res))
+ (loop (cdr w*) res)))
+ ((engine? (slot-ref e 'delegate))
+ (liip (slot-ref e 'delegate) res))
+ (else
+ (reverse! res)))))))))
+
+;;; ======================================================================
+;;;;
+;;;; COPY-MARKUP-WRITER
+;;;;
+;;;; ======================================================================
+(define (copy-markup-writer markup old-engine :optional new-engine
+ :key (predicate 'unspecified)
+ (class 'unspecified)
+ (options 'unspecified)
+ (validate 'unspecified)
+ (before 'unspecified)
+ (action 'unspecified)
+ (after 'unspecified))
+ (let ((old (markup-writer-get markup old-engine))
+ (new-engine (or new-engine old-engine)))
+ (markup-writer markup new-engine
+ :pred (if (unspecified? predicate) (slot-ref old 'pred) predicate)
+ :class (if (unspecified? class) (slot-ref old 'class) class)
+ :options (if (unspecified? options) (slot-ref old 'options) options)
+ :validate (if (unspecified? validate) (slot-ref old 'validate) validate)
+ :before (if (unspecified? before) (slot-ref old 'before) before)
+ :action (if (unspecified? action) (slot-ref old 'action) action)
+ :after (if (unspecified? after) (slot-ref old 'after) after))))
+
+)
diff --git a/skribe/src/stklos/xml-lex.l b/skribe/src/stklos/xml-lex.l
new file mode 100644
index 0000000..5d9a8d9
--- /dev/null
+++ b/skribe/src/stklos/xml-lex.l
@@ -0,0 +1,64 @@
+;;;; -*- Scheme -*-
+;;;;
+;;;; xml-lex.l -- SILex input for the XML languages
+;;;;
+;;;; Copyright � 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 21-Dec-2003 17:19 (eg)
+;;;; Last file update: 21-Dec-2003 22:38 (eg)
+;;;;
+
+space [ \n\9]
+
+%%
+
+;; Strings
+\"[^\"]*\" (new markup
+ (markup '&source-string)
+ (body yytext))
+'[^']*' (new markup
+ (markup '&source-string)
+ (body yytext))
+
+;;Comment
+<!--(.|\n)*--> (new markup
+ (markup '&source-comment)
+ (body yytext))
+
+;; Markup
+<[^>\n ]+|> (new markup
+ (markup '&source-module)
+ (body yytext))
+
+;; Regular text
+[^<>\"']+ (begin yytext)
+
+
+<<EOF>> 'eof
+<<ERROR>> (skribe-error 'xml-fontifier "Parse error" yytext)
+
+
+
+
+
+
+
+
+
\ No newline at end of file
diff --git a/skribe/src/stklos/xml.stk b/skribe/src/stklos/xml.stk
new file mode 100644
index 0000000..47dd46f
--- /dev/null
+++ b/skribe/src/stklos/xml.stk
@@ -0,0 +1,52 @@
+;;;;
+;;;; xml.stk -- XML Fontification stuff
+;;;;
+;;;; Copyright � 2003 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 16-Oct-2003 22:33 (eg)
+;;;; Last file update: 28-Dec-2003 17:33 (eg)
+;;;;
+
+
+(require "lex-rt") ;; to avoid module problems
+
+
+(define-module SKRIBE-XML-MODULE
+ (export xml)
+ (import SKRIBE-SOURCE-MODULE)
+
+(include "xml-lex.stk") ;; SILex generated
+
+(define (xml-fontifier s)
+ (let ((lex (xml-lex (open-input-string s))))
+ (let Loop ((token (lexer-next-token lex))
+ (res '()))
+ (if (eq? token 'eof)
+ (reverse! res)
+ (Loop (lexer-next-token lex)
+ (cons token res))))))
+
+
+(define xml
+ (new language
+ (name "xml")
+ (fontifier xml-fontifier)
+ (extractor #f)))
+)
diff --git a/skribe/tools/Makefile b/skribe/tools/Makefile
new file mode 100644
index 0000000..200db45
--- /dev/null
+++ b/skribe/tools/Makefile
@@ -0,0 +1,60 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/tools/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Wed Jul 30 16:23:07 2003 */
+#* Last change : Tue Oct 26 19:36:26 2004 (eg) */
+#* Copyright : 2003-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Skribe Tools general makefile */
+#*=====================================================================*/
+include ../etc/Makefile.config
+
+TOOLS= skribebibtex
+
+#*---------------------------------------------------------------------*/
+#* all */
+#*---------------------------------------------------------------------*/
+.PHONY: all
+
+all:
+ for p in $(TOOLS); do \
+ (cd $$p/$(SYSTEM) && $(MAKE)) || exit -1; \
+ done
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: pop
+
+pop:
+ @ for p in $(TOOLS); do \
+ (cd $$p/bigloo && $(MAKE) pop); \
+ (cd $$p/stklos && $(MAKE) pop); \
+ done
+ @ echo tools/Makefile
+
+#*---------------------------------------------------------------------*/
+#* pop */
+#*---------------------------------------------------------------------*/
+.PHONY: install uninstall
+
+install:
+ @ for p in $(TOOLS); do \
+ (cd $$p/$(SYSTEM) && $(MAKE) install) || exit -1; \
+ done
+uninstall:
+ @ for p in $(TOOLS); do \
+ (cd $$p/$(SYSTEM) && $(MAKE) uninstall) || exit -1; \
+ done
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+.PHONY: clean
+
+clean:
+ for p in $(TOOLS); do \
+ (cd $$p/$(SYSTEM) && $(MAKE) clean); \
+ done
+
diff --git a/skribe/tools/skribebibtex/bigloo/Makefile b/skribe/tools/skribebibtex/bigloo/Makefile
new file mode 100644
index 0000000..c2a4cc1
--- /dev/null
+++ b/skribe/tools/skribebibtex/bigloo/Makefile
@@ -0,0 +1,70 @@
+#*=====================================================================*/
+#* serrano/prgm/project/skribe/tools/skribebibtex/Makefile */
+#* ------------------------------------------------------------- */
+#* Author : Manuel Serrano */
+#* Creation : Thu Dec 20 10:42:25 2001 */
+#* Last change : Tue Oct 26 19:34:00 2004 (eg) */
+#* Copyright : 2001-04 Manuel Serrano */
+#* ------------------------------------------------------------- */
+#* The Makefile to compile the bibtex->Skribe translator */
+#*=====================================================================*/
+
+#*---------------------------------------------------------------------*/
+#* Standard configuration */
+#*---------------------------------------------------------------------*/
+include ../../../etc/bigloo/Makefile.skb
+
+#*---------------------------------------------------------------------*/
+#* Binary */
+#*---------------------------------------------------------------------*/
+TARGETNAME = skribebibtex
+
+#*---------------------------------------------------------------------*/
+#* Objects */
+#*---------------------------------------------------------------------*/
+_BGL_OBJECTS = skribebibtex main
+_C_OBJECTS =
+_JAVA_OBJECTS =
+
+_OBJECTS = $(_BGL_OBJECTS) $(_C_OBJECTS)
+OBJECTS = $(_OBJECTS:%=o/%.o)
+
+_CLASSES = $(_BGL_OBJECTS) $(_JAVA_OBJECTS)
+CLASSES = $(_OBJECTS:%=o/class_s/bigloo/skribe/$(TARGETNAME)/%.class)
+
+_BGL_SOURCES = $(_BGL_OBJECTS:%=%.scm)
+_C_SOURCES = $(_C_OBJECTS:%=%.c)
+_JAVA_SOURCES = $(_JAVA_OBJECTS:%=%.java)
+
+SOURCES = $(_BGL_SOURCES) $(_C_SOURCES) $(_JAVA_SOURCES)
+INCLUDES =
+
+#*---------------------------------------------------------------------*/
+#* Sources */
+#*---------------------------------------------------------------------*/
+POPULATION = $(SOURCES) $(INCLUDES) Makefile
+
+#*---------------------------------------------------------------------*/
+#* all, c & jvm */
+#*---------------------------------------------------------------------*/
+all: bin-$(TARGET)
+c: bin-c
+jvm: bin-jvm
+
+#*---------------------------------------------------------------------*/
+#* Standard Skribe Makefile */
+#*---------------------------------------------------------------------*/
+include ../../../etc/bigloo/Makefile.tpl
+
+#*---------------------------------------------------------------------*/
+#* pop: */
+#*---------------------------------------------------------------------*/
+pop:
+ @ echo $(POPULATION:%=tools/$(TARGETNAME)/bigloo/%)
+
+#*---------------------------------------------------------------------*/
+#* clean */
+#*---------------------------------------------------------------------*/
+clean: stdclean
+
+
diff --git a/skribe/tools/skribebibtex/bigloo/main.scm b/skribe/tools/skribebibtex/bigloo/main.scm
new file mode 100644
index 0000000..3ff89de
--- /dev/null
+++ b/skribe/tools/skribebibtex/bigloo/main.scm
@@ -0,0 +1,44 @@
+;*=====================================================================*/
+;* serrano/prgm/project/skribe/tools/skribebibtex/main.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Oct 12 14:57:58 2001 */
+;* Last change : Fri Oct 24 12:00:23 2003 (serrano) */
+;* Copyright : 2001-03 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The entry point of the bibtex->skribe translator */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module main
+ (import skribebibtex)
+ (main main))
+
+;*---------------------------------------------------------------------*/
+;* main ... */
+;*---------------------------------------------------------------------*/
+(define (main argv)
+ (define (usage args-parse-usage)
+ (print "usage: skribebibtex [options] [input]")
+ (newline)
+ (args-parse-usage #f))
+ (let ((stage 'scr)
+ (dest #f)
+ (in #f))
+ (args-parse (cdr argv)
+ ((("-h" "--help") (help "This help message"))
+ (usage args-parse-usage)
+ (exit 0))
+ ((("--options") (help "Display the options and exit"))
+ (args-parse-usage #t)
+ (exit 0))
+ (("-o" ?out (help "Set the destination file"))
+ (set! dest out))
+ (else
+ (set! in else)))
+ (if (string? dest)
+ (with-output-to-file dest (lambda () (skribebibtex in)))
+ (skribebibtex in))))
+
diff --git a/skribe/tools/skribebibtex/bigloo/skribebibtex.scm b/skribe/tools/skribebibtex/bigloo/skribebibtex.scm
new file mode 100644
index 0000000..b581537
--- /dev/null
+++ b/skribe/tools/skribebibtex/bigloo/skribebibtex.scm
@@ -0,0 +1,385 @@
+;*=====================================================================*/
+;* .../skribe/tools/skribebibtex/bigloo/skribebibtex.scm */
+;* ------------------------------------------------------------- */
+;* Author : Manuel Serrano */
+;* Creation : Fri Oct 12 14:57:58 2001 */
+;* Last change : Sun Apr 10 09:10:02 2005 (serrano) */
+;* Copyright : 2001-05 Manuel Serrano */
+;* ------------------------------------------------------------- */
+;* The bibtex->skribe translator */
+;*=====================================================================*/
+
+;*---------------------------------------------------------------------*/
+;* The module */
+;*---------------------------------------------------------------------*/
+(module skribebibtex
+ (export (skribebibtex in)))
+
+;*---------------------------------------------------------------------*/
+;* skribebibtex ... */
+;*---------------------------------------------------------------------*/
+(define (skribebibtex in)
+ (let* ((port (if (string? in)
+ (let ((p (open-input-file in)))
+ (if (not (input-port? p))
+ (error "skribebibtext"
+ "Can't read input file"
+ in)
+ p))
+ (current-input-port)))
+ (sexp (parse-bibtex port)))
+ (for-each (lambda (e)
+ (match-case e
+ ((?kind ?ident . ?fields)
+ (display* "("
+ (string-downcase (symbol->string kind))
+ " \"" ident "\"")
+ (for-each (lambda (f)
+ (display* "\n (" (car f) " ")
+ (write (cdr f))
+ (display ")"))
+ fields)
+ (print ")\n"))))
+ sexp)))
+
+;*---------------------------------------------------------------------*/
+;* *bibtex-string-table* ... */
+;*---------------------------------------------------------------------*/
+(define *bibtex-string-table* #unspecified)
+
+;*---------------------------------------------------------------------*/
+;* make-bibtex-hashtable ... */
+;*---------------------------------------------------------------------*/
+(define (make-bibtex-hashtable)
+ (let ((table (make-hashtable)))
+ (for-each (lambda (k)
+ (let ((cp (string-capitalize k)))
+ (hashtable-put! table k cp)
+ (hashtable-put! table cp cp)))
+ '("jan" "feb" "mar" "apr" "may" "jun" "jul"
+ "aug" "sep" "oct" "nov" "dec"))
+ table))
+
+;*---------------------------------------------------------------------*/
+;* parse-bibtex ... */
+;*---------------------------------------------------------------------*/
+(define (parse-bibtex port::input-port)
+ (set! *bibtex-string-table* (make-bibtex-hashtable))
+ (cond-expand
+ (bigloo2.6
+ (try (read/lalrp bibtex-parser bibtex-lexer port)
+ (lambda (escape proc mes obj)
+ (match-case obj
+ ((?token (?fname . ?pos) . ?val)
+ (error/location proc "bibtex parse error" token fname pos))
+ (else
+ (notify-error proc mes obj)
+ (error proc mes obj))))))
+ (else
+ (with-exception-handler
+ (lambda (e)
+ (if (&io-parse-error? e)
+ (let ((o (&error-obj e)))
+ (match-case o
+ ((?token (?fname . ?pos) . ?val)
+ (error/location (&error-proc e)
+ "bibtex parse error"
+ token
+ fname
+ pos))
+ (else
+ (raise e))))
+ (raise e)))
+ (lambda ()
+ (read/lalrp bibtex-parser bibtex-lexer port))))))
+
+;*---------------------------------------------------------------------*/
+;* the-coord ... */
+;*---------------------------------------------------------------------*/
+(define (the-coord port)
+ (cons (input-port-name port) (input-port-position port)))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-lexer ... */
+;*---------------------------------------------------------------------*/
+(define bibtex-lexer
+ (regular-grammar ((blank (in " \t\n")))
+ ;; separators
+ ((+ blank)
+ (list 'BLANK (the-coord (the-port))))
+ ;; comments
+ ((: "%" (* all))
+ (ignore))
+ ;; egal sign
+ (#\=
+ (list 'EGAL (the-coord (the-port))))
+ ;; sharp sign
+ ((: (* blank) #\# (* blank))
+ (list 'SHARP (the-coord (the-port))))
+ ;; open bracket
+ (#\{
+ (list 'BRA-OPEN (the-coord (the-port))))
+ ;; close bracket
+ (#\}
+ (list 'BRA-CLO (the-coord (the-port))))
+ ;; comma
+ (#\,
+ (list 'COMMA (the-coord (the-port))))
+ ;; double quote
+ ((: #\\ (in "\"\\_"))
+ (list 'CHAR (the-coord (the-port)) (the-character)))
+ ;; optional linebreak
+ ((: #\\ #\-)
+ (ignore))
+ ;; special latin characters
+ ((or "{\\'e}" "\\'e")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\o}" "\\o")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\~{n}}" "\\~{n}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\~{N}}" "\\~{N}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\^{o}}" "\\^{o}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\^{O}}" "\\^{O}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"{o}}" "\\\"{o}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"{O}}" "\\\"{O}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`e}" "\\`e")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`a}" "\\`a")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"i}" "{\\\"{i}}" "\\\"i" "\\\"{i}")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\\"u}" "\\\"u")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ((or "{\\`u}" "\\`u")
+ (list 'CHAR (the-coord (the-port)) "�"))
+ ;; latex commands
+ ((: #\\ alpha (+ (or alpha digit)))
+ (let ((s (the-substring 1 (the-length))))
+ (cond
+ ((member s '("pi" "Pi" "lambda" "Lambda"))
+ (list 'IDENT (the-coord (the-port)) s))
+ (else
+ (ignore)))))
+ ;; strings
+ ((: "\"" (* (or (out #a000 #\\ #\") (: #\\ all))) "\"")
+ (list 'STRING
+ (the-coord (the-port))
+ (the-substring 1 (-fx (the-length) 1))))
+ ;; commands
+ ((: "@" (+ alpha))
+ (let* ((str (string-upcase (the-substring 1 (the-length))))
+ (sym (string->symbol str)))
+ (case sym
+ ((STRING)
+ (list 'BIBSTRING (the-coord (the-port))))
+ (else
+ (list 'BIBITEM (the-coord (the-port)) sym)))))
+ ;; digit
+ ((+ digit)
+ (list 'NUMBER (the-coord (the-port)) (the-string)))
+ ;; ident
+ ((+ (or alpha digit (in ".:-&/?+*")))
+ (list 'IDENT (the-coord (the-port)) (the-string)))
+ ;; default
+ (else
+ (let ((c (the-failure)))
+ (if (eof-object? c)
+ c
+ (list 'CHAR (the-coord (the-port)) c))))))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-parser ... */
+;*---------------------------------------------------------------------*/
+(define bibtex-parser
+ (lalr-grammar
+ ;; tokens
+ (CHAR IDENT STRING COMMA BRA-OPEN BRA-CLO SHARP BLANK NUMBER EGAL
+ BIBSTRING BIBITEM)
+
+ ;; bibtex
+ (bibtex
+ (()
+ '())
+ ((bibtex string-def)
+ bibtex)
+ ((bibtex bibtex-entry)
+ (cons bibtex-entry bibtex))
+ ((bibtex BLANK)
+ bibtex))
+
+ ;; blank*
+ (blank*
+ (() '())
+ ((blank* BLANK) '()))
+
+ ;; string-def
+ (string-def
+ ((BIBSTRING BRA-OPEN blank* IDENT blank* EGAL blank* bibtex-entry-value BRA-CLO)
+ (bibtex-string-def! (cadr IDENT) bibtex-entry-value)))
+
+ ;; bibtex-entry
+ (bibtex-entry
+ ((BIBITEM blank* BRA-OPEN blank* IDENT blank* COMMA
+ bibtex-entry-item* BRA-CLO)
+ (make-bibtex-entry (cadr BIBITEM)
+ (cadr IDENT)
+ bibtex-entry-item*)))
+
+ ;; bibtex-entry-item*
+ (bibtex-entry-item*
+ ((blank*)
+ '())
+ ((bibtex-entry-item)
+ (list bibtex-entry-item))
+ ((bibtex-entry-item COMMA bibtex-entry-item*)
+ (cons bibtex-entry-item bibtex-entry-item*)))
+
+ ;; bibtex-entry-item
+ (bibtex-entry-item
+ ((blank* IDENT blank* EGAL blank* bibtex-entry-value blank*)
+ (cons (cadr IDENT) bibtex-entry-value)))
+
+ ;; bibtex-entry-value
+ (bibtex-entry-value
+ ((NUMBER)
+ (list (cadr NUMBER)))
+ ((bibtex-entry-value-string)
+ bibtex-entry-value-string)
+ ((BRA-OPEN bibtex-entry-value-block* BRA-CLO)
+ bibtex-entry-value-block*))
+
+ ;; bibtex-entry-value-string
+ (bibtex-entry-value-string
+ ((bibtex-entry-value-string-simple)
+ (list bibtex-entry-value-string-simple))
+ ((bibtex-entry-value-string SHARP bibtex-entry-value-string-simple)
+ `(,@bibtex-entry-value-string ,bibtex-entry-value-string-simple)))
+
+ ;; bibtex-entry-value-string-simple
+ (bibtex-entry-value-string-simple
+ ((STRING)
+ (cadr STRING))
+ ((IDENT)
+ `(ref ,(cadr IDENT))))
+
+ ;; bibtex-entry-value-block*
+ (bibtex-entry-value-block*
+ (()
+ '())
+ ((bibtex-entry-value-block* bibtex-entry-value-block)
+ (append bibtex-entry-value-block* bibtex-entry-value-block)))
+
+ ;; bibtex-entry-value-block
+ (bibtex-entry-value-block
+ ((BRA-OPEN bibtex-entry-value-block* BRA-CLO)
+ bibtex-entry-value-block*)
+ ((COMMA)
+ (list ","))
+ ((IDENT)
+ (list (cadr IDENT)))
+ ((BLANK)
+ (list " "))
+ ((EGAL)
+ (list "="))
+ ((CHAR)
+ (list (cadr CHAR)))
+ ((NUMBER)
+ (list (cadr NUMBER)))
+ ((STRING)
+ (list (string-append "\"" (cadr STRING) "\""))))))
+
+;*---------------------------------------------------------------------*/
+;* bibtex-string-def! ... */
+;*---------------------------------------------------------------------*/
+(define (bibtex-string-def! ident value)
+ (define (->string value)
+ (if (string? value)
+ value
+ (match-case value
+ (((and ?s (? string?)))
+ s)
+ (((and ?n (? number?)))
+ (number->string n))
+ (else
+ (apply string-append (map ->string value))))))
+ (hashtable-put! *bibtex-string-table* ident (->string value)))
+
+;*---------------------------------------------------------------------*/
+;* make-bibtex-entry ... */
+;*---------------------------------------------------------------------*/
+(define (make-bibtex-entry kind ident value)
+ (define (parse-entry-value line)
+ (let ((name (car line))
+ (val (cdr line)))
+ (let loop ((val (reverse val))
+ (res ""))
+ (cond
+ ((null? val)
+ (cons name (untexify res)))
+ ((char? (car val))
+ (loop (cdr val) (string-append (string (car val)) res)))
+ ((string? (car val))
+ (loop (cdr val) (string-append (car val) res)))
+ (else
+ (match-case (car val)
+ ((ref ?ref)
+ (let ((h (hashtable-get *bibtex-string-table* ref)))
+ (loop (cdr val)
+ (if (string? h)
+ (string-append h res)
+ res))))
+ (else
+ (loop (cdr val) res))))))))
+ (let ((fields (map parse-entry-value value)))
+ `(,kind ,ident ,@fields)))
+
+;*---------------------------------------------------------------------*/
+;* untexify ... */
+;*---------------------------------------------------------------------*/
+(define (untexify val)
+ (define (untexify-math-string str)
+ (string-case str
+ ((+ (out #\_ #\^ #\space #\Newline #\tab))
+ (let ((s (the-string)))
+ (string-append s (ignore))))
+ ((+ (in "^_"))
+ (ignore))
+ ((+ (in " \n\t"))
+ (string-append " " (ignore)))
+ (else
+ "")))
+ (define (untexify-string str)
+ (let ((s (pregexp-replace* "C[$]\\^[$]_[+][+][$][$]" str "C++")))
+ (string-case (pregexp-replace* "[{}]" s "")
+ ((+ (out #\\ #\$ #\space #\Newline #\tab #\~))
+ (let ((s (the-string)))
+ (string-append s (ignore))))
+ ((: #\\ (+ (or (: "c" (out #\h))
+ (: "ch" (out #\a))
+ (: "cha" (out #\r))
+ (: "char" (out digit))
+ (out #\\ #\space #\c))))
+ (ignore))
+ ((: #\\ "char" (+ digit))
+ (string-append
+ (string
+ (integer->char
+ (string->integer
+ (the-substring 5 (the-length)))))
+ (ignore)))
+ ((: #\$ (* (out #\$)) #\$)
+ (let ((s (the-substring 1 (-fx (the-length) 1))))
+ (string-append (untexify-math-string s) (ignore))))
+ ((+ (in " \n\t~"))
+ (string-append " " (ignore)))
+ (else
+ ""))))
+ (if (string? val)
+ (untexify-string val)
+ (map untexify val)))
diff --git a/skribe/tools/skribebibtex/stklos/Makefile b/skribe/tools/skribebibtex/stklos/Makefile
new file mode 100644
index 0000000..3e31d88
--- /dev/null
+++ b/skribe/tools/skribebibtex/stklos/Makefile
@@ -0,0 +1,62 @@
+#
+# Makefile for STklos skribebibtex
+#
+# Author: Erick Gallesio [eg@essi.fr]
+# Creation date: 26-Oct-2004 18:40 (eg)
+# Last file update: 8-Nov-2004 15:25 (eg)
+
+include ../../../etc/stklos/Makefile.skb
+include ../../../etc/Makefile.config
+
+POPULATION = Makefile bibtex-lex.l bibtex-parser.y skribebibtex.stk main.stk
+BINDIR = ../../../bin
+TARGET = skribebibtex
+EXE = $(BINDIR)/$(TARGET).stklos
+
+all: $(EXE)
+
+$(EXE): main.stk bibtex-lex.stk bibtex-parser.stk
+ stklos-compile -l -o $(EXE) main.stk
+
+bibtex-lex.stk: bibtex-lex.l
+ stklos-genlex bibtex-lex.l bibtex-lex.stk bibtex-lex
+
+bibtex-parser.stk: bibtex-parser.y
+ stklos -f bibtex-parser.y
+
+bibtex: bibtex-lex.stk
+
+
+#======================================================================
+# install ...
+#======================================================================
+install: $(INSTALL_BINDIR)
+ cp $(EXE) $(INSTALL_BINDIR)/$(TARGET).stklos \
+ && chmod $(BMASK) $(INSTALL_BINDIR)/$(TARGET).stklos
+ rm -f $(INSTALL_BINDIR)/$(TARGET)
+ ln -s $(TARGET).stklos $(INSTALL_BINDIR)/$(TARGET)
+
+$(INSTALL_BINDIR):
+ mkdir -p $(INSTALL_BINDIR) && chmod a+rx $(INSTALL_BINDIR)
+
+
+#======================================================================
+# uninstall ...
+#======================================================================
+uninstall:
+ rm $(INSTALL_BINDIR)/$(TARGET)
+ rm $(INSTALL_BINDIR)/$(TARGET).stklos
+
+
+#======================================================================
+# pop ...
+#======================================================================
+pop:
+ @echo $(POPULATION:%=tools/skribebibtex/stklos/%)
+
+#======================================================================
+# clean ...
+#======================================================================
+
+clean:
+ rm -f $(EXE) bibtex-lex.stk bibtex-parser.stk *~
diff --git a/skribe/tools/skribebibtex/stklos/bibtex-lex.l b/skribe/tools/skribebibtex/stklos/bibtex-lex.l
new file mode 100644
index 0000000..03b4871
--- /dev/null
+++ b/skribe/tools/skribebibtex/stklos/bibtex-lex.l
@@ -0,0 +1,75 @@
+;;;; -*- Scheme -*-
+;;;; bibtex-lex.l -- SILex input for BibTeX
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 21-Oct-2004 17:47 (eg)
+;;;; Last file update: 25-Oct-2004 20:16 (eg)
+;;;;
+
+
+space [ \n\9]
+alpha [-+a-zA-Z����������������������������./:()?!'&_~]
+
+%%
+
+;; Spaces
+{space}+ (list 'BLANK)
+;; Comment
+\%.*$ (yycontinue)
+;; equal sign
+= (list 'EQUAL)
+;; Open Bracket
+\{ (list 'LBRACKET)
+;; Close Bracket
+\} (list 'RBRACKET)
+;; Comma
+, (list 'COMMA)
+;; Strings
+\"[^\"]*\" (list 'STRING yytext)
+;; Commands
+@{alpha}+ (let* ((str (string-downcase
+ (substring yytext 1
+ (string-length yytext))))
+ (sym (string->symbol str)))
+ (case sym
+ ((string) (list 'BIBSTRING))
+ (else (list 'BIBITEM sym))))
+;; Ident
+{alpha}({alpha}|[0-9])* (list 'IDENT yytext)
+;; Number
+[0-9]+ (list 'NUMBER yytext)
+;; Diacritic
+\\['`^\"][aeiouAEIOU] (lex-char (string-ref yytext 1)
+ (string-ref yytext 2))
+\{\\['`^\"][aeiouAEIOU]\} (lex-char (string-ref yytext 2)
+ (string-ref yytext 3))
+
+;; Unrecognized character
+. (begin
+ (format (current-error-port)
+ "Skipping character ~S\n" yytext)
+ (yycontinue))
+
+;;;; ======================================================================
+<<EOF>> '*eoi*
+<<ERROR>> (error 'bibtex-lexer "Parse error" yytext)
+
+
diff --git a/skribe/tools/skribebibtex/stklos/bibtex-parser.y b/skribe/tools/skribebibtex/stklos/bibtex-parser.y
new file mode 100644
index 0000000..50236a9
--- /dev/null
+++ b/skribe/tools/skribebibtex/stklos/bibtex-parser.y
@@ -0,0 +1,117 @@
+;;;; -*- Scheme -*-
+;;;; bibtex-parser.y -- SILex input for BibTeX
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 21-Oct-2004 17:47 (eg)
+;;;; Last file update: 22-Oct-2004 18:14 (eg)
+;;;;
+
+(load "lalr")
+
+(define (main args)
+ ;; Build the parser
+ (lalr-parser
+ ;; Options
+ (output: parser "bibtex-parser.stk")
+
+ ;; Terminal symbols
+ (CHAR BLANK IDENT STRING COMMA LBRACKET RBRACKET NUMBER EQUAL
+ BIBSTRING BIBITEM)
+
+ ;; Rules
+ (S
+ ()
+ (S string-def)
+ (S blank*)
+ (S bibtex-entry))
+
+
+ (blank*
+ ()
+ (blank* BLANK))
+
+
+ (string-def
+ (BIBSTRING LBRACKET blank* IDENT blank* EQUAL blank* entry-value
+ blank* RBRACKET)
+ : (bibtex-string-def! (car $4) (car $8)))
+
+
+ (bibtex-entry
+ (BIBITEM LBRACKET blank* IDENT blank* COMMA blank* entry-item* RBRACKET)
+ : (make-bibentry $1 $4 $8))
+
+
+ (entry-item*
+ (blank*)
+ : '()
+ (entry-item)
+ : (list $1)
+ (entry-item COMMA entry-item*)
+ : (cons $1 $3))
+
+
+ (entry-item
+ (blank* IDENT blank* EQUAL blank* entry-value blank*)
+ : (cons (car $2) $6))
+
+
+ (entry-value
+ (NUMBER)
+ : (list (car $1))
+ (STRING)
+ : $1
+ (IDENT)
+ : (bibtex-string-ref (car $1))
+ (LBRACKET entry-value-block* RBRACKET)
+ : (list (apply string-append $2)))
+
+
+ (entry-value-block*
+ ()
+ : '()
+ (entry-value-block* entry-value-block)
+ : (append $1 $2))
+
+
+ (entry-value-block
+ (LBRACKET entry-value-block* RBRACKET)
+ : $2
+ (COMMA)
+ : (list ",")
+ (IDENT)
+ : $1
+ (BLANK)
+ : (list " ")
+ (EQUAL)
+ : (list "=")
+ (CHAR)
+ : $1
+ (NUMBER)
+ : $1
+ (STRING)
+ : $1)
+ )
+ ;; Terminate
+ 0)
+
+
+
\ No newline at end of file
diff --git a/skribe/tools/skribebibtex/stklos/main.stk b/skribe/tools/skribebibtex/stklos/main.stk
new file mode 100644
index 0000000..3225658
--- /dev/null
+++ b/skribe/tools/skribebibtex/stklos/main.stk
@@ -0,0 +1,118 @@
+;;;;
+;;;; main.stk -- Skribebibtex Main
+;;;;
+;;;; Copyright � 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
+;;;;
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this program; if not, write to the Free Software
+;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+;;;; USA.
+;;;;
+;;;; Author: Erick Gallesio [eg@essi.fr]
+;;;; Creation date: 22-Oct-2004 10:29 (eg)
+;;;; Last file update: 26-Oct-2004 21:52 (eg)
+;;;;
+
+(define *bibtex-strings* (make-hash-table string=?))
+(define *debug* (getenv "DEBUG"))
+(define *in* (current-input-port))
+(define *out* (current-output-port))
+
+
+(define (bibtex-string-def! str val)
+ (hash-table-put! *bibtex-strings* str val))
+
+
+(define (bibtex-string-ref str)
+ (list (hash-table-get *bibtex-strings* str str)))
+
+
+(define (lex-char accent letter)
+ (list 'CHAR
+ (case accent
+ ((#\') (case letter
+ ((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
+ ((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
+ (else "?")))
+ ((#\`) (case letter
+ ((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
+ ((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
+ (else "?")))
+ ((#\^) (case letter
+ ((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
+ ((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
+ (else "?")))
+ ((#\") (case letter
+ ((#\a) "�") ((#\e) "�") ((#\i) "�") ((#\o) "�") ((#\u) "�")
+ ((#\A) "�") ((#\E) "�") ((#\I) "�") ((#\O) "�") ((#\U) "�")
+ (else "?")))
+ (else "?"))))
+
+
+(define (make-bibentry kind key infos)
+ (define (pretty-string s)
+ (if (and (string? s)
+ (>= (string-length s) 2)
+ (eq? #\" (string-ref s 0))
+ (eq? #\" (string-ref s (- (string-length s) 1))))
+ (substring s 1 (- (string-length s) 1))
+ s))
+ (format *out* ";;;;\n(~A ~S\n" (car kind) (car key))
+ (for-each (lambda (x) (format *out* " (~A ~S)\n"
+ (car x)
+ (pretty-string (cadr x))))
+ infos)
+ (format *out* ")\n\n"))
+
+
+;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+(include "bibtex-lex.stk")
+(include "bibtex-parser.stk")
+;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
+
+(define (bibtex2scheme in out)
+ (let* ((lex (bibtex-lex in))
+ (scan (lambda ()
+ (let ((tok (lexer-next-token lex)))
+ (when *debug*
+ (format (current-error-port) "token = ~S\n" tok))
+ tok)))
+ (error (lambda (a b) (error 'bibtex-parser "~A~A" a b))))
+ (parser scan error)))
+
+
+(define (main args)
+ ;; Parse the program arguments
+ (parse-arguments args
+ "Usage: skribebibtex [options] [input]"
+ (("help" :alternate "h" :help "provide help for the command")
+ (arg-usage (current-error-port))
+ (exit 0))
+ (("options" :help "display the options and exit")
+ (arg-usage (current-output-port) #t)
+ (exit 0))
+ (("output" :alternate "o" :arg file :help "set the output to <file>")
+ (let ((port (open-file file "w")))
+ (if port
+ (set! *out* port)
+ (die (format "~A: bad output file ~S" 'skribebibtex file) 1))))
+ (else
+ (cond
+ ((= (length other-arguments) 1)
+ (let* ((file (car other-arguments))
+ (port (open-file file "r")))
+ (if port
+ (set! *in* file)
+ (die (format "~A: bad input file ~S" 'skribebibtex file) 1)))))))
+ (bibtex2scheme *in* *out*))
--
cgit v1.2.3