diff options
| -rw-r--r-- | ChangeLog | 54 | ||||
| -rw-r--r-- | doc/Makefile | 420 | ||||
| -rwxr-xr-x | src/guile/skribilo.scm | 121 | ||||
| -rw-r--r-- | src/guile/skribilo/ast.scm (renamed from src/guile/skribilo/types.scm) | 278 | ||||
| -rw-r--r-- | src/guile/skribilo/biblio.scm | 50 | ||||
| -rw-r--r-- | src/guile/skribilo/compat.scm | 155 | ||||
| -rw-r--r-- | src/guile/skribilo/engine.scm | 108 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/html.scm | 5 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/lout.scm | 355 | ||||
| -rw-r--r-- | src/guile/skribilo/evaluator.scm | 49 | ||||
| -rw-r--r-- | src/guile/skribilo/lib.scm | 153 | ||||
| -rw-r--r-- | src/guile/skribilo/location.scm | 68 | ||||
| -rw-r--r-- | src/guile/skribilo/module.scm | 30 | ||||
| -rw-r--r-- | src/guile/skribilo/output.scm | 25 | ||||
| -rw-r--r-- | src/guile/skribilo/parameters.scm | 65 | ||||
| -rw-r--r-- | src/guile/skribilo/reader/skribe.scm | 1 | ||||
| -rw-r--r-- | src/guile/skribilo/resolve.scm | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/runtime.scm | 234 | ||||
| -rw-r--r-- | src/guile/skribilo/source.scm | 30 | ||||
| -rw-r--r-- | src/guile/skribilo/vars.scm | 66 | ||||
| -rw-r--r-- | src/guile/skribilo/verify.scm | 2 | ||||
| -rw-r--r-- | src/guile/skribilo/writer.scm | 78 |
22 files changed, 970 insertions, 1379 deletions
@@ -2,6 +2,60 @@ # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2 # +2005-11-26 18:03:04 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-13 + + Summary: + Merge from lcourtes@laas.fr--2004-libre + Revision: + skribilo--devel--1.2--patch-13 + + Patches applied: + + * lcourtes@laas.fr--2004-libre/skribilo--devel--1.2 (patch 6-11) + + - Lots of changes... + - Started relying on the per-module reader; first doc produced ever! + - The first vaguely working version. + - Minor fixes for file/line error reporting. + - Cleaned up the source tree and the installation process. + - Overhaul: emphasized logical separation of the modules. + + new files: + src/guile/skribilo/ast.scm src/guile/skribilo/location.scm + src/guile/skribilo/parameters.scm + + removed files: + doc/.arch-ids/Makefile.id doc/Makefile + src/guile/skribilo/.arch-ids/types.scm.id + src/guile/skribilo/types.scm + + modified files: + ChangeLog src/guile/skribilo.scm src/guile/skribilo/biblio.scm + src/guile/skribilo/compat.scm src/guile/skribilo/engine.scm + src/guile/skribilo/engine/html.scm + src/guile/skribilo/engine/lout.scm + src/guile/skribilo/evaluator.scm src/guile/skribilo/lib.scm + src/guile/skribilo/module.scm src/guile/skribilo/output.scm + src/guile/skribilo/reader/skribe.scm + src/guile/skribilo/resolve.scm src/guile/skribilo/runtime.scm + src/guile/skribilo/source.scm src/guile/skribilo/verify.scm + src/guile/skribilo/writer.scm + + renamed files: + src/guile/skribilo/.arch-ids/vars.scm.id + ==> src/guile/skribilo/.arch-ids/compat.scm.id + src/guile/skribilo/vars.scm + ==> src/guile/skribilo/compat.scm + + new patches: + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-6 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-7 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-8 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-9 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10 + lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-11 + + 2005-11-26 18:01:09 GMT Ludovic Courtes <ludovic.courtes@laas.fr> patch-12 Summary: diff --git a/doc/Makefile b/doc/Makefile deleted file mode 100644 index 7a177fc..0000000 --- a/doc/Makefile +++ /dev/null @@ -1,420 +0,0 @@ -# Makefile.in generated by automake 1.9.6 from Makefile.am. -# doc/Makefile. Generated from Makefile.in by configure. - -# 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, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - - -srcdir = . -top_srcdir = .. - -pkgdatadir = $(datadir)/skribilo -pkglibdir = $(libdir)/skribilo -pkgincludedir = $(includedir)/skribilo -top_builddir = .. -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -INSTALL = /usr/bin/install -c -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 = doc -DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.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 = -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 -ETAGS = etags -CTAGS = ctags -DIST_SUBDIRS = $(SUBDIRS) -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = ${SHELL} /home/ludo/src/skribilo/missing --run aclocal-1.9 -AMTAR = ${SHELL} /home/ludo/src/skribilo/missing --run tar -AUTOCONF = ${SHELL} /home/ludo/src/skribilo/missing --run autoconf -AUTOHEADER = ${SHELL} /home/ludo/src/skribilo/missing --run autoheader -AUTOMAKE = ${SHELL} /home/ludo/src/skribilo/missing --run automake-1.9 -AWK = gawk -CYGPATH_W = echo -DEFS = -DPACKAGE_NAME=\"skribilo\" -DPACKAGE_TARNAME=\"skribilo\" -DPACKAGE_VERSION=\"1.2\" -DPACKAGE_STRING=\"skribilo\ 1.2\" -DPACKAGE_BUGREPORT=\"ludovic.courtes@laas.fr\" -DPACKAGE=\"skribilo\" -DVERSION=\"1.2\" -ECHO_C = -ECHO_N = -n -ECHO_T = -GUILE = /usr/bin/guile -GUILE_CONFIG = /usr/bin/guile-config -GUILE_SITE = /usr/share/guile/site -GUILE_TOOLS = /usr/bin/guile-tools -HAVE_LOUT_FALSE = # -HAVE_LOUT_TRUE = -INSTALL_DATA = ${INSTALL} -m 644 -INSTALL_PROGRAM = ${INSTALL} -INSTALL_SCRIPT = ${INSTALL} -INSTALL_STRIP_PROGRAM = ${SHELL} $(install_sh) -c -s -LIBOBJS = -LIBS = -LOUT = /usr/bin/lout -LTLIBOBJS = -MAKEINFO = ${SHELL} /home/ludo/src/skribilo/missing --run makeinfo -PACKAGE = skribilo -PACKAGE_BUGREPORT = ludovic.courtes@laas.fr -PACKAGE_NAME = skribilo -PACKAGE_STRING = skribilo 1.2 -PACKAGE_TARNAME = skribilo -PACKAGE_VERSION = 1.2 -PATH_SEPARATOR = : -SET_MAKE = -SHELL = /bin/sh -SKRIBILO_DOC_DIR = ${prefix}/share/doc/skribilo -SKRIBILO_EXT_DIR = ${prefix}/share/skribilo/1.2/ -SKRIBILO_SKR_PATH = /usr/share/guile/site/ -STRIP = -VERSION = 1.2 -ac_ct_STRIP = -am__leading_dot = . -am__tar = ${AMTAR} chof - "$$tardir" -am__untar = ${AMTAR} xf - -bindir = ${exec_prefix}/bin -build_alias = -datadir = ${prefix}/share -exec_prefix = ${prefix} -host_alias = -includedir = ${prefix}/include -infodir = ${prefix}/info -install_sh = /home/ludo/src/skribilo/install-sh -libdir = ${exec_prefix}/lib -libexecdir = ${exec_prefix}/libexec -localstatedir = ${prefix}/var -mandir = ${prefix}/man -mkdir_p = mkdir -p -- -oldincludedir = /usr/include -prefix = /usr/local -program_transform_name = s,x,x, -sbindir = ${exec_prefix}/sbin -sharedstatedir = ${prefix}/com -sysconfdir = ${prefix}/etc -target_alias = -SUBDIRS = user -all: all-recursive - -.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 doc/Makefile'; \ - cd $(top_srcdir) && \ - $(AUTOMAKE) --gnu doc/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; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(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 -uninstall-info-am: - -# 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" - -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 - -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 - -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 - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && cd $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) $$here - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -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 -installdirs: installdirs-recursive -installdirs-am: -install: install-recursive -install-exec: install-exec-recursive -install-data: install-data-recursive -uninstall: uninstall-recursive - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -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: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -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 - -clean-am: clean-generic mostlyclean-am - -distclean: distclean-recursive - -rm -f Makefile -distclean-am: clean-am distclean-generic distclean-tags - -dvi: dvi-recursive - -dvi-am: - -html: html-recursive - -info: info-recursive - -info-am: - -install-data-am: - -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 - -ps-am: - -uninstall-am: uninstall-info-am - -uninstall-info: uninstall-info-recursive - -.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-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-info-am - -# 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.scm b/src/guile/skribilo.scm index 33c2bb4..c4a5eac 100755 --- a/src/guile/skribilo.scm +++ b/src/guile/skribilo.scm @@ -60,23 +60,21 @@ exec ${GUILE-guile} --debug -l $0 -c "(apply $main (cdr (command-line)))" "$@" -(define-module (skribilo)) +(define-module (skribilo) + :autoload (skribilo module) (make-run-time-module) + :autoload (skribilo engine) (*current-engine*)) -(use-modules (skribilo module) - (skribilo runtime) - (skribilo evaluator) - (skribilo types) - (skribilo engine) +(use-modules (skribilo evaluator) (skribilo debug) - (skribilo vars) + (skribilo parameters) (skribilo lib) + (srfi srfi-39) (ice-9 optargs) (ice-9 getopt-long)) -;;; FIXME: With my `#:reader' thing added to `define-module', @@ -351,7 +349,7 @@ Processes a Skribilo/Skribe source file and produces its output. (define (load-rc) (if *load-rc* - (let ((file (make-path *skribe-rc-directory* *skribe-rc-file*))) + (let ((file (make-path (*rc-directory*) (*rc-file*)))) (if (and file (file-exists? file)) (load file))))) @@ -373,8 +371,15 @@ Processes a Skribilo/Skribe source file and produces its output. ; (skribe-eval-port (current-input-port) *skribe-engine*)))) (define (doskribe) - (set-current-module (make-run-time-module)) - (skribe-eval-port (current-input-port) *skribe-engine*)) + (let ((user-module (current-module))) + (dynamic-wind + (lambda () + (set-current-module (make-run-time-module))) + (lambda () + (format #t "engine is ~a~%" (*current-engine*)) + (skribe-eval-port (current-input-port) (*current-engine*))) + (lambda () + (set-current-module user-module))))) ;;;; ====================================================================== @@ -407,8 +412,6 @@ Processes a Skribilo/Skribe source file and produces its output. ;; Parse the most important options. - (set! *skribe-engine* engine) - (set-skribe-debug! (string->number debugging-level)) (if (> (skribe-debug) 4) @@ -416,54 +419,50 @@ Processes a Skribilo/Skribe source file and produces its output. (lambda (file) (format #t "~~ loading `~a'...~%" file)))) - (set! %skribilo-load-path - (cons load-path %skribilo-load-path)) - (set! %skribilo-bib-path - (cons bib-path %skribilo-bib-path)) - - (if (option-ref options 'verbose #f) - (set! *skribe-verbose* #t)) - - ;; Load the user rc file - ;(load-rc) - - ;; Load the base file to bootstrap the system as well as the files - ;; that are in the PRELOAD variable. - (find-engine 'base) - (for-each (lambda (f) - (skribe-load f :engine *skribe-engine*)) - preload) - - ;; Load the specified variants. - (for-each (lambda (x) - (skribe-load (format #f "~a.skr" x) :engine *skribe-engine*)) - (reverse! variants)) - - (let ((files (option-ref options '() '()))) - - (if (> (length files) 2) - (error "you can specify at most one input file and one output file" - files)) - - (let* ((source-file (if (null? files) #f (car files))) - (dest-file (if (or (not source-file) - (null? (cdr files))) - #f - (cadr files))) - (do-it! (lambda () - (if (string? dest-file) - (with-output-to-file dest-file doskribe) - (doskribe))))) - - (set! *skribe-dest* dest-file) - - (if (and dest-file (file-exists? dest-file)) - (delete-file dest-file)) - - (if source-file - (with-input-from-file source-file - do-it!) - (do-it!)))))) + (parameterize ((*current-engine* engine) + (*document-path* (cons load-path (*document-path*))) + (*bib-path* (cons bib-path (*bib-path*))) + (*verbose* (option-ref options 'verbose #f))) + + ;; Load the user rc file + ;;(load-rc) + + (for-each (lambda (f) + (skribe-load f :engine (*current-engine*))) + preload) + + ;; Load the specified variants. + (for-each (lambda (x) + (skribe-load (format #f "~a.skr" x) + :engine (*current-engine*))) + (reverse! variants)) + + (let ((files (option-ref options '() '()))) + + (if (> (length files) 2) + (error "you can specify at most one input file and one output file" + files)) + + (let* ((source-file (if (null? files) #f (car files))) + (dest-file (if (or (not source-file) + (null? (cdr files))) + #f + (cadr files))) + (do-it! (lambda () + (if (string? dest-file) + (with-output-to-file dest-file doskribe) + (doskribe))))) + + (parameterize ((*destination-file* dest-file) + (*source-file* source-file)) + + (if (and dest-file (file-exists? dest-file)) + (delete-file dest-file)) + + ;; (start-stack 7 + (if source-file + (with-input-from-file source-file do-it!) + (do-it!)))))))) (define main skribilo) diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/ast.scm index ac1edc4..fc6859e 100644 --- a/src/guile/skribilo/types.scm +++ b/src/guile/skribilo/ast.scm @@ -1,7 +1,7 @@ +;;; ast.scm -- Skribilo abstract syntax trees. ;;; -;;; types.stk -- Definition of Skribe classes -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,37 +18,43 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA. + +(define-module (skribilo ast) + :use-module (oop goops) + :autoload (skribilo location) (location?) + :export (<ast> ast? ast-loc ast-loc-set! + ast-parent ast->string + + <command> command? command-fmt command-body + <unresolved> unresolved? unresolved-proc + <handle> handle? handle-ast handle-body + <node> node? node-options node-loc + <processor> processor? processor-combinator processor-engine + + <markup> markup? bind-markup! markup-options is-markup? + markup-markup markup-body markup-ident markup-class + find-markups + markup-option markup-option-add! markup-output + markup-parent markup-document markup-chapter + + <container> container? container-options + container-ident container-body + container-env-get + + <document> document? document-ident document-body + document-options document-end)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: ;;; -;;; Author: Erick Gallesio [eg@essi.fr] -;;; Creation date: 12-Aug-2003 22:18 (eg) -;;; Last file update: 28-Oct-2004 16:18 (eg) +;;; The abstract syntax tree (AST) and its sub-types. These class form the +;;; core of a document: each part of a document is an instance of `<ast>' or +;;; one of its sub-classes. ;;; +;;; Code: (read-set! keywords 'prefix) -(define-module (skribilo types) ;; FIXME: Why should it be a separate module? - :export (<ast> ast? ast-loc ast-loc-set! - <command> command? command-fmt command-body - <unresolved> unresolved? unresolved-proc - <handle> handle? handle-ast - <node> node? node-options node-loc - <engine> engine? engine-ident engine-format engine-customs - engine-filter engine-symbol-table - <writer> writer? write-object writer-options writer-ident - writer-before writer-action writer-after writer-class - <processor> processor? processor-combinator processor-engine - <markup> markup? bind-markup! markup-options is-markup? - markup-markup markup-body markup-ident markup-class - find-markups write-object - <container> container? container-options - container-ident container-body - <document> document? document-ident document-body - document-options document-end - <language> language? language-extractor language-fontifier - <location> location? ast-location - location-file location-line location-pos - - *node-table*) - :use-module (oop goops)) (define *node-table* (make-hash-table)) ; Used to stores the nodes of an AST. @@ -56,6 +62,7 @@ ; identifier. + ;;; ====================================================================== ;;; ;;; <AST> @@ -70,7 +77,36 @@ (define (ast? obj) (is-a? obj <ast>)) (define (ast-loc obj) (slot-ref obj 'loc)) (define (ast-loc-set! obj v) (slot-set! obj 'loc v)) +(define (ast-parent n) + (slot-ref n 'parent)) + +(define (ast->file-location ast) + (let ((l (ast-loc ast))) + (if (location? l) + (format #f "~a:~a:" (location-file l) (location-line l)) + ""))) + +(define-generic ast->string) + +(define-method (ast->string (ast <top>)) "") +(define-method (ast->string (ast <string>)) ast) +(define-method (ast->string (ast <number>)) (number->string ast)) + +(define-method (ast->string (ast <pair>)) + (let ((out (open-output-string))) + (let Loop ((lst ast)) + (cond + ((null? lst) + (get-output-string out)) + (else + (display (ast->string (car lst)) out) + (unless (null? (cdr lst)) + (display #\space out)) + (Loop (cdr lst))))))) + + + ;;; ====================================================================== ;;; ;;; <COMMAND> @@ -105,70 +141,7 @@ (define (handle? obj) (is-a? obj <handle>)) (define (handle-ast obj) (slot-ref obj 'ast)) - -;;; ====================================================================== -;;; -;;; <ENGINE> -;;; -;;; ====================================================================== -(define-class <engine> () - (ident :init-keyword :ident :init-value '???) - (format :init-keyword :format :init-value "raw") - (info :init-keyword :info :init-value '()) - (version :init-keyword :version :init-value 'unspecified) - (delegate :init-keyword :delegate :init-value #f) - (writers :init-keyword :writers :init-value '()) - (filter :init-keyword :filter :init-value #f) - (customs :init-keyword :custom :init-value '()) - (symbol-table :init-keyword :symbol-table :init-value '())) - - - - -(define (engine? obj) - (is-a? obj <engine>)) - -(define (engine-ident obj) ;; Define it here since the doc searches it - (slot-ref obj 'ident)) - -(define (engine-format obj) ;; Define it here since the doc searches it - (slot-ref obj 'format)) - -(define (engine-customs obj) ;; Define it here since the doc searches it - (slot-ref obj 'customs)) - -(define (engine-filter obj) ;; Define it here since the doc searches it - (slot-ref obj 'filter)) - -(define (engine-symbol-table obj) ;; Define it here since the doc searches it - (slot-ref obj 'symbol-table)) - -;;; ====================================================================== -;;; -;;; <WRITER> -;;; -;;; ====================================================================== -(define-class <writer> () - (ident :init-keyword :ident :init-value '??? :getter writer-ident) - (class :init-keyword :class :init-value 'unspecified - :getter writer-class) - (pred :init-keyword :pred :init-value 'unspecified) - (upred :init-keyword :upred :init-value 'unspecified) - (options :init-keyword :options :init-value '() :getter writer-options) - (verified? :init-keyword :verified? :init-value #f) - (validate :init-keyword :validate :init-value #f) - (before :init-keyword :before :init-value #f :getter writer-before) - (action :init-keyword :action :init-value #f :getter writer-action) - (after :init-keyword :after :init-value #f :getter writer-after)) - -(define (writer? obj) - (is-a? obj <writer>)) - -(define-method (write-object (obj <writer>) port) - (format port "#[~A (~A) ~A]" - (class-name (class-of obj)) - (slot-ref obj 'ident) - (address-of obj))) +(define (handle-body h) (slot-ref h 'body)) ;;; ====================================================================== ;;; @@ -185,6 +158,9 @@ (define (node-options obj) (slot-ref obj 'options)) (define node-loc ast-loc) +(define-method (ast->string (ast <node>)) + (ast->string (slot-ref ast 'body))) + ;;; ====================================================================== ;;; @@ -200,6 +176,8 @@ (define (processor-combinator obj) (slot-ref obj 'combinator)) (define (processor-engine obj) (slot-ref obj 'engine)) + + ;;; ====================================================================== ;;; ;;; <MARKUP> @@ -227,12 +205,49 @@ (define (markup-options obj) (slot-ref obj 'options)) (define markup-body node-body) +(define (markup-option m opt) + (if (markup? m) + (let ((c (assq opt (slot-ref m 'options)))) + (and (pair? c) (pair? (cdr c)) + (cadr c))) + (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) + + +(define (markup-option-add! m opt val) + (if (markup? m) + (slot-set! m 'options (cons (list opt val) + (slot-ref m 'options))) + (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) + (define (is-markup? obj markup) (and (is-a? obj <markup>) (eq? (slot-ref obj 'markup) markup))) +(define (markup-parent m) + (let ((p (slot-ref m 'parent))) + (if (eq? p 'unspecified) + (skribe-error 'markup-parent "Unresolved parent reference" m) + p))) + +(define (markup-document m) + (let Loop ((p m) + (l #f)) + (cond + ((is-markup? p 'document) p) + ((or (eq? p 'unspecified) (not p)) l) + (else (Loop (slot-ref p 'parent) p))))) + +(define (markup-chapter m) + (let loop ((p m) + (l #f)) + (cond + ((is-markup? p 'chapter) p) + ((or (eq? p 'unspecified) (not p)) l) + (else (loop (slot-ref p 'parent) p))))) + + (define (find-markups ident) (hash-ref *node-table* ident #f)) @@ -245,6 +260,35 @@ (slot-ref obj 'ident) (address-of obj))) + +;;; XXX: This was already commented out in the original Skribe source. +;;; +;; (define (markup-output markup +;; :optional (engine #f) +;; :key (predicate #f) +;; (options '()) +;; (before #f) +;; (action #f) +;; (after #f)) +;; (let ((e (or engine (use-engine)))) +;; (cond +;; ((not (is-a? e <engine>)) +;; (skribe-error 'markup-writer "illegal engine" e)) +;; ((and (not before) +;; (not action) +;; (not after)) +;; (%find-markup-output e markup)) +;; (else +;; (let ((mp (if (procedure? predicate) +;; (lambda (n e) (and (is-markup? n markup) (predicate n e))) +;; (lambda (n e) (is-markup? n markup))))) +;; (engine-output e markup mp options +;; (or before (slot-ref e 'default-before)) +;; (or action (slot-ref e 'default-action)) +;; (or after (slot-ref e 'default-after)))))))) + + + ;;; ====================================================================== ;;; ;;; <CONTAINER> @@ -259,6 +303,9 @@ (define container-ident markup-ident) (define container-body node-body) +(define (container-env-get m key) + (let ((c (assq key (slot-ref m 'env)))) + (and (pair? c) (cadr c)))) ;;; ====================================================================== @@ -275,45 +322,6 @@ (define document-env container-env) +;;; arch-tag: e2489bd6-1b6d-4b03-bdfb-83cffd2f7ce7 -;;; ====================================================================== -;;; -;;; <LANGUAGE> -;;; -;;; ====================================================================== -(define-class <language> () - (name :init-keyword :name :init-value #f :getter langage-name) - (fontifier :init-keyword :fontifier :init-value #f :getter language-fontifier) - (extractor :init-keyword :extractor :init-value #f :getter language-extractor)) - -(define (language? obj) - (is-a? obj <language>)) - - -;;; ====================================================================== -;;; -;;; <LOCATION> -;;; -;;; ====================================================================== -(define-class <location> () - (file :init-keyword :file :getter location-file) - (pos :init-keyword :pos :getter location-pos) - (line :init-keyword :line :getter location-line)) - -(define (location? obj) - (is-a? obj <location>)) - -(define (ast-location obj) - (let ((loc (slot-ref obj 'loc))) - (if (location? loc) - (let* ((fname (location-file loc)) - (line (location-line loc)) - (pwd (getcwd)) - (len (string-length pwd)) - (lenf (string-length fname)) - (file (if (and (substring=? pwd fname len) - (> lenf len)) - (substring fname len (+ 1 (string-length fname))) - fname))) - (format #f "~a, line ~a" file line)) - "no source location"))) +;;; ast.scm ends here diff --git a/src/guile/skribilo/biblio.scm b/src/guile/skribilo/biblio.scm index f3ddf97..dd04f68 100644 --- a/src/guile/skribilo/biblio.scm +++ b/src/guile/skribilo/biblio.scm @@ -1,7 +1,6 @@ +;;; biblio.scm -- Bibliography functions. ;;; -;;; biblio.scm -- Bibliography functions -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> ;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -18,21 +17,22 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA.main.st -;;; -;;; Author: Erick Gallesio [eg@essi.fr] -;;; Creation date: 31-Aug-2003 22:07 (eg) -;;; Last file update: 28-Oct-2004 21:19 (eg) -;;; (define-module (skribilo biblio) :use-module (skribilo runtime) :use-module (skribilo lib) ;; `when', `unless' - :use-module (skribilo vars) + :use-module (skribilo module) + :use-module (skribilo skribe bib) ;; `make-bib-entry' + :autoload (skribilo parameters) (*bib-path*) + :autoload (ice-9 format) (format) :export (bib-table? make-bib-table default-bib-table bib-add!)) + + +;; FIXME: Should be a fluid? (define *bib-table* #f) ;; Forward declarations @@ -76,13 +76,13 @@ (let ((ofrom (markup-option old 'from))) (skribe-warning 2 'bib - (format "Duplicated bibliographic entry ~a'.\n" ident) + (format #f "duplicated bibliographic entry ~a'.\n" ident) (if ofrom - (format " Using version of `~a'.\n" ofrom) + (format #f " using version of `~a'.\n" ofrom) "") (if from - (format " Ignoring version of `~a'." from) - " Ignoring redefinition.")))) + (format #f " ignoring version of `~a'." from) + " ignoring redefinition.")))) ;;; ====================================================================== @@ -99,14 +99,13 @@ (cond ((and (list? entry) (> (length entry) 2)) (let* ((kind (car entry)) - (key (format "~A" (cadr entry))) + (key (format #f "~A" (cadr entry))) (fields (cddr entry)) - (old (hashtable-get table key))) + (old (hash-ref table key))) (if old (bib-duplicate ident from old) - (hash-table-put! table - key - (make-bib-entry kind key fields from))) + (hash-set! table key + (make-bib-entry kind key fields from))) (Loop (read port)))) (else (%bib-error 'bib-parse entry)))))))) @@ -124,14 +123,13 @@ (cond ((and (list? entry) (> (length entry) 2)) (let* ((kind (car entry)) - (key (format "~A" (cadr entry))) + (key (format #f "~A" (cadr entry))) (fields (cddr entry)) - (old (hashtable-get table ident))) + (old (hash-ref table key))) (if old (bib-duplicate key #f old) - (hash-table-put! table - key - (make-bib-entry kind key fields #f))))) + (hash-set! table key + (make-bib-entry kind key fields #f))))) (else (%bib-error 'bib-add! entry)))) entries))) @@ -144,14 +142,14 @@ ;;; ====================================================================== ;; FIXME: Factoriser (define (skribe-open-bib-file file command) - (let ((path (search-path *skribe-bib-path* file))) + (let ((path (search-path (*bib-path*) file))) (if (string? path) (begin - (when (> *skribe-verbose* 0) + (when (> (*verbose*) 0) (format (current-error-port) " [loading bibliography: ~S]\n" path)) (open-input-file (if (string? command) (string-append "| " - (format command path)) + (format #f command path)) path))) (begin (skribe-warning 1 diff --git a/src/guile/skribilo/compat.scm b/src/guile/skribilo/compat.scm new file mode 100644 index 0000000..c90af1d --- /dev/null +++ b/src/guile/skribilo/compat.scm @@ -0,0 +1,155 @@ +;;; compat.scm -- Skribe compatibility module. +;;; +;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + + +(define-module (skribilo compat) + :use-module (skribilo parameters) + :use-module (srfi srfi-1)) + + +;;; +;;; Global variables that have been replaced by parameter objects +;;; in `(skribilo parameters)'. +;;; + +;;; Switches +(define-public *skribe-verbose* 0) +(define-public *skribe-warning* 5) +(define-public *load-rc* #t) + + +;;; Path variables +(define-public *skribe-path* #f) +(define-public *skribe-bib-path* '(".")) +(define-public *skribe-source-path* '(".")) +(define-public *skribe-image-path* '(".")) + + +(define-public *skribe-rc-directory* + (string-append (getenv "HOME") "/" ".skribilo")) + + +;;; In and out ports +(define-public *skribe-src* '()) +(define-public *skribe-dest* #f) + +;;; Engine +(define-public *skribe-engine* 'html) ;; Use HTML by default + +;;; Misc +(define-public *skribe-chapter-split* '()) +(define-public *skribe-ref-base* #f) +(define-public *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter +(define-public *skribe-variants* '()) + + + +;;; +;;; Accessors mapped to parameter objects. +;;; + +(define-public skribe-path *document-path*) +(define-public skribe-image-path *image-path*) +(define-public skribe-source-path *source-path*) +(define-public skribe-bib-path *bib-path*) + + +;;; +;;; Compatibility with Bigloo. +;;; + +(define-public (substring=? s1 s2 len) + (let ((l1 (string-length s1)) + (l2 (string-length s2))) + (let Loop ((i 0)) + (cond + ((= i len) #t) + ((= i l1) #f) + ((= i l2) #f) + ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1))) + (else #f))))) + +(define-public (directory->list str) + (map basename (glob (string-append str "/*") (string-append "/.*")))) + +(define-macro (printf . args) `(format #t ,@args)) +(export-syntax printf) +(define-public fprintf format) + +(define-public (fprint port . args) + (if port + (with-output-to-port port + (lambda () + (for-each display args) + (display "\n"))))) + +(define-public (file-prefix fn) + (if fn + (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) + (if match + (cadr match) + fn)) + "./SKRIBILO-OUTPUT")) + +(define-public (file-suffix s) + ;; Not completely correct, but sufficient here + (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2")) + (split (string-split basename "."))) + (if (> (length split) 1) + (car (reverse! split)) + ""))) + +(define-public prefix file-prefix) +(define-public suffix file-suffix) +(define-public system->string system) ;; FIXME +(define-public any? any) +(define-public every? every) +(define-public find-file/path (lambda (. args) + (format #t "find-file/path: ~a~%" args) + #f)) +(define-public process-input-port #f) ;process-input) +(define-public process-output-port #f) ;process-output) +(define-public process-error-port #f) ;process-error) + +;;; hash tables +(define-public make-hashtable make-hash-table) +(define-public hashtable? hash-table?) +(define-public hashtable-get (lambda (h k) (hash-ref h k #f))) +(define-public hashtable-put! hash-set!) +(define-public hashtable-update! hash-set!) +(define-public hashtable->list (lambda (h) + (map cdr (hash-map->list cons h)))) + +(define-public find-runtime-type (lambda (obj) obj)) + + + +;;; +;;; Miscellaneous. +;;; + +(use-modules ((srfi srfi-19) #:renamer (symbol-prefix-proc 's19:))) + +(define (date) + (s19:date->string (s19:current-date) "~c")) + + + +;;; compat.scm ends here diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 0353e2d..5b18b5c 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -1,7 +1,6 @@ +;;; engine.scm -- Skribilo engines. ;;; -;;; engine.scm -- Skribe Engines Stuff -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> ;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; @@ -19,24 +18,24 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA. -;;; -;;; Author: Erick Gallesio [eg@essi.fr] -;;; Creation date: 24-Jul-2003 20:33 (eg) -;;; Last file update: 28-Oct-2004 21:21 (eg) -;;; (define-module (skribilo engine) - :use-module (skribilo module) :use-module (skribilo debug) - :use-module (skribilo writer) - :use-module (skribilo types) :use-module (skribilo lib) - :use-module (skribilo vars) + + ;; `(skribilo writer)' depends on this module so it needs to be loaded + ;; after we defined `<engine>' and the likes. + :autoload (skribilo writer) (<writer>) :use-module (oop goops) :use-module (ice-9 optargs) + :autoload (srfi srfi-39) (make-parameter) - :export (default-engine default-engine-set! + :export (<engine> engine? engine-ident engine-format + engine-customs engine-filter engine-symbol-table + + *current-engine* + default-engine default-engine-set! make-engine copy-engine find-engine lookup-engine engine-custom engine-custom-set! engine-format? engine-add-writer! @@ -45,10 +44,47 @@ + +;;; +;;; Class definition. +;;; + +(define-class <engine> () + (ident :init-keyword :ident :init-value '???) + (format :init-keyword :format :init-value "raw") + (info :init-keyword :info :init-value '()) + (version :init-keyword :version + :init-value 'unspecified) + (delegate :init-keyword :delegate :init-value #f) + (writers :init-keyword :writers :init-value '()) + (filter :init-keyword :filter :init-value #f) + (customs :init-keyword :custom :init-value '()) + (symbol-table :init-keyword :symbol-table :init-value '())) + + +(define (engine? obj) + (is-a? obj <engine>)) + +(define (engine-ident obj) + (slot-ref obj 'ident)) + +(define (engine-format obj) + (slot-ref obj 'format)) + +(define (engine-customs obj) + (slot-ref obj 'customs)) + +(define (engine-filter obj) + (slot-ref obj 'filter)) -;;; Module definition is split here because this file is read by the -;;; documentation Should be changed. -;(select-module SKRIBE-ENGINE-MODULE) +(define (engine-symbol-table obj) + (slot-ref obj 'symbol-table)) + + + +;;; +;;; Default engines. +;;; (define *engines* '()) (define *default-engine* #f) @@ -97,8 +133,7 @@ (define (engine-format? fmt . e) (let ((e (cond ((pair? e) (car e)) - ((engine? *skribe-engine*) *skribe-engine*) - (else (find-engine *skribe-engine*))))) + (else (*current-engine*))))) (if (not (engine? e)) (skribe-error 'engine-format? "no engine" e) (string=? fmt (engine-format e))))) @@ -164,9 +199,11 @@ otherwise the requested engine is returned." (false-if-exception (apply lookup-engine args))) + ;;; -;;; ENGINE-CUSTOM +;;; Engine methods. ;;; + (define (engine-custom e id) (let* ((customs (slot-ref e 'customs)) (c (assq id customs))) @@ -175,9 +212,6 @@ otherwise the requested engine is returned." 'unspecified))) -;;; -;;; ENGINE-CUSTOM-SET! -;;; (define (engine-custom-set! e id val) (let* ((customs (slot-ref e 'customs)) (c (assq id customs))) @@ -186,9 +220,6 @@ otherwise the requested engine is returned." (slot-set! e 'customs (cons (list id val) customs))))) -;;; -;;; ENGINE-ADD-WRITER! -;;; (define (engine-add-writer! e ident pred upred opt before action after class valid) (define (check-procedure name proc arity) (cond @@ -233,14 +264,27 @@ otherwise the requested engine is returned." (slot-set! e 'writers (cons n (slot-ref e 'writers))) n)) -;;; ====================================================================== + + ;;; -;;; I N I T S +;;; Current engine. ;;; -;;; ====================================================================== -;; A base engine must pre-exist before anything is loaded. In -;; particular, this dummy base engine is used to load the actual -;; definition of base. +;;; `(skribilo module)' must be loaded before the first `find-engine' call. +(use-modules (skribilo module)) + +;; At this point, we're almost done with the bootstrap process. +(format #t "base engine: ~a~%" (lookup-engine 'base)) + +(define *current-engine* + ;; By default, use the HTML engine. + (make-parameter (lookup-engine 'html) + (lambda (val) + (cond ((symbol? val) (lookup-engine val)) + ((engine? val) val) + (else + (error "invalid value for `*current-engine*'" + val)))))) + -(make-engine 'base :version 'bootstrap) +;;; engine.scm ends here diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm index 6e0dc85..01708c8 100644 --- a/src/guile/skribilo/engine/html.scm +++ b/src/guile/skribilo/engine/html.scm @@ -17,12 +17,15 @@ ;*=====================================================================*/ (define-skribe-module (skribilo engine html) - #:use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:))) + :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:))) ;; Keep a reference to the base engine. (define base-engine (find-engine 'base)) +(if (not (engine? base-engine)) + (error "bootstrap problem: base engine broken" base-engine)) + ;*---------------------------------------------------------------------*/ ;* html-file-default ... */ ;*---------------------------------------------------------------------*/ diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm index 36df9f9..64a3c5d 100644 --- a/src/guile/skribilo/engine/lout.scm +++ b/src/guile/skribilo/engine/lout.scm @@ -515,184 +515,183 @@ ;* lout-engine ... */ ;*---------------------------------------------------------------------*/ (define lout-engine - (default-engine-set! - (make-engine 'lout - :version 0.2 - :format "lout" - :delegate (find-engine 'base) - :filter (make-string-replace lout-encoding) - :custom `(;; The underlying Lout document type, i.e. one - ;; of `doc', `report', `book' or `slides'. - (document-type report) - - ;; Document style file include line (a string - ;; such as `@Include { doc-style.lout }') or - ;; `auto' (symbol) in which case the include - ;; file is deduced from `document-type'. - (document-include auto) - - (includes "@SysInclude { tbl }\n") - (initial-font "Palatino Base 10p") - (initial-break - ,(string-append "unbreakablefirst " - "unbreakablelast " - "hyphen adjust 1.2fx")) - - ;; The document's language, used for hyphenation - ;; and other things. - (initial-language "English") - - ;; Number of columns. - (column-number 1) - - ;; First page number. - (first-page-number 1) - - ;; Page orientation, `portrait', `landscape', - ;; `reverse-portrait' or `reverse-landscape'. - (page-orientation portrait) - - ;; For reports, whether to produce a cover - ;; sheet. The `doc-cover-sheet-proc' custom may - ;; also honor this custom for `doc' documents. - (cover-sheet? #t) - - ;; For reports, the date line. - (date-line #t) - - ;; For reports, an abstract. - (abstract #f) - - ;; For reports, title/name of the abstract. If - ;; `#f', the no abstract title will be - ;; produced. If `#t', a default name in the - ;; current language is chosen. - (abstract-title #t) - - ;; Whether to optimize pages. - (optimize-pages? #f) - - ;; For docs, the procedure that produces the - ;; Lout code for the cover sheet or title. - (doc-cover-sheet-proc - ,lout-make-doc-cover-sheet) - - ;; Procedure used to sort bibliography - ;; references when several are referred to at - ;; the same time, as in: - ;; (ref :bib '("smith03" "jones98")) . - ;; By default they are sorted by number. If - ;; `#f' is given, they are left as is. - (bib-refs-sort-proc - ,lout-bib-refs-sort/number) - - ;; Lout code for paragraph gaps (similar to - ;; `@PP' with `@ParaGap' equal to `1.0vx' by - ;; default) - (paragraph-gap - "\n//1.0vx @ParaIndent @Wide &{0i}\n") - - ;; For multi-page tables, it may be - ;; useful to set this to `#t'. However, - ;; this looks kind of buggy. - (use-header-rows? #f) - - ;; Tells whether to use Skribe's footnote - ;; numbers or Lout's numbering scheme (the - ;; latter may be better, typography-wise). - (use-skribe-footnote-numbers? #t) - - ;; A procedure that is passed the engine - ;; and produces Lout definitions. - (inline-definitions-proc ,lout-definitions) - - ;; A procedure that takes a URL `ref' markup and - ;; returns a list containing (maybe) one such - ;; `ref' markup. This custom can be used to - ;; modified the way URLs are rendered. The - ;; default value is a procedure that limits the - ;; size of Lout's @ExternalLink symbols since - ;; they are unbreakable. In order to completely - ;; disable use of @ExternalLinks, just set it to - ;; `markup-body'. - (transform-url-ref-proc - ,lout-split-external-link) - - ;; Leader used in the table of contents entries. - (toc-leader ".") - - ;; Inter-leader spacing in the TOC entries. - (toc-leader-space "2.5s") - - ;; Procedure that takes a large-scale structure - ;; (chapter, section, etc.) and the engine and - ;; produces the number and possibly title of - ;; this structure for use the TOC. - (toc-entry-proc ,lout-make-toc-entry) - - ;; The Lout program name, only useful when using - ;; `lout-illustration' on other back-ends. - (lout-program-name "lout") - - ;; Title and author information in the PDF - ;; document information. If `#t', the - ;; document's `:title' and `:author' are used. - (pdf-title #t) - (pdf-author #t) - - ;; Keywords (a list of string) in the PDF - ;; document information. - (pdf-keywords #f) - - ;; Extra PDF information, an alist of key-value - ;; pairs (string pairs). - (pdf-extra-info (("SkribeVersion" - ,(skribe-release)))) - - ;; Tells whether to produce PDF "docinfo" - ;; (meta-information with title, author, - ;; keywords, etc.). - (make-pdf-docinfo? #t) - - ;; Tells whether a PDF outline - ;; (aka. "bookmarks") should be produced. - (make-pdf-outline? #t) - - ;; Procedure that takes a node and an engine and - ;; return a string representing the title of - ;; that node's PDF bookmark. - (pdf-bookmark-title-proc ,lout-pdf-bookmark-title) - - ;; Procedure that takes a node and an engine and - ;; returns true if that node should have a PDF - ;; outline entry. - (pdf-bookmark-node-pred ,lout-pdf-bookmark-node?) - - ;; Procedure that takes a node and an engine and - ;; returns true if the bookmark for that node - ;; should be closed ("folded") when the user - ;; opens the PDF document. - (pdf-bookmark-closed-pred - ,(lambda (n e) - (not (is-markup? n 'chapter)))) - - ;; color - (color? #t) - - ;; source fontification - (source-color #t) - (source-comment-color "#ffa600") - (source-define-color "#6959cf") - (source-module-color "#1919af") - (source-markup-color "#1919af") - (source-thread-color "#ad4386") - (source-string-color "red") - (source-bracket-color "red") - (source-type-color "#00cf00")) - - :symbol-table (lout-symbol-table - (lambda (m) - (format #f "@Eq { ~a }\n" m)))))) + (make-engine 'lout + :version 0.2 + :format "lout" + :delegate (find-engine 'base) + :filter (make-string-replace lout-encoding) + :custom `(;; The underlying Lout document type, i.e. one + ;; of `doc', `report', `book' or `slides'. + (document-type report) + + ;; Document style file include line (a string + ;; such as `@Include { doc-style.lout }') or + ;; `auto' (symbol) in which case the include + ;; file is deduced from `document-type'. + (document-include auto) + + (includes "@SysInclude { tbl }\n") + (initial-font "Palatino Base 10p") + (initial-break + ,(string-append "unbreakablefirst " + "unbreakablelast " + "hyphen adjust 1.2fx")) + + ;; The document's language, used for hyphenation + ;; and other things. + (initial-language "English") + + ;; Number of columns. + (column-number 1) + + ;; First page number. + (first-page-number 1) + + ;; Page orientation, `portrait', `landscape', + ;; `reverse-portrait' or `reverse-landscape'. + (page-orientation portrait) + + ;; For reports, whether to produce a cover + ;; sheet. The `doc-cover-sheet-proc' custom may + ;; also honor this custom for `doc' documents. + (cover-sheet? #t) + + ;; For reports, the date line. + (date-line #t) + + ;; For reports, an abstract. + (abstract #f) + + ;; For reports, title/name of the abstract. If + ;; `#f', the no abstract title will be + ;; produced. If `#t', a default name in the + ;; current language is chosen. + (abstract-title #t) + + ;; Whether to optimize pages. + (optimize-pages? #f) + + ;; For docs, the procedure that produces the + ;; Lout code for the cover sheet or title. + (doc-cover-sheet-proc + ,lout-make-doc-cover-sheet) + + ;; Procedure used to sort bibliography + ;; references when several are referred to at + ;; the same time, as in: + ;; (ref :bib '("smith03" "jones98")) . + ;; By default they are sorted by number. If + ;; `#f' is given, they are left as is. + (bib-refs-sort-proc + ,lout-bib-refs-sort/number) + + ;; Lout code for paragraph gaps (similar to + ;; `@PP' with `@ParaGap' equal to `1.0vx' by + ;; default) + (paragraph-gap + "\n//1.0vx @ParaIndent @Wide &{0i}\n") + + ;; For multi-page tables, it may be + ;; useful to set this to `#t'. However, + ;; this looks kind of buggy. + (use-header-rows? #f) + + ;; Tells whether to use Skribe's footnote + ;; numbers or Lout's numbering scheme (the + ;; latter may be better, typography-wise). + (use-skribe-footnote-numbers? #t) + + ;; A procedure that is passed the engine + ;; and produces Lout definitions. + (inline-definitions-proc ,lout-definitions) + + ;; A procedure that takes a URL `ref' markup and + ;; returns a list containing (maybe) one such + ;; `ref' markup. This custom can be used to + ;; modified the way URLs are rendered. The + ;; default value is a procedure that limits the + ;; size of Lout's @ExternalLink symbols since + ;; they are unbreakable. In order to completely + ;; disable use of @ExternalLinks, just set it to + ;; `markup-body'. + (transform-url-ref-proc + ,lout-split-external-link) + + ;; Leader used in the table of contents entries. + (toc-leader ".") + + ;; Inter-leader spacing in the TOC entries. + (toc-leader-space "2.5s") + + ;; Procedure that takes a large-scale structure + ;; (chapter, section, etc.) and the engine and + ;; produces the number and possibly title of + ;; this structure for use the TOC. + (toc-entry-proc ,lout-make-toc-entry) + + ;; The Lout program name, only useful when using + ;; `lout-illustration' on other back-ends. + (lout-program-name "lout") + + ;; Title and author information in the PDF + ;; document information. If `#t', the + ;; document's `:title' and `:author' are used. + (pdf-title #t) + (pdf-author #t) + + ;; Keywords (a list of string) in the PDF + ;; document information. + (pdf-keywords #f) + + ;; Extra PDF information, an alist of key-value + ;; pairs (string pairs). + (pdf-extra-info (("SkribeVersion" + ,(skribe-release)))) + + ;; Tells whether to produce PDF "docinfo" + ;; (meta-information with title, author, + ;; keywords, etc.). + (make-pdf-docinfo? #t) + + ;; Tells whether a PDF outline + ;; (aka. "bookmarks") should be produced. + (make-pdf-outline? #t) + + ;; Procedure that takes a node and an engine and + ;; return a string representing the title of + ;; that node's PDF bookmark. + (pdf-bookmark-title-proc ,lout-pdf-bookmark-title) + + ;; Procedure that takes a node and an engine and + ;; returns true if that node should have a PDF + ;; outline entry. + (pdf-bookmark-node-pred ,lout-pdf-bookmark-node?) + + ;; Procedure that takes a node and an engine and + ;; returns true if the bookmark for that node + ;; should be closed ("folded") when the user + ;; opens the PDF document. + (pdf-bookmark-closed-pred + ,(lambda (n e) + (not (is-markup? n 'chapter)))) + + ;; color + (color? #t) + + ;; source fontification + (source-color #t) + (source-comment-color "#ffa600") + (source-define-color "#6959cf") + (source-module-color "#1919af") + (source-markup-color "#1919af") + (source-thread-color "#ad4386") + (source-string-color "red") + (source-bracket-color "red") + (source-type-color "#00cf00")) + + :symbol-table (lout-symbol-table + (lambda (m) + (format #f "@Eq { ~a }\n" m))))) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index def3280..bbf92e3 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -1,7 +1,6 @@ +;;; eval.scm -- Skribilo evaluator. ;;; -;;; eval.stk -- Skribe Evaluator -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> ;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; @@ -19,26 +18,24 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA. -;;; - - - -;; FIXME; On peut implémenter maintenant skribe-warning/node (define-module (skribilo evaluator) :export (skribe-eval skribe-eval-port skribe-load skribe-load-options - skribe-include)) + skribe-include) + :autoload (skribilo parameters) (*verbose*) + :autoload (skribilo location) (<location>) + :autoload (skribilo ast) (ast? markup?) + :autoload (skribilo engine) (engine? find-engine engine-ident) + :autoload (skribilo reader) (%default-reader) + + :autoload (skribilo verify) (verify) + :autoload (skribilo resolve) (resolve!)) + (use-modules (skribilo debug) - (skribilo reader) - (skribilo engine) - (skribilo verify) - (skribilo resolve) (skribilo output) - (skribilo types) (skribilo lib) - (skribilo vars) (ice-9 optargs) (oop goops) @@ -94,8 +91,10 @@ (let ((e (if (symbol? engine) (find-engine engine) engine))) (debug-item "e=" e) - (if (not (is-a? e <engine>)) - (skribe-error 'skribe-eval-port "cannot find engine" engine) + (if (not (engine? e)) + (begin + (format #t "engine: ~a~%" e) + (skribe-error 'skribe-eval-port "cannot find engine" engine)) (let loop ((exp (reader port))) (with-debug 10 'skribe-eval-port (debug-item "exp=" exp)) @@ -106,6 +105,8 @@ ;;; ;;; SKRIBE-LOAD ;;; + +;;; FIXME: Use a fluid for that. (define *skribe-load-options* '()) (define (skribe-load-options) @@ -117,13 +118,7 @@ (debug-item " path=" path) (debug-item " opt=" opt) - (let* ((ei (cond - ((not engine) *skribe-engine*) - ((engine? engine) engine) - ((not (symbol? engine)) - (skribe-error 'skribe-load - "illegal engine" engine)) - (else engine))) + (let* ((ei (*current-engine*)) (path (append (cond ((not path) (skribe-path)) ((string? path) (list path)) @@ -151,9 +146,9 @@ ;; Load this file if not already done (unless (member filep *skribe-loaded*) (cond - ((> *skribe-verbose* 1) + ((> (*verbose*) 1) (format (current-error-port) " [loading file: ~S ~S]\n" filep opt)) - ((> *skribe-verbose* 0) + ((> (*verbose*) 0) (format (current-error-port) " [loading file: ~S]\n" filep))) ;; Load it (with-input-from-file filep @@ -173,7 +168,7 @@ (skribe-error 'skribe-load (format #t "cannot find ~S in path" file) path)) - (when (> *skribe-verbose* 0) + (when (> (*verbose*) 0) (format (current-error-port) " [including file: ~S]\n" path)) (with-input-from-file path diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index 2961fc6..b15960e 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -2,6 +2,7 @@ ;;; lib.scm -- Utilities ;;; ;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -26,37 +27,9 @@ skribe-type-error skribe-warning skribe-warning/ast skribe-message - - ;; paths as lists of directories - - %skribilo-load-path - %skribilo-image-path %skribilo-bib-path %skribilo-source-path - - ;; compatibility - - skribe-path skribe-path-set! - skribe-image-path skribe-image-path-set! - skribe-bib-path skribe-bib-path-set! - skribe-source-path skribe-source-path-set! - - ;; various utilities for compatiblity - - substring=? - file-suffix file-prefix prefix suffix - directory->list find-file/path - printf fprintf - any? every? - process-input-port process-output-port process-error-port - %procedure-arity - - make-hashtable hashtable? - hashtable-get hashtable-put! hashtable-update! - hashtable->list - skribe-read - find-runtime-type - date) + %procedure-arity) :export-syntax (new define-markup define-simple-markup define-simple-container define-processor-markup @@ -65,12 +38,16 @@ unwind-protect unless when) :use-module (skribilo config) - :use-module (skribilo types) + :use-module (skribilo ast) + + ;; useful for `new' to work well with <language> + :autoload (skribilo source) (<language>) + :use-module (skribilo reader) - :use-module (skribilo vars) + :use-module (skribilo parameters) + :use-module (skribilo location) :use-module (srfi srfi-1) - :use-module ((srfi srfi-19) :renamer (symbol-prefix-proc 's19:)) ;; date :use-module (oop goops) :use-module (ice-9 optargs)) @@ -81,11 +58,11 @@ ;;; NEW ;;; -(define %types-module (resolve-module '(skribilo types))) +(define %types-module (current-module)) (define-macro (new class . parameters) ;; Thanks to the trick below, modules don't need to import `(oop goops)' - ;; and `(skribilo types)' in order to make use of `new'. + ;; and `(skribilo ast)' in order to make use of `new'. (let* ((class-name (symbol-append '< class '>)) (actual-class (module-ref %types-module class-name))) `(let ((make ,make) @@ -221,12 +198,12 @@ (define (skribe-warning level . obj) - (if (>= *skribe-warning* level) + (if (>= (*warning*) level) (%skribe-warn level #f #f obj))) (define (skribe-warning/ast level ast . obj) - (if (>= *skribe-warning* level) + (if (>= (*warning*) level) (let ((l (ast-loc ast))) (if (location? l) (%skribe-warn level (location-file l) (location-line l) obj) @@ -236,27 +213,9 @@ ;;; SKRIBE-MESSAGE ;;; (define (skribe-message fmt . obj) - (when (> *skribe-verbose* 0) + (when (> (*verbose*) 0) (apply format (current-error-port) fmt obj))) -;;; -;;; FILE-PREFIX / FILE-SUFFIX -;;; -(define (file-prefix fn) - (if fn - (let ((match (regexp-match "(.*)\\.([^/]*$)" fn))) - (if match - (cadr match) - fn)) - "./SKRIBE-OUTPUT")) - -(define (file-suffix s) - ;; Not completely correct, but sufficient here - (let* ((basename (regexp-replace "^(.*)/(.*)$" s "\\2")) - (split (string-split basename "."))) - (if (> (length split) 1) - (car (reverse! split)) - ""))) ;;; @@ -289,87 +248,6 @@ (else (Loop (cdr l)))))) - - -;;; ====================================================================== -;;; -;;; A C C E S S O R S -;;; -;;; ====================================================================== - - -(define %skribilo-load-path (list (skribilo-default-path) ".")) -(define %skribilo-image-path '(".")) -(define %skribilo-bib-path '(".")) -(define %skribilo-source-path '(".")) - -(define-macro (define-compatibility-accessors var oldname) - (let ((newname (symbol-append '%skribilo- var)) - (setter (symbol-append oldname '-set!))) - `(begin - (define (,oldname) ,newname) - (define (,setter path) - (if (not (and (list? path) (every string? path))) - (skribe-error ',setter "illegal path" path) - (set! ,newname path)))))) - -(define-compatibility-accessors load-path skribe-path) -(define-compatibility-accessors image-path skribe-image-path) -(define-compatibility-accessors bib-path skribe-bib-path) -(define-compatibility-accessors source-path skribe-source-path) - - - -;;; ====================================================================== -;;; -;;; Compatibility with Bigloo -;;; -;;; ====================================================================== - -(define (substring=? s1 s2 len) - (let ((l1 (string-length s1)) - (l2 (string-length s2))) - (let Loop ((i 0)) - (cond - ((= i len) #t) - ((= i l1) #f) - ((= i l2) #f) - ((char=? (string-ref s1 i) (string-ref s2 i)) (Loop (+ i 1))) - (else #f))))) - -(define (directory->list str) - (map basename (glob (string-append str "/*") (string-append "/.*")))) - -(define-macro (printf . args) `(format #t ,@args)) -(define fprintf format) - - -(define prefix file-prefix) -(define suffix file-suffix) -(define system->string system) ;; FIXME -(define any? any) -(define every? every) -(define find-file/path (lambda (. args) - (format #t "find-file/path: ~a~%" args) - #f)) -(define process-input-port #f) ;process-input) -(define process-output-port #f) ;process-output) -(define process-error-port #f) ;process-error) - - -;;; -;;; h a s h t a b l e s -;;; -(define make-hashtable make-hash-table) -(define hashtable? hash-table?) -(define hashtable-get (lambda (h k) (hash-ref h k #f))) -(define hashtable-put! hash-set!) -(define hashtable-update! hash-set!) -(define hashtable->list (lambda (h) - (map cdr (hash-map->list cons h)))) - -(define find-runtime-type (lambda (obj) obj)) - ;;; ;;; Various things. @@ -396,8 +274,5 @@ (define-macro (when condition . exprs) `(if ,condition (begin ,@exprs))) -(define (date) - (s19:date->string (s19:current-date) "~c")) - ;;; lib.scm ends here diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm new file mode 100644 index 0000000..a134f8a --- /dev/null +++ b/src/guile/skribilo/location.scm @@ -0,0 +1,68 @@ +;;; location.scm -- Skribilo source location. +;;; +;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + +(define-module (skribilo location) + :use-module (oop goops) + :export (<location> location? ast-location + location-file location-line location-pos)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; An abstract data type to keep track of source locations. +;;; +;;; Code: + +(read-set! keywords 'prefix) + + +;;; +;;; Class definition. +;;; + +(define-class <location> () + (file :init-keyword :file :getter location-file) + (pos :init-keyword :pos :getter location-pos) + (line :init-keyword :line :getter location-line)) + +(define (location? obj) + (is-a? obj <location>)) + +(define (ast-location obj) + (let ((loc (slot-ref obj 'loc))) + (if (location? loc) + (let* ((fname (location-file loc)) + (line (location-line loc)) + (pwd (getcwd)) + (len (string-length pwd)) + (lenf (string-length fname)) + (file (if (and (substring=? pwd fname len) + (> lenf len)) + (substring fname len (+ 1 (string-length fname))) + fname))) + (format #f "~a, line ~a" file line)) + "no source location"))) + + +;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83 + +;;; location.scm ends here. diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index bb0c5ad..21917b2 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -20,7 +20,6 @@ (define-module (skribilo module) :use-module (skribilo reader) - :use-module (skribilo evaluator) :use-module (skribilo debug) :use-module (srfi srfi-1) :use-module (ice-9 optargs)) @@ -37,20 +36,20 @@ ;;; ;;; Code: -(define *skribilo-user-imports* +(define %skribilo-user-imports ;; List of modules that should be imported by any good Skribilo module. '((srfi srfi-1) ;; lists (srfi srfi-13) ;; strings - ;(srfi srfi-19) ;; date and time (ice-9 optargs) ;; `define*' (ice-9 and-let-star) ;; `and-let*' (ice-9 receive) ;; `receive' (skribilo module) - (skribilo types) ;; `<document>', `document?', etc. + (skribilo parameters) ;; run-time parameters + (skribilo compat) ;; `skribe-load-path', etc. + (skribilo ast) ;; `<document>', `document?', etc. (skribilo config) - (skribilo vars) - (skribilo runtime) ;; `the-options', `the-body' + (skribilo runtime) ;; `the-options', `the-body', `make-string-replace' (skribilo biblio) (skribilo lib) ;; `define-markup', `unwind-protect', etc. (skribilo resolve) @@ -78,7 +77,7 @@ ;; Pull all the bindings that Skribe code may expect, plus those needed ;; to actually create and read the module. ,(cons 'use-modules - (append *skribilo-user-imports* + (append %skribilo-user-imports (filter-map (lambda (mod) (let ((m `(skribilo skribe ,(string->symbol @@ -94,7 +93,7 @@ -(define *skribilo-user-module* #f) +(define %skribilo-user-module #f) ;;; ;;; MAKE-RUN-TIME-MODULE @@ -105,7 +104,7 @@ execution of Skribilo/Skribe code." (let ((the-module (make-module))) (for-each (lambda (iface) (module-use! the-module (resolve-module iface))) - (append *skribilo-user-imports* + (append %skribilo-user-imports (map (lambda (mod) `(skribilo skribe ,(string->symbol mod))) @@ -118,9 +117,9 @@ execution of Skribilo/Skribe code." ;;; (define-public (run-time-module) "Return the default instance of a Skribilo/Skribe run-time module." - (if (not *skribilo-user-module*) - (set! *skribilo-user-module* (make-run-time-module))) - *skribilo-user-module*) + (if (not %skribilo-user-module) + (set! %skribilo-user-module (make-run-time-module))) + %skribilo-user-module) ;; FIXME: This will eventually be replaced by the per-module reader thing in @@ -134,12 +133,11 @@ execution of Skribilo/Skribe code." ; (format #t "load-file-with-read: ~a~%" read) (let loop ((sexp (read)) (result #f)) - (if (eof-object? sexp) - result + (if (not (eof-object? sexp)) (begin ; (format #t "preparing to evaluate `~a'~%" sexp) - (loop (read) - (primitive-eval sexp))))))))) + (primitive-eval sexp) + (loop (read))))))))) (define-public (load-skribilo-file file reader-name) (load-file-with-read file (make-reader reader-name) (current-module))) diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm index 8a63a48..cbd4523 100644 --- a/src/guile/skribilo/output.scm +++ b/src/guile/skribilo/output.scm @@ -1,7 +1,6 @@ +;;;; output.scm -- Skribilo output stage. ;;;; -;;;; output.stk -- Skribe Output Stage -;;;; -;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;;; ;;;; ;;;; This program is free software; you can redistribute it and/or modify @@ -18,21 +17,15 @@ ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;;; USA. -;;;; -;;;; Author: Erick Gallesio [eg@essi.fr] -;;;; Creation date: 13-Aug-2003 18:42 (eg) -;;;; Last file update: 5-Mar-2004 10:32 (eg) -;;;; + (define-module (skribilo output) - :export (output)) - -(use-modules (skribilo debug) - (skribilo types) -; (skribilo engine) - (skribilo writer) - (skribilo lib) ;; `when', `unless' - (oop goops)) + :export (output) + :use-module (skribilo ast) + :use-module (skribilo writer) + :use-module (skribilo lib) + :use-module (skribilo debug) + :use-module (oop goops)) (define-generic out) diff --git a/src/guile/skribilo/parameters.scm b/src/guile/skribilo/parameters.scm new file mode 100644 index 0000000..d8b259f --- /dev/null +++ b/src/guile/skribilo/parameters.scm @@ -0,0 +1,65 @@ +;;; parameters.scm -- Skribilo settings as parameter objects. +;;; +;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + +(define-module (skribilo parameters) + :use-module (srfi srfi-39)) + +;;; Author: Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module defines parameter objects that may be used to specify +;;; run-time parameters of a Skribilo process. +;;; +;;; Code: + + +;;; +;;; Switches. +;;; + +(define-public *verbose* (make-parameter #f)) +(define-public *warning* (make-parameter 5)) +(define-public *load-rc-file?* (make-parameter #f)) + +;;; +;;; Paths. +;;; + +(define-public *document-path* (make-parameter (list "."))) +(define-public *bib-path* (make-parameter (list "."))) +(define-public *source-path* (make-parameter (list "."))) +(define-public *image-path* (make-parameter (list "."))) + +;;; +;;; Files. +;;; + +(define-public *destination-file* (make-parameter "output.html")) +(define-public *source-file* (make-parameter "default-input-file.skb")) + + +;;; TODO: Skribe used to have other parameters as global variables. See +;;; which ones need to be kept. + + +;;; arch-tag: 3c0d2e18-b997-4615-8a3d-b6622ae28874 + +;;; parameters.scm ends here diff --git a/src/guile/skribilo/reader/skribe.scm b/src/guile/skribilo/reader/skribe.scm index 714f19e..5c71cc1 100644 --- a/src/guile/skribilo/reader/skribe.scm +++ b/src/guile/skribilo/reader/skribe.scm @@ -37,6 +37,7 @@ ;;; ;;; Code: +;;; Note: We need guile-reader 0.2 at least. (define* (make-skribe-reader #:optional (version "1.2d")) "Return a Skribe reader (a procedure) suitable for version @var{version} of diff --git a/src/guile/skribilo/resolve.scm b/src/guile/skribilo/resolve.scm index a39bb77..7075f2d 100644 --- a/src/guile/skribilo/resolve.scm +++ b/src/guile/skribilo/resolve.scm @@ -27,7 +27,7 @@ (define-module (skribilo resolve) :use-module (skribilo debug) :use-module (skribilo runtime) - :use-module (skribilo types) + :use-module (skribilo ast) :use-module (skribilo lib) ;; `unless' and `when' :use-module (oop goops) diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm index 03e515c..d4be2e9 100644 --- a/src/guile/skribilo/runtime.scm +++ b/src/guile/skribilo/runtime.scm @@ -1,8 +1,8 @@ ;;; -;;; runtime.stk -- Skribe runtime system +;;; runtime.scm -- Skribilo runtime system ;;; ;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; +;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -18,46 +18,22 @@ ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ;;; USA. -;;; -;;; Author: Erick Gallesio [eg@essi.fr] -;;; Creation date: 13-Aug-2003 18:47 (eg) -;;; Last file update: 15-Nov-2004 14:03 (eg) -;;; (define-module (skribilo runtime) ;; FIXME: Useful procedures are scattered between here and ;; `(skribilo skribe utils)'. :export (;; Utilities - strip-ref-base ast->file-location string-canonicalize - - ;; Markup functions - markup-option markup-option-add! markup-output + strip-ref-base string-canonicalize - ;; Container functions - container-env-get ;; Images convert-image ;; String writing - make-string-replace - - ;; AST - ast-parent ast->string - markup-parent markup-document markup-chapter - - handle-body)) - -(use-modules (skribilo debug) - (skribilo types) - (skribilo verify) - (skribilo resolve) - (skribilo output) - (skribilo evaluator) - (skribilo vars) - (skribilo lib) - (srfi srfi-13) - (oop goops)) + make-string-replace) + :use-module (skribilo parameters) + :use-module (skribilo lib) + :use-module (srfi srfi-13)) @@ -70,13 +46,13 @@ ;;FIXME: Remonter cette fonction (define (strip-ref-base file) - (if (not (string? *skribe-ref-base*)) + (if (not (string? (*ref-base*))) file - (let ((l (string-length *skribe-ref-base*))) + (let ((l (string-length (*ref-base*)))) (cond ((not (> (string-length file) (+ l 2))) file) - ((not (substring=? file *skribe-ref-base* l)) + ((not (substring=? file (*ref-base*) l)) file) ((not (char=? (string-ref file l) (file-separator))) file) @@ -84,12 +60,6 @@ (substring file (+ l 1) (string-length file))))))) -(define (ast->file-location ast) - (let ((l (ast-loc ast))) - (if (location? l) - (format "~a:~a:" (location-file l) (location-line l)) - ""))) - ;; FIXME: Remonter cette fonction (define (string-canonicalize old) (let* ((l (string-length old)) @@ -123,58 +93,6 @@ (loop (+ r 1) (+ w 1) #f)))))) -;;; ====================================================================== -;;; -;;; M A R K U P S F U N C T I O N S -;;; -;;; ====================================================================== -;; (define (markup-output markup -;; :optional (engine #f) -;; :key (predicate #f) -;; (options '()) -;; (before #f) -;; (action #f) -;; (after #f)) -;; (let ((e (or engine (use-engine)))) -;; (cond -;; ((not (is-a? e <engine>)) -;; (skribe-error 'markup-writer "illegal engine" e)) -;; ((and (not before) -;; (not action) -;; (not after)) -;; (%find-markup-output e markup)) -;; (else -;; (let ((mp (if (procedure? predicate) -;; (lambda (n e) (and (is-markup? n markup) (predicate n e))) -;; (lambda (n e) (is-markup? n markup))))) -;; (engine-output e markup mp options -;; (or before (slot-ref e 'default-before)) -;; (or action (slot-ref e 'default-action)) -;; (or after (slot-ref e 'default-after)))))))) - -(define (markup-option m opt) - (if (markup? m) - (let ((c (assq opt (slot-ref m 'options)))) - (and (pair? c) (pair? (cdr c)) - (cadr c))) - (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) - - -(define (markup-option-add! m opt val) - (if (markup? m) - (slot-set! m 'options (cons (list opt val) - (slot-ref m 'options))) - (skribe-type-error 'markup-option "Illegal markup: " m "markup"))) - -;;; ====================================================================== -;;; -;;; C O N T A I N E R S -;;; -;;; ====================================================================== -(define (container-env-get m key) - (let ((c (assq key (slot-ref m 'env)))) - (and (pair? c) (cadr c)))) - ;;; ====================================================================== ;;; @@ -195,9 +113,9 @@ (string-append "fig2dev -L " fmt " " from " > " to) (string-append "convert " from " " to)))) (cond - ((> *skribe-verbose* 1) + ((> (*verbose*) 1) (format (current-error-port) " [converting image: ~S (~S)]" from c)) - ((> *skribe-verbose* 0) + ((> (*verbose*) 0) (format (current-error-port) " [converting image: ~S]" from))) (and (zero? (system c)) to)))))) @@ -210,8 +128,8 @@ (skribe-image-path)) (let ((suf (suffix file))) (if (member suf formats) - (let* ((dir (if (string? *skribe-dest*) - (dirname *skribe-dest*) + (let* ((dir (if (string? (*destination-file*)) + (dirname (*destination-file*)) #f))) (if dir (let ((dest (basename path))) @@ -221,8 +139,8 @@ (let loop ((fmts formats)) (if (null? fmts) #f - (let* ((dir (if (string? *skribe-dest*) - (dirname *skribe-dest*) + (let* ((dir (if (string? (*destination-file*)) + (dirname (*destination-file*)) ".")) (p (builtin-convert-image path (car fmts) dir))) (if (string? p) @@ -282,123 +200,3 @@ - -;;; ====================================================================== -;;; -;;; O P T I O N S -;;; -;;; ====================================================================== - -;;NEW ;; -;;NEW ;; GET-OPTION -;;NEW ;; -;;NEW (define (get-option obj key) -;;NEW ;; This function either searches inside an a-list or a markup. -;;NEW (cond -;;NEW ((pair? obj) (let ((c (assq key obj))) -;;NEW (and (pair? c) (pair? (cdr c)) (cadr c)))) -;;NEW ((markup? obj) (get-option (slot-ref obj 'option*) key)) -;;NEW (else #f))) -;;NEW -;;NEW ;; -;;NEW ;; BIND-OPTION! -;;NEW ;; -;;NEW (define (bind-option! obj key value) -;;NEW (slot-set! obj 'option* (cons (list key value) -;;NEW (slot-ref obj 'option*)))) -;;NEW -;;NEW -;;NEW ;; -;;NEW ;; GET-ENV -;;NEW ;; -;;NEW (define (get-env obj key) -;;NEW ;; This function either searches inside an a-list or a container -;;NEW (cond -;;NEW ((pair? obj) (let ((c (assq key obj))) -;;NEW (and (pair? c) (cadr c)))) -;;NEW ((container? obj) (get-env (slot-ref obj 'env) key)) -;;NEW (else #f))) -;;NEW - - - - -;;; ====================================================================== -;;; -;;; A S T -;;; -;;; ====================================================================== - -(define-generic ast->string) - - -(define-method (ast->string (ast <top>)) "") -(define-method (ast->string (ast <string>)) ast) -(define-method (ast->string (ast <number>)) (number->string ast)) - -(define-method (ast->string (ast <pair>)) - (let ((out (open-output-string))) - (let Loop ((lst ast)) - (cond - ((null? lst) - (get-output-string out)) - (else - (display (ast->string (car lst)) out) - (unless (null? (cdr lst)) - (display #\space out)) - (Loop (cdr lst))))))) - -(define-method (ast->string (ast <node>)) - (ast->string (slot-ref ast 'body))) - - - -;; -;; AST-PARENT -;; -(define (ast-parent n) - (slot-ref n 'parent)) - -;; -;; MARKUP-PARENT -;; -(define (markup-parent m) - (let ((p (slot-ref m 'parent))) - (if (eq? p 'unspecified) - (skribe-error 'markup-parent "Unresolved parent reference" m) - p))) - - -;; -;; MARKUP-DOCUMENT -;; -(define (markup-document m) - (let Loop ((p m) - (l #f)) - (cond - ((is-markup? p 'document) p) - ((or (eq? p 'unspecified) (not p)) l) - (else (Loop (slot-ref p 'parent) p))))) - -;; -;; -;; MARKUP-CHAPTER -;; -(define (markup-chapter m) - (let loop ((p m) - (l #f)) - (cond - ((is-markup? p 'chapter) p) - ((or (eq? p 'unspecified) (not p)) l) - (else (loop (slot-ref p 'parent) p))))) - - - -;;;; ====================================================================== -;;;; -;;;; H A N D L E S -;;;; -;;;; ====================================================================== -(define (handle-body h) - (slot-ref h 'body)) - diff --git a/src/guile/skribilo/source.scm b/src/guile/skribilo/source.scm index e03deae..bd523f2 100644 --- a/src/guile/skribilo/source.scm +++ b/src/guile/skribilo/source.scm @@ -1,4 +1,3 @@ -;;;; ;;;; source.scm -- Highlighting source files. ;;;; ;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> @@ -22,16 +21,33 @@ ;;;; - (define-module (skribilo source) - :export (source-read-lines source-read-definition source-fontify) - :use-module (skribilo types) - :use-module (skribilo vars) + :export (<language> language? language-extractor language-fontifier + source-read-lines source-read-definition source-fontify) + :use-module (skribilo parameters) :use-module (skribilo lib) + :use-module (oop goops) :use-module (ice-9 rdelim)) +(read-set! keywords 'prefix) + + +;;; +;;; Class definition. +;;; + +(define-class <language> () + (name :init-keyword :name :init-value #f :getter langage-name) + (fontifier :init-keyword :fontifier :init-value #f + :getter language-fontifier) + (extractor :init-keyword :extractor :init-value #f + :getter language-extractor)) + +(define (language? obj) + (is-a? obj <language>)) + ;*---------------------------------------------------------------------*/ ;* source-read-lines ... */ ;*---------------------------------------------------------------------*/ @@ -43,7 +59,7 @@ (skribe-source-path)) (with-input-from-file p (lambda () - (if (> *skribe-verbose* 0) + (if (> (*verbose*) 0) (format (current-error-port) " [source file: ~S]\n" p)) (let ((startl (if (string? start) (string-length start) -1)) (stopl (if (string? stop) (string-length stop) -1))) @@ -125,7 +141,7 @@ (skribe-source-path))) (else (let ((ip (open-input-file p))) - (if (> *skribe-verbose* 0) + (if (> (*verbose*) 0) (format (current-error-port) " [source file: ~S]\n" p)) (if (not (input-port? ip)) (skribe-error 'source "Can't open file for input" p) diff --git a/src/guile/skribilo/vars.scm b/src/guile/skribilo/vars.scm deleted file mode 100644 index 4877e78..0000000 --- a/src/guile/skribilo/vars.scm +++ /dev/null @@ -1,66 +0,0 @@ -;;; -;;; vars.scm -- Skribe Globals -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> -;;; -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2 of the License, or -;;; (at your option) any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, -;;; USA. - - -(define-module (skribilo vars)) - -;;; -;;; Switches -;;; -(define-public *skribe-verbose* 0) -(define-public *skribe-warning* 5) -(define-public *load-rc* #t) - - -;;; -;;; PATH variables -;;; -(define-public *skribe-path* #f) -(define-public *skribe-bib-path* '(".")) -(define-public *skribe-source-path* '(".")) -(define-public *skribe-image-path* '(".")) - - -(define-public *skribe-rc-directory* - (string-append (getenv "HOME") "/" ".skribilo")) - - -;;; -;;; In and out ports -;;; -(define-public *skribe-src* '()) -(define-public *skribe-dest* #f) - -;;; -;;; Engine -;;; -(define-public *skribe-engine* 'html) ;; Use HTML by default - -;;; -;;; Misc -;;; -(define-public *skribe-chapter-split* '()) -(define-public *skribe-ref-base* #f) -(define-public *skribe-convert-image* #f) ;; i.e. use the Skribe standard converter -(define-public *skribe-variants* '()) - - diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 0f9e053..aa2dd78 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -31,7 +31,7 @@ (skribilo engine) (skribilo writer) (skribilo runtime) - (skribilo types) + (skribilo ast) (skribilo lib) ;; `when', `unless' (oop goops)) diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm index abfb10c..b393c5c 100644 --- a/src/guile/skribilo/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -26,25 +26,57 @@ (define-module (skribilo writer) - :export (invoke markup-writer markup-writer-get markup-writer-get* - lookup-markup-writer copy-markup-writer)) + :export (<writer> writer? write-object writer-options writer-ident + writer-before writer-action writer-after writer-class + + invoke markup-writer markup-writer-get markup-writer-get* + lookup-markup-writer copy-markup-writer) + + :autoload (skribilo engine) (engine? engine-ident? default-engine)) (use-modules (skribilo debug) - (skribilo engine) (skribilo output) - (skribilo types) + (skribilo ast) (skribilo lib) (oop goops) (ice-9 optargs)) -;;;; ====================================================================== -;;;; -;;;; INVOKE -;;;; -;;;; ====================================================================== + +;;; +;;; Class definition. +;;; + +(define-class <writer> () + (ident :init-keyword :ident :init-value '??? :getter writer-ident) + (class :init-keyword :class :init-value 'unspecified + :getter writer-class) + (pred :init-keyword :pred :init-value 'unspecified) + (upred :init-keyword :upred :init-value 'unspecified) + (options :init-keyword :options :init-value '() :getter writer-options) + (verified? :init-keyword :verified? :init-value #f) + (validate :init-keyword :validate :init-value #f) + (before :init-keyword :before :init-value #f :getter writer-before) + (action :init-keyword :action :init-value #f :getter writer-action) + (after :init-keyword :after :init-value #f :getter writer-after)) + +(define (writer? obj) + (is-a? obj <writer>)) + +(define-method (write-object (obj <writer>) port) + (format port "#[~A (~A) ~A]" + (class-name (class-of obj)) + (slot-ref obj 'ident) + (address-of obj))) + + + +;;; +;;; Writer methods. +;;; + (define (invoke proc node e) (with-debug 5 'invoke (debug-item "e=" (engine-ident e)) @@ -56,11 +88,6 @@ (proc node e))))) -;;;; ====================================================================== -;;;; -;;;; LOOKUP-MARKUP-WRITER -;;;; -;;;; ====================================================================== (define (lookup-markup-writer node e) (let ((writers (slot-ref e 'writers)) (delegate (slot-ref e 'delegate))) @@ -76,11 +103,6 @@ (else #f))))) -;;;; ====================================================================== -;;;; -;;;; MAKE-WRITER-PREDICATE -;;;; -;;;; ====================================================================== (define (make-writer-predicate markup predicate class) (let* ((t1 (if (symbol? markup) (lambda (n e) (is-markup? n markup)) @@ -165,11 +187,6 @@ options before ac after class validate)))))) -;;;; ====================================================================== -;;;; -;;;; MARKUP-WRITER-GET -;;;; -;;;; ====================================================================== (define* (markup-writer-get markup :optional engine :key (class #f) (pred #f)) (let ((e (or engine (default-engine)))) (cond @@ -193,14 +210,8 @@ (else #f)))))))) -;;;; ====================================================================== -;;;; -;;;; MARKUP-WRITER-GET* -;;;; -;;;; ====================================================================== ;; Finds all writers that matches MARKUP with optional CLASS attribute. - (define* (markup-writer-get* markup #:optional engine #:key (class #f)) (let ((e (or engine (default-engine)))) (cond @@ -224,11 +235,6 @@ (else (reverse! res))))))))) -;;; ====================================================================== -;;;; -;;;; COPY-MARKUP-WRITER -;;;; -;;;; ====================================================================== (define* (copy-markup-writer markup old-engine :optional new-engine :key (predicate 'unspecified) (class 'unspecified) @@ -247,3 +253,5 @@ :before (if (unspecified? before) (slot-ref old 'before) before) :action (if (unspecified? action) (slot-ref old 'action) action) :after (if (unspecified? after) (slot-ref old 'after) after)))) + +;;; writer.scm ends here |