From 052c10245a523aa714489bda59e18a6c1a4f473e Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Mon, 31 Oct 2005 23:26:24 +0000 Subject: Installed Autoconf/Automake machinery. Fixed a few things. * src/guile/skribilo/evaluator.scm (skribe-load): Search through `%load-path' and try with a `.scm' extension (rather than the `.skr' one provided by the user). (skribe-include): Added a few debugging statements. * src/guile/skribilo/lib.scm (fix-rest-arg): Handle the dot notation for rest arguments. * src/guile/skribilo/reader/skribe.scm (%make-skribe-reader): Use SQUARE-BRACKET-FREE-SYMBOL-MISC-CHARS. * src/guile/skribilo/skribe/index.scm: Use `define-public' instead of `define'. * src/guile/skribilo/packages/*.scm: Moved to `skribilo/package'. * LICENSE: Removed. * COPYING: New. * AUTHORS: New. * NEWS: New. * ChangeLog: New. * configure.ac: New. * Makefile.am: New. In various directories. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10 --- src/Makefile.am | 1 + src/guile/Makefile.am | 4 + src/guile/skribilo/Makefile.am | 9 + src/guile/skribilo/Makefile.in | 517 +++++++++++++++++---- src/guile/skribilo/coloring/Makefile.am | 2 + src/guile/skribilo/config.scm.in | 2 +- src/guile/skribilo/engine/Makefile.am | 5 + src/guile/skribilo/engine/html.scm | 2 +- src/guile/skribilo/engine/latex.scm | 2 + src/guile/skribilo/evaluator.scm | 54 ++- src/guile/skribilo/lib.scm | 23 +- src/guile/skribilo/package/Makefile.am | 4 + src/guile/skribilo/package/acmproc.scm | 155 +++++++ src/guile/skribilo/package/french.scm | 21 + src/guile/skribilo/package/jfp.scm | 319 +++++++++++++ src/guile/skribilo/package/letter.scm | 148 ++++++ src/guile/skribilo/package/lncs.scm | 149 +++++++ src/guile/skribilo/package/scribe.scm | 231 ++++++++++ src/guile/skribilo/package/sigplan.scm | 157 +++++++ src/guile/skribilo/package/skribe.scm | 76 ++++ src/guile/skribilo/package/slide.scm | 667 ++++++++++++++++++++++++++++ src/guile/skribilo/package/web-article.scm | 232 ++++++++++ src/guile/skribilo/package/web-book.scm | 109 +++++ src/guile/skribilo/packages/acmproc.scm | 155 ------- src/guile/skribilo/packages/french.scm | 21 - src/guile/skribilo/packages/jfp.scm | 319 ------------- src/guile/skribilo/packages/letter.scm | 148 ------ src/guile/skribilo/packages/lncs.scm | 149 ------- src/guile/skribilo/packages/scribe.scm | 231 ---------- src/guile/skribilo/packages/sigplan.scm | 157 ------- src/guile/skribilo/packages/skribe.scm | 76 ---- src/guile/skribilo/packages/slide.scm | 667 ---------------------------- src/guile/skribilo/packages/web-article.scm | 232 ---------- src/guile/skribilo/packages/web-book.scm | 107 ----- src/guile/skribilo/reader/Makefile.am | 2 + src/guile/skribilo/reader/skribe.scm | 20 +- src/guile/skribilo/skribe/Makefile.am | 2 + src/guile/skribilo/skribe/index.scm | 12 +- 38 files changed, 2807 insertions(+), 2380 deletions(-) create mode 100644 src/Makefile.am create mode 100644 src/guile/Makefile.am create mode 100644 src/guile/skribilo/Makefile.am create mode 100644 src/guile/skribilo/coloring/Makefile.am create mode 100644 src/guile/skribilo/engine/Makefile.am create mode 100644 src/guile/skribilo/package/Makefile.am create mode 100644 src/guile/skribilo/package/acmproc.scm create mode 100644 src/guile/skribilo/package/french.scm create mode 100644 src/guile/skribilo/package/jfp.scm create mode 100644 src/guile/skribilo/package/letter.scm create mode 100644 src/guile/skribilo/package/lncs.scm create mode 100644 src/guile/skribilo/package/scribe.scm create mode 100644 src/guile/skribilo/package/sigplan.scm create mode 100644 src/guile/skribilo/package/skribe.scm create mode 100644 src/guile/skribilo/package/slide.scm create mode 100644 src/guile/skribilo/package/web-article.scm create mode 100644 src/guile/skribilo/package/web-book.scm delete mode 100644 src/guile/skribilo/packages/acmproc.scm delete mode 100644 src/guile/skribilo/packages/french.scm delete mode 100644 src/guile/skribilo/packages/jfp.scm delete mode 100644 src/guile/skribilo/packages/letter.scm delete mode 100644 src/guile/skribilo/packages/lncs.scm delete mode 100644 src/guile/skribilo/packages/scribe.scm delete mode 100644 src/guile/skribilo/packages/sigplan.scm delete mode 100644 src/guile/skribilo/packages/skribe.scm delete mode 100644 src/guile/skribilo/packages/slide.scm delete mode 100644 src/guile/skribilo/packages/web-article.scm delete mode 100644 src/guile/skribilo/packages/web-book.scm create mode 100644 src/guile/skribilo/reader/Makefile.am create mode 100644 src/guile/skribilo/skribe/Makefile.am (limited to 'src') diff --git a/src/Makefile.am b/src/Makefile.am new file mode 100644 index 0000000..1d3db1f --- /dev/null +++ b/src/Makefile.am @@ -0,0 +1 @@ +SUBDIRS = guile diff --git a/src/guile/Makefile.am b/src/guile/Makefile.am new file mode 100644 index 0000000..afe4667 --- /dev/null +++ b/src/guile/Makefile.am @@ -0,0 +1,4 @@ +SUBDIRS = skribilo + +bin_SCRIPTS = skribilo.scm +EXTRA_DIST = README diff --git a/src/guile/skribilo/Makefile.am b/src/guile/skribilo/Makefile.am new file mode 100644 index 0000000..c86f2f3 --- /dev/null +++ b/src/guile/skribilo/Makefile.am @@ -0,0 +1,9 @@ +guilemoduledir = $(GUILE_SITE)/skribilo +dist_guilemodule_DATA = biblio.scm color.scm config.scm \ + debug.scm engine.scm evaluator.scm \ + lib.scm module.scm output.scm prog.scm \ + reader.scm resolve.scm runtime.scm \ + source.scm types.scm vars.scm verify.scm \ + writer.scm + +SUBDIRS = reader engine package skribe coloring diff --git a/src/guile/skribilo/Makefile.in b/src/guile/skribilo/Makefile.in index 80a26de..add7d0e 100644 --- a/src/guile/skribilo/Makefile.in +++ b/src/guile/skribilo/Makefile.in @@ -1,110 +1,463 @@ -# -# Makefile.in -- Skribe Src Makefile -# -# Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI -# -# -# 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. -# +# Makefile.in generated by automake 1.9.6 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + # 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 +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. -prefix=@PREFIX@ +@SET_MAKE@ -SKR = $(wildcard ../../skr/*.skr) +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +top_builddir = ../../.. +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +INSTALL = @INSTALL@ +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +subdir = src/guile/skribilo +DIST_COMMON = $(dist_guilemodule_DATA) $(srcdir)/Makefile.am \ + $(srcdir)/Makefile.in $(srcdir)/config.scm.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_CLEAN_FILES = config.scm +SOURCES = +DIST_SOURCES = +RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \ + html-recursive info-recursive install-data-recursive \ + install-exec-recursive install-info-recursive \ + install-recursive installcheck-recursive installdirs-recursive \ + pdf-recursive ps-recursive uninstall-info-recursive \ + uninstall-recursive +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = `echo $$p | sed -e 's|^.*/||'`; +am__installdirs = "$(DESTDIR)$(guilemoduledir)" +dist_guilemoduleDATA_INSTALL = $(INSTALL_DATA) +DATA = $(dist_guilemodule_DATA) +ETAGS = etags +CTAGS = ctags +DIST_SUBDIRS = $(SUBDIRS) +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +GUILE = @GUILE@ +GUILE_CONFIG = @GUILE_CONFIG@ +GUILE_SITE = @GUILE_SITE@ +GUILE_TOOLS = @GUILE_TOOLS@ +HAVE_LOUT_FALSE = @HAVE_LOUT_FALSE@ +HAVE_LOUT_TRUE = @HAVE_LOUT_TRUE@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LOUT = @LOUT@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SKRIBILO_DOC_DIR = @SKRIBILO_DOC_DIR@ +SKRIBILO_EXT_DIR = @SKRIBILO_EXT_DIR@ +SKRIBILO_SKR_PATH = @SKRIBILO_SKR_PATH@ +STRIP = @STRIP@ +VERSION = @VERSION@ +ac_ct_STRIP = @ac_ct_STRIP@ +am__leading_dot = @am__leading_dot@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build_alias = @build_alias@ +datadir = @datadir@ +exec_prefix = @exec_prefix@ +host_alias = @host_alias@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +guilemoduledir = $(GUILE_SITE)/skribilo +dist_guilemodule_DATA = biblio.scm color.scm config.scm \ + debug.scm engine.scm evaluator.scm \ + lib.scm module.scm output.scm prog.scm \ + reader.scm resolve.scm runtime.scm \ + source.scm types.scm vars.scm verify.scm \ + writer.scm -DEPS= ../common/configure.scm ../common/param.scm ../common/api.scm \ - ../common/index.scm ../common/bib.scm ../common/lib.scm +SUBDIRS = reader engine package skribe coloring +all: all-recursive -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 +.SUFFIXES: +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/guile/skribilo/Makefile'; \ + cd $(top_srcdir) && \ + $(AUTOMAKE) --gnu src/guile/skribilo/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; -LEXFILES = c-lex.l lisp-lex.l xml-lex.l +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -LEXSRCS = c-lex.stk lisp-lex.stk xml-lex.stk +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +config.scm: $(top_builddir)/config.status $(srcdir)/config.scm.in + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ +uninstall-info-am: +install-dist_guilemoduleDATA: $(dist_guilemodule_DATA) + @$(NORMAL_INSTALL) + test -z "$(guilemoduledir)" || $(mkdir_p) "$(DESTDIR)$(guilemoduledir)" + @list='$(dist_guilemodule_DATA)'; for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + f=$(am__strip_dir) \ + echo " $(dist_guilemoduleDATA_INSTALL) '$$d$$p' '$(DESTDIR)$(guilemoduledir)/$$f'"; \ + $(dist_guilemoduleDATA_INSTALL) "$$d$$p" "$(DESTDIR)$(guilemoduledir)/$$f"; \ + done -BINDIR=../../bin +uninstall-dist_guilemoduleDATA: + @$(NORMAL_UNINSTALL) + @list='$(dist_guilemodule_DATA)'; for p in $$list; do \ + f=$(am__strip_dir) \ + echo " rm -f '$(DESTDIR)$(guilemoduledir)/$$f'"; \ + rm -f "$(DESTDIR)$(guilemoduledir)/$$f"; \ + done -EXE= $(BINDIR)/skribe.stklos +# This directory's subdirectories are mostly independent; you can cd +# into them and run `make' without going through this Makefile. +# To change the values of `make' variables: instead of editing Makefiles, +# (1) if the variable is set in `config.status', edit `config.status' +# (which will cause the Makefiles to be regenerated when you run `make'); +# (2) otherwise, pass the desired values on the `make' command line. +$(RECURSIVE_TARGETS): + @failcom='exit 1'; \ + for f in x $$MAKEFLAGS; do \ + case $$f in \ + *=* | --[!k]*);; \ + *k*) failcom='fail=yes';; \ + esac; \ + done; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" -PRCS_FILES = Makefile.in $(SRCS) $(LEXFILES) +mostlyclean-recursive clean-recursive distclean-recursive \ +maintainer-clean-recursive: + @failcom='exit 1'; \ + for f in x $$MAKEFLAGS; do \ + case $$f in \ + *=* | --[!k]*);; \ + *k*) failcom='fail=yes';; \ + esac; \ + done; \ + dot_seen=no; \ + case "$@" in \ + distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ + *) list='$(SUBDIRS)' ;; \ + esac; \ + rev=''; for subdir in $$list; do \ + if test "$$subdir" = "."; then :; else \ + rev="$$subdir $$rev"; \ + fi; \ + done; \ + rev="$$rev ."; \ + target=`echo $@ | sed s/-recursive//`; \ + for subdir in $$rev; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || eval $$failcom; \ + done && test -z "$$fail" +tags-recursive: + list='$(SUBDIRS)'; for subdir in $$list; do \ + test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \ + done +ctags-recursive: + list='$(SUBDIRS)'; for subdir in $$list; do \ + test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) ctags); \ + done -SFLAGS= +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + mkid -fID $$unique +tags: TAGS -all: $(EXE) +TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ + include_option=--etags-include; \ + empty_fix=.; \ + else \ + include_option=--include; \ + empty_fix=; \ + fi; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test ! -f $$subdir/TAGS || \ + tags="$$tags $$include_option=$$here/$$subdir/TAGS"; \ + fi; \ + done; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + if test -z "$(ETAGS_ARGS)$$tags$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$tags $$unique; \ + fi +ctags: CTAGS +CTAGS: ctags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + tags=; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + test -z "$(CTAGS_ARGS)$$tags$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$tags $$unique -Makefile: Makefile.in - (cd ../../etc/stklos; autoconf; configure) +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && cd $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) $$here -$(EXE): $(DEPS) $(BINDIR) $(LEXSRCS) $(SRCS) - stklos-compile $(SFLAGS) -o $(EXE) main.stk && \ - chmod $(BMASK) $(EXE) +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags -# -# Lex files -# -lisp-lex.stk: lisp-lex.l - stklos-genlex lisp-lex.l lisp-lex.stk lisp-lex +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's|.|.|g'`; \ + list='$(DISTFILES)'; for file in $$list; do \ + case $$file in \ + $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \ + $(top_srcdir)/*) file=`echo "$$file" | sed "s|^$$topsrcdirstrip/|$(top_builddir)/|"`;; \ + esac; \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + dir=`echo "$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test "$$dir" != "$$file" && test "$$dir" != "."; then \ + dir="/$$dir"; \ + $(mkdir_p) "$(distdir)$$dir"; \ + else \ + dir=''; \ + fi; \ + if test -d $$d/$$file; then \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -pR $(srcdir)/$$file $(distdir)$$dir || exit 1; \ + fi; \ + cp -pR $$d/$$file $(distdir)$$dir || exit 1; \ + else \ + test -f $(distdir)/$$file \ + || cp -p $$d/$$file $(distdir)/$$file \ + || exit 1; \ + fi; \ + done + list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test -d "$(distdir)/$$subdir" \ + || $(mkdir_p) "$(distdir)/$$subdir" \ + || exit 1; \ + distdir=`$(am__cd) $(distdir) && pwd`; \ + top_distdir=`$(am__cd) $(top_distdir) && pwd`; \ + (cd $$subdir && \ + $(MAKE) $(AM_MAKEFLAGS) \ + top_distdir="$$top_distdir" \ + distdir="$$distdir/$$subdir" \ + distdir) \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-recursive +all-am: Makefile $(DATA) +installdirs: installdirs-recursive +installdirs-am: + for dir in "$(DESTDIR)$(guilemoduledir)"; do \ + test -z "$$dir" || $(mkdir_p) "$$dir"; \ + done +install: install-recursive +install-exec: install-exec-recursive +install-data: install-data-recursive +uninstall: uninstall-recursive -xml-lex.stk: xml-lex.l - stklos-genlex xml-lex.l xml-lex.stk xml-lex +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am -c-lex.stk: c-lex.l - stklos-genlex c-lex.l c-lex.stk c-lex +installcheck: installcheck-recursive +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: +clean-generic: -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 +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) -uninstall: - rm $(INSTALL_BINDIR)/skribe - rm $(INSTALL_BINDIR)/skribe.stklos +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-recursive -$(BINDIR): - mkdir -p $(BINDIR) && chmod a+rx $(BINDIR) +clean-am: clean-generic mostlyclean-am -$(INSTALL_BINDIR): - mkdir -p $(INSTALL_BINDIR) && chmod a+rx $(INSTALL_BINDIR) +distclean: distclean-recursive + -rm -f Makefile +distclean-am: clean-am distclean-generic distclean-tags -## -## Services -## -tags: TAGS +dvi: dvi-recursive + +dvi-am: + +html: html-recursive + +info: info-recursive + +info-am: + +install-data-am: install-dist_guilemoduleDATA + +install-exec-am: + +install-info: install-info-recursive + +install-man: + +installcheck-am: + +maintainer-clean: maintainer-clean-recursive + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-recursive + +mostlyclean-am: mostlyclean-generic + +pdf: pdf-recursive + +pdf-am: + +ps: ps-recursive -TAGS: $(SRCS) - etags -l scheme $(SRCS) +ps-am: -pop: - @echo $(PRCS_FILES:%=src/stklos/%) +uninstall-am: uninstall-dist_guilemoduleDATA uninstall-info-am -links: - ln -s $(DEPS) . - ln -s $(SKR) . +uninstall-info: uninstall-info-recursive -clean: - /bin/rm -f skribe $(EXE) *~ TAGS *.scm *.skr +.PHONY: $(RECURSIVE_TARGETS) CTAGS GTAGS all all-am check check-am \ + clean clean-generic clean-recursive ctags ctags-recursive \ + distclean distclean-generic distclean-recursive distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am \ + install-dist_guilemoduleDATA install-exec install-exec-am \ + install-info install-info-am install-man install-strip \ + installcheck installcheck-am installdirs installdirs-am \ + maintainer-clean maintainer-clean-generic \ + maintainer-clean-recursive mostlyclean mostlyclean-generic \ + mostlyclean-recursive pdf pdf-am ps ps-am tags tags-recursive \ + uninstall uninstall-am uninstall-dist_guilemoduleDATA \ + uninstall-info-am -distclean: clean - /bin/rm -f Makefile - /bin/rm -f ../common/configure.scm +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/src/guile/skribilo/coloring/Makefile.am b/src/guile/skribilo/coloring/Makefile.am new file mode 100644 index 0000000..d518553 --- /dev/null +++ b/src/guile/skribilo/coloring/Makefile.am @@ -0,0 +1,2 @@ +guilemoduledir = $(GUILE_SITE)/skribilo +dist_guilemodule_DATA = c.scm lisp.scm xml.scm diff --git a/src/guile/skribilo/config.scm.in b/src/guile/skribilo/config.scm.in index a5e3b7c..51e7a93 100644 --- a/src/guile/skribilo/config.scm.in +++ b/src/guile/skribilo/config.scm.in @@ -3,7 +3,7 @@ (define-module (skribilo config)) -(define-public (skribilo-release) "1.3") +(define-public (skribilo-release) "1.2") (define-public (skribilo-url) "http://www.laas.fr/~lcourtes/") (define-public (skribilo-doc-directory) "@SKRIBILO_DOC_DIR@") (define-public (skribilo-extension-directory) "@SKRIBILO_EXT_DIR@") diff --git a/src/guile/skribilo/engine/Makefile.am b/src/guile/skribilo/engine/Makefile.am new file mode 100644 index 0000000..7b6ec2c --- /dev/null +++ b/src/guile/skribilo/engine/Makefile.am @@ -0,0 +1,5 @@ +guilemoduledir = $(GUILE_SITE)/skribilo/engine +dist_guilemodule_DATA = base.scm context.scm html.scm html4.scm \ + latex-simple.scm latex.scm \ + lout.scm \ + xml.scm diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index 3ad7da6..6e0dc85 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -82,7 +82,7 @@ ;*---------------------------------------------------------------------*/ ;* html-engine ... */ ;*---------------------------------------------------------------------*/ -(define html-engine +(define-public html-engine ;; setup the html engine (default-engine-set! (make-engine 'html diff --git a/src/guile/skribilo/engine/latex.scm b/src/guile/skribilo/engine/latex.scm index 8bd0ae3..2a59b4f 100644 --- a/src/guile/skribilo/engine/latex.scm +++ b/src/guile/skribilo/engine/latex.scm @@ -16,6 +16,8 @@ ;* @ref ../../doc/user/latexe.skb:ref@ */ ;*=====================================================================*/ +(define-skribe-module (skribilo engine latex)) + ;*---------------------------------------------------------------------*/ ;* latex-verbatim-encoding ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 616144d..974d72a 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -39,8 +39,11 @@ (skribilo types) (skribilo lib) (skribilo vars) + (ice-9 optargs) - (oop goops)) + (oop goops) + (srfi srfi-13) + (srfi srfi-1)) @@ -49,6 +52,9 @@ (define *skribe-loaded* '()) ;; List of already loaded files (define *skribe-load-options* '()) +;;; +;;; %EVALUATE +;;; (define (%evaluate expr) (let ((result (eval expr (current-module)))) (if (or (ast? result) (markup? result)) @@ -84,6 +90,8 @@ (reader %default-reader)) (with-debug 2 'skribe-eval-port (debug-item "engine=" engine) + (debug-item "reader=" reader) + (let ((e (if (symbol? engine) (find-engine engine) engine))) (debug-item "e=" e) (if (not (is-a? e )) @@ -114,22 +122,31 @@ ((engine? engine) engine) ((not (symbol? engine)) (skribe-error 'skribe-load - "Illegal engine" engine)) + "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 (search-path path file))) + (path (append (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)) + %load-path)) + (filep (or (search-path path file) + (search-path (append path %load-path) file) + (search-path (append path %load-path) + (let ((dot (string-rindex file #\.))) + (if dot + (string-append + (string-take file dot) + ".scm") + file)))))) (set! *skribe-load-options* opt) (unless (and (string? filep) (file-exists? filep)) (skribe-error 'skribe-load (string-append "cannot find `" file "' in path") - (skribe-path))) + path)) ;; Load this file if not already done (unless (member filep *skribe-loaded*) @@ -149,22 +166,25 @@ ;;; (define* (skribe-include file #:optional (path (skribe-path))) (unless (every string? path) - (skribe-error 'skribe-include "Illegal path" path)) + (skribe-error 'skribe-include "illegal path" path)) (let ((path (search-path path file))) (unless (and (string? path) (file-exists? path)) (skribe-error 'skribe-load - (format "Cannot find ~S in path" file) + (format #t "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))) + (let Loop ((exp (%default-reader (current-input-port))) (res '())) + (format (current-error-port) "exp=~a~%" exp) (if (eof-object? exp) - (if (and (pair? res) (null? (cdr res))) - (car res) - (reverse! res)) - (Loop (read (current-input-port)) + (begin + (format (current-error-port) "include: eof reached~%") + (if (and (pair? res) (null? (cdr res))) + (car res) + (reverse! res))) + (Loop (%default-reader (current-input-port)) (cons (%evaluate exp) res)))))))) diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index 8667f7e..d916db4 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -99,12 +99,23 @@ (let loop ((args args) (result '()) (rest-arg #f)) - (if (null? args) - (if rest-arg (append (reverse result) rest-arg) (reverse result)) - (let ((is-rest-arg? (eq? (car args) #:rest))) - (loop (if is-rest-arg? (cddr args) (cdr args)) - (if is-rest-arg? result (cons (car args) result)) - (if is-rest-arg? (list (car args) (cadr args)) rest-arg)))))) + (cond ((null? args) + (if rest-arg + (append (reverse result) rest-arg) + (reverse result))) + + ((list? args) + (let ((is-rest-arg? (eq? (car args) #:rest))) + (loop (if is-rest-arg? (cddr args) (cdr args)) + (if is-rest-arg? result (cons (car args) result)) + (if is-rest-arg? + (list (car args) (cadr args)) + rest-arg)))) + + ((pair? args) + (loop '() + (cons (car args) result) + (list #:rest (cdr args))))))) (let ((name (car bindings)) (opts (cdr bindings))) diff --git a/src/guile/skribilo/package/Makefile.am b/src/guile/skribilo/package/Makefile.am new file mode 100644 index 0000000..6e047d3 --- /dev/null +++ b/src/guile/skribilo/package/Makefile.am @@ -0,0 +1,4 @@ +guilemoduledir = $(GUILE_SITE)/skribilo/package +dist_guilemodule_DATA = acmproc.scm french.scm jfp.scm letter.scm \ + lncs.scm scribe.scm sigplan.scm skribe.scm \ + slide.scm web-article.scm web-book.scm diff --git a/src/guile/skribilo/package/acmproc.scm b/src/guile/skribilo/package/acmproc.scm new file mode 100644 index 0000000..4accc7c --- /dev/null +++ b/src/guile/skribilo/package/acmproc.scm @@ -0,0 +1,155 @@ +;*=====================================================================*/ +;* serrano/prgm/project/skribe/skr/acmproc.skr */ +;* ------------------------------------------------------------- */ +;* Author : Manuel Serrano */ +;* Creation : Sun Sep 28 14:40:38 2003 */ +;* Last change : Thu Jun 2 10:55:39 2005 (serrano) */ +;* Copyright : 2003-05 Manuel Serrano */ +;* ------------------------------------------------------------- */ +;* The Skribe style for ACMPROC articles. */ +;*=====================================================================*/ + +;*---------------------------------------------------------------------*/ +;* LaTeX global customizations */ +;*---------------------------------------------------------------------*/ +(let ((le (find-engine 'latex))) + (engine-custom-set! le + 'documentclass + "\\documentclass[letterpaper]{acmproc}") + ;; &latex-author + (markup-writer '&latex-author le + :before (lambda (n e) + (let ((body (markup-body n))) + (printf "\\numberofauthors{~a}\n\\author{\n" + (if (pair? body) (length body) 1)))) + :action (lambda (n e) + (let ((body (markup-body n))) + (for-each (lambda (a) + (display "\\alignauthor\n") + (output a e)) + (if (pair? body) body (list body))))) + :after "}\n") + ;; author + (let ((old-author (markup-writer-get 'author le))) + (markup-writer 'author le + :options (writer-options old-author) + :action (writer-action old-author))) + ;; ACM category, terms, and keywords + (markup-writer '&acm-category le + :options '(:index :section :subsection) + :before (lambda (n e) + (display "\\category{") + (display (markup-option n :index)) + (display "}") + (display "{") + (display (markup-option n :section)) + (display "}") + (display "{") + (display (markup-option n :subsection)) + (display "}\n[")) + :after "]\n") + (markup-writer '&acm-terms le + :before "\\terms{" + :after "}") + (markup-writer '&acm-keywords le + :before "\\keywords{" + :after "}") + (markup-writer '&acm-copyright le + :action (lambda (n e) + (display "\\conferenceinfo{") + (output (markup-option n :conference) e) + (display ",} {") + (output (markup-option n :location) e) + (display "}\n") + (display "\\CopyrightYear{") + (output (markup-option n :year) e) + (display "}\n") + (display "\\crdata{") + (output (markup-option n :crdata) e) + (display "}\n")))) + +;*---------------------------------------------------------------------*/ +;* HTML global customizations */ +;*---------------------------------------------------------------------*/ +(let ((he (find-engine 'html))) + (markup-writer '&html-acmproc-abstract he + :action (lambda (n e) + (let* ((ebg (engine-custom e 'abstract-background)) + (bg (or (and (string? ebg) + (> (string-length ebg) 0)) + ebg + "#cccccc")) + (exp (p (center (color :bg bg :width 90. + (markup-body n)))))) + (skribe-eval exp e)))) + ;; ACM category, terms, and keywords + (markup-writer '&acm-category :action #f) + (markup-writer '&acm-terms :action #f) + (markup-writer '&acm-keywords :action #f) + (markup-writer '&acm-copyright :action #f)) + +;*---------------------------------------------------------------------*/ +;* abstract ... */ +;*---------------------------------------------------------------------*/ +(define-markup (abstract #!rest opt #!key (class "abstract") postscript) + (if (engine-format? "latex") + (section :number #f :title "ABSTRACT" (p (the-body opt))) + (let ((a (new markup + (markup '&html-acmproc-abstract) + (body (the-body opt))))) + (list (if postscript + (section :number #f :toc #f :title "Postscript download" + postscript)) + (section :number #f :toc #f :class class :title "Abstract" a) + (section :number #f :toc #f :title "Table of contents" + (toc :subsection #t)))))) + +;*---------------------------------------------------------------------*/ +;* acm-category ... */ +;*---------------------------------------------------------------------*/ +(define-markup (acm-category #!rest opt #!key index section subsection) + (new markup + (markup '&acm-category) + (options (the-options opt)) + (body (the-body opt)))) + +;*---------------------------------------------------------------------*/ +;* acm-terms ... */ +;*---------------------------------------------------------------------*/ +(define-markup (acm-terms #!rest opt) + (new markup + (markup '&acm-terms) + (options (the-options opt)) + (body (the-body opt)))) + +;*---------------------------------------------------------------------*/ +;* acm-keywords ... */ +;*---------------------------------------------------------------------*/ +(define-markup (acm-keywords #!rest opt) + (new markup + (markup '&acm-keywords) + (options (the-options opt)) + (body (the-body opt)))) + +;*---------------------------------------------------------------------*/ +;* acm-copyright ... */ +;*---------------------------------------------------------------------*/ +(define-markup (acm-copyright #!rest opt #!key conference location year crdata) + (let* ((le (find-engine 'latex)) + (cop (format "\\conferenceinfo{~a,} {~a} +\\CopyrightYear{~a} +\\crdata{~a}\n" conference location year crdata)) + (old (engine-custom le 'predocument))) + (if (string? old) + (engine-custom-set! le 'predocument (string-append cop old)) + (engine-custom-set! le 'predocument cop)))) + +;*---------------------------------------------------------------------*/ +;* references ... */ +;*---------------------------------------------------------------------*/ +(define (references) + (list "\n\n" + (if (engine-format? "latex") + (font :size -1 (flush :side 'left (the-bibliography))) + (section :title "References" + (font :size -1 (the-bibliography)))))) diff --git a/src/guile/skribilo/package/french.scm b/src/guile/skribilo/package/french.scm new file mode 100644 index 0000000..bd095db --- /dev/null +++ b/src/guile/skribilo/package/french.scm @@ -0,0 +1,21 @@ +;*=====================================================================*/ +;* 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 */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package french)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/jfp.scm b/src/guile/skribilo/package/jfp.scm new file mode 100644 index 0000000..108b938 --- /dev/null +++ b/src/guile/skribilo/package/jfp.scm @@ -0,0 +1,319 @@ +;*=====================================================================*/ +;* 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. */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package jfp)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/letter.scm b/src/guile/skribilo/package/letter.scm new file mode 100644 index 0000000..1c39301 --- /dev/null +++ b/src/guile/skribilo/package/letter.scm @@ -0,0 +1,148 @@ +;*=====================================================================*/ +;* 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 */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package letter)) + +;*---------------------------------------------------------------------*/ +;* 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 "\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 "\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 "
") + (output n e) + (when hd + (display "") + (output hd e) + (set! hd #f)) + (display "
\n
\n\n")) + + diff --git a/src/guile/skribilo/package/lncs.scm b/src/guile/skribilo/package/lncs.scm new file mode 100644 index 0000000..2f027d0 --- /dev/null +++ b/src/guile/skribilo/package/lncs.scm @@ -0,0 +1,149 @@ +;*=====================================================================*/ +;* 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. */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package lncs)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/scribe.scm b/src/guile/skribilo/package/scribe.scm new file mode 100644 index 0000000..8e99c76 --- /dev/null +++ b/src/guile/skribilo/package/scribe.scm @@ -0,0 +1,231 @@ +;*=====================================================================*/ +;* 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 */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package scribe)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/sigplan.scm b/src/guile/skribilo/package/sigplan.scm new file mode 100644 index 0000000..b5269dc --- /dev/null +++ b/src/guile/skribilo/package/sigplan.scm @@ -0,0 +1,157 @@ +;*=====================================================================*/ +;* 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. */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package sigplan)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/skribe.scm b/src/guile/skribilo/package/skribe.scm new file mode 100644 index 0000000..86425ac --- /dev/null +++ b/src/guile/skribilo/package/skribe.scm @@ -0,0 +1,76 @@ +;*=====================================================================*/ +;* serrano/prgm/project/skribe/skr/skribe.skr */ +;* ------------------------------------------------------------- */ +;* Author : Manuel Serrano */ +;* Creation : Fri Jan 11 11:23:12 2002 */ +;* Last change : Sun Jul 11 12:22:38 2004 (serrano) */ +;* Copyright : 2002-04 Manuel Serrano */ +;* ------------------------------------------------------------- */ +;* The standard Skribe style (always loaded). */ +;*=====================================================================*/ + +;*---------------------------------------------------------------------*/ +;* p ... */ +;*---------------------------------------------------------------------*/ +(define-markup (p #!rest opt #!key ident (class #f) &skribe-eval-location) + (paragraph :ident ident :class class :loc &skribe-eval-location + (the-body opt))) + +;*---------------------------------------------------------------------*/ +;* fg ... */ +;*---------------------------------------------------------------------*/ +(define (fg c . body) + (color :fg c body)) + +;*---------------------------------------------------------------------*/ +;* bg ... */ +;*---------------------------------------------------------------------*/ +(define (bg c . body) + (color :bg c body)) + +;*---------------------------------------------------------------------*/ +;* counter ... */ +;* ------------------------------------------------------------- */ +;* This produces a kind of "local enumeration" that is: */ +;* (counting "toto," "tutu," "titi.") */ +;* produces: */ +;* i) toto, ii) tutu, iii) titi. */ +;*---------------------------------------------------------------------*/ +(define-markup (counter #!rest opts #!key (numbering 'roman)) + (define items (if (eq? (car opts) :numbering) (cddr opts) opts)) + (define vroman '#(- "i" "ii" "iii" "iv" "v" "vi" "vii" "viii" "ix" "x")) + (define (the-roman-number num) + (if (< num (vector-length vroman)) + (list (list "(" (it (vector-ref vroman num)) ") ")) + (skribe-error 'counter + "too many items for roman numbering" + (length items)))) + (define (the-arabic-number num) + (list (list "(" (it (integer->string num)) ") "))) + (define (the-alpha-number num) + (list (list "(" (it (+ (integer->char #\a) num -1)) ") "))) + (let ((the-number (case numbering + ((roman) the-roman-number) + ((arabic) the-arabic-number) + ((alpha) the-alpha-number) + (else (skribe-error 'counter + "Illegal numbering" + numbering))))) + (let loop ((num 1) + (items items) + (res '())) + (if (null? items) + (reverse! res) + (loop (+ num 1) + (cdr items) + (cons (list (the-number num) (car items)) res)))))) + +;*---------------------------------------------------------------------*/ +;* q */ +;*---------------------------------------------------------------------*/ +(define-markup (q #!rest opt) + (new markup + (markup 'q) + (options (the-options opt)) + (body (the-body opt)))) + diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm new file mode 100644 index 0000000..37ee054 --- /dev/null +++ b/src/guile/skribilo/package/slide.scm @@ -0,0 +1,667 @@ +;*=====================================================================*/ +;* 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 */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package slide)) + +;*---------------------------------------------------------------------*/ +;* 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 (if (not ident) + (symbol->string (gensym 'slide)) + ident)) + (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 "
\n" + (html-width (slide-body-width e))) + (if (string? tbg) + (printf "
" tbg) + (display "")) + (if (string? tfg) + (printf "" tfg)) + (if title + (begin + (display "
") + (if (string? tfont) + (begin + (printf "" tfont) + (output title e) + (display "")) + (begin + (printf "
") + (output title e) + (display ""))) + (display "
\n"))) + (if (not authors) + (display "\n") + (html-title-authors authors e)) + (if (string? tfg) + (display "")) + (display "
\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 "" (markup-ident n)) + (display "
\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 "
") + ;; slide-vspace + (markup-writer 'slide-vspace he + :action (lambda (n e) (display "
")))) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/package/web-article.scm b/src/guile/skribilo/package/web-article.scm new file mode 100644 index 0000000..6a480be --- /dev/null +++ b/src/guile/skribilo/package/web-article.scm @@ -0,0 +1,232 @@ +;*=====================================================================*/ +;* 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 */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package web-article)) + +;*---------------------------------------------------------------------*/ +;* &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 "
\n" + (html-width (web-article-body-width e))) + (if (string? tbg) + (printf "
" tbg) + (display "")) + (if (string? tfg) + (printf "" tfg)) + (if title + (begin + (display "
") + (if (string? tfont) + (begin + (printf "" tfont) + (output title e) + (display "")) + (begin + (printf "

") + (output title e) + (display "

"))) + (display "
\n"))) + (if (not authors) + (display "\n") + (html-title-authors authors e)) + (if (string? tfg) + (display "")) + (display "
\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 "
\n" + (string-canonicalize id)) + (output title e) + (display "
\n") + ;; the authors + (printf "
\n" + (string-canonicalize id)) + (for-each (lambda (a) (output a e)) + (cond + ((is-markup? authors 'author) + (list authors)) + ((list? authors) + authors) + (else + '()))) + (display "
\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 "" + (string-canonicalize (markup-ident n))) + (output name e) + (display "\n")) + (when title + (printf "" + (string-canonicalize (markup-ident n))) + (output title e) + (display "\n")) + (when affiliation + (printf "" + (string-canonicalize (markup-ident n))) + (output affiliation e) + (display "\n")) + (when (pair? address) + (printf "" + (string-canonicalize (markup-ident n))) + (for-each (lambda (a) + (output a e) + (newline)) + address) + (display "\n")) + (when phone + (printf "" + (string-canonicalize (markup-ident n))) + (output phone e) + (display "\n")) + (when email + (printf "" + (string-canonicalize (markup-ident n))) + (output email e) + (display "\n")) + (when url + (printf "" + (string-canonicalize (markup-ident n))) + (output url e) + (display "\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 "
" + :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 "
" + :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 "
\n" + (string-canonicalize (markup-ident n)))) + :action web-article-css-document-title + :after "
\n") + ;; author + (markup-writer 'author he + :options '(:name :title :affiliation :email :url :address :phone :photo :align) + :before (lambda (n e) + (printf "\n" + (string-canonicalize (markup-ident n)))) + :action web-article-css-author + :after "" + (string-canonicalize (markup-ident n)))) + :action (lambda (n e) (output n e sec)) + :after "\n") + ;; &html-footnotes + (markup-writer '&html-footnotes he + :options 'all + :before (lambda (n e) + (printf "
" + (string-canonicalize (markup-ident n)))) + :action (lambda (n e) + (output n e ft)) + :after "
\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/src/guile/skribilo/package/web-book.scm b/src/guile/skribilo/package/web-book.scm new file mode 100644 index 0000000..a954c7a --- /dev/null +++ b/src/guile/skribilo/package/web-book.scm @@ -0,0 +1,109 @@ +;*=====================================================================*/ +;* 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. */ +;*=====================================================================*/ + +(define-skribe-module (skribilo package web-book)) + +;*---------------------------------------------------------------------*/ +;* 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/src/guile/skribilo/packages/acmproc.scm b/src/guile/skribilo/packages/acmproc.scm deleted file mode 100644 index 4accc7c..0000000 --- a/src/guile/skribilo/packages/acmproc.scm +++ /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/src/guile/skribilo/packages/french.scm b/src/guile/skribilo/packages/french.scm deleted file mode 100644 index 3e454f5..0000000 --- a/src/guile/skribilo/packages/french.scm +++ /dev/null @@ -1,21 +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 */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages french)) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/jfp.scm b/src/guile/skribilo/packages/jfp.scm deleted file mode 100644 index e34a4fe..0000000 --- a/src/guile/skribilo/packages/jfp.scm +++ /dev/null @@ -1,319 +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. */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages jfp)) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/letter.scm b/src/guile/skribilo/packages/letter.scm deleted file mode 100644 index 565a1eb..0000000 --- a/src/guile/skribilo/packages/letter.scm +++ /dev/null @@ -1,148 +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 */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages letter)) - -;*---------------------------------------------------------------------*/ -;* 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 "\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 "\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 "
") - (output n e) - (when hd - (display "") - (output hd e) - (set! hd #f)) - (display "
\n
\n\n")) - - diff --git a/src/guile/skribilo/packages/lncs.scm b/src/guile/skribilo/packages/lncs.scm deleted file mode 100644 index 4aadacc..0000000 --- a/src/guile/skribilo/packages/lncs.scm +++ /dev/null @@ -1,149 +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. */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages lncs)) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/scribe.scm b/src/guile/skribilo/packages/scribe.scm deleted file mode 100644 index c97f8e9..0000000 --- a/src/guile/skribilo/packages/scribe.scm +++ /dev/null @@ -1,231 +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 */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages scribe)) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/sigplan.scm b/src/guile/skribilo/packages/sigplan.scm deleted file mode 100644 index c4ea1e2..0000000 --- a/src/guile/skribilo/packages/sigplan.scm +++ /dev/null @@ -1,157 +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. */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages sigplan)) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/skribe.scm b/src/guile/skribilo/packages/skribe.scm deleted file mode 100644 index 86425ac..0000000 --- a/src/guile/skribilo/packages/skribe.scm +++ /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/src/guile/skribilo/packages/slide.scm b/src/guile/skribilo/packages/slide.scm deleted file mode 100644 index 54ac21c..0000000 --- a/src/guile/skribilo/packages/slide.scm +++ /dev/null @@ -1,667 +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 */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages slide)) - -;*---------------------------------------------------------------------*/ -;* 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 (if (not ident) - (symbol->string (gensym 'slide)) - ident)) - (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 "
\n" - (html-width (slide-body-width e))) - (if (string? tbg) - (printf "
" tbg) - (display "")) - (if (string? tfg) - (printf "" tfg)) - (if title - (begin - (display "
") - (if (string? tfont) - (begin - (printf "" tfont) - (output title e) - (display "")) - (begin - (printf "
") - (output title e) - (display ""))) - (display "
\n"))) - (if (not authors) - (display "\n") - (html-title-authors authors e)) - (if (string? tfg) - (display "")) - (display "
\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 "" (markup-ident n)) - (display "
\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 "
") - ;; slide-vspace - (markup-writer 'slide-vspace he - :action (lambda (n e) (display "
")))) - -;*---------------------------------------------------------------------*/ -;* 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/src/guile/skribilo/packages/web-article.scm b/src/guile/skribilo/packages/web-article.scm deleted file mode 100644 index f853231..0000000 --- a/src/guile/skribilo/packages/web-article.scm +++ /dev/null @@ -1,232 +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 */ -;*=====================================================================*/ - -(define-skribe-module (skribilo packages web-article)) - -;*---------------------------------------------------------------------*/ -;* &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 "
\n" - (html-width (web-article-body-width e))) - (if (string? tbg) - (printf "
" tbg) - (display "")) - (if (string? tfg) - (printf "" tfg)) - (if title - (begin - (display "
") - (if (string? tfont) - (begin - (printf "" tfont) - (output title e) - (display "")) - (begin - (printf "

") - (output title e) - (display "

"))) - (display "
\n"))) - (if (not authors) - (display "\n") - (html-title-authors authors e)) - (if (string? tfg) - (display "")) - (display "
\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 "
\n" - (string-canonicalize id)) - (output title e) - (display "
\n") - ;; the authors - (printf "
\n" - (string-canonicalize id)) - (for-each (lambda (a) (output a e)) - (cond - ((is-markup? authors 'author) - (list authors)) - ((list? authors) - authors) - (else - '()))) - (display "
\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 "" - (string-canonicalize (markup-ident n))) - (output name e) - (display "\n")) - (when title - (printf "" - (string-canonicalize (markup-ident n))) - (output title e) - (display "\n")) - (when affiliation - (printf "" - (string-canonicalize (markup-ident n))) - (output affiliation e) - (display "\n")) - (when (pair? address) - (printf "" - (string-canonicalize (markup-ident n))) - (for-each (lambda (a) - (output a e) - (newline)) - address) - (display "\n")) - (when phone - (printf "" - (string-canonicalize (markup-ident n))) - (output phone e) - (display "\n")) - (when email - (printf "" - (string-canonicalize (markup-ident n))) - (output email e) - (display "\n")) - (when url - (printf "" - (string-canonicalize (markup-ident n))) - (output url e) - (display "\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 "
" - :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 "
" - :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 "
\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-document-title - :after "
\n") - ;; author - (markup-writer 'author he - :options '(:name :title :affiliation :email :url :address :phone :photo :align) - :before (lambda (n e) - (printf "\n" - (string-canonicalize (markup-ident n)))) - :action web-article-css-author - :after "" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) (output n e sec)) - :after "\n") - ;; &html-footnotes - (markup-writer '&html-footnotes he - :options 'all - :before (lambda (n e) - (printf "
" - (string-canonicalize (markup-ident n)))) - :action (lambda (n e) - (output n e ft)) - :after "
\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/src/guile/skribilo/packages/web-book.scm b/src/guile/skribilo/packages/web-book.scm deleted file mode 100644 index f907c8b..0000000 --- a/src/guile/skribilo/packages/web-book.scm +++ /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/src/guile/skribilo/reader/Makefile.am b/src/guile/skribilo/reader/Makefile.am new file mode 100644 index 0000000..a1c58fb --- /dev/null +++ b/src/guile/skribilo/reader/Makefile.am @@ -0,0 +1,2 @@ +guilemoduledir = $(GUILE_SITE)/skribilo/reader +dist_guilemodule_DATA = skribe.scm diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm index 78f1814..714f19e 100644 --- a/src/guile/skribilo/reader/skribe.scm +++ b/src/guile/skribilo/reader/skribe.scm @@ -54,6 +54,7 @@ the Skribe syntax." (sharp-reader (r:make-reader (cons dsssl-keyword-reader (map r:standard-token-reader '(character srfi-4 + vector number+radix boolean))) #f ;; use default fault handler @@ -61,16 +62,25 @@ the Skribe syntax." (colon-keywords ;; keywords à la `:key' fashion (r:make-token-reader #\: (r:token-reader-procedure - (r:standard-token-reader 'keyword))))) + (r:standard-token-reader 'keyword)))) + (square-bracket-free-symbol-misc-chars + (let* ((tr (r:standard-token-reader 'guile-symbol-misc-chars)) + (tr-spec (r:token-reader-specification tr)) + (tr-proc (r:token-reader-procedure tr))) + (r:make-token-reader (filter (lambda (chr) + (not (or (eq? chr #\[) + (eq? chr #\])))) + tr-spec) + tr-proc)))) (r:make-reader (cons* (r:make-token-reader #\# sharp-reader) colon-keywords + square-bracket-free-symbol-misc-chars (map r:standard-token-reader `(whitespace - sexp string number - symbol-lower-case - symbol-upper-case - symbol-misc-chars + sexp string guile-number + guile-symbol-lower-case + guile-symbol-upper-case quote-quasiquote-unquote semicolon-comment skribe-exp))) diff --git a/src/guile/skribilo/skribe/Makefile.am b/src/guile/skribilo/skribe/Makefile.am new file mode 100644 index 0000000..2850c4d --- /dev/null +++ b/src/guile/skribilo/skribe/Makefile.am @@ -0,0 +1,2 @@ +guilemoduledir = $(GUILE_SITE)/skribilo +dist_guilemodule_DATA = api.scm bib.scm index.scm param.scm sui.scm utils.scm diff --git a/src/guile/skribilo/skribe/index.scm b/src/guile/skribilo/skribe/index.scm index 840a179..415cadf 100644 --- a/src/guile/skribilo/skribe/index.scm +++ b/src/guile/skribilo/skribe/index.scm @@ -36,24 +36,24 @@ ;*---------------------------------------------------------------------*/ ;* index? ... */ ;*---------------------------------------------------------------------*/ -(define (index? obj) +(define-public (index? obj) (hashtable? obj)) ;*---------------------------------------------------------------------*/ ;* *index-table* ... */ ;*---------------------------------------------------------------------*/ -(define *index-table* #f) +(define-public *index-table* #f) ;*---------------------------------------------------------------------*/ ;* make-index-table ... */ ;*---------------------------------------------------------------------*/ -(define (make-index-table ident) +(define-public (make-index-table ident) (make-hashtable)) ;*---------------------------------------------------------------------*/ ;* default-index ... */ ;*---------------------------------------------------------------------*/ -(define (default-index) +(define-public (default-index) (if (not *index-table*) (set! *index-table* (make-index-table "default-index"))) *index-table*) @@ -61,7 +61,7 @@ ;*---------------------------------------------------------------------*/ ;* resolve-the-index ... */ ;*---------------------------------------------------------------------*/ -(define (resolve-the-index loc i c indexes split char-offset header-limit col) +(define-public (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))) @@ -70,7 +70,7 @@ (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 + (sort ie (lambda (i1 i2) (or (not (markup-option i1 :note)) (markup-option i2 :note))))) -- cgit v1.2.3