diff options
| author | Ludovic Court`es | 2005-11-02 10:08:38 +0000 |
|---|---|---|
| committer | Ludovic Court`es | 2005-11-02 10:08:38 +0000 |
| commit | b76d5e1b252967521f210eac10ddbf089dde8c6a (patch) | |
| tree | 00fc81c51256991c04799d79a749bbdd5b9fad30 /skribe | |
| parent | ba63b8d4780428d9f63f6ace7f49361b77401112 (diff) | |
| parent | f553cb65b157b6df9563cefa593902d59301461b (diff) | |
| download | skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip | |
Cleaned up the source tree and the installation process.
Patches applied:
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6
Cosmetic changes.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7
Removed useless files, integrated packages.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8
Removed useless files, integrated packages.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
Moved the STkLos and Bigloo code to `legacy'.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10
Installed Autoconf/Automake machinery. Fixed a few things.
* lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11
Changes related to source-highlighting and to the manual.
git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'skribe')
209 files changed, 0 insertions, 33287 deletions
diff --git a/skribe/INSTALL b/skribe/INSTALL deleted file mode 100644 index 30507e7..0000000 --- a/skribe/INSTALL +++ /dev/null @@ -1,110 +0,0 @@ -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 deleted file mode 100644 index dbf912f..0000000 --- a/skribe/LICENSE +++ /dev/null @@ -1,25 +0,0 @@ ---------------------------------------------------------------------- - 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 deleted file mode 100644 index 918e91a..0000000 --- a/skribe/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/skribe/README b/skribe/README deleted file mode 100644 index db68b22..0000000 --- a/skribe/README +++ /dev/null @@ -1,69 +0,0 @@ -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 deleted file mode 100644 index dcb0457..0000000 --- a/skribe/README.java +++ /dev/null @@ -1,36 +0,0 @@ -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 deleted file mode 100755 index 798d9d2..0000000 --- a/skribe/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/skribe/doc/Makefile b/skribe/doc/Makefile deleted file mode 100644 index 934389e..0000000 --- a/skribe/doc/Makefile +++ /dev/null @@ -1,233 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index e35cf0b..0000000 --- a/skribe/doc/Makefile.dir +++ /dev/null @@ -1,22 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 8c6d377..0000000 --- a/skribe/doc/dir/dir.skb +++ /dev/null @@ -1,113 +0,0 @@ -;*=====================================================================*/ -;* 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 Binary files differdeleted file mode 100644 index e406ba6..0000000 --- a/skribe/doc/img/bsd.gif +++ /dev/null diff --git a/skribe/doc/img/lambda.gif b/skribe/doc/img/lambda.gif Binary files differdeleted file mode 100644 index 9c46b7d..0000000 --- a/skribe/doc/img/lambda.gif +++ /dev/null diff --git a/skribe/doc/img/linux.gif b/skribe/doc/img/linux.gif Binary files differdeleted file mode 100644 index fa764bd..0000000 --- a/skribe/doc/img/linux.gif +++ /dev/null diff --git a/skribe/doc/skr/api.skr b/skribe/doc/skr/api.skr deleted file mode 100644 index a27c3a4..0000000 --- a/skribe/doc/skr/api.skr +++ /dev/null @@ -1,575 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 09d5146..0000000 --- a/skribe/doc/skr/env.skr +++ /dev/null @@ -1,32 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index ce10ce7..0000000 --- a/skribe/doc/skr/extension.skr +++ /dev/null @@ -1,95 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 1982237..0000000 --- a/skribe/doc/skr/manual.skr +++ /dev/null @@ -1,281 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index a006a9b..0000000 --- a/skribe/doc/user/bib.skb +++ /dev/null @@ -1,252 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 85409f0..0000000 --- a/skribe/doc/user/char.skb +++ /dev/null @@ -1,86 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 79b32f9..0000000 --- a/skribe/doc/user/colframe.skb +++ /dev/null @@ -1,57 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 09f8cb3..0000000 --- a/skribe/doc/user/document.skb +++ /dev/null @@ -1,80 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 742fa87..0000000 --- a/skribe/doc/user/emacs.skb +++ /dev/null @@ -1,58 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 06be3c4..0000000 --- a/skribe/doc/user/engine.skb +++ /dev/null @@ -1,135 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 01155e2..0000000 --- a/skribe/doc/user/enumeration.skb +++ /dev/null @@ -1,33 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index a37ece4..0000000 --- a/skribe/doc/user/examples.skb +++ /dev/null @@ -1,34 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 08fbdd5..0000000 --- a/skribe/doc/user/figure.skb +++ /dev/null @@ -1,58 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index df0bfed..0000000 --- a/skribe/doc/user/font.skb +++ /dev/null @@ -1,30 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 96101f3..0000000 --- a/skribe/doc/user/footnote.skb +++ /dev/null @@ -1,28 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b5d0b0e..0000000 --- a/skribe/doc/user/htmle.skb +++ /dev/null @@ -1,111 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index d08ad18..0000000 --- a/skribe/doc/user/image.skb +++ /dev/null @@ -1,79 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index dd5e8fa..0000000 --- a/skribe/doc/user/index.skb +++ /dev/null @@ -1,118 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 94db7d5..0000000 --- a/skribe/doc/user/justify.skb +++ /dev/null @@ -1,30 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index f53737b..0000000 --- a/skribe/doc/user/latexe.skb +++ /dev/null @@ -1,60 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 499ca61..0000000 --- a/skribe/doc/user/lib.skb +++ /dev/null @@ -1,156 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 85f84dd..0000000 --- a/skribe/doc/user/line.skb +++ /dev/null @@ -1,39 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b454f28..0000000 --- a/skribe/doc/user/links.skb +++ /dev/null @@ -1,152 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 272bfbe..0000000 --- a/skribe/doc/user/markup.skb +++ /dev/null @@ -1,83 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index e65b9d1..0000000 --- a/skribe/doc/user/ornament.skb +++ /dev/null @@ -1,25 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index ad989d0..0000000 --- a/skribe/doc/user/package.skb +++ /dev/null @@ -1,139 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index c894614..0000000 --- a/skribe/doc/user/prgm.skb +++ /dev/null @@ -1,121 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 48bbc45..0000000 --- a/skribe/doc/user/sectioning.skb +++ /dev/null @@ -1,117 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 956af63..0000000 --- a/skribe/doc/user/skribe-config.skb +++ /dev/null @@ -1,44 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 0f00632..0000000 --- a/skribe/doc/user/skribec.skb +++ /dev/null @@ -1,56 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 502cc73..0000000 --- a/skribe/doc/user/skribeinfo.skb +++ /dev/null @@ -1,50 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index c1111ee..0000000 --- a/skribe/doc/user/slide.skb +++ /dev/null @@ -1,114 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 80c4389..0000000 --- a/skribe/doc/user/src/api1.skb +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index 207d8a7..0000000 --- a/skribe/doc/user/src/api10.skb +++ /dev/null @@ -1,12 +0,0 @@ -(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 deleted file mode 100644 index 5014e30..0000000 --- a/skribe/doc/user/src/api11.skb +++ /dev/null @@ -1,22 +0,0 @@ -(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 deleted file mode 100644 index b0c68da..0000000 --- a/skribe/doc/user/src/api12.skb +++ /dev/null @@ -1 +0,0 @@ -(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 deleted file mode 100644 index a9acb04..0000000 --- a/skribe/doc/user/src/api13.skb +++ /dev/null @@ -1,10 +0,0 @@ -(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 deleted file mode 100644 index a3ede40..0000000 --- a/skribe/doc/user/src/api14.skb +++ /dev/null @@ -1,9 +0,0 @@ -(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 deleted file mode 100644 index f8f4958..0000000 --- a/skribe/doc/user/src/api15.skb +++ /dev/null @@ -1,25 +0,0 @@ -(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 deleted file mode 100644 index a9d5705..0000000 --- a/skribe/doc/user/src/api16.skb +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index 42fa54f..0000000 --- a/skribe/doc/user/src/api17.skb +++ /dev/null @@ -1,9 +0,0 @@ -(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 deleted file mode 100644 index 2112dc4..0000000 --- a/skribe/doc/user/src/api18.skb +++ /dev/null @@ -1,2 +0,0 @@ -[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 deleted file mode 100644 index cfc11f6..0000000 --- a/skribe/doc/user/src/api19.skb +++ /dev/null @@ -1,3 +0,0 @@ -(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 deleted file mode 100644 index 2c20965..0000000 --- a/skribe/doc/user/src/api2.skb +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index 686efcb..0000000 --- a/skribe/doc/user/src/api20.skb +++ /dev/null @@ -1,2 +0,0 @@ -[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 deleted file mode 100644 index ed46eea..0000000 --- a/skribe/doc/user/src/api3.skb +++ /dev/null @@ -1,8 +0,0 @@ -(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 deleted file mode 100644 index cfe13f7..0000000 --- a/skribe/doc/user/src/api4.skb +++ /dev/null @@ -1,2 +0,0 @@ -(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 deleted file mode 100644 index 01188c1..0000000 --- a/skribe/doc/user/src/api5.skb +++ /dev/null @@ -1,2 +0,0 @@ -(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 deleted file mode 100644 index 22a1c77..0000000 --- a/skribe/doc/user/src/api6.skb +++ /dev/null @@ -1 +0,0 @@ -(toc :chapter #t :section #f :subsection #f) diff --git a/skribe/doc/user/src/api7.skb b/skribe/doc/user/src/api7.skb deleted file mode 100644 index c6aec8b..0000000 --- a/skribe/doc/user/src/api7.skb +++ /dev/null @@ -1,3 +0,0 @@ -(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 deleted file mode 100644 index a4403ff..0000000 --- a/skribe/doc/user/src/api8.skb +++ /dev/null @@ -1,15 +0,0 @@ -(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 deleted file mode 100644 index 1f6890e..0000000 --- a/skribe/doc/user/src/api9.skb +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index 3f1c04f..0000000 --- a/skribe/doc/user/src/bib1.sbib +++ /dev/null @@ -1,39 +0,0 @@ -(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 deleted file mode 100644 index 25417b5..0000000 --- a/skribe/doc/user/src/bib2.skb +++ /dev/null @@ -1,7 +0,0 @@ -[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 deleted file mode 100644 index 9cb838e..0000000 --- a/skribe/doc/user/src/bib3.skb +++ /dev/null @@ -1,3 +0,0 @@ -(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 deleted file mode 100644 index 81ba5df..0000000 --- a/skribe/doc/user/src/bib4.skb +++ /dev/null @@ -1,5 +0,0 @@ -(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 deleted file mode 100644 index a0ee361..0000000 --- a/skribe/doc/user/src/bib5.skb +++ /dev/null @@ -1,24 +0,0 @@ -(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 deleted file mode 100644 index 013ca97..0000000 --- a/skribe/doc/user/src/bib6.skb +++ /dev/null @@ -1 +0,0 @@ -(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 deleted file mode 100644 index 199428c..0000000 --- a/skribe/doc/user/src/index1.skb +++ /dev/null @@ -1 +0,0 @@ -(define *index1* (make-index "a new index")) diff --git a/skribe/doc/user/src/index2.skb b/skribe/doc/user/src/index2.skb deleted file mode 100644 index f49cf33..0000000 --- a/skribe/doc/user/src/index2.skb +++ /dev/null @@ -1,11 +0,0 @@ -[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 deleted file mode 100644 index 3d76a90..0000000 --- a/skribe/doc/user/src/index3.skb +++ /dev/null @@ -1 +0,0 @@ -(the-index *index1*) diff --git a/skribe/doc/user/src/links1.skb b/skribe/doc/user/src/links1.skb deleted file mode 100644 index e0ce61c..0000000 --- a/skribe/doc/user/src/links1.skb +++ /dev/null @@ -1,23 +0,0 @@ -[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 deleted file mode 100644 index 7cdee07..0000000 --- a/skribe/doc/user/src/links2.skb +++ /dev/null @@ -1,4 +0,0 @@ -[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 deleted file mode 100644 index dcdeb88..0000000 --- a/skribe/doc/user/src/prgm1.skb +++ /dev/null @@ -1,15 +0,0 @@ -(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 deleted file mode 100644 index 5b5644b..0000000 --- a/skribe/doc/user/src/prgm2.skb +++ /dev/null @@ -1,18 +0,0 @@ -(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 deleted file mode 100644 index 51cb564..0000000 --- a/skribe/doc/user/src/prgm3.skb +++ /dev/null @@ -1,55 +0,0 @@ -(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 deleted file mode 100644 index ac584d1..0000000 --- a/skribe/doc/user/src/slides.skb +++ /dev/null @@ -1,27 +0,0 @@ -(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 deleted file mode 100644 index 4e37dda..0000000 --- a/skribe/doc/user/src/start1.skb +++ /dev/null @@ -1,2 +0,0 @@ -(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 deleted file mode 100644 index 9fcfdbf..0000000 --- a/skribe/doc/user/src/start2.skb +++ /dev/null @@ -1,2 +0,0 @@ -(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 deleted file mode 100644 index 0705966..0000000 --- a/skribe/doc/user/src/start3.skb +++ /dev/null @@ -1,10 +0,0 @@ -(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 deleted file mode 100644 index 3311925..0000000 --- a/skribe/doc/user/src/start4.skb +++ /dev/null @@ -1,13 +0,0 @@ -(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 deleted file mode 100644 index 9e6b877..0000000 --- a/skribe/doc/user/src/start5.skb +++ /dev/null @@ -1,9 +0,0 @@ -(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 deleted file mode 100644 index f3c1e28..0000000 --- a/skribe/doc/user/start.skb +++ /dev/null @@ -1,197 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index de60bd9..0000000 --- a/skribe/doc/user/syntax.skb +++ /dev/null @@ -1,105 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index c726d44..0000000 --- a/skribe/doc/user/table.skb +++ /dev/null @@ -1,81 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index aa6c0dc..0000000 --- a/skribe/doc/user/toc.skb +++ /dev/null @@ -1,37 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 07a6e03..0000000 --- a/skribe/doc/user/user.skb +++ /dev/null @@ -1,163 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 4a1ee78..0000000 --- a/skribe/doc/user/xmle.skb +++ /dev/null @@ -1,25 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 52074cb..0000000 --- a/skribe/emacs/Makefile +++ /dev/null @@ -1,55 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 1b1ae4f..0000000 --- a/skribe/emacs/skribe.el.in +++ /dev/null @@ -1,841 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 6987245..0000000 --- a/skribe/etc/ChangeLog +++ /dev/null @@ -1,698 +0,0 @@ -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 deleted file mode 100644 index 349fcf8..0000000 --- a/skribe/etc/Makefile +++ /dev/null @@ -1,50 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 82ffceb..0000000 --- a/skribe/etc/bigloo/Makefile +++ /dev/null @@ -1,114 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 24326c1..0000000 --- a/skribe/etc/bigloo/Makefile.tpl +++ /dev/null @@ -1,200 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index c077107..0000000 --- a/skribe/etc/bigloo/autoconf/Makefile +++ /dev/null @@ -1,53 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100755 index 128d5c7..0000000 --- a/skribe/etc/bigloo/autoconf/bfildir +++ /dev/null @@ -1,36 +0,0 @@ -#!/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 deleted file mode 100755 index 603d484..0000000 --- a/skribe/etc/bigloo/autoconf/blibdir +++ /dev/null @@ -1,36 +0,0 @@ -#!/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 deleted file mode 100755 index 1f24c86..0000000 --- a/skribe/etc/bigloo/autoconf/bversion +++ /dev/null @@ -1,42 +0,0 @@ -#!/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 deleted file mode 100755 index ff83b1c..0000000 --- a/skribe/etc/bigloo/autoconf/getbversion +++ /dev/null @@ -1,36 +0,0 @@ -#!/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 deleted file mode 100755 index 1bedd72..0000000 --- a/skribe/etc/bigloo/autoconf/gmaketest +++ /dev/null @@ -1,38 +0,0 @@ -#!/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 deleted file mode 100755 index 9215911..0000000 --- a/skribe/etc/bigloo/configure +++ /dev/null @@ -1,552 +0,0 @@ -#!/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 deleted file mode 100644 index 2a03e26..0000000 --- a/skribe/etc/skribe-config.in +++ /dev/null @@ -1,64 +0,0 @@ -#!/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 deleted file mode 100644 index 13a60d8..0000000 --- a/skribe/etc/stklos/Makefile.config.in +++ /dev/null @@ -1,5 +0,0 @@ -SYSTEM=@SYSTEM@ -SKRIBE=@SKRIBE@ -SKRIBEINFO=@SKRIBEINFO@ -SKRIBEBIBTEX=@SKRIBEBIBTEX@ - diff --git a/skribe/etc/stklos/Makefile.in b/skribe/etc/stklos/Makefile.in deleted file mode 100644 index 186fd58..0000000 --- a/skribe/etc/stklos/Makefile.in +++ /dev/null @@ -1,44 +0,0 @@ -# -# 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 deleted file mode 100644 index 7568474..0000000 --- a/skribe/etc/stklos/Makefile.skb.in +++ /dev/null @@ -1,5 +0,0 @@ -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 deleted file mode 100755 index e1d2526..0000000 --- a/skribe/etc/stklos/configure +++ /dev/null @@ -1,830 +0,0 @@ -#! /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 deleted file mode 100644 index 956af77..0000000 --- a/skribe/etc/stklos/configure.in +++ /dev/null @@ -1,57 +0,0 @@ -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 deleted file mode 100644 index 7f47f6e..0000000 --- a/skribe/examples/Makefile +++ /dev/null @@ -1,48 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index c9b7a84..0000000 --- a/skribe/examples/slide/Makefile +++ /dev/null @@ -1,153 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 40b2d08..0000000 --- a/skribe/examples/slide/PPRskribe.sty +++ /dev/null @@ -1,67 +0,0 @@ -%============================================================================== -% 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 deleted file mode 100644 index cb9f303..0000000 --- a/skribe/examples/slide/README +++ /dev/null @@ -1,11 +0,0 @@ -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 deleted file mode 100644 index 9b5e09f..0000000 --- a/skribe/examples/slide/advi.sty +++ /dev/null @@ -1,416 +0,0 @@ -%% -%% 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 deleted file mode 100644 index d1a525e..0000000 --- a/skribe/examples/slide/ex/skribe.skb +++ /dev/null @@ -1,11 +0,0 @@ -(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 deleted file mode 100644 index 8590f4a..0000000 --- a/skribe/examples/slide/ex/syntax.scr +++ /dev/null @@ -1 +0,0 @@ -[text goodies: ,(bold "bold") and ,(it "italic").] diff --git a/skribe/examples/slide/skb/slides.skb b/skribe/examples/slide/skb/slides.skb deleted file mode 100644 index c13b102..0000000 --- a/skribe/examples/slide/skb/slides.skb +++ /dev/null @@ -1,286 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 2802a53..0000000 --- a/skribe/examples/slide/skr/local.skr +++ /dev/null @@ -1,73 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index dcc3e77..0000000 --- a/skribe/skr/Makefile +++ /dev/null @@ -1,43 +0,0 @@ -#*=====================================================================*/ -#* serrano/prgm/project/skribe/skr/Makefile */ -#* ------------------------------------------------------------- */ -#* Author : Manuel Serrano */ -#* Creation : Sat Oct 25 08:21:20 2003 */ -#* Last change : Wed May 18 15:34:21 2005 (serrano) */ -#* Copyright : 2003-05 Manuel Serrano */ -#* ------------------------------------------------------------- */ -#* The Skribe SKR Makefile */ -#*=====================================================================*/ -include ../etc/Makefile.config -include ../etc/$(SYSTEM)/Makefile.skb - -#*---------------------------------------------------------------------*/ -#* POPULATION */ -#*---------------------------------------------------------------------*/ -POPULATION= acmproc.skr sigplan.skr jfp.skr \ - slide.skr web-book.skr web-article.skr \ - base.skr latex.skr scribe.skr xml.skr \ - html.skr html4.skr lncs.skr skribe.skr \ - letter.skr french.skr latex-simple.skr context.skr Makefile - -#*---------------------------------------------------------------------*/ -#* pop */ -#*---------------------------------------------------------------------*/ -.PHONY: pop - -pop: - @ echo $(POPULATION:%=skr/%) - -#*---------------------------------------------------------------------*/ -#* Install/Uinstall */ -#*---------------------------------------------------------------------*/ -.PHONY: install uninstall - -install: $(DESTDIR)$(INSTALL_SKRDIR) - cp *.skr $(DESTDIR)$(INSTALL_SKRDIR) && chmod $(BMASK) $(DESTDIR)$(INSTALL_SKRDIR)/* - -uninstall: - -$(DESTDIR)$(INSTALL_SKRDIR): - mkdir -p $(DESTDIR)$(INSTALL_SKRDIR) && chmod a+rx $(DESTDIR)$(INSTALL_SKRDIR) - diff --git a/skribe/skr/acmproc.skr b/skribe/skr/acmproc.skr deleted file mode 100644 index 4accc7c..0000000 --- a/skribe/skr/acmproc.skr +++ /dev/null @@ -1,155 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/acmproc.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sun Sep 28 14:40:38 2003 */ -;* Last change : Thu Jun 2 10:55:39 2005 (serrano) */ -;* Copyright : 2003-05 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Skribe style for ACMPROC articles. */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* LaTeX global customizations */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le - 'documentclass - "\\documentclass[letterpaper]{acmproc}") - ;; &latex-author - (markup-writer '&latex-author le - :before (lambda (n e) - (let ((body (markup-body n))) - (printf "\\numberofauthors{~a}\n\\author{\n" - (if (pair? body) (length body) 1)))) - :action (lambda (n e) - (let ((body (markup-body n))) - (for-each (lambda (a) - (display "\\alignauthor\n") - (output a e)) - (if (pair? body) body (list body))))) - :after "}\n") - ;; author - (let ((old-author (markup-writer-get 'author le))) - (markup-writer 'author le - :options (writer-options old-author) - :action (writer-action old-author))) - ;; ACM category, terms, and keywords - (markup-writer '&acm-category le - :options '(:index :section :subsection) - :before (lambda (n e) - (display "\\category{") - (display (markup-option n :index)) - (display "}") - (display "{") - (display (markup-option n :section)) - (display "}") - (display "{") - (display (markup-option n :subsection)) - (display "}\n[")) - :after "]\n") - (markup-writer '&acm-terms le - :before "\\terms{" - :after "}") - (markup-writer '&acm-keywords le - :before "\\keywords{" - :after "}") - (markup-writer '&acm-copyright le - :action (lambda (n e) - (display "\\conferenceinfo{") - (output (markup-option n :conference) e) - (display ",} {") - (output (markup-option n :location) e) - (display "}\n") - (display "\\CopyrightYear{") - (output (markup-option n :year) e) - (display "}\n") - (display "\\crdata{") - (output (markup-option n :crdata) e) - (display "}\n")))) - -;*---------------------------------------------------------------------*/ -;* HTML global customizations */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - (markup-writer '&html-acmproc-abstract he - :action (lambda (n e) - (let* ((ebg (engine-custom e 'abstract-background)) - (bg (or (and (string? ebg) - (> (string-length ebg) 0)) - ebg - "#cccccc")) - (exp (p (center (color :bg bg :width 90. - (markup-body n)))))) - (skribe-eval exp e)))) - ;; ACM category, terms, and keywords - (markup-writer '&acm-category :action #f) - (markup-writer '&acm-terms :action #f) - (markup-writer '&acm-keywords :action #f) - (markup-writer '&acm-copyright :action #f)) - -;*---------------------------------------------------------------------*/ -;* abstract ... */ -;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key (class "abstract") postscript) - (if (engine-format? "latex") - (section :number #f :title "ABSTRACT" (p (the-body opt))) - (let ((a (new markup - (markup '&html-acmproc-abstract) - (body (the-body opt))))) - (list (if postscript - (section :number #f :toc #f :title "Postscript download" - postscript)) - (section :number #f :toc #f :class class :title "Abstract" a) - (section :number #f :toc #f :title "Table of contents" - (toc :subsection #t)))))) - -;*---------------------------------------------------------------------*/ -;* acm-category ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-category #!rest opt #!key index section subsection) - (new markup - (markup '&acm-category) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-terms ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-terms #!rest opt) - (new markup - (markup '&acm-terms) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-keywords ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-keywords #!rest opt) - (new markup - (markup '&acm-keywords) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-copyright ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright #!rest opt #!key conference location year crdata) - (let* ((le (find-engine 'latex)) - (cop (format "\\conferenceinfo{~a,} {~a} -\\CopyrightYear{~a} -\\crdata{~a}\n" conference location year crdata)) - (old (engine-custom le 'predocument))) - (if (string? old) - (engine-custom-set! le 'predocument (string-append cop old)) - (engine-custom-set! le 'predocument cop)))) - -;*---------------------------------------------------------------------*/ -;* references ... */ -;*---------------------------------------------------------------------*/ -(define (references) - (list "\n\n" - (if (engine-format? "latex") - (font :size -1 (flush :side 'left (the-bibliography))) - (section :title "References" - (font :size -1 (the-bibliography)))))) diff --git a/skribe/skr/base.skr b/skribe/skr/base.skr deleted file mode 100644 index ec987ec..0000000 --- a/skribe/skr/base.skr +++ /dev/null @@ -1,464 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 5bc5316..0000000 --- a/skribe/skr/context.skr +++ /dev/null @@ -1,1380 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 373d076..0000000 --- a/skribe/skr/french.skr +++ /dev/null @@ -1,19 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/letter.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Fri Oct 3 12:22:13 2003 */ -;* Last change : Tue Oct 28 14:33:43 2003 (serrano) */ -;* Copyright : 2003 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* French Skribe style */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* LaTeX configuration */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le 'usepackage - (string-append (engine-custom le 'usepackage) - "\\usepackage[french]{babel} -\\usepackage{a4}"))) diff --git a/skribe/skr/html.skr b/skribe/skr/html.skr deleted file mode 100644 index ebac5f2..0000000 --- a/skribe/skr/html.skr +++ /dev/null @@ -1,2251 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index acb7068..0000000 --- a/skribe/skr/html4.skr +++ /dev/null @@ -1,165 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 60b40f2..0000000 --- a/skribe/skr/jfp.skr +++ /dev/null @@ -1,317 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/jfp.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sun Sep 28 14:40:38 2003 */ -;* Last change : Mon Oct 11 15:44:08 2004 (serrano) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Skribe style for JFP articles. */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* LaTeX global customizations */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le 'documentclass "\\documentclass{jfp}") - (engine-custom-set! le 'hyperref #f) - ;; &latex-author - (markup-writer '&latex-author le - :action (lambda (n e) - (define (&latex-subauthor) - (let* ((d (ast-document n)) - (sa (and (is-markup? d 'document) - (markup-option d :head-author)))) - (if sa - (begin - (display "[") - (output sa e) - (display "]"))))) - (define (&latex-author-1 n) - (display "\\author") - (&latex-subauthor) - (display "{\n") - (output n e) - (display "}\n")) - (define (&latex-author-n n) - (display "\\author") - (&latex-subauthor) - (display "{\n") - (output (car n) e) - (for-each (lambda (a) - (display "\\and ") - (output a e)) - (cdr n)) - (display "}\n")) - (let ((body (markup-body n))) - (cond - ((is-markup? body 'author) - (&latex-author-1 body)) - ((and (list? body) - (every? (lambda (b) (is-markup? b 'author)) - body)) - (&latex-author-n body)) - (else - (skribe-error 'author - "Illegal `jfp' author" - body)))))) - ;; title - (markup-writer '&latex-title le - :before (lambda (n e) - (let* ((d (ast-document n)) - (st (and (is-markup? d 'document) - (markup-option d :head-title)))) - (if st - (begin - (display "\\title[") - (output st e) - (display "]{")) - (display "\\title{")))) - :after "}\n") - ;; author - (let ((old-author (markup-writer-get 'author le))) - (markup-writer 'author le - :options (writer-options old-author) - :action (lambda (n e) - (let ((name (markup-option n :name)) - (aff (markup-option n :affiliation)) - (addr (markup-option n :address)) - (email (markup-option n :email))) - (if name - (begin - (output name e) - (display "\\\\\n"))) - (if aff - (begin - (output aff e) - (display "\\\\\n"))) - (if addr - (begin - (if (pair? addr) - (for-each (lambda (a) - (output a e) - (display "\\\\\n")) - addr) - (begin - (output addr e) - (display "\\\\\n"))))) - (if email - (begin - (display "\\email{") - (output email e) - (display "}\\\\\n"))))))) - ;; bib-ref - (markup-writer 'bib-ref le - :options '(:bib :text :key) - :before "(" - :action (lambda (n e) - (let ((be (handle-ast (markup-body n)))) - (if (is-markup? be '&bib-entry) - (let ((a (markup-option be 'author)) - (y (markup-option be 'year))) - (cond - ((and (is-markup? a '&bib-entry-author) - (is-markup? y '&bib-entry-year)) - (let ((ba (markup-body a))) - (if (not (string? ba)) - (output ba e) - (let* ((s1 (pregexp-replace* " and " - ba - " \\& ")) - (s2 (pregexp-replace* ", [^ ]+" - s1 - ""))) - (output s2 e) - (display ", ") - (output y e))))) - ((is-markup? y '&bib-entry-year) - (skribe-error 'bib-ref - "Missing `name' entry" - (markup-ident be))) - (else - (let ((ba (markup-body a))) - (if (not (string? ba)) - (output ba e) - (let* ((s1 (pregexp-replace* " and " - ba - " \\& ")) - (s2 (pregexp-replace* ", [^ ]+" - s1 - ""))) - (output s2 e))))))) - (skribe-error 'bib-ref - "Illegal bib-ref" - (markup-ident be))))) - :after ")") - ;; bib-ref/text - (markup-writer 'bib-ref le - :options '(:bib :text :key) - :predicate (lambda (n e) - (markup-option n :key)) - :action (lambda (n e) - (output (markup-option n :key) e))) - ;; &the-bibliography - (markup-writer '&the-bibliography le - :before (lambda (n e) - (display "{% -\\sloppy -\\sfcode`\\.=1000\\relax -\\newdimen\\bibindent -\\bibindent=0em -\\begin{list}{}{% - \\settowidth\\labelwidth{[]}% - \\leftmargin\\labelwidth - \\advance\\leftmargin\\labelsep - \\advance\\leftmargin\\bibindent - \\itemindent -\\bibindent - \\listparindent \\itemindent - }%\n")) - :after (lambda (n e) - (display "\n\\end{list}}\n"))) - ;; bib-entry - (markup-writer '&bib-entry le - :options '(:title) - :action (lambda (n e) - (output n e (markup-writer-get '&bib-entry-body e))) - :after "\n") - ;; %bib-entry-title - (markup-writer '&bib-entry-title le - :action (lambda (n e) - (output (markup-body n) e))) - ;; %bib-entry-body - (markup-writer '&bib-entry-body le - :action (lambda (n e) - (define (output-fields descr) - (display "\\item[") - (let loop ((descr descr) - (pending #f) - (armed #f) - (first #t)) - (cond - ((null? descr) - 'done) - ((pair? (car descr)) - (if (eq? (caar descr) 'or) - (let ((o1 (cadr (car descr)))) - (if (markup-option n o1) - (loop (cons o1 (cdr descr)) - pending - #t - #f) - (let ((o2 (caddr (car descr)))) - (loop (cons o2 (cdr descr)) - pending - armed - #f)))) - (let ((o (markup-option n (cadr (car descr))))) - (if o - (begin - (if (and pending armed) - (output pending e)) - (output (caar descr) e) - (output o e) - (if (pair? (cddr (car descr))) - (output (caddr (car descr)) e)) - (loop (cdr descr) #f #t #f)) - (loop (cdr descr) pending armed #f))))) - ((symbol? (car descr)) - (let ((o (markup-option n (car descr)))) - (if o - (begin - (if (and armed pending) - (output pending e)) - (output o e) - (if first - (display "]")) - (loop (cdr descr) #f #t #f)) - (loop (cdr descr) pending armed #f)))) - ((null? (cdr descr)) - (output (car descr) e)) - ((string? (car descr)) - (loop (cdr descr) - (if pending pending (car descr)) - armed - #f)) - (else - (skribe-error 'output-bib-fields - "Illegal description" - (car descr)))))) - (output-fields - (case (markup-option n 'kind) - ((techreport) - `(author (" (" year ")") " " (or title url) ". " - number ", " institution ", " - address ", " month ", " - ("pp. " pages) ".")) - ((article) - `(author (" (" year ")") " " (or title url) ". " - journal ", " volume ", " ("(" number ")") ", " - address ", " month ", " - ("pp. " pages) ".")) - ((inproceedings) - `(author (" (" year ")") " " (or title url) ". " - book(or title url) ", " series ", " ("(" number ")") ", " - address ", " month ", " - ("pp. " pages) ".")) - ((book) - '(author (" (" year ")") " " (or title url) ". " - publisher ", " address - ", " month ", " ("pp. " pages) ".")) - ((phdthesis) - '(author (" (" year ")") " " (or title url) ". " type ", " - school ", " address - ", " month ".")) - ((misc) - '(author (" (" year ")") " " (or title url) ". " - publisher ", " address - ", " month ".")) - (else - '(author (" (" year ")") " " (or title url) ". " - publisher ", " address - ", " month ", " ("pp. " pages) ".")))))) - ;; abstract - (markup-writer 'jfp-abstract le - :options '(postscript) - :before "\\begin{abstract}\n" - :after "\\end{abstract}\n")) - -;*---------------------------------------------------------------------*/ -;* HTML global customizations */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - (markup-writer '&html-jfp-abstract he - :action (lambda (n e) - (let* ((bg (engine-custom e 'abstract-background)) - (exp (p (if bg - (center (color :bg bg :width 90. - (it (markup-body n)))) - (it (markup-body n)))))) - (skribe-eval exp e))))) - -;*---------------------------------------------------------------------*/ -;* abstract ... */ -;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key postscript) - (if (engine-format? "latex") - (new markup - (markup 'jfp-abstract) - (body (p (the-body opt)))) - (let ((a (new markup - (markup '&html-jfp-abstract) - (body (the-body opt))))) - (list (if postscript - (section :number #f :toc #f :title "Postscript download" - postscript)) - (section :number #f :toc #f :title "Abstract" a) - (section :number #f :toc #f :title "Table of contents" - (toc :subsection #t)))))) - -;*---------------------------------------------------------------------*/ -;* references ... */ -;*---------------------------------------------------------------------*/ -(define (references) - (list "\n\n" - (section :title "References" :class "references" - :number (not (engine-format? "latex")) - (font :size -1 (the-bibliography))))) - diff --git a/skribe/skr/latex-simple.skr b/skribe/skr/latex-simple.skr deleted file mode 100644 index dd2eccb..0000000 --- a/skribe/skr/latex-simple.skr +++ /dev/null @@ -1,101 +0,0 @@ -;;; -;;; 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 deleted file mode 100644 index bc20493..0000000 --- a/skribe/skr/latex.skr +++ /dev/null @@ -1,1780 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 17a0058..0000000 --- a/skribe/skr/letter.skr +++ /dev/null @@ -1,146 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/letter.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Fri Oct 3 12:22:13 2003 */ -;* Last change : Thu Sep 23 20:00:42 2004 (serrano) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* Skribe style for letters */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* document */ -;*---------------------------------------------------------------------*/ -(define %letter-document document) - -(define-markup (document #!rest opt - #!key (ident #f) (class "letter") - where date author - &skribe-eval-location) - (let* ((ubody (the-body opt)) - (body (list (new markup - (markup '&letter-where) - (loc &skribe-eval-location) - (options `((:where ,where) - (:date ,date) - (:author ,author)))) - ubody))) - (apply %letter-document - :author #f :title #f - (append (apply append - (the-options opt :where :date :author :title)) - body)))) - -;*---------------------------------------------------------------------*/ -;* LaTeX configuration */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le 'documentclass "\\documentclass[12pt]{letter}\n") - (engine-custom-set! le 'maketitle #f) - ;; &letter-where - (markup-writer '&letter-where le - :before "\\begin{raggedright}\n" - :action (lambda (n e) - (let* ((w (markup-option n :where)) - (d (markup-option n :date)) - (a (markup-option n :author)) - (hd (if (and w d) - (list w ", " d) - (or w d))) - (ne (copy-engine 'author e))) - ;; author - (markup-writer 'author ne - :options '(:name :title :affiliation :email :url :address :phone :photo :align :header) - :action (lambda (n e) - (let ((name (markup-option n :name)) - (title (markup-option n :title)) - (affiliation (markup-option n :affiliation)) - (email (markup-option n :email)) - (url (markup-option n :url)) - (address (markup-option n :address)) - (phone (markup-option n :phone))) - (define (row n) - (output n e) - (when hd - (display "\\hfill ") - (output hd e) - (set! hd #f)) - (display "\\\\\n")) - ;; name - (if name (row name)) - ;; title - (if title (row title)) - ;; affiliation - (if affiliation (row affiliation)) - ;; address - (if (pair? address) - (for-each row address)) - ;; telephone - (if phone (row phone)) - ;; email - (if email (row email)) - ;; url - (if url (row url))))) - ;; emit the author - (if a - (output a ne) - (output hd e)))) - :after "\\end{raggedright}\n\\vspace{1cm}\n\n")) - -;*---------------------------------------------------------------------*/ -;* HTML configuration */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - ;; &letter-where - (markup-writer '&letter-where he - :before "<table width=\"100%\">\n" - :action (lambda (n e) - (let* ((w (markup-option n :where)) - (d (markup-option n :date)) - (a (markup-option n :author)) - (hd (if (and w d) - (list w ", " d) - (or w d))) - (ne (copy-engine 'author e))) - ;; author - (markup-writer 'author ne - :options '(:name :title :affiliation :email :url :address :phone :photo :align :header) - :action (lambda (n e) - (let ((name (markup-option n :name)) - (title (markup-option n :title)) - (affiliation (markup-option n :affiliation)) - (email (markup-option n :email)) - (url (markup-option n :url)) - (address (markup-option n :address)) - (phone (markup-option n :phone))) - (define (row n) - (display "<tr><td align='left'>") - (output n e) - (when hd - (display "</td><td align='right'>") - (output hd e) - (set! hd #f)) - (display "</td></tr>\n")) - ;; name - (if name (row name)) - ;; title - (if title (row title)) - ;; affiliation - (if affiliation (row affiliation)) - ;; address - (if (pair? address) - (for-each row address)) - ;; telephone - (if phone (row phone)) - ;; email - (if email (row email)) - ;; url - (if url (row url))))) - ;; emit the author - (if a - (output a ne) - (output hd e)))) - :after "</table>\n<hr>\n\n")) - - diff --git a/skribe/skr/lncs.skr b/skribe/skr/lncs.skr deleted file mode 100644 index 4668404..0000000 --- a/skribe/skr/lncs.skr +++ /dev/null @@ -1,147 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/lncs.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sun Sep 28 14:40:38 2003 */ -;* Last change : Fri Jan 16 07:04:51 2004 (serrano) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Skribe style for LNCS articles. */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* LaTeX global customizations */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le 'documentclass "\\documentclass{llncs}") - ;; &latex-author - (markup-writer '&latex-author le - :action (lambda (n e) - (define (&latex-inst-body n) - (let ((affiliation (markup-option n :affiliation)) - (address (markup-option n :address))) - (when affiliation (output affiliation e) (display ", ")) - (when address - (for-each (lambda (a) (output a e) (display " ")) - address) - (newline)))) - (define (&latex-inst-n i) - (display "\\institute{\n") - (&latex-inst-body (car i)) - (for-each (lambda (n) - (display "\\and\n") - (&latex-inst-body n)) - (cdr i)) - (display "}\n")) - (define (&latex-author-1 n) - (display "\\author{\n") - (output n e) - (display "}\n")) - (define (&latex-author-n n) - (display "\\author{\n") - (output (car n) e) - (for-each (lambda (a) - (display " and ") - (output a e)) - (cdr n)) - (display "}\n")) - (let ((body (markup-body n))) - (cond - ((is-markup? body 'author) - (markup-option-add! n 'inst 1) - (&latex-author-1 body) - (&latex-inst-n (list body))) - ((and (list? body) - (every? (lambda (b) (is-markup? b 'author)) - body)) - (define (institute=? n1 n2) - (let ((aff1 (markup-option n1 :affiliation)) - (add1 (markup-option n1 :address)) - (aff2 (markup-option n2 :affiliation)) - (add2 (markup-option n2 :address))) - (and (equal? aff1 aff2) (equal? add1 add2)))) - (define (search-institute n i j) - (cond - ((null? i) - #f) - ((institute=? n (car i)) - j) - (else - (search-institute n (cdr i) (- j 1))))) - (if (null? (cdr body)) - (begin - (markup-option-add! (car body) 'inst 1) - (&latex-author-1 (car body)) - (&latex-inst-n body)) - ;; collect the institutes - (let loop ((ns body) - (is '()) - (j 1)) - (if (null? ns) - (begin - (&latex-author-n body) - (&latex-inst-n (reverse! is))) - (let* ((n (car ns)) - (si (search-institute n is (- j 1)))) - (if (integer? si) - (begin - (markup-option-add! n 'inst si) - (loop (cdr ns) is j)) - (begin - (markup-option-add! n 'inst j) - (loop (cdr ns) - (cons n is) - (+ 1 j))))))))) - (else - (skribe-error 'author - "Illegal `lncs' author" - body)))))) - ;; author - (let ((old-author (markup-writer-get 'author le))) - (markup-writer 'author le - :options (writer-options old-author) - :action (lambda (n e) - (let ((name (markup-option n :name)) - (title (markup-option n :title)) - (inst (markup-option n 'inst))) - (if name (output name e)) - (if title (output title e)) - (if inst (printf "\\inst{~a}\n" inst))))))) - -;*---------------------------------------------------------------------*/ -;* HTML global customizations */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - (markup-writer '&html-lncs-abstract he - :action (lambda (n e) - (let* ((bg (or (engine-custom e 'abstract-background) - "#cccccc")) - (exp (p (center (color :bg bg :width 90. - (markup-body n)))))) - (skribe-eval exp e))))) - -;*---------------------------------------------------------------------*/ -;* abstract ... */ -;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key postscript) - (if (engine-format? "latex") - (section :number #f :title "ABSTRACT" (p (the-body opt))) - (let ((a (new markup - (markup '&html-lncs-abstract) - (body (the-body opt))))) - (list (if postscript - (section :number #f :toc #f :title "Postscript download" - postscript)) - (section :number #f :toc #f :title "Abstract" a) - (section :number #f :toc #f :title "Table of contents" - (toc :subsection #t)))))) - -;*---------------------------------------------------------------------*/ -;* references ... */ -;*---------------------------------------------------------------------*/ -(define (references) - (list "\n\n" - (if (engine-format? "latex") - (font :size -1 (flush :side 'left (the-bibliography))) - (section :title "References" - (font :size -1 (the-bibliography)))))) diff --git a/skribe/skr/scribe.skr b/skribe/skr/scribe.skr deleted file mode 100644 index d9e3bb8..0000000 --- a/skribe/skr/scribe.skr +++ /dev/null @@ -1,229 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/scribe.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Tue Jul 29 10:07:21 2003 */ -;* Last change : Wed Oct 8 09:56:52 2003 (serrano) */ -;* Copyright : 2003 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* Scribe Compatibility kit */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* style ... */ -;*---------------------------------------------------------------------*/ -(define (style . styles) - (define (load-style style) - (let ((name (cond - ((string? style) - style) - ((symbol? style) - (string-append (symbol->string style) ".scr"))))) - (skribe-load name :engine *skribe-engine*))) - (for-each load-style styles)) - -;*---------------------------------------------------------------------*/ -;* chapter ... */ -;*---------------------------------------------------------------------*/ -(define skribe-chapter chapter) - -(define-markup (chapter #!rest opt #!key title subtitle split number toc file) - (apply skribe-chapter - :title (or title subtitle) - :number number - :toc toc - :file file - (the-body opt))) - -;*---------------------------------------------------------------------*/ -;* table-of-contents ... */ -;*---------------------------------------------------------------------*/ -(define-markup (table-of-contents #!rest opts #!key chapter section subsection) - (apply toc opts)) - -;*---------------------------------------------------------------------*/ -;* frame ... */ -;*---------------------------------------------------------------------*/ -(define skribe-frame frame) - -(define-markup (frame #!rest opt #!key width margin) - (apply skribe-frame - :width (if (real? width) (* 100 width) width) - :margin margin - (the-body opt))) - -;*---------------------------------------------------------------------*/ -;* copyright ... */ -;*---------------------------------------------------------------------*/ -(define (copyright) - (symbol 'copyright)) - -;*---------------------------------------------------------------------*/ -;* sect ... */ -;*---------------------------------------------------------------------*/ -(define (sect) - (symbol 'section)) - -;*---------------------------------------------------------------------*/ -;* euro ... */ -;*---------------------------------------------------------------------*/ -(define (euro) - (symbol 'euro)) - -;*---------------------------------------------------------------------*/ -;* tab ... */ -;*---------------------------------------------------------------------*/ -(define (tab) - (char #\tab)) - -;*---------------------------------------------------------------------*/ -;* space ... */ -;*---------------------------------------------------------------------*/ -(define (space) - (char #\space)) - -;*---------------------------------------------------------------------*/ -;* print-bibliography ... */ -;*---------------------------------------------------------------------*/ -(define-markup (print-bibliography #!rest opts - #!key all (sort bib-sort/authors)) - (the-bibliography all sort)) - -;*---------------------------------------------------------------------*/ -;* linebreak ... */ -;*---------------------------------------------------------------------*/ -(define skribe-linebreak linebreak) - -(define-markup (linebreak . lnum) - (cond - ((null? lnum) - (skribe-linebreak)) - ((string? (car lnum)) - (skribe-linebreak (string->number (car lnum)))) - (else - (skribe-linebreak (car lnum))))) - -;*---------------------------------------------------------------------*/ -;* ref ... */ -;*---------------------------------------------------------------------*/ -(define skribe-ref ref) - -(define-markup (ref #!rest opts - #!key scribe url id page figure mark - chapter section subsection subsubsection subsubsection - bib bib+ number) - (let ((bd (the-body opts)) - (args (apply append (the-options opts :id)))) - (if id (set! args (cons* :mark id args))) - (if (pair? bd) (set! args (cons* :text bd args))) - (apply skribe-ref args))) - -;*---------------------------------------------------------------------*/ -;* indexes ... */ -;*---------------------------------------------------------------------*/ -(define *scribe-indexes* - (list (cons "theindex" (make-index "theindex")))) - -(define skribe-index index) -(define skribe-make-index make-index) - -(define-markup (make-index index) - (let ((i (skribe-make-index index))) - (set! *scribe-indexes* (cons (cons index i) *scribe-indexes*)) - i)) - -(define-markup (index #!rest opts #!key note index shape) - (let ((i (if (not index) - "theindex" - (let ((i (assoc index *scribe-indexes*))) - (if (pair? i) - (cdr i) - (make-index index)))))) - (apply skribe-index :note note :index i :shape shape (the-body opts)))) - -(define-markup (print-index #!rest opts - #!key split (char-offset 0) (header-limit 100)) - (apply the-index - :split split - :char-offset char-offset - :header-limit header-limit - (map (lambda (i) - (let ((c (assoc i *scribe-indexes*))) - (if (pair? c) - (cdr c) - (skribe-error 'the-index "Unknown index" i)))) - (the-body opts)))) - -;*---------------------------------------------------------------------*/ -;* format? */ -;*---------------------------------------------------------------------*/ -(define (scribe-format? fmt) #f) - -;*---------------------------------------------------------------------*/ -;* scribe-url ... */ -;*---------------------------------------------------------------------*/ -(define (scribe-url) (skribe-url)) - -;*---------------------------------------------------------------------*/ -;* Various configurations */ -;*---------------------------------------------------------------------*/ -(define *scribe-background* #f) -(define *scribe-foreground* #f) -(define *scribe-tbackground* #f) -(define *scribe-tforeground* #f) -(define *scribe-title-font* #f) -(define *scribe-author-font* #f) -(define *scribe-chapter-numbering* #f) -(define *scribe-footer* #f) -(define *scribe-prgm-color* #f) - -;*---------------------------------------------------------------------*/ -;* prgm ... */ -;*---------------------------------------------------------------------*/ -(define-markup (prgm #!rest opts - #!key lnum lnumwidth language bg frame (width 1.) - colors (monospace #t)) - (let* ((w (cond - ((real? width) (* width 100.)) - ((number? width) width) - (else 100.))) - (body (if language - (source :language language (the-body opts)) - (the-body opts))) - (body (if monospace - (prog :line lnum body) - body)) - (body (if bg - (color :width 100. :bg bg body) - body))) - (skribe-frame :width w - :border (if frame 1 #f) - body))) - -;*---------------------------------------------------------------------*/ -;* latex configuration */ -;*---------------------------------------------------------------------*/ -(define *scribe-tex-predocument* #f) - -;*---------------------------------------------------------------------*/ -;* latex-prelude ... */ -;*---------------------------------------------------------------------*/ -(define (latex-prelude e) - (if (engine-format? "latex" e) - (begin - (if *scribe-tex-predocument* - (engine-custom-set! e 'predocument *scribe-tex-predocument*))))) - -;*---------------------------------------------------------------------*/ -;* html-prelude ... */ -;*---------------------------------------------------------------------*/ -(define (html-prelude e) - (if (engine-format? "html" e) - (begin - #f))) - -;*---------------------------------------------------------------------*/ -;* prelude */ -;*---------------------------------------------------------------------*/ -(let ((p (user-prelude))) - (user-prelude-set! (lambda (e) (p e) (latex-prelude e)))) diff --git a/skribe/skr/sigplan.skr b/skribe/skr/sigplan.skr deleted file mode 100644 index 9bdb939..0000000 --- a/skribe/skr/sigplan.skr +++ /dev/null @@ -1,155 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/sigplan.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sun Sep 28 14:40:38 2003 */ -;* Last change : Wed May 18 16:00:38 2005 (serrano) */ -;* Copyright : 2003-05 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Skribe style for ACMPROC articles. */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* LaTeX global customizations */ -;*---------------------------------------------------------------------*/ -(let ((le (find-engine 'latex))) - (engine-custom-set! le - 'documentclass - "\\documentclass[twocolumns]{sigplanconf}") - ;; &latex-author - (markup-writer '&latex-author le - :before (lambda (n e) - (let ((body (markup-body n))) - (printf "\\authorinfo{\n" - (if (pair? body) (length body) 1)))) - :action (lambda (n e) - (let ((body (markup-body n))) - (for-each (lambda (a) - (display "}\n\\authorinfo{") - (output a e)) - (if (pair? body) body (list body))))) - :after "}\n") - ;; author - (let ((old-author (markup-writer-get 'author le))) - (markup-writer 'author le - :options (writer-options old-author) - :action (writer-action old-author))) - ;; ACM category, terms, and keywords - (markup-writer '&acm-category le - :options '(:index :section :subsection) - :before (lambda (n e) - (display "\\category{") - (display (markup-option n :index)) - (display "}") - (display "{") - (display (markup-option n :section)) - (display "}") - (display "{") - (display (markup-option n :subsection)) - (display "}\n[")) - :after "]\n") - (markup-writer '&acm-terms le - :before "\\terms{" - :after "}") - (markup-writer '&acm-keywords le - :before "\\keywords{" - :after "}") - (markup-writer '&acm-copyright le - :action (lambda (n e) - (display "\\conferenceinfo{") - (output (markup-option n :conference) e) - (display ",} {") - (output (markup-option n :location) e) - (display "}\n") - (display "\\copyrightyear{") - (output (markup-option n :year) e) - (display "}\n") - (display "\\copyrightdata{") - (output (markup-option n :crdata) e) - (display "}\n")))) - -;*---------------------------------------------------------------------*/ -;* HTML global customizations */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - (markup-writer '&html-acmproc-abstract he - :action (lambda (n e) - (let* ((ebg (engine-custom e 'abstract-background)) - (bg (or (and (string? ebg) - (> (string-length ebg) 0)) - ebg - "#cccccc")) - (exp (p (center (color :bg bg :width 90. - (markup-body n)))))) - (skribe-eval exp e)))) - ;; ACM category, terms, and keywords - (markup-writer '&acm-category :action #f) - (markup-writer '&acm-terms :action #f) - (markup-writer '&acm-keywords :action #f) - (markup-writer '&acm-copyright :action #f)) - -;*---------------------------------------------------------------------*/ -;* abstract ... */ -;*---------------------------------------------------------------------*/ -(define-markup (abstract #!rest opt #!key postscript) - (if (engine-format? "latex") - (section :number #f :title "ABSTRACT" (p (the-body opt))) - (let ((a (new markup - (markup '&html-acmproc-abstract) - (body (the-body opt))))) - (list (if postscript - (section :number #f :toc #f :title "Postscript download" - postscript)) - (section :number #f :toc #f :title "Abstract" a) - (section :number #f :toc #f :title "Table of contents" - (toc :subsection #t)))))) - -;*---------------------------------------------------------------------*/ -;* acm-category ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-category #!rest opt #!key index section subsection) - (new markup - (markup '&acm-category) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-terms ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-terms #!rest opt) - (new markup - (markup '&acm-terms) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-keywords ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-keywords #!rest opt) - (new markup - (markup '&acm-keywords) - (options (the-options opt)) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* acm-copyright ... */ -;*---------------------------------------------------------------------*/ -(define-markup (acm-copyright #!rest opt #!key conference location year crdata) - (let* ((le (find-engine 'latex)) - (cop (format "\\conferenceinfo{~a,} {~a} -\\CopyrightYear{~a} -\\crdata{~a}\n" conference location year crdata)) - (old (engine-custom le 'predocument))) - (if (string? old) - (engine-custom-set! le 'predocument (string-append cop old)) - (engine-custom-set! le 'predocument cop)))) - -;*---------------------------------------------------------------------*/ -;* references ... */ -;*---------------------------------------------------------------------*/ -(define (references) - (list "\n\n" - (if (engine-format? "latex") - (font :size -1 (flush :side 'left (the-bibliography))) - (section :title "References" - (font :size -1 (the-bibliography)))))) diff --git a/skribe/skr/skribe.skr b/skribe/skr/skribe.skr deleted file mode 100644 index 86425ac..0000000 --- a/skribe/skr/skribe.skr +++ /dev/null @@ -1,76 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/skribe.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Fri Jan 11 11:23:12 2002 */ -;* Last change : Sun Jul 11 12:22:38 2004 (serrano) */ -;* Copyright : 2002-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The standard Skribe style (always loaded). */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* p ... */ -;*---------------------------------------------------------------------*/ -(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location) - (paragraph :ident ident :class class :loc &skribe-eval-location - (the-body opt))) - -;*---------------------------------------------------------------------*/ -;* fg ... */ -;*---------------------------------------------------------------------*/ -(define (fg c . body) - (color :fg c body)) - -;*---------------------------------------------------------------------*/ -;* bg ... */ -;*---------------------------------------------------------------------*/ -(define (bg c . body) - (color :bg c body)) - -;*---------------------------------------------------------------------*/ -;* counter ... */ -;* ------------------------------------------------------------- */ -;* This produces a kind of "local enumeration" that is: */ -;* (counting "toto," "tutu," "titi.") */ -;* produces: */ -;* i) toto, ii) tutu, iii) titi. */ -;*---------------------------------------------------------------------*/ -(define-markup (counter #!rest opts #!key (numbering 'roman)) - (define items (if (eq? (car opts) :numbering) (cddr opts) opts)) - (define vroman '#(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x")) - (define (the-roman-number num) - (if (< num (vector-length vroman)) - (list (list "(" (it (vector-ref vroman num)) ") ")) - (skribe-error 'counter - "too many items for roman numbering" - (length items)))) - (define (the-arabic-number num) - (list (list "(" (it (integer->string num)) ") "))) - (define (the-alpha-number num) - (list (list "(" (it (+ (integer->char #\a) num -1)) ") "))) - (let ((the-number (case numbering - ((roman) the-roman-number) - ((arabic) the-arabic-number) - ((alpha) the-alpha-number) - (else (skribe-error 'counter - "Illegal numbering" - numbering))))) - (let loop ((num 1) - (items items) - (res '())) - (if (null? items) - (reverse! res) - (loop (+ num 1) - (cdr items) - (cons (list (the-number num) (car items)) res)))))) - -;*---------------------------------------------------------------------*/ -;* q */ -;*---------------------------------------------------------------------*/ -(define-markup (q #!rest opt) - (new markup - (markup 'q) - (options (the-options opt)) - (body (the-body opt)))) - diff --git a/skribe/skr/slide.skr b/skribe/skr/slide.skr deleted file mode 100644 index f8638ad..0000000 --- a/skribe/skr/slide.skr +++ /dev/null @@ -1,664 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/slide.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Fri Oct 3 12:22:13 2003 */ -;* Last change : Mon Aug 23 09:08:21 2004 (serrano) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* Skribe style for slides */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* slide-options */ -;*---------------------------------------------------------------------*/ -(define &slide-load-options (skribe-load-options)) - -;*---------------------------------------------------------------------*/ -;* &slide-seminar-predocument ... */ -;*---------------------------------------------------------------------*/ -(define &slide-seminar-predocument - "\\special{landscape} - \\slideframe{none} - \\centerslidesfalse - \\raggedslides[0pt] - \\renewcommand{\\slideleftmargin}{0.2in} - \\renewcommand{\\slidetopmargin}{0.3in} - \\newdimen\\slidewidth \\slidewidth 9in") - -;*---------------------------------------------------------------------*/ -;* &slide-seminar-maketitle ... */ -;*---------------------------------------------------------------------*/ -(define &slide-seminar-maketitle - "\\def\\labelitemi{$\\bullet$} - \\def\\labelitemii{$\\circ$} - \\def\\labelitemiii{$\\diamond$} - \\def\\labelitemiv{$\\cdot$} - \\pagestyle{empty} - \\slideframe{none} - \\centerslidestrue - \\begin{slide} - \\date{} - \\maketitle - \\end{slide} - \\slideframe{none} - \\centerslidesfalse") - -;*---------------------------------------------------------------------*/ -;* &slide-prosper-predocument ... */ -;*---------------------------------------------------------------------*/ -(define &slide-prosper-predocument - "\\slideCaption{}\n") - -;*---------------------------------------------------------------------*/ -;* %slide-the-slides ... */ -;*---------------------------------------------------------------------*/ -(define %slide-the-slides '()) -(define %slide-the-counter 0) -(define %slide-initialized #f) -(define %slide-latex-mode 'seminar) - -;*---------------------------------------------------------------------*/ -;* %slide-initialize! ... */ -;*---------------------------------------------------------------------*/ -(define (%slide-initialize!) - (unless %slide-initialized - (set! %slide-initialized #t) - (case %slide-latex-mode - ((seminar) - (%slide-seminar-setup!)) - ((advi) - (%slide-advi-setup!)) - ((prosper) - (%slide-prosper-setup!)) - (else - (skribe-error 'slide "Illegal latex mode" %slide-latex-mode))))) - -;*---------------------------------------------------------------------*/ -;* slide ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide #!rest opt - #!key - (ident #f) (class #f) - (toc #t) - title (number #t) - (vspace #f) (vfill #f) - (transition #f) - (bg #f) (image #f)) - (%slide-initialize!) - (let ((s (new container - (markup 'slide) - (ident (symbol->string (gensym 'slide))) - (class class) - (required-options '(:title :number :toc)) - (options `((:number - ,(cond - ((number? number) - (set! %slide-the-counter number) - number) - (number - (set! %slide-the-counter - (+ 1 %slide-the-counter)) - %slide-the-counter) - (else - #f))) - (:toc ,toc) - ,@(the-options opt :ident :class :vspace :toc))) - (body (if vspace - (list (slide-vspace vspace) (the-body opt)) - (the-body opt)))))) - (set! %slide-the-slides (cons s %slide-the-slides)) - s)) - -;*---------------------------------------------------------------------*/ -;* ref ... */ -;*---------------------------------------------------------------------*/ -(define %slide-old-ref ref) - -(define-markup (ref #!rest opt #!key (slide #f)) - (if (not slide) - (apply %slide-old-ref opt) - (new unresolved - (proc (lambda (n e env) - (cond - ((eq? slide 'next) - (let ((c (assq n %slide-the-slides))) - (if (pair? c) - (handle (cadr c)) - #f))) - ((eq? slide 'prev) - (let ((c (assq n (reverse %slide-the-slides)))) - (if (pair? c) - (handle (cadr c)) - #f))) - ((number? slide) - (let loop ((s %slide-the-slides)) - (cond - ((null? s) - #f) - ((= slide (markup-option (car s) :number)) - (handle (car s))) - (else - (loop (cdr s)))))) - (else - #f))))))) - -;*---------------------------------------------------------------------*/ -;* slide-pause ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-pause) - (new markup - (markup 'slide-pause))) - -;*---------------------------------------------------------------------*/ -;* slide-vspace ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-vspace #!rest opt #!key (unit 'cm)) - (new markup - (markup 'slide-vspace) - (options `((:unit ,unit) ,@(the-options opt :unit))) - (body (the-body opt)))) - -;*---------------------------------------------------------------------*/ -;* slide-embed ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-embed #!rest opt - #!key - command - (geometry-opt "-geometry") - (geometry #f) (rgeometry #f) - (transient #f) (transient-opt #f) - (alt #f) - &skribe-eval-location) - (if (not (string? command)) - (skribe-error 'slide-embed - "No command provided" - command) - (new markup - (markup 'slide-embed) - (loc &skribe-eval-location) - (required-options '(:alt)) - (options `((:geometry-opt ,geometry-opt) - (:alt ,alt) - ,@(the-options opt :geometry-opt :alt))) - (body (the-body opt))))) - -;*---------------------------------------------------------------------*/ -;* slide-record ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-record #!rest opt #!key ident class tag (play #t)) - (if (not tag) - (skribe-error 'slide-record "Tag missing" tag) - (new markup - (markup 'slide-record) - (ident ident) - (class class) - (options `((:play ,play) ,@(the-options opt))) - (body (the-body opt))))) - -;*---------------------------------------------------------------------*/ -;* slide-play ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-play #!rest opt #!key ident class tag color) - (if (not tag) - (skribe-error 'slide-play "Tag missing" tag) - (new markup - (markup 'slide-play) - (ident ident) - (class class) - (options `((:color ,(if color (skribe-use-color! color) #f)) - ,@(the-options opt :color))) - (body (the-body opt))))) - -;*---------------------------------------------------------------------*/ -;* slide-play* ... */ -;*---------------------------------------------------------------------*/ -(define-markup (slide-play* #!rest opt - #!key ident class color (scolor "#000000")) - (let ((body (the-body opt))) - (for-each (lambda (lbl) - (match-case lbl - ((?id ?col) - (skribe-use-color! col)))) - body) - (new markup - (markup 'slide-play*) - (ident ident) - (class class) - (options `((:color ,(if color (skribe-use-color! color) #f)) - (:scolor ,(if color (skribe-use-color! scolor) #f)) - ,@(the-options opt :color :scolor))) - (body body)))) - -;*---------------------------------------------------------------------*/ -;* base */ -;*---------------------------------------------------------------------*/ -(let ((be (find-engine 'base))) - (skribe-message "Base slides setup...\n") - ;; slide-pause - (markup-writer 'slide-pause be - :action #f) - ;; slide-vspace - (markup-writer 'slide-vspace be - :options '() - :action #f) - ;; slide-embed - (markup-writer 'slide-embed be - :options '(:alt :geometry-opt) - :action (lambda (n e) - (output (markup-option n :alt) e))) - ;; slide-record - (markup-writer 'slide-record be - :options '(:tag :play) - :action (lambda (n e) - (output (markup-body n) e))) - ;; slide-play - (markup-writer 'slide-play be - :options '(:tag :color) - :action (lambda (n e) - (output (markup-option n :alt) e))) - ;; slide-play* - (markup-writer 'slide-play* be - :options '(:tag :color :scolor) - :action (lambda (n e) - (output (markup-option n :alt) e)))) - -;*---------------------------------------------------------------------*/ -;* slide-body-width ... */ -;*---------------------------------------------------------------------*/ -(define (slide-body-width e) - (let ((w (engine-custom e 'body-width))) - (if (or (number? w) (string? w)) w 95.))) - -;*---------------------------------------------------------------------*/ -;* html-slide-title ... */ -;*---------------------------------------------------------------------*/ -(define (html-slide-title n e) - (let* ((title (markup-body n)) - (authors (markup-option n 'author)) - (tbg (engine-custom e 'title-background)) - (tfg (engine-custom e 'title-foreground)) - (tfont (engine-custom e 'title-font))) - (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>" - (html-width (slide-body-width e))) - (if (string? tbg) - (printf "<td bgcolor=\"~a\">" tbg) - (display "<td>")) - (if (string? tfg) - (printf "<font color=\"~a\">" tfg)) - (if title - (begin - (display "<center>") - (if (string? tfont) - (begin - (printf "<font ~a><strong>" tfont) - (output title e) - (display "</strong></font>")) - (begin - (printf "<div class=\"skribetitle\"><strong><big><big><big>") - (output title e) - (display "</big></big></big></strong</div>"))) - (display "</center>\n"))) - (if (not authors) - (display "\n") - (html-title-authors authors e)) - (if (string? tfg) - (display "</font>")) - (display "</td></tr></tbody></table></center>\n"))) - -;*---------------------------------------------------------------------*/ -;* slide-number ... */ -;*---------------------------------------------------------------------*/ -(define (slide-number) - (length (filter (lambda (n) - (and (is-markup? n 'slide) - (markup-option n :number))) - %slide-the-slides))) - -;*---------------------------------------------------------------------*/ -;* html */ -;*---------------------------------------------------------------------*/ -(let ((he (find-engine 'html))) - (skribe-message "HTML slides setup...\n") - ;; &html-page-title - (markup-writer '&html-document-title he - :predicate (lambda (n e) %slide-initialized) - :action html-slide-title) - ;; slide - (markup-writer 'slide he - :options '(:title :number :transition :toc :bg) - :before (lambda (n e) - (printf "<a name=\"~a\">" (markup-ident n)) - (display "<br>\n")) - :action (lambda (n e) - (let ((nb (markup-option n :number)) - (t (markup-option n :title))) - (skribe-eval - (center - (color :width (slide-body-width e) - :bg (or (markup-option n :bg) "#ffffff") - (table :width 100. - (tr (th :align 'left - (list - (if nb - (format "~a / ~a -- " nb - (slide-number))) - t))) - (tr (td (hrule))) - (tr (td :width 100. :align 'left - (markup-body n)))) - (linebreak))) - e))) - :after "<br>") - ;; slide-vspace - (markup-writer 'slide-vspace he - :action (lambda (n e) (display "<br>")))) - -;*---------------------------------------------------------------------*/ -;* latex */ -;*---------------------------------------------------------------------*/ -(define &latex-slide #f) -(define &latex-pause #f) -(define &latex-embed #f) -(define &latex-record #f) -(define &latex-play #f) -(define &latex-play* #f) - -(let ((le (find-engine 'latex))) - ;; slide-vspace - (markup-writer 'slide-vspace le - :options '(:unit) - :action (lambda (n e) - (display "\n\\vspace{") - (output (markup-body n) e) - (printf " ~a}\n\n" (markup-option n :unit)))) - ;; slide-slide - (markup-writer 'slide le - :options '(:title :number :transition :vfill :toc :vspace :image) - :action (lambda (n e) - (if (procedure? &latex-slide) - (&latex-slide n e)))) - ;; slide-pause - (markup-writer 'slide-pause le - :options '() - :action (lambda (n e) - (if (procedure? &latex-pause) - (&latex-pause n e)))) - ;; slide-embed - (markup-writer 'slide-embed le - :options '(:alt :command :geometry-opt :geometry - :rgeometry :transient :transient-opt) - :action (lambda (n e) - (if (procedure? &latex-embed) - (&latex-embed n e)))) - ;; slide-record - (markup-writer 'slide-record le - :options '(:tag :play) - :action (lambda (n e) - (if (procedure? &latex-record) - (&latex-record n e)))) - ;; slide-play - (markup-writer 'slide-play le - :options '(:tag :color) - :action (lambda (n e) - (if (procedure? &latex-play) - (&latex-play n e)))) - ;; slide-play* - (markup-writer 'slide-play* le - :options '(:tag :color :scolor) - :action (lambda (n e) - (if (procedure? &latex-play*) - (&latex-play* n e))))) - -;*---------------------------------------------------------------------*/ -;* %slide-seminar-setup! ... */ -;*---------------------------------------------------------------------*/ -(define (%slide-seminar-setup!) - (skribe-message "Seminar slides setup...\n") - (let ((le (find-engine 'latex)) - (be (find-engine 'base))) - ;; latex configuration - (define (seminar-slide n e) - (let ((nb (markup-option n :number)) - (t (markup-option n :title))) - (display "\\begin{slide}\n") - (if nb (printf "~a/~a -- " nb (slide-number))) - (output t e) - (display "\\hrule\n")) - (output (markup-body n) e) - (if (markup-option n :vill) (display "\\vfill\n")) - (display "\\end{slide}\n")) - (engine-custom-set! le 'documentclass - "\\documentclass[landscape]{seminar}\n") - (let ((o (engine-custom le 'predocument))) - (engine-custom-set! le 'predocument - (if (string? o) - (string-append &slide-seminar-predocument o) - &slide-seminar-predocument))) - (engine-custom-set! le 'maketitle - &slide-seminar-maketitle) - (engine-custom-set! le 'hyperref-usepackage - "\\usepackage[setpagesize=false]{hyperref}\n") - ;; slide-slide - (set! &latex-slide seminar-slide))) - -;*---------------------------------------------------------------------*/ -;* %slide-advi-setup! ... */ -;*---------------------------------------------------------------------*/ -(define (%slide-advi-setup!) - (skribe-message "Generating `Advi Seminar' slides...\n") - (let ((le (find-engine 'latex)) - (be (find-engine 'base))) - (define (advi-geometry geo) - (let ((r (pregexp-match "([0-9]+)x([0-9]+)" geo))) - (if (pair? r) - (let* ((w (cadr r)) - (w' (string->integer w)) - (w'' (number->string (/ w' *skribe-slide-advi-scale*))) - (h (caddr r)) - (h' (string->integer h)) - (h'' (number->string (/ h' *skribe-slide-advi-scale*)))) - (values "" (string-append w "x" h "+!x+!y"))) - (let ((r (pregexp-match "([0-9]+)x([0-9]+)[+](-?[0-9]+)[+](-?[0-9]+)" geo))) - (if (pair? r) - (let ((w (number->string (/ (string->integer (cadr r)) - *skribe-slide-advi-scale*))) - (h (number->string (/ (string->integer (caddr r)) - *skribe-slide-advi-scale*))) - (x (cadddr r)) - (y (car (cddddr r)))) - (values (string-append "width=" w "cm,height=" h "cm") - "!g")) - (values "" geo)))))) - (define (advi-transition trans) - (cond - ((string? trans) - (printf "\\advitransition{~s}" trans)) - ((and (symbol? trans) - (memq trans '(wipe block slide))) - (printf "\\advitransition{~s}" trans)) - (else - #f))) - ;; latex configuration - (define (advi-slide n e) - (let ((i (markup-option n :image)) - (n (markup-option n :number)) - (t (markup-option n :title)) - (lt (markup-option n :transition)) - (gt (engine-custom e 'transition))) - (if (and i (engine-custom e 'advi)) - (printf "\\advibg[global]{image=~a}\n" - (if (and (pair? i) - (null? (cdr i)) - (string? (car i))) - (car i) - i))) - (display "\\begin{slide}\n") - (advi-transition (or lt gt)) - (if n (printf "~a/~a -- " n (slide-number))) - (output t e) - (display "\\hrule\n")) - (output (markup-body n) e) - (if (markup-option n :vill) (display "\\vfill\n")) - (display "\\end{slide}\n\n\n")) - ;; advi record - (define (advi-record n e) - (display "\\advirecord") - (when (markup-option n :play) (display "[play]")) - (printf "{~a}{" (markup-option n :tag)) - (output (markup-body n) e) - (display "}")) - ;; advi play - (define (advi-play n e) - (display "\\adviplay") - (let ((c (markup-option n :color))) - (when c - (display "[") - (display (skribe-get-latex-color c)) - (display "]"))) - (printf "{~a}" (markup-option n :tag))) - ;; advi play* - (define (advi-play* n e) - (let ((c (skribe-get-latex-color (markup-option n :color))) - (d (skribe-get-latex-color (markup-option n :scolor)))) - (let loop ((lbls (markup-body n)) - (last #f)) - (when last - (display "\\adviplay[") - (display d) - (printf "]{~a}" last)) - (when (pair? lbls) - (let ((lbl (car lbls))) - (match-case lbl - ((?id ?col) - (display "\\adviplay[") - (display (skribe-get-latex-color col)) - (printf "]{" ~a "}" id) - (skribe-eval (slide-pause) e) - (loop (cdr lbls) id)) - (else - (display "\\adviplay[") - (display c) - (printf "]{~a}" lbl) - (skribe-eval (slide-pause) e) - (loop (cdr lbls) lbl)))))))) - (engine-custom-set! le 'documentclass - "\\documentclass{seminar}\n") - (let ((o (engine-custom le 'predocument))) - (engine-custom-set! le 'predocument - (if (string? o) - (string-append &slide-seminar-predocument o) - &slide-seminar-predocument))) - (engine-custom-set! le 'maketitle - &slide-seminar-maketitle) - (engine-custom-set! le 'usepackage - (string-append "\\usepackage{advi}\n" - (engine-custom le 'usepackage))) - ;; slide - (set! &latex-slide advi-slide) - (set! &latex-pause - (lambda (n e) (display "\\adviwait\n"))) - (set! &latex-embed - (lambda (n e) - (let ((geometry-opt (markup-option n :geometry-opt)) - (geometry (markup-option n :geometry)) - (rgeometry (markup-option n :rgeometry)) - (transient (markup-option n :transient)) - (transient-opt (markup-option n :transient-opt)) - (cmd (markup-option n :command))) - (let* ((a (string-append "ephemeral=" - (symbol->string (gensym)))) - (c (cond - (geometry - (string-append cmd " " - geometry-opt " " - geometry)) - (rgeometry - (multiple-value-bind (aopt dopt) - (advi-geometry rgeometry) - (set! a (string-append a "," aopt)) - (string-append cmd " " - geometry-opt " " - dopt))) - (else - cmd))) - (c (if (and transient transient-opt) - (string-append c " " transient-opt " !p") - c))) - (printf "\\adviembed[~a]{~a}\n" a c))))) - (set! &latex-record advi-record) - (set! &latex-play advi-play) - (set! &latex-play* advi-play*))) - -;*---------------------------------------------------------------------*/ -;* %slide-prosper-setup! ... */ -;*---------------------------------------------------------------------*/ -(define (%slide-prosper-setup!) - (skribe-message "Generating `Prosper' slides...\n") - (let ((le (find-engine 'latex)) - (be (find-engine 'base)) - (overlay-count 0)) - ;; transitions - (define (prosper-transition trans) - (cond - ((string? trans) - (printf "[~s]" trans)) - ((eq? trans 'slide) - (printf "[Blinds]")) - ((and (symbol? trans) - (memq trans '(split blinds box wipe dissolve glitter))) - (printf "[~s]" - (string-upcase (symbol->string trans)))) - (else - #f))) - ;; latex configuration - (define (prosper-slide n e) - (let* ((i (markup-option n :image)) - (t (markup-option n :title)) - (lt (markup-option n :transition)) - (gt (engine-custom e 'transition)) - (pa (search-down (lambda (x) (is-markup? x 'slide-pause)) n)) - (lpa (length pa))) - (set! overlay-count 1) - (if (>= lpa 1) (printf "\\overlays{~a}{%\n" (+ 1 lpa))) - (display "\\begin{slide}") - (prosper-transition (or lt gt)) - (display "{") - (output t e) - (display "}\n") - (output (markup-body n) e) - (display "\\end{slide}\n") - (if (>= lpa 1) (display "}\n")) - (newline) - (newline))) - (engine-custom-set! le 'documentclass "\\documentclass[pdf,skribe,slideColor,nototal]{prosper}\n") - (let* ((cap (engine-custom le 'slide-caption)) - (o (engine-custom le 'predocument)) - (n (if (string? cap) - (format "~a\\slideCaption{~a}\n" - &slide-prosper-predocument - cap) - &slide-prosper-predocument))) - (engine-custom-set! le 'predocument - (if (string? o) (string-append n o) n))) - (engine-custom-set! le 'hyperref-usepackage "\\usepackage{hyperref}\n") - ;; writers - (set! &latex-slide prosper-slide) - (set! &latex-pause - (lambda (n e) - (set! overlay-count (+ 1 overlay-count)) - (printf "\\FromSlide{~s}%\n" overlay-count))))) - -;*---------------------------------------------------------------------*/ -;* Setup ... */ -;*---------------------------------------------------------------------*/ -(let* ((opt &slide-load-options) - (p (memq :prosper opt))) - (if (and (pair? p) (pair? (cdr p)) (cadr p)) - ;; prosper - (set! %slide-latex-mode 'prosper) - (let ((a (memq :advi opt))) - (if (and (pair? a) (pair? (cdr a)) (cadr a)) - ;; advi - (set! %slide-latex-mode 'advi))))) - diff --git a/skribe/skr/web-article.skr b/skribe/skr/web-article.skr deleted file mode 100644 index e33328b..0000000 --- a/skribe/skr/web-article.skr +++ /dev/null @@ -1,230 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/web-article.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Sat Jan 10 09:09:43 2004 */ -;* Last change : Wed Mar 24 16:45:08 2004 (serrano) */ -;* Copyright : 2004 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* A Skribe style for producing web articles */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* &web-article-load-options ... */ -;*---------------------------------------------------------------------*/ -(define &web-article-load-options (skribe-load-options)) - -;*---------------------------------------------------------------------*/ -;* web-article-body-width ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-body-width e) - (let ((w (engine-custom e 'body-width))) - (if (or (number? w) (string? w)) w 98.))) - -;*---------------------------------------------------------------------*/ -;* html-document-title-web ... */ -;*---------------------------------------------------------------------*/ -(define (html-document-title-web n e) - (let* ((title (markup-body n)) - (authors (markup-option n 'author)) - (tbg (engine-custom e 'title-background)) - (tfg (engine-custom e 'title-foreground)) - (tfont (engine-custom e 'title-font))) - (printf "<center><table cellspacing='0' cellpadding='0' width=\"~a\" class=\"skribetitle\"><tbody>\n<tr>" - (html-width (web-article-body-width e))) - (if (string? tbg) - (printf "<td bgcolor=\"~a\">" tbg) - (display "<td>")) - (if (string? tfg) - (printf "<font color=\"~a\">" tfg)) - (if title - (begin - (display "<center>") - (if (string? tfont) - (begin - (printf "<font ~a><b>" tfont) - (output title e) - (display "</b></font>")) - (begin - (printf "<h1>") - (output title e) - (display "</h1>"))) - (display "</center>\n"))) - (if (not authors) - (display "\n") - (html-title-authors authors e)) - (if (string? tfg) - (display "</font>")) - (display "</td></tr></tbody></table></center>\n"))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-document-title ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-document-title n e) - (let* ((title (markup-body n)) - (authors (markup-option n 'author)) - (id (markup-ident n))) - ;; the title - (printf "<div id=\"~a\" class=\"document-title-title\">\n" - (string-canonicalize id)) - (output title e) - (display "</div>\n") - ;; the authors - (printf "<div id=\"~a\" class=\"document-title-authors\">\n" - (string-canonicalize id)) - (for-each (lambda (a) (output a e)) - (cond - ((is-markup? authors 'author) - (list authors)) - ((list? authors) - authors) - (else - '()))) - (display "</div>\n"))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-author ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-author n e) - (let ((name (markup-option n :name)) - (title (markup-option n :title)) - (affiliation (markup-option n :affiliation)) - (email (markup-option n :email)) - (url (markup-option n :url)) - (address (markup-option n :address)) - (phone (markup-option n :phone)) - (nfn (engine-custom e 'author-font)) - (align (markup-option n :align))) - (when name - (printf "<span class=\"document-author-name\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output name e) - (display "</span>\n")) - (when title - (printf "<span class=\"document-author-title\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output title e) - (display "</span>\n")) - (when affiliation - (printf "<span class=\"document-author-affiliation\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output affiliation e) - (display "</span>\n")) - (when (pair? address) - (printf "<span class=\"document-author-address\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (for-each (lambda (a) - (output a e) - (newline)) - address) - (display "</span>\n")) - (when phone - (printf "<span class=\"document-author-phone\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output phone e) - (display "</span>\n")) - (when email - (printf "<span class=\"document-author-email\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output email e) - (display "</span>\n")) - (when url - (printf "<span class=\"document-author-url\" id=\"~a\">" - (string-canonicalize (markup-ident n))) - (output url e) - (display "</span>\n")))) - -;*---------------------------------------------------------------------*/ -;* HTML settings */ -;*---------------------------------------------------------------------*/ -(define (web-article-modern-setup he) - (let ((sec (markup-writer-get 'section he)) - (ft (markup-writer-get '&html-footnotes he))) - ;; &html-document-title - (markup-writer '&html-document-title he - :action html-document-title-web) - ;; section - (markup-writer 'section he - :options 'all - :before "<br>" - :action (lambda (n e) - (let ((e1 (make-engine 'html-web :delegate e)) - (bg (engine-custom he 'section-background))) - (markup-writer 'section e1 - :options 'all - :action (lambda (n e2) (output n e sec))) - (skribe-eval - (center (color :width (web-article-body-width e) - :margin 5 :bg bg n)) - e1)))) - ;; &html-footnotes - (markup-writer '&html-footnotes he - :options 'all - :before "<br>" - :action (lambda (n e) - (let ((e1 (make-engine 'html-web :delegate e)) - (bg (engine-custom he 'section-background)) - (fg (engine-custom he 'subsection-title-foreground))) - (markup-writer '&html-footnotes e1 - :options 'all - :action (lambda (n e2) - (invoke (writer-action ft) n e))) - (skribe-eval - (center (color :width (web-article-body-width e) - :margin 5 :bg bg :fg fg n)) - e1)))))) - -;*---------------------------------------------------------------------*/ -;* web-article-css-setup ... */ -;*---------------------------------------------------------------------*/ -(define (web-article-css-setup he) - (let ((sec (markup-writer-get 'section he)) - (ft (markup-writer-get '&html-footnotes he))) - ;; &html-document-title - (markup-writer '&html-document-title he - :before (lambda (n e) - (printf "<div id=\"~a\" class=\"document-title\">\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-document-title - :after "</div>\n") - ;; author - (markup-writer 'author he - :options '(:name :title :affiliation :email :url :address :phone :photo :align) - :before (lambda (n e) - (printf "<span id=\"~a\" class=\"document-author\">\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-author - :after "</span\n") - ;; section - (markup-writer 'section he - :options 'all - :before (lambda (n e) - (printf "<div class=\"section\" id=\"~a\">" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) (output n e sec)) - :after "</div>\n") - ;; &html-footnotes - (markup-writer '&html-footnotes he - :options 'all - :before (lambda (n e) - (printf "<div class=\"footnotes\" id=\"~a\">" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) - (output n e ft)) - :after "</div>\n"))) - -;*---------------------------------------------------------------------*/ -;* Setup ... */ -;*---------------------------------------------------------------------*/ -(let* ((opt &web-article-load-options) - (p (memq :style opt)) - (css (memq :css opt)) - (he (find-engine 'html))) - (cond - ((and (pair? p) (pair? (cdr p)) (eq? (cadr p) 'css)) - (web-article-css-setup he)) - ((and (pair? css) (pair? (cdr css)) (string? (cadr css))) - (engine-custom-set! he 'css (cadr css)) - (web-article-css-setup he)) - (else - (web-article-modern-setup he)))) diff --git a/skribe/skr/web-book.skr b/skribe/skr/web-book.skr deleted file mode 100644 index f907c8b..0000000 --- a/skribe/skr/web-book.skr +++ /dev/null @@ -1,107 +0,0 @@ -;*=====================================================================*/ -;* serrano/prgm/project/skribe/skr/web-book.skr */ -;* ------------------------------------------------------------- */ -;* Author : Manuel Serrano */ -;* Creation : Mon Sep 1 10:54:32 2003 */ -;* Last change : Mon Nov 8 10:43:46 2004 (eg) */ -;* Copyright : 2003-04 Manuel Serrano */ -;* ------------------------------------------------------------- */ -;* The Skribe web book style. */ -;*=====================================================================*/ - -;*---------------------------------------------------------------------*/ -;* html customization */ -;*---------------------------------------------------------------------*/ -(define he (find-engine 'html)) -(engine-custom-set! he 'main-browsing-extra #f) -(engine-custom-set! he 'chapter-file #t) - -;*---------------------------------------------------------------------*/ -;* main-browsing ... */ -;*---------------------------------------------------------------------*/ -(define main-browsing - (lambda (n e) - ;; search the document - (let ((p (ast-document n))) - (cond - ((document? p) - ;; got it - (let* ((mt (markup-option p :margin-title)) - (r (ref :handle (handle p) - :text (or mt (markup-option p :title)))) - (fx (engine-custom e 'web-book-main-browsing-extra))) - (center - (table :width 97. :border 1 :frame 'box - :cellpadding 0 :cellspacing 0 - (tr :bg (engine-custom e 'title-background) - (th (color :fg (engine-custom e 'background) - (bold "main page")))) - (tr :bg (engine-custom e 'background) - (td (apply table :width 100. :border 0 - (tr (td :align 'left - :valign 'top - (bold "top:")) - (td :align 'right - :valign 'top r)) - (if (procedure? fx) - (list (tr (td :width 100. - :colspan 2 - (fx n e)))) - '())))))))) - ((not p) - ;; no document!!! - #f))))) - -;*---------------------------------------------------------------------*/ -;* chapter-browsing ... */ -;*---------------------------------------------------------------------*/ -(define chapter-browsing - (lambda (n e) - (center - (table :width 97. :border 1 :frame 'box - :cellpadding 0 :cellspacing 0 - (tr :bg (engine-custom e 'title-background) - (th (color :fg (engine-custom e 'background) - (bold (markup-option n :title))))) - (tr :bg (engine-custom e 'background) - (td (toc (handle n) :chapter #t :section #t :subsection #t))))))) - -;*---------------------------------------------------------------------*/ -;* document-browsing ... */ -;*---------------------------------------------------------------------*/ -(define document-browsing - (lambda (n e) - (let ((chap (find1-down (lambda (n) - (is-markup? n 'chapter)) - n))) - (center - (table :width 97. :border 1 :frame 'box - :cellpadding 0 :cellspacing 0 - (tr :bg (engine-custom e 'title-background) - (th (color :fg (engine-custom e 'background) - (bold (if chap "Chapters" "Sections"))))) - (tr :bg (engine-custom e 'background) - (td (if chap - (toc (handle n) :chapter #t :section #f) - (toc (handle n) :section #t :subsection #t))))))))) - -;*---------------------------------------------------------------------*/ -;* left margin ... */ -;*---------------------------------------------------------------------*/ -(engine-custom-set! he 'left-margin-size 20.) - -(engine-custom-set! he 'left-margin - (lambda (n e) - (let ((d (ast-document n)) - (c (ast-chapter n))) - (list (linebreak 1) - (main-browsing n e) - (if (is-markup? c 'chapter) - (list (linebreak 2) - (chapter-browsing c e)) - #f) - (if (document? d) - (list (linebreak 2) - (document-browsing d e)) - #f))))) - diff --git a/skribe/skr/xml.skr b/skribe/skr/xml.skr deleted file mode 100644 index 784b6f0..0000000 --- a/skribe/skr/xml.skr +++ /dev/null @@ -1,111 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 1539075..0000000 --- a/skribe/skribe.prj +++ /dev/null @@ -1,332 +0,0 @@ -;; -*- 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 deleted file mode 100644 index 09e96d5..0000000 --- a/skribe/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/skribe/src/bigloo/Makefile b/skribe/src/bigloo/Makefile deleted file mode 100644 index 02d2b6a..0000000 --- a/skribe/src/bigloo/Makefile +++ /dev/null @@ -1,271 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 55493b0..0000000 --- a/skribe/src/bigloo/api.bgl +++ /dev/null @@ -1,117 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 390b8fa..0000000 --- a/skribe/src/bigloo/api.sch +++ /dev/null @@ -1,91 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 03196ac..0000000 --- a/skribe/src/bigloo/asm.scm +++ /dev/null @@ -1,99 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 6b0f7dd..0000000 --- a/skribe/src/bigloo/bib.bgl +++ /dev/null @@ -1,161 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 07290ce..0000000 --- a/skribe/src/bigloo/c.scm +++ /dev/null @@ -1,134 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index e40638b..0000000 --- a/skribe/src/bigloo/color.scm +++ /dev/null @@ -1,702 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index e100d8d..0000000 --- a/skribe/src/bigloo/configure.bgl +++ /dev/null @@ -1,90 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 9b53c84..0000000 --- a/skribe/src/bigloo/debug.sch +++ /dev/null @@ -1,54 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 8f1691c..0000000 --- a/skribe/src/bigloo/debug.scm +++ /dev/null @@ -1,188 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index bd8a027..0000000 --- a/skribe/src/bigloo/engine.scm +++ /dev/null @@ -1,262 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b5c6548..0000000 --- a/skribe/src/bigloo/eval.scm +++ /dev/null @@ -1,335 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 6f0d49e..0000000 --- a/skribe/src/bigloo/evapi.scm +++ /dev/null @@ -1,39 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 9697981..0000000 --- a/skribe/src/bigloo/index.bgl +++ /dev/null @@ -1,32 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 6dd6d37..0000000 --- a/skribe/src/bigloo/lib.bgl +++ /dev/null @@ -1,340 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 65a8227..0000000 --- a/skribe/src/bigloo/lisp.scm +++ /dev/null @@ -1,530 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 5b9e5e5..0000000 --- a/skribe/src/bigloo/main.scm +++ /dev/null @@ -1,96 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 16bb7d5..0000000 --- a/skribe/src/bigloo/new.sch +++ /dev/null @@ -1,17 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 4bc6271..0000000 --- a/skribe/src/bigloo/output.scm +++ /dev/null @@ -1,167 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 6ff6b42..0000000 --- a/skribe/src/bigloo/param.bgl +++ /dev/null @@ -1,134 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 4ce58c4..0000000 --- a/skribe/src/bigloo/parseargs.scm +++ /dev/null @@ -1,186 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index baad0f0..0000000 --- a/skribe/src/bigloo/prog.scm +++ /dev/null @@ -1,196 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 91cd345..0000000 --- a/skribe/src/bigloo/read.scm +++ /dev/null @@ -1,482 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 7507560..0000000 --- a/skribe/src/bigloo/resolve.scm +++ /dev/null @@ -1,281 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index babadff..0000000 --- a/skribe/src/bigloo/source.scm +++ /dev/null @@ -1,238 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 63c5477..0000000 --- a/skribe/src/bigloo/sui.bgl +++ /dev/null @@ -1,34 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b8babd4..0000000 --- a/skribe/src/bigloo/types.scm +++ /dev/null @@ -1,685 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 602a951..0000000 --- a/skribe/src/bigloo/verify.scm +++ /dev/null @@ -1,143 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index ce515bf..0000000 --- a/skribe/src/bigloo/writer.scm +++ /dev/null @@ -1,232 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index d4c662e..0000000 --- a/skribe/src/bigloo/xml.scm +++ /dev/null @@ -1,92 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index 397ba09..0000000 --- a/skribe/src/common/api.scm +++ /dev/null @@ -1,1243 +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 (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 deleted file mode 100644 index b73c5f0..0000000 --- a/skribe/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/skribe/src/common/configure.scm.in b/skribe/src/common/configure.scm.in deleted file mode 100644 index 830ec4d..0000000 --- a/skribe/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/skribe/src/common/index.scm b/skribe/src/common/index.scm deleted file mode 100644 index 65c271f..0000000 --- a/skribe/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/skribe/src/common/lib.scm b/skribe/src/common/lib.scm deleted file mode 100644 index b0fa2d0..0000000 --- a/skribe/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/skribe/src/common/param.scm b/skribe/src/common/param.scm deleted file mode 100644 index ba8d489..0000000 --- a/skribe/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/skribe/src/common/sui.scm b/skribe/src/common/sui.scm deleted file mode 100644 index eb6134b..0000000 --- a/skribe/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)))) diff --git a/skribe/src/stklos/Makefile.in b/skribe/src/stklos/Makefile.in deleted file mode 100644 index 80a26de..0000000 --- a/skribe/src/stklos/Makefile.in +++ /dev/null @@ -1,110 +0,0 @@ -# -# 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 deleted file mode 100644 index 5691588..0000000 --- a/skribe/src/stklos/biblio.stk +++ /dev/null @@ -1,161 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index a5b337e..0000000 --- a/skribe/src/stklos/c-lex.l +++ /dev/null @@ -1,67 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 265c421..0000000 --- a/skribe/src/stklos/c.stk +++ /dev/null @@ -1,95 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 0cb829f..0000000 --- a/skribe/src/stklos/color.stk +++ /dev/null @@ -1,622 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index ece7abc..0000000 --- a/skribe/src/stklos/configure.stk +++ /dev/null @@ -1,90 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index a9fefde..0000000 --- a/skribe/src/stklos/debug.stk +++ /dev/null @@ -1,161 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index a13ed0f..0000000 --- a/skribe/src/stklos/engine.stk +++ /dev/null @@ -1,242 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 3acace9..0000000 --- a/skribe/src/stklos/eval.stk +++ /dev/null @@ -1,149 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 3c3b9f0..0000000 --- a/skribe/src/stklos/lib.stk +++ /dev/null @@ -1,317 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index efad24b..0000000 --- a/skribe/src/stklos/lisp-lex.l +++ /dev/null @@ -1,91 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 9bfe75a..0000000 --- a/skribe/src/stklos/lisp.stk +++ /dev/null @@ -1,294 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 4905423..0000000 --- a/skribe/src/stklos/main.stk +++ /dev/null @@ -1,264 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 3c00323..0000000 --- a/skribe/src/stklos/output.stk +++ /dev/null @@ -1,158 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 6301ece..0000000 --- a/skribe/src/stklos/prog.stk +++ /dev/null @@ -1,219 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index bd38562..0000000 --- a/skribe/src/stklos/reader.stk +++ /dev/null @@ -1,136 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 91dc965..0000000 --- a/skribe/src/stklos/resolve.stk +++ /dev/null @@ -1,255 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 58d0d45..0000000 --- a/skribe/src/stklos/runtime.stk +++ /dev/null @@ -1,456 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index a3102c1..0000000 --- a/skribe/src/stklos/source.stk +++ /dev/null @@ -1,191 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index fb16230..0000000 --- a/skribe/src/stklos/types.stk +++ /dev/null @@ -1,294 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 1c875f8..0000000 --- a/skribe/src/stklos/vars.stk +++ /dev/null @@ -1,82 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index da9b132..0000000 --- a/skribe/src/stklos/verify.stk +++ /dev/null @@ -1,157 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 2b0f91c..0000000 --- a/skribe/src/stklos/writer.stk +++ /dev/null @@ -1,211 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 5d9a8d9..0000000 --- a/skribe/src/stklos/xml-lex.l +++ /dev/null @@ -1,64 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 47dd46f..0000000 --- a/skribe/src/stklos/xml.stk +++ /dev/null @@ -1,52 +0,0 @@ -;;;; -;;;; 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 deleted file mode 100644 index 200db45..0000000 --- a/skribe/tools/Makefile +++ /dev/null @@ -1,60 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index c2a4cc1..0000000 --- a/skribe/tools/skribebibtex/bigloo/Makefile +++ /dev/null @@ -1,70 +0,0 @@ -#*=====================================================================*/ -#* 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 deleted file mode 100644 index 3ff89de..0000000 --- a/skribe/tools/skribebibtex/bigloo/main.scm +++ /dev/null @@ -1,44 +0,0 @@ -;*=====================================================================*/ -;* 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 deleted file mode 100644 index b581537..0000000 --- a/skribe/tools/skribebibtex/bigloo/skribebibtex.scm +++ /dev/null @@ -1,385 +0,0 @@ -;*=====================================================================*/ -;* .../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 deleted file mode 100644 index 3e31d88..0000000 --- a/skribe/tools/skribebibtex/stklos/Makefile +++ /dev/null @@ -1,62 +0,0 @@ -# -# 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 deleted file mode 100644 index 03b4871..0000000 --- a/skribe/tools/skribebibtex/stklos/bibtex-lex.l +++ /dev/null @@ -1,75 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 50236a9..0000000 --- a/skribe/tools/skribebibtex/stklos/bibtex-parser.y +++ /dev/null @@ -1,117 +0,0 @@ -;;;; -*- 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 deleted file mode 100644 index 3225658..0000000 --- a/skribe/tools/skribebibtex/stklos/main.stk +++ /dev/null @@ -1,118 +0,0 @@ -;;;; -;;;; 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*)) |
