aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtes2005-10-31 16:16:54 +0000
committerLudovic Courtes2005-10-31 16:16:54 +0000
commit89a424521b753ee7c2c67ebdc957865657f647c4 (patch)
tree7d15f69ef9aa87cd6e89153d34240baa031177c2
parentfe831fd1e716de64a1b92beeabe4d865546dd986 (diff)
downloadskribilo-89a424521b753ee7c2c67ebdc957865657f647c4.tar.gz
skribilo-89a424521b753ee7c2c67ebdc957865657f647c4.tar.lz
skribilo-89a424521b753ee7c2c67ebdc957865657f647c4.zip
Moved the STkLos and Bigloo code to `legacy'.
Moved the STkLos and Bigloo code from `src' to `legacy'. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
-rw-r--r--Makefile131
-rwxr-xr-xconfigure124
-rw-r--r--legacy/bigloo/Makefile (renamed from src/bigloo/Makefile)0
-rw-r--r--legacy/bigloo/api.bgl (renamed from src/bigloo/api.bgl)0
-rw-r--r--legacy/bigloo/api.sch (renamed from src/bigloo/api.sch)0
-rw-r--r--legacy/bigloo/asm.scm (renamed from src/bigloo/asm.scm)0
-rw-r--r--legacy/bigloo/bib.bgl (renamed from src/bigloo/bib.bgl)0
-rw-r--r--legacy/bigloo/c.scm (renamed from src/bigloo/c.scm)0
-rw-r--r--legacy/bigloo/color.scm (renamed from src/bigloo/color.scm)0
-rw-r--r--legacy/bigloo/configure.bgl (renamed from src/bigloo/configure.bgl)0
-rw-r--r--legacy/bigloo/debug.sch (renamed from src/bigloo/debug.sch)0
-rw-r--r--legacy/bigloo/debug.scm (renamed from src/bigloo/debug.scm)0
-rw-r--r--legacy/bigloo/engine.scm (renamed from src/bigloo/engine.scm)0
-rw-r--r--legacy/bigloo/eval.scm (renamed from src/bigloo/eval.scm)0
-rw-r--r--legacy/bigloo/evapi.scm (renamed from src/bigloo/evapi.scm)0
-rw-r--r--legacy/bigloo/index.bgl (renamed from src/bigloo/index.bgl)0
-rw-r--r--legacy/bigloo/lib.bgl (renamed from src/bigloo/lib.bgl)0
-rw-r--r--legacy/bigloo/lisp.scm (renamed from src/bigloo/lisp.scm)0
-rw-r--r--legacy/bigloo/main.scm (renamed from src/bigloo/main.scm)0
-rw-r--r--legacy/bigloo/new.sch (renamed from src/bigloo/new.sch)0
-rw-r--r--legacy/bigloo/output.scm (renamed from src/bigloo/output.scm)0
-rw-r--r--legacy/bigloo/param.bgl (renamed from src/bigloo/param.bgl)0
-rw-r--r--legacy/bigloo/parseargs.scm (renamed from src/bigloo/parseargs.scm)0
-rw-r--r--legacy/bigloo/prog.scm (renamed from src/bigloo/prog.scm)0
-rw-r--r--legacy/bigloo/read.scm (renamed from src/bigloo/read.scm)0
-rw-r--r--legacy/bigloo/resolve.scm (renamed from src/bigloo/resolve.scm)0
-rw-r--r--legacy/bigloo/source.scm (renamed from src/bigloo/source.scm)0
-rw-r--r--legacy/bigloo/sui.bgl (renamed from src/bigloo/sui.bgl)0
-rw-r--r--legacy/bigloo/types.scm (renamed from src/bigloo/types.scm)0
-rw-r--r--legacy/bigloo/verify.scm (renamed from src/bigloo/verify.scm)0
-rw-r--r--legacy/bigloo/writer.scm (renamed from src/bigloo/writer.scm)0
-rw-r--r--legacy/bigloo/xml.scm (renamed from src/bigloo/xml.scm)0
-rw-r--r--legacy/stklos/Makefile.in (renamed from src/stklos/Makefile.in)0
-rw-r--r--legacy/stklos/biblio.stk (renamed from src/stklos/biblio.stk)0
-rw-r--r--legacy/stklos/c-lex.l (renamed from src/stklos/c-lex.l)0
-rw-r--r--legacy/stklos/c.stk (renamed from src/stklos/c.stk)0
-rw-r--r--legacy/stklos/color.stk (renamed from src/stklos/color.stk)0
-rw-r--r--legacy/stklos/configure.stk (renamed from src/stklos/configure.stk)0
-rw-r--r--legacy/stklos/debug.stk (renamed from src/stklos/debug.stk)0
-rw-r--r--legacy/stklos/engine.stk (renamed from src/stklos/engine.stk)0
-rw-r--r--legacy/stklos/eval.stk (renamed from src/stklos/eval.stk)0
-rw-r--r--legacy/stklos/lib.stk (renamed from src/stklos/lib.stk)0
-rw-r--r--legacy/stklos/lisp-lex.l (renamed from src/stklos/lisp-lex.l)0
-rw-r--r--legacy/stklos/lisp.stk (renamed from src/stklos/lisp.stk)0
-rw-r--r--legacy/stklos/main.stk (renamed from src/stklos/main.stk)0
-rw-r--r--legacy/stklos/output.stk (renamed from src/stklos/output.stk)0
-rw-r--r--legacy/stklos/prog.stk (renamed from src/stklos/prog.stk)0
-rw-r--r--legacy/stklos/reader.stk (renamed from src/stklos/reader.stk)0
-rw-r--r--legacy/stklos/resolve.stk (renamed from src/stklos/resolve.stk)0
-rw-r--r--legacy/stklos/runtime.stk (renamed from src/stklos/runtime.stk)0
-rw-r--r--legacy/stklos/source.stk (renamed from src/stklos/source.stk)0
-rw-r--r--legacy/stklos/types.stk (renamed from src/stklos/types.stk)0
-rw-r--r--legacy/stklos/vars.stk (renamed from src/stklos/vars.stk)0
-rw-r--r--legacy/stklos/verify.stk (renamed from src/stklos/verify.stk)0
-rw-r--r--legacy/stklos/writer.stk (renamed from src/stklos/writer.stk)0
-rw-r--r--legacy/stklos/xml-lex.l (renamed from src/stklos/xml-lex.l)0
-rw-r--r--legacy/stklos/xml.stk (renamed from src/stklos/xml.stk)0
-rw-r--r--src/Makefile41
-rw-r--r--src/common/api.scm1249
-rw-r--r--src/common/bib.scm192
-rw-r--r--src/common/configure.scm8
-rw-r--r--src/common/configure.scm.in6
-rw-r--r--src/common/index.scm126
-rw-r--r--src/common/lib.scm238
-rw-r--r--src/common/param.scm69
-rw-r--r--src/common/sui.scm166
66 files changed, 0 insertions, 2350 deletions
diff --git a/Makefile b/Makefile
deleted file mode 100644
index 918e91a..0000000
--- a/Makefile
+++ /dev/null
@@ -1,131 +0,0 @@
-#*=====================================================================*/
-#* 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/configure b/configure
deleted file mode 100755
index 798d9d2..0000000
--- a/configure
+++ /dev/null
@@ -1,124 +0,0 @@
-#!/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/src/bigloo/Makefile b/legacy/bigloo/Makefile
index 02d2b6a..02d2b6a 100644
--- a/src/bigloo/Makefile
+++ b/legacy/bigloo/Makefile
diff --git a/src/bigloo/api.bgl b/legacy/bigloo/api.bgl
index 55493b0..55493b0 100644
--- a/src/bigloo/api.bgl
+++ b/legacy/bigloo/api.bgl
diff --git a/src/bigloo/api.sch b/legacy/bigloo/api.sch
index 390b8fa..390b8fa 100644
--- a/src/bigloo/api.sch
+++ b/legacy/bigloo/api.sch
diff --git a/src/bigloo/asm.scm b/legacy/bigloo/asm.scm
index 03196ac..03196ac 100644
--- a/src/bigloo/asm.scm
+++ b/legacy/bigloo/asm.scm
diff --git a/src/bigloo/bib.bgl b/legacy/bigloo/bib.bgl
index 6b0f7dd..6b0f7dd 100644
--- a/src/bigloo/bib.bgl
+++ b/legacy/bigloo/bib.bgl
diff --git a/src/bigloo/c.scm b/legacy/bigloo/c.scm
index 07290ce..07290ce 100644
--- a/src/bigloo/c.scm
+++ b/legacy/bigloo/c.scm
diff --git a/src/bigloo/color.scm b/legacy/bigloo/color.scm
index e481d65..e481d65 100644
--- a/src/bigloo/color.scm
+++ b/legacy/bigloo/color.scm
diff --git a/src/bigloo/configure.bgl b/legacy/bigloo/configure.bgl
index e100d8d..e100d8d 100644
--- a/src/bigloo/configure.bgl
+++ b/legacy/bigloo/configure.bgl
diff --git a/src/bigloo/debug.sch b/legacy/bigloo/debug.sch
index 9b53c84..9b53c84 100644
--- a/src/bigloo/debug.sch
+++ b/legacy/bigloo/debug.sch
diff --git a/src/bigloo/debug.scm b/legacy/bigloo/debug.scm
index 8f1691c..8f1691c 100644
--- a/src/bigloo/debug.scm
+++ b/legacy/bigloo/debug.scm
diff --git a/src/bigloo/engine.scm b/legacy/bigloo/engine.scm
index bd8a027..bd8a027 100644
--- a/src/bigloo/engine.scm
+++ b/legacy/bigloo/engine.scm
diff --git a/src/bigloo/eval.scm b/legacy/bigloo/eval.scm
index b5c6548..b5c6548 100644
--- a/src/bigloo/eval.scm
+++ b/legacy/bigloo/eval.scm
diff --git a/src/bigloo/evapi.scm b/legacy/bigloo/evapi.scm
index 6f0d49e..6f0d49e 100644
--- a/src/bigloo/evapi.scm
+++ b/legacy/bigloo/evapi.scm
diff --git a/src/bigloo/index.bgl b/legacy/bigloo/index.bgl
index 9697981..9697981 100644
--- a/src/bigloo/index.bgl
+++ b/legacy/bigloo/index.bgl
diff --git a/src/bigloo/lib.bgl b/legacy/bigloo/lib.bgl
index 6dd6d37..6dd6d37 100644
--- a/src/bigloo/lib.bgl
+++ b/legacy/bigloo/lib.bgl
diff --git a/src/bigloo/lisp.scm b/legacy/bigloo/lisp.scm
index 65a8227..65a8227 100644
--- a/src/bigloo/lisp.scm
+++ b/legacy/bigloo/lisp.scm
diff --git a/src/bigloo/main.scm b/legacy/bigloo/main.scm
index 5b9e5e5..5b9e5e5 100644
--- a/src/bigloo/main.scm
+++ b/legacy/bigloo/main.scm
diff --git a/src/bigloo/new.sch b/legacy/bigloo/new.sch
index 16bb7d5..16bb7d5 100644
--- a/src/bigloo/new.sch
+++ b/legacy/bigloo/new.sch
diff --git a/src/bigloo/output.scm b/legacy/bigloo/output.scm
index 4bc6271..4bc6271 100644
--- a/src/bigloo/output.scm
+++ b/legacy/bigloo/output.scm
diff --git a/src/bigloo/param.bgl b/legacy/bigloo/param.bgl
index 6ff6b42..6ff6b42 100644
--- a/src/bigloo/param.bgl
+++ b/legacy/bigloo/param.bgl
diff --git a/src/bigloo/parseargs.scm b/legacy/bigloo/parseargs.scm
index 4ce58c4..4ce58c4 100644
--- a/src/bigloo/parseargs.scm
+++ b/legacy/bigloo/parseargs.scm
diff --git a/src/bigloo/prog.scm b/legacy/bigloo/prog.scm
index baad0f0..baad0f0 100644
--- a/src/bigloo/prog.scm
+++ b/legacy/bigloo/prog.scm
diff --git a/src/bigloo/read.scm b/legacy/bigloo/read.scm
index 91cd345..91cd345 100644
--- a/src/bigloo/read.scm
+++ b/legacy/bigloo/read.scm
diff --git a/src/bigloo/resolve.scm b/legacy/bigloo/resolve.scm
index 8248a4f..8248a4f 100644
--- a/src/bigloo/resolve.scm
+++ b/legacy/bigloo/resolve.scm
diff --git a/src/bigloo/source.scm b/legacy/bigloo/source.scm
index babadff..babadff 100644
--- a/src/bigloo/source.scm
+++ b/legacy/bigloo/source.scm
diff --git a/src/bigloo/sui.bgl b/legacy/bigloo/sui.bgl
index 63c5477..63c5477 100644
--- a/src/bigloo/sui.bgl
+++ b/legacy/bigloo/sui.bgl
diff --git a/src/bigloo/types.scm b/legacy/bigloo/types.scm
index b8babd4..b8babd4 100644
--- a/src/bigloo/types.scm
+++ b/legacy/bigloo/types.scm
diff --git a/src/bigloo/verify.scm b/legacy/bigloo/verify.scm
index 602a951..602a951 100644
--- a/src/bigloo/verify.scm
+++ b/legacy/bigloo/verify.scm
diff --git a/src/bigloo/writer.scm b/legacy/bigloo/writer.scm
index ce515bf..ce515bf 100644
--- a/src/bigloo/writer.scm
+++ b/legacy/bigloo/writer.scm
diff --git a/src/bigloo/xml.scm b/legacy/bigloo/xml.scm
index d4c662e..d4c662e 100644
--- a/src/bigloo/xml.scm
+++ b/legacy/bigloo/xml.scm
diff --git a/src/stklos/Makefile.in b/legacy/stklos/Makefile.in
index 80a26de..80a26de 100644
--- a/src/stklos/Makefile.in
+++ b/legacy/stklos/Makefile.in
diff --git a/src/stklos/biblio.stk b/legacy/stklos/biblio.stk
index 5691588..5691588 100644
--- a/src/stklos/biblio.stk
+++ b/legacy/stklos/biblio.stk
diff --git a/src/stklos/c-lex.l b/legacy/stklos/c-lex.l
index a5b337e..a5b337e 100644
--- a/src/stklos/c-lex.l
+++ b/legacy/stklos/c-lex.l
diff --git a/src/stklos/c.stk b/legacy/stklos/c.stk
index 265c421..265c421 100644
--- a/src/stklos/c.stk
+++ b/legacy/stklos/c.stk
diff --git a/src/stklos/color.stk b/legacy/stklos/color.stk
index 0cb829f..0cb829f 100644
--- a/src/stklos/color.stk
+++ b/legacy/stklos/color.stk
diff --git a/src/stklos/configure.stk b/legacy/stklos/configure.stk
index ece7abc..ece7abc 100644
--- a/src/stklos/configure.stk
+++ b/legacy/stklos/configure.stk
diff --git a/src/stklos/debug.stk b/legacy/stklos/debug.stk
index a9fefde..a9fefde 100644
--- a/src/stklos/debug.stk
+++ b/legacy/stklos/debug.stk
diff --git a/src/stklos/engine.stk b/legacy/stklos/engine.stk
index a13ed0f..a13ed0f 100644
--- a/src/stklos/engine.stk
+++ b/legacy/stklos/engine.stk
diff --git a/src/stklos/eval.stk b/legacy/stklos/eval.stk
index 3acace9..3acace9 100644
--- a/src/stklos/eval.stk
+++ b/legacy/stklos/eval.stk
diff --git a/src/stklos/lib.stk b/legacy/stklos/lib.stk
index 3c3b9f0..3c3b9f0 100644
--- a/src/stklos/lib.stk
+++ b/legacy/stklos/lib.stk
diff --git a/src/stklos/lisp-lex.l b/legacy/stklos/lisp-lex.l
index efad24b..efad24b 100644
--- a/src/stklos/lisp-lex.l
+++ b/legacy/stklos/lisp-lex.l
diff --git a/src/stklos/lisp.stk b/legacy/stklos/lisp.stk
index 9bfe75a..9bfe75a 100644
--- a/src/stklos/lisp.stk
+++ b/legacy/stklos/lisp.stk
diff --git a/src/stklos/main.stk b/legacy/stklos/main.stk
index 4905423..4905423 100644
--- a/src/stklos/main.stk
+++ b/legacy/stklos/main.stk
diff --git a/src/stklos/output.stk b/legacy/stklos/output.stk
index 3c00323..3c00323 100644
--- a/src/stklos/output.stk
+++ b/legacy/stklos/output.stk
diff --git a/src/stklos/prog.stk b/legacy/stklos/prog.stk
index 6301ece..6301ece 100644
--- a/src/stklos/prog.stk
+++ b/legacy/stklos/prog.stk
diff --git a/src/stklos/reader.stk b/legacy/stklos/reader.stk
index bd38562..bd38562 100644
--- a/src/stklos/reader.stk
+++ b/legacy/stklos/reader.stk
diff --git a/src/stklos/resolve.stk b/legacy/stklos/resolve.stk
index 91dc965..91dc965 100644
--- a/src/stklos/resolve.stk
+++ b/legacy/stklos/resolve.stk
diff --git a/src/stklos/runtime.stk b/legacy/stklos/runtime.stk
index 58d0d45..58d0d45 100644
--- a/src/stklos/runtime.stk
+++ b/legacy/stklos/runtime.stk
diff --git a/src/stklos/source.stk b/legacy/stklos/source.stk
index a3102c1..a3102c1 100644
--- a/src/stklos/source.stk
+++ b/legacy/stklos/source.stk
diff --git a/src/stklos/types.stk b/legacy/stklos/types.stk
index fb16230..fb16230 100644
--- a/src/stklos/types.stk
+++ b/legacy/stklos/types.stk
diff --git a/src/stklos/vars.stk b/legacy/stklos/vars.stk
index 1c875f8..1c875f8 100644
--- a/src/stklos/vars.stk
+++ b/legacy/stklos/vars.stk
diff --git a/src/stklos/verify.stk b/legacy/stklos/verify.stk
index da9b132..da9b132 100644
--- a/src/stklos/verify.stk
+++ b/legacy/stklos/verify.stk
diff --git a/src/stklos/writer.stk b/legacy/stklos/writer.stk
index 2b0f91c..2b0f91c 100644
--- a/src/stklos/writer.stk
+++ b/legacy/stklos/writer.stk
diff --git a/src/stklos/xml-lex.l b/legacy/stklos/xml-lex.l
index 5d9a8d9..5d9a8d9 100644
--- a/src/stklos/xml-lex.l
+++ b/legacy/stklos/xml-lex.l
diff --git a/src/stklos/xml.stk b/legacy/stklos/xml.stk
index 47dd46f..47dd46f 100644
--- a/src/stklos/xml.stk
+++ b/legacy/stklos/xml.stk
diff --git a/src/Makefile b/src/Makefile
deleted file mode 100644
index 09e96d5..0000000
--- a/src/Makefile
+++ /dev/null
@@ -1,41 +0,0 @@
-#*=====================================================================*/
-#* 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/src/common/api.scm b/src/common/api.scm
deleted file mode 100644
index eb657c7..0000000
--- a/src/common/api.scm
+++ /dev/null
@@ -1,1249 +0,0 @@
-;*=====================================================================*/
-;* 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 (symbol->string (gensym 'chapter))))
- (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 (symbol->string (gensym 'section))))
- (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 (symbol->string (gensym 'subsection))))
- (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 (symbol->string (gensym 'subsubsection))))
- (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") (label #t))
- ;; The `:label' option used to be called `:number'.
- (new container
- (markup 'footnote)
- (ident (symbol->string (gensym 'footnote)))
- (class class)
- (required-options '())
- (options `((:label
- ,(cond ((string? label) label)
- ((number? label) label)
- ((not label) label)
- (else
- (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/src/common/bib.scm b/src/common/bib.scm
deleted file mode 100644
index b73c5f0..0000000
--- a/src/common/bib.scm
+++ /dev/null
@@ -1,192 +0,0 @@
-;*=====================================================================*/
-;* 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/src/common/configure.scm b/src/common/configure.scm
deleted file mode 100644
index 90e2339..0000000
--- a/src/common/configure.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-;; Automatically generated file (don't edit)
-(define (skribe-release) "1.2d")
-(define (skribe-url) "http://www.inria.fr/mimosa/fp/Skribe")
-(define (skribe-doc-dir) "/usr/local/doc/skribe-1.2d")
-(define (skribe-ext-dir) "/usr/local/share/skribe/extensions")
-(define (skribe-default-path) '("." "/usr/local/share/skribe/extensions" "/usr/local/share/skribe/1.2d/skr" ))
-(define (skribe-scheme) "bigloo")
-
diff --git a/src/common/configure.scm.in b/src/common/configure.scm.in
deleted file mode 100644
index 830ec4d..0000000
--- a/src/common/configure.scm.in
+++ /dev/null
@@ -1,6 +0,0 @@
-(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/src/common/index.scm b/src/common/index.scm
deleted file mode 100644
index 65c271f..0000000
--- a/src/common/index.scm
+++ /dev/null
@@ -1,126 +0,0 @@
-;*=====================================================================*/
-;* 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/src/common/lib.scm b/src/common/lib.scm
deleted file mode 100644
index b0fa2d0..0000000
--- a/src/common/lib.scm
+++ /dev/null
@@ -1,238 +0,0 @@
-;*=====================================================================*/
-;* 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/src/common/param.scm b/src/common/param.scm
deleted file mode 100644
index ba8d489..0000000
--- a/src/common/param.scm
+++ /dev/null
@@ -1,69 +0,0 @@
-;*=====================================================================*/
-;* 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/src/common/sui.scm b/src/common/sui.scm
deleted file mode 100644
index eb6134b..0000000
--- a/src/common/sui.scm
+++ /dev/null
@@ -1,166 +0,0 @@
-;*=====================================================================*/
-;* 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))))